© Резанов М.
Таганрог 2003
г.
Часто возникает вопрос можно ли выполнить некоторые специфичные действия (не
являющиеся подмножеством 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, как выяснилось, не известно по чьей вине, ошибок при удаленни несуществующего пользователя не возникает.
Copyright© 2003 Max Резанов Специально для Delphi Plus