| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как програмно узнать, установлен ли InterBase

volser ©   (2004-04-19 19:23:00) 

Как програмно узнать, установлен ли InterBase и какая версия?

---

y-soft   (2004-04-21 09:33:00) [1]

Вот пример, как найти все установденные клоны на стороне сервера (упрощено). Процедура передает информацию о каждом найденном клоне через процедуру обратного вызова - там уже можно проверять версию exe и т.д.:


uses
 Windows,Classes,WinSvc,SysUtils;
...

type
 TIBServer = (ibInterBase,ibYaffilSS,ibYaffilCS,ibFirebird10X,ibFirebird15orHigher);
 TEnumIBServicesCbk = procedure(ServerKind : TIBServer; const Cfg : TQueryServiceConfigA;
   const Status : TServiceStatus);
procedure EnumIBServices(EnumCbk : TEnumIBServicesCbk);
const
 SvcNames : array[TIBServer] of string = ('InterBaseServer',
                                            'YaffilSQLServer(SS)',
                                            'YaffilSQLServer(CS)',
                                            'FireBirdServer',
                                            'FirebirdServerDefaultInstance');
var
 ibs : TIBServer;
 SCM, Service : THandle;
 ServiceStatus : TServiceStatus;
 CfgSize, LastErr : DWORD;
 Cfg : PQueryServiceConfigA;

begin
 for ibs = Low(TIBServer) to High(TIBServer) do
 begin
   SCM := OpenSCManager(nil,nil,SC_MANAGER_CONNECT);
   if SCM = 0 then
     raise Exception.CreateFmt('Ошибка OpenSCManager'#13#10'%s',
       [SysErrorMessage(GetLastError)]);
   try
     Service := OpenService(SCM,PChar(SvcNames[ibs]),SERVICE_QUERY_STATUS or SERVICE_QUERY_CONFIG);
     if Service = 0 then
     begin
       LastErr := GetLastError;
       case LastErr of
         ERROR_SERVICE_DOES_NOT_EXIST, ERROR_INVALID_NAME : Continue
       else
         raise Exception.CreateFmt('Ошибка OpenService'#13#10'%s',
           [SysErrorMessage(LastErr)]);
       end;
     end
     else
       try
         if QueryServiceStatus(Service,ServiceStatus) then
         begin
           QueryServiceConfig(Service,nil,0,CfgSize);
           LastErr := GetLastError;
           if LastErr = ERROR_INSUFFICIENT_BUFFER then
           begin
             GetMem(Cfg,CfgSize);
             try
               if QueryServiceConfig(Service,Cfg,CfgSize,CfgSize) then
                 EnumCbk(ibs, Cfg^, ServiceStatus)//В обработчике получаем все необходимые сведения
               else
               begin
                 LastErr := GetLastError;
                 raise Exception.CreateFmt('Ошибка QueryServiceConfig'#13#10'%s',
                   [SysErrorMessage(LastErr)]);
               end;
             finally
               FreeMem(Cfg);
             end;
           end
           else
             raise Exception.CreateFmt('Ошибка QueryServiceConfig'#13#10'%s',
               [SysErrorMessage(LastErr)]);
         end
         else
         begin
           raise Exception.CreateFmt('Ошибка QueryServiceStatus'#13#10'%s',
             [SysErrorMessage(GetLastError)]);
         end;
       finally
         CloseServiceHandle(Service);
       end;
   finally
     CloseServiceHandle(SCM);
   end;
 end;

P.S. Заранее sorry за возможные огрехи - выдрано на скорую руку из реального проекта...

---

sniknik   (2004-04-20 23:50:00) [2]

igoreha   (20.04.04 20:10) [10]
у меня дллка лежит в системной директории но сам ib не установлен (dll от персонал версии) и...? это же не установлен.

---

AndrewVolkov   (2004-04-20 23:37:00) [3]

>>igoreha

только надо добавить, что надо воспользоваться классом TVersionInfo из набора RxLib.

Uses ..,RxVerInf;

---

igoreha   (2004-04-20 20:10:00) [4]

Так, на мой взгляд, проще и надежнее:

function GetIBClientInformation: string;
var
 Buffer: array[0..261] of Char;
 FileName: string;
 VerInfo: TVersionInfo;
 IBLibrary: THandle;
begin
 result:= '';
 try
   IBLibrary:= LoadLibrary('gds32.dll');
   SetString(FileName, Buffer, Windows.GetModuleFileName(IBLibrary, Buffer, SizeOf(Buffer)));
   FreeLibrary(IBLibrary);
   if FileName <> '' then begin
     VerInfo:= TVersionInfo.Create(FileName);
     try
       if VerInfo.Valid then
         result:= VerInfo.FileDescription + ' ' + VerInfo.FileVersion;
      finally
       VerInfo.Free;
     end;
   end;
  except
 end;
end;

---

Romkin   (2004-04-20 14:40:00) [5]

НУ это уже детали :))
Самая хорошая проверка - подключиться.
Кстати, и наличие строки gds_db в Services неплохо проверить, мало ли...
Вот, проверяет и записывает, если что:

resourcestring
 Sgds = 'gds_db 3050/tcp';
 SIBServ = 'gds_db';

const
 ServiceKey = '\SYSTEM\CurrentControlSet\Services\Tcpip\Parameters';

function TfrmPages.LogServices: boolean;

 function GetIBService(var IBPort: integer): boolean;
 var
   ServEnt: PServEnt;
 begin
   Result := false;
   ServEnt := GetServByName(PChar(SIBServ), 'tcp');
   if assigned(ServEnt) then
   begin
     Result := true;
     IBPort := ntohs(ServEnt.s_port);
   end;
 end;

 function WriteServString(const ServString: string): boolean;
 var
   ServFile: textFile;
   reg: TRegistry;
   ServPath: string;
   PathStr: array [0..MAX_PATH] of char;
 begin
   Result := false;
   //Путь
   if GetWindowsDirectory(PathStr, MAX_PATH) = 0 then
     RaiseLastOSError;
   ServPath := IncludeTrailingPathDelimiter(PathStr);
   Reg := TRegistry.Create(KEY_READ);
   try
     Reg.RootKey := HKEY_LOCAL_MACHINE;
     if Reg.OpenKeyReadOnly(ServiceKey) then
     begin
       ServPath := reg.ReadString('DataBasePath');
       ExpandEnvironmentStrings(PChar(ServPath), PathStr, MAX_PATH);
       ServPath := IncludeTrailingPathDelimiter(PathStr);
     end;
   finally
     reg.CloseKey;
     reg.Free;
   end;
   assignFile(ServFile, ServPath + 'Services');
   append(ServFile);
   try
     Writeln(ServFile, Sgds);
     Result := true;
   finally
     CloseFile(ServFile);
   end;
 end;

var
 ErrorCode: integer;
 WSAData: TWSAData;
 IBPort: integer;
begin
 Result := false;
 ErrorCode := WSAStartup($0101, WSAData);
 if ErrorCode <> 0 then
   raiseLastOSError;
 try
   if GetIBService(IBPort) then //Запись есть
     Result := true
   else  //Записи нет, будем ставить
   begin
     if not WriteServString(Sgds) then
       raise Exception.Create('Не получилось что-то');
   end;
 finally
   ErrorCode := WSACleanup;
   if ErrorCode <> 0 then
     raiseLastOSError;
 end;
end;

---

y-soft   (2004-04-20 14:01:00) [6]

>Romkin ©   (20.04.04 12:14) [7]

Оно, однако, не всегда верно - ключик может быть, а IB отсутствовать :)

Сам производитель в руководстве по написанию инсталляторов настоятельно рекомендует проверять наличие файлов

---

Romkin   (2004-04-20 12:14:00) [7]

HKLM\Software\InterBase Corp\InterBase\CurrentVersion\
В ключе Version написана версия, так что больше никуда заглядывать не надо :))

---

iKS1   (2004-04-20 11:59:00) [8]

Если речи идет об IB вообще и его (ее) клонах, то никак. Если о конткретных реализациях то см. выше.

---

y-soft   (2004-04-20 08:50:00) [9]

Romkin ©   (19.04.04 19:28) [1]
Посмотри в реестре. Все прописывается как положено, в HKLM/Software. Правда, несколько различно :)

Вот именно, что различно :) К тому же одновременно может быть установлено несколько движков разных версий...

Тут можно предложить разные способы:

На стороне сервера:

1.1 Читать из реестра путь к директории \Bin для каждого

Для IB X.X и FB 1.0X

 HKLM\Software\InterBase Corp\InterBase\CurrentVersion\ServerDitrectory

Для Yaffil

 HKLM\Software\Yaffil\ServerDitrectory

Для FB 1.5 и выше точно не помню :)

1.2 В директории \Bin читать версию исполняемого файла

Можно пойти другим путем - искать зарегистрированные сервисы клонов IB и получать для них информацию о запущенном exe, и далее - как в первом способе

На стороне как сервера, так и клиента:
 
Проще всего прочитать версию из gds32.dll (В InterBase Express так и реализовано) Но способ не дает 100% гарантии, т.к. клиенты могут работать вместе с серверами более старых версий, к тому же сразу с несколькими :(

---

gire   (2004-04-20 01:13:00) [10]

мне нужен помощник (с оплатой) по Delphi

---

Vlad   (2004-04-19 21:51:00) [11]

TIBDataBaseInfo ?

---

volser   (2004-04-19 21:13:00) [12]

> Посмотри в реестре. Все прописывается как положено, в HKLM/Software.
> Правда, несколько различно :)

Как узнать что установленная именно6 или 7 версия InterBase

---

Romkin   (2004-04-19 19:28:00) [13]

Посмотри в реестре. Все прописывается как положено, в HKLM/Software. Правда, несколько различно :)

---

Наверх