uses Tlhelp32


function IsFireBirdRunning: boolean;
const
В В PROCESS_TERMINATE = $0001;
var
В В Co: BOOL;
В В FS: THandle;
В В FP: TProcessEntry32;
В В s:В В string;
begin
В В FS := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
В В FP.dwSize := Sizeof(FP);
В В Co := Process32First(FS, FP);
В В while integer(Co) <> 0 do
В В begin
В В В В s := s + FP.szExeFile + #13;
В В В В Co := Process32Next(FS, FP);
В В end;
В В CloseHandle(FS);
В В if pos('fbserver', s) > 0 then result := true
В В else result := false;
end;

function TDM.TestConnectServerFB(aDB: TpFIBDatabase): Boolean;
// Проверка возможности соединения с БД
const
В В cnstProtokolName: array [TProtocol] of string = ('TCP', 'SPX', 'NamedPipe', 'Local');
В В  constDeffVerFbClient1В В В В В В В В В В В В В В В В = 'Версия клиентской библиотеки отличается от версии сервера FireBird.';
В В  constDeffVerFbClient2В В В В В В В В В В В В В В В В = 'Версия клиента(';
В В  constDeffVerFbClient3В В В В В В В В В В В В В В В В = 'Версия сервера: "';
В В  constDeffVerFbClient4В В В В В В В В В В В В В В В В = 'Нажмите "ДА" для продолжения работы';
В В  constDeffVerFbClient5В В В В В В В В В В В В В В В В = 'Нажмите "НЕТ" для отмены';
В В  constServerNameВ В В В В В В В В В В В В В В В В В В В В В = 'Имя сервера: ';
В В  constProtoTCPВ В В В В В В В В В В В В В В В В В В В В В В В = 'Протокол TCP';
var
В В h: Cardinal;
В В buffer: array [0..MAX_PATH] of Char;
В В VerClient: string;
В В VerServer: string;
В В FI : TFileInfo;
begin
В В Result:= False;
В В //нужно ли проверять версию FB-сервера и клиента(fbClient.dll)
В В  if not bCheckServer then begin
В В В В  Result := true;
В В В В  exit;
В В  end;
В В h:= LoadLibrary(PAnsiChar(aDB.LibraryName));
В В if h = 0 then
В В В В begin
В В В В В В Showmessage(constClientDllFirebird + aDB.LibraryName + constNotFoundClientDllFirebird);
В В В В В В Exit;
В В В В end;
В В GetModuleFileName(h, buffer, MAX_PATH);
В В FreeLibrary(h);
В В FI := fmMain.xGetExeFileInfo(buffer);
В В VerClient := fi.FileVersion;
В В with GetConnectServerInf(aDB.DBName) do begin
В В В В with TpFIBServerProperties.Create(nil) do try
В В В В В В LibraryName:= buffer;
В В В В В В LoginPrompt:= False;
В В В В В В Params.Add('user_name=' + aDB.ConnectParams.UserName);
В В В В В В Params.Add('password='В В + aDB.ConnectParams.Password);
В В В В В В ServerName := NameServer;
В В В В В В ProtocolВ В  := ConnectProtocol;
В В В В В В try
В В В В В В В В Active:= True;
В В В В В В except
В В В В В В В В on e: EFIBError do
В В В В В В В В begin
В В В В В В В В В В case e.IBErrorCode of
В В В В В В В В В В В В isc_network_error: begin
В В В В В В В В В В В В В В log(constFirebirdOnCompNotFound1 + ServerName + constFirebirdOnCompNotFound2);
В В В В В В В В В В В В В В ShowMessage(constFirebirdOnCompNotFound1 + ServerName + constFirebirdOnCompNotFound2);
В В В В В В В В В В В В В В Exit;
В В В В В В В В В В В В end;
В В В В В В В В В В В В isc_login : begin
В В В В В В В В В В В В В В log(constInvalidLoginPass + Params.Text);
В В В В В В В В В В В В В В ShowMessage(constInvalidLoginPass + Params.Text);
В В В В В В В В В В В В В В Exit;
В В В В В В В В В В В В end;
В В В В В В В В В В else//case
В В В В В В В В В В В В begin
В В В В В В В В В В В В В В log('Ошибка "'+IntToStr(e.IBErrorCode)+'" при попытке подключиться к серверу базы данных');
В В В В В В В В В В В В В В ShowMessage(constError + ' "' + IntToStr(e.IBErrorCode) + constWhileConnectingToServer);
В В В В В В В В В В В В В В raise;
В В В В В В В В В В В В end;//case-else
В В В В В В В В В В end;//case
В В В В В В В В end;
В В В В В В else
В В В В В В В В raise;
В В В В В В end;
В В В В В В try
В В В В В В В В FetchVersionInfo;
В В В В В В В В VerServer:= VersionInfo.ServerVersion;
В В В В В В finally
В В В В В В В В Active:= False;
В В В В В В end;
В В В В finally
В В В В В В Free;
В В В В end;
В В end;
В В if pos(VerClient, VerServer) = 0 then
В В begin
В В В В case MessageBox(Application.ActiveFormHandle, PAnsiChar(constDeffVerFbClient1 + #13 +
В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В constDeffVerFbClient2 + buffer +'): "' + VerClient + '"' + #13 +
В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В constDeffVerFbClient3 + VerServer + '"' + #13 +
В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В #13+
В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В constDeffVerFbClient4 + #13 +
В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В В constDeffVerFbClient5 + #13), constMsgAttention, MB_ICONWARNING or MB_YESNO) of
В В В В  ID_YES: Result := True;
В В В В  ID_NO : exit;
В В В В end;//case
В В end;//if
В В Result:= True;
end;
function TDM.GetConnectServerInf(const DBName:string): tConnectServerInf;
// Получение из строки соединения БД имени сервера, на котором
// лежит БД и тип протокола соединения
var Idx1, Idx2: Integer;
В В В В Temp: string;
begin
В В Result.ConnectProtocol:= Local;
В В Result.NameServer:= 'localhost';
В В if Pos('\', DBName) = 1 then
В В В В begin
В В В В В В Temp := Copy(DBName, 3, Length(DBName));
В В В В В В Idx1 := PosCh('', Temp);
В В В В В В if Idx1 <> 0 then
В В В В В В В В begin
В В В В В В В В В В Result.ConnectProtocol:= NamedPipe;
В В В В В В В В В В Result.NameServer:= Copy(Temp, 1, Idx1 - 1);
В В В В В В В В end;
В В В В end
В В else
В В В В begin
В В В В В В Idx1 := PosCh(':', DBName);
В В В В В В if (Idx1 <> 0) and (Idx1 <> 2) then
В В В В В В В В begin
В В В В В В В В В В Idx2 := Pos('@', DBName);
В В В В В В В В В В if Idx2 = 0 then
В В В В В В В В В В В В begin
В В В В В В В В В В В В В В Result.NameServer:= copy(DBName, 1, Idx1 - 1);
В В В В В В В В В В В В В В log(constServerName + Result.NameServer);
В В В В В В В В В В В В В В Result.ConnectProtocol:= TCP;
В В В В В В В В В В В В В В log(constProtoTCP);
В В В В В В В В В В В В end
В В В В В В В В В В else
В В В В В В В В В В В В begin
В В В В В В В В В В В В В В Result.NameServer:= copy(DBName, 1, Idx2 - 1);
В В В В В В В В В В В В В В log(constServerName + Result.NameServer);
В В В В В В В В В В В В В В Result.ConnectProtocol:= SPX;
В В В В В В В В В В В В В В log(constProtoTCP);
В В В В В В В В В В В В end;
В В В В В В В В end;
В В В В end;
end;