MainMenu
   :
  Undo memo
   :
  Excel
   :
 
   :
 
   :
 
   :
 
   :
  BDE
   :
  Paramstr
   :
 
   :

Delphi - : FireBird

  <<   

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;


FIB

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;
  <<