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

← →
volser (2004-04-19 19:23) [0]

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

← →
Romkin © (2004-04-19 19:28) [1]

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

← →
volser (2004-04-19 21:13) [2]

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

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

← →
Vlad © (2004-04-19 21:51) [3]

TIBDataBaseInfo ?

← →
gire (2004-04-20 01:13) [4]

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

← →
y-soft © (2004-04-20 08:50) [5]

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% гарантии, т.к. клиенты могут работать вместе с серверами более старых версий, к тому же сразу с несколькими :(

← →
iKS1 © (2004-04-20 11:59) [6]

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

← →
Romkin © (2004-04-20 12:14) [7]

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

← →
y-soft © (2004-04-20 14:01) [8]

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

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

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

← →
Romkin © (2004-04-20 14:40) [9]

НУ это уже детали :))
Самая хорошая проверка - подключиться.
Кстати, и наличие строки 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;

← →
igoreha (2004-04-20 20:10) [10]

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

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;

← →
AndrewVolkov (2004-04-20 23:37) [11]

>>igoreha

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

Uses ..,RxVerInf;

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

Вот пример, как найти все установденные клоны на стороне сервера (упрощено). Процедура передает информацию о каждом найденном клоне через процедуру обратного вызова - там уже можно проверять версию 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 за возможные огрехи - выдрано на скорую руку из реального проекта...

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