Доступ к некоторым функциям InterBase используя технологию COM

© Резанов М.
Таганрог 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