Предыстория:
Часто возникает вопрос можно ли выполнить некоторые специфичные действия (не являющиеся подмножеством DDL для IB),
но от этого немение необходимые.
Навеяно одним из тредов в эхо конференции news:epsylon.public.interbase.
В этой статье я попробую рассмотреть вопрос управления пользователем из программ,
не написанных на языке Delphi и не имеющим компонентов прямого доступа.
Реализация:
В качестве реализации попробуем использовать внешний COM сервер.
Опишем внешний COM интерфейс (рисунок 1):

Посмотрим на реализацию класс ibUsersInfo:
TibUsersInfo = class(TAutoObject, IibUsersInfo)
private
ibsUsers: TIBSecurityService;
FLastError: string;
FServerName,
FUser,
FPsw: string;
FProtocol: TProtocol;
// Сброс описания последний ошибки
procedure ResetError;
// Сформировать сообщение об ошибке
procedure FormatException(cmd:string;e:Exception);
// Установить параметры подключнеия
procedure SetParam;
// Вывести отладочную информацию
procedure AddDebug(str:string);
protected
// описание интерфейса IibUsersInfo
procedure SetConnectInfo(const Host, User, Psw: WideString;
Prot: enIBProtocol); safecall;
function AddUser(const UserName, Password, FirstName, MiddleName,
LastName: WideString; UserID, GroupID: SYSINT): WordBool; safecall;
function DeleteUser(const UserName: WideString): WordBool; safecall;
function GetUsersInfo(var Info: OleVariant): WordBool; safecall;
function GetLastError: WideString; safecall;
public
// вместо конструктора для TAutoObject - содание внутренних
обьектов
procedure
Initialize; override;
//
освобождение созданых внутрених обьектов в десрукторе
destructor
destroy; override;
end;
Использование данного класса подразумевает следующую стратегию:
- Устанавливаются параметры соединения
- Выполняется функция
- При необходимости выполняется следующая функция и так далее.
Рассмотрим основные функции интерфейса:
Установка параметров соединения все параметры запоминаются во внутренних переменных - членах класса.
procedure TibUsersInfo.SetConnectInfo(const Host, User, Psw: WideString; Prot: enIBProtocol);
function
GetProtocol:TProtocol;
begin
Result := TProtocol(Prot);
end;
begin
AddDebug('Enter TibUsersInfo.SetConnectInfo('+Host+','+User+','+'*,'+IntToStr(Prot)+')');
FServerName := host;
FUser := User;
FPsw := Psw;
FProtocol := GetProtocol;
AddDebug('Leave TibUsersInfo.SetConnectInfo('+Host+','+User+','+'*,'+IntToStr(Prot)+')');
end
Добавление пользователя с заданными параметрами при этом выполняется соединение
с сервисами IB на основании значений переменных запомненных
предыдущей функцией. В случае успеха функция возвращает истину в противном ложь
ошибку возникшую в процессе выполнения можно получить используя функцию GetLstError.
Такая же стратегия поведения в отношении ошибок будет использоваться во всех
функциях данного класса.
function TibUsersInfo.AddUser(const UserName, Password, FirstName,
MiddleName,
LastName: WideString; UserID, GroupID: SYSINT): WordBool;
begin
AddDebug('Enter TibUsersInfo.AddUser('+UserName+','+'*'+','+FirstName+','+MiddleName+','+LastName+','+IntToStr(UserID)+','+IntToStr(GroupID)+')');
result
:= false;
ResetError;
try
SetParam;
ibsUsers.Active := True;
ibsUsers.UserName := UserName;
ibsUsers.FirstName := FirstName;
ibsUsers.MiddleName := MiddleName;
ibsUsers.LastName := LastName;
ibsUsers.UserID := UserID;
ibsUsers.GroupID := GroupID;
ibsUsers.Password := Password;
try
ibsUsers.AddUser;
finally
ibsUsers.Active := false;
end;
FLastError := sOk;
result := true;
except
on
E:Exception do
begin
FormatException('TibUsersInfo.AddUser',e);
end;
end;
AddDebug('Leave
TibUsersInfo.AddUser('+UserName+','+'*'+','+FirstName+','+MiddleName+','+LastName+','+IntToStr(UserID)+','+IntToStr(GroupID)+')');
end
Удаление пользователя.
function TibUsersInfo.DeleteUser(const UserName: WideString): WordBool;
begin
AddDebug('Enter
TibUsersInfo.DeleteUser('+UserName+')');
result
:= false;
ResetError;
try
SetParam;
ibsUsers.Active := True;
ibsUsers.UserName := UserName;
try
ibsUsers.DeleteUser;
finally
ibsUsers.Active := false;
end;
FLastError := sOk;
result := true;
except
on
E:Exception do
begin
FormatException('TibUsersInfo.DeleteUser',e);
end;
end;
AddDebug('Leave
TibUsersInfo.DeleteUser('+UserName+')');
end
Получение информации обо всех пользователях на сервере. Список пользователей
возвращается в строковой переменной где каждая строка - информация о пользователе,
поля разделены символом "-".
function
TibUsersInfo.GetUsersInfo(var Info: OleVariant): WordBool;
var
res
:string;
i
:integer;
begin
AddDebug('Enter
TibUsersInfo.GetUsersInfo');
result
:= false;
ResetError;
Info
:= '';
res
:= '';
try
SetParam;
ibsUsers.Active
:= True;
ibsUsers.DisplayUsers;
try
for I := 0 to ibsUsers.UserInfoCount - 1 do
begin
res := res + Format('%s-%s-%s-%s-%d-%d'+#13+#10,[
ibsUsers.UserInfo[i].UserName,
ibsUsers.UserInfo[i].FirstName,
ibsUsers.UserInfo[i].MiddleName,
ibsUsers.UserInfo[i].LastName,
ibsUsers.UserInfo[i].UserId,
ibsUsers.UserInfo[i].GroupId
]);
end;
Info := res;
finally
ibsUsers.Active := false;
end;
FLastError := sOk;
result := true;
except
on
E:Exception do
begin
FormatException('TibUsersInfo.DeleteUser',e);
end;
end;
AddDebug('Leave
TibUsersInfo.GetUsersInfo');
end;
Посмотри на то что у нас получилось Ж:). Несколько слов о сервисных возможностях
программы. Во первых мы написали сервер автоматизации COM ему нет необходимости взаимодействовать с пользователем
или все таки есть? Для тех кто положительно ответил на второй вопрос есть возможность
запустить программу вручную до использования COM объекта
с ключом командной строки -DEBUG. В этом случае на экране
появиться главное окно программы в котором можно будет наблюдать все вызовы
и ошибки времени исполнения COM объекта. А также в качестве теста выполнить
добавление 10 пользователей/удаление их же а также просмотр информации на локальном
компьютере(подключение: вызов SetConnectInfo('localhost','sysdba','masterkey',ibpTCP);).
Перейдем к тому как можно использовать то что мы написали. Если у вас есть
возможность импортировать библиотеку типа то можно использовать «прямой» интерфейс
отнаследованный от IDispatch. Пример использования функции
добавления пользователя на Delphi:
var
u : IibUsersInfo;
i : integer;
str : string;
begin
u := CoibUsersInfo.Create;
u.SetConnectInfo('localhost','sysdba','masterkey',ibpTCP);
for
i:=0 to 10 do
begin
str := format('user_%d',[i]);
if u.AddUser(str,'12345',str,'','',0,0) then
begin
AddLog('AddingUser'+str);
end
else
begin
AddLog('Error adding User'+str);
AddLog(u.GetLastError);
end;
end;
end;
Ниже приведен макрос написанный на языке Visual Basic под Microsoft Word:
Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 21.07.2003 max
'
Dim
ibs As Object
Set
ibs = CreateObject("ibUsers.ibUsersInfo")
Dim
t As Variant
If
Not ibs.SetConnectInfo("localhost", "sysdba", "masterkey",
3) Then
Selection.TypeText
Text:="Set Connect param Error " + vbCr
Selection.TypeText
ibs.GetLastError
End
If
Selection.TypeText
Text:="Addin user" + vbCr
If
ibs.AddUser("TestUser", "12345", "F", "I",
"O", 0, 0) Then
Selection.TypeText
Text:="Add user - ok" + vbCr
Else
Selection.TypeText
Text:="Add user - Error"
Selection.TypeText
ibs.GetLastError + vbCr
End
If
Selection.TypeText
Text:="Show info" + vbCr
If
ibs.GetUsersInfo(t) Then
End
If
Selection.TypeText
t + vbCr
If
ibs.DeleteUser("TestUser") Then
Selection.TypeText
Text:="del user - ok" + vbCr
Else
Selection.TypeText
Text:="del user - Error" + vbCr
Selection.TypeText
ibs.GetLastError + vbCr
End
If
Selection.TypeText
Text:="Show info" + vbCr
If
ibs.GetUsersInfo(t) Then
End
If
Selection.TypeText
t + vbCr
End Sub
Макрос выполняет подключение к сервису IB, добавляет
пользователя TestUser/12345, выводит информацию о зарегистрированных пользователях,
удаляет созданного пользователя и опять выводит информацию о пользователях.
Заключение:
На тех же принципах можно реализовать доступ и ко всем остальным сервисам и
службам IB. Использование такого подхода позволят получить доступ к необходимой
функциональности из любого приложения умеющего работать с COM.
Приложения:
Исходные тескты sour.zip (12К)
Скомпилированая программа prog.zip (250К)
Документ Word с записанным макросом doc.zip Имя макроса
"Макрос1".
P.S. В качестве компонетов обеспечивающих доступ сервисам IB использовался
TIBSecurityService из пакета IBX, как выяснилось, не известно по чьей вине,
ошибок при удаленни несуществующего пользователя не возникает.