VPF::Узнать, запущен ли FireBird - Форум программистов

GrigoriyFomin

Дата 4.1.2011, 00:57 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 84
Регистрация: 16.11.2010

Репутация: нет
Всего: нет

Как корректно узнать - запущен ли сервис FireBird? Delphi XE + IBDAC

Данкинг

Дата 4.1.2011, 01:13 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 35
Всего: 130

Отловить ошибку подключения IBDatabase. smile

Добавлено через 1 минуту и 11 секунд
А, IBDAC какой-то, ну, всё равно же там есть момент подключения к БД.

--------------------

There's nothing left but silent epitaphs.

GrigoriyFomin

Дата 4.1.2011, 01:38 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 84
Регистрация: 16.11.2010

Репутация: нет
Всего: нет

Ошибка может генериться от разных причин, а мне нужно отловить именно отсутствие запущенного сервиса

Keeper89

Дата 4.1.2011, 02:21 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 2580
Регистрация: 26.2.2009

Репутация: 1
Всего: 58

firebirdfaq.org/faq123/

--------------------

Cogito, ergo sum

Keeper's blog
CnWizards Downloads

user posted image

Данкинг

Дата 4.1.2011, 02:48 (ссылка)

(нет голосов)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: 35
Всего: 130

Цитата(GrigoriyFomin @ 4.1.2011, 01:38

)

Ошибка может генериться от разных причин, а мне нужно отловить именно отсутствие запущенного сервиса

Получай список сервисов и ищи среди них fbserver.

--------------------

There's nothing left but silent epitaphs.

GrigoriyFomin

Дата 4.1.2011, 11:35 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 84
Регистрация: 16.11.2010

Репутация: нет
Всего: нет

Спасибо ответившим, работает сейчас так

Код



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;

Akella

Дата 4.1.2011, 13:27 (ссылка)

(нет голосов)

Загрузка ...

Творец

Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 29
Всего: 329

Цитата(Данкинг @ 4.1.2011, 02:48

)

Получай список сервисов и ищи среди них fbserver.

как у удалённой машины запросить список сервисов? а если это линукс или др. ОС?

Добавлено @ 13:31
Вот ещё код by Alex
потребуются компоненты 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;

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Базы данных и репортинг \| Следующая тема »