Проверка наличия соединения с интернетом.

[Rockot]

Доброе утро всем, у меня вот такая вот проблемка. Соединяюсь с Mysql базой с помощью FireDAC, написал уже всю программу, всё хорошо, но вот если нет соединения с интернетом, то она просто вылетает с ошибкой. Какое событие обрабатывать, что почитать может?

Просто я не пойму почему приложение даже не запускается, то есть я отключаю Connection = False; и всё равно, кстати ошибка -
Exception EMySQLNativeException in module "Project.exe" at 0025FCDE
[FireDAC][Phys][MySQL] Unknown MySQL server Hosr '1gb.ru' (11004)

Интернет отключал просто выключив адаптер в "Сетевые подключения".

Самое странное, что по formCreate я не произвожу подключение к БД. И не выполняю никаких запросов.

[Stilet]

Там где соединение поставь try except

try
 соединяемся
except
 on e:Exception do begin
  e.message - текст ошибки
  exit; //Выходим из процедуры
 end;
end;

[Rockot]

Сообщение от Stilet

Там где соединение поставь try except

try
 соединяемся
except
 on e:Exception do begin
  e.message - текст ошибки
  exit; //Выходим из процедуры
 end;
end;

Да я примерно так же сделал, но после такого кода я себя программистом не чувствую)))

procedure TAuthorization_f.FDConnection1Error(ASender: TObject;
  const AInitiator: IFDStanObject; var AException: Exception);
begin
if (AException.Message = Authorization_f.Error1.Caption) or (AException.Message = Authorization_f.Error2.Caption) then
AException.Message:= 'Проверьте соединение с интернетом.';
end;

У FireDac Connection есть событие OnError в общем там есть переменная AException, в итоге я чего сотворил, я вытаскиваю ошибку из этой переменной, которая лежит в TLabel = (Name = Error1)

Ошибка вот такая вот - [FireDAC][Phys][MySQL] Unknown MySQL Server Host 'gb.ru' (11004)

И я сделал типо

Если Ошибка = [FireDAC][Phys][MySQL] Unknown MySQL Server Host 'gb.ru ТО

Говорить = Проверьте соединение с тырнетом.

Мне кажется более дибильного решения я никогда не писал... Вот думаю, может кто чего знает...

Кстати и решил проблему теперь приложение запускается, до это не запускалось из-за свойства у FDConnection.Connection = TRUE, я просто не заметил его.

[Stilet]

Да я примерно так же сделал, но после такого кода я себя программистом не чувствую)))

О лала... Ну тогда я почетный быдлокодер Академии IE... Я вот try-ить все у себя поставил. Впрочем эта зараза себя оправдывает в моих проектах уже который раз...
потому и посоветовал.

Мне кажется более дибильного решения я никогда не писал...

Не ну логично, но всетки сравнивать с заранее приведенным текстом не камильфо (или кОмильфо...).

procedure TAuthorization_f.FDConnection1Error(ASender: TObject;
  const AInitiator: IFDStanObject; var AException: Exception);
begin
 AException.Message:= 'Ошибка: '+AException.Message+#13#10+' Рекомендация: Проверьте соединение с интернетом.';
end;

Вот я бы так и сделал: Сохранил текст ошибки + свою рекомендацию.

А и еще: (AException.Message = Authorization_f.Error1.Caption)
У AException должно быть свойство кода ошибки. Вот лучше проверять его а не сравнивать строки, которые могут быть различными хотя бы из-за локалей ОС. А код ошибки - число.

[Rockot]

Сообщение от Stilet

О лала... Ну тогда я почетный быдлокодер Академии IE... Я вот try-ить все у себя поставил. Впрочем эта зараза себя оправдывает в моих проектах уже который раз...
потому и посоветовал.

Не ну логично, но всетки сравнивать с заранее приведенным текстом не камильфо (или кОмильфо...).

procedure TAuthorization_f.FDConnection1Error(ASender: TObject;
  const AInitiator: IFDStanObject; var AException: Exception);
begin
 AException.Message:= 'Ошибка: '+AException.Message+#13#10+' Рекомендация: Проверьте соединение с интернетом.';
end;

Вот я бы так и сделал: Сохранил текст ошибки + свою рекомендацию.

А и еще: (AException.Message = Authorization_f.Error1.Caption)
У AException должно быть свойство кода ошибки. Вот лучше проверять его а не сравнивать строки, которые могут быть различными хотя бы из-за локалей ОС. А код ошибки - число.

Да ты прав, надо покопать)), а то не комильфо такой код)) Спасибо за помощь))

[vovs]

Как вариант:

uses Winsock;
//------------------ Структура ай-пи для ICMP --------------------------------
  type
  IPINFO = record
    Ttl: char;
    Tos: char;
    IPFlags: char;
    OptSize: char;
    Options: ^char;
  end;

type
  ICMPECHO = record
    Source: longint;
    Status: longint;
    RTTime: longint;
    DataSize: Shortint;
    Reserved: Shortint;
    pData: ^variant;
    i_ipinfo: IPINFO;
  end;

  TIcmpCreateFile = function(): integer; {$IFDEF WIN32}stdcall; {$ENDIF}
  TIcmpCloseHandle = procedure(var handle: integer); {$IFDEF WIN32}stdcall; {$ENDIF}
  TIcmpSendEcho = function(var handle: integer; endereco: DWORD; buffer: variant; tam: WORD; IP: IPINFO; ICMP: ICMPECHO; tamicmp: DWORD; tempo: DWORD): DWORD; {$IFDEF WIN32}stdcall; {$ENDIF}
//------------------------------------------------------------------------------
//main                                                                         /

procedure Ping;
var


 wsadt: wsadata;
  icmp: icmpecho;
  HNDicmp: integer;
  hndFile: integer;
  Host: PHostEnt;
  Destino: in_addr;
  Endereco: ^DWORD;
  IP: ipinfo;
  Retorno: integer;
  dwRetorno: DWORD;
  x: integer;



  IcmpCreateFile: TIcmpCreateFile;
  IcmpCloseHandle: TIcmpCloseHandle;
  IcmpSendEcho: TIcmpSendEcho;

begin

  HNDicmp := LoadLibrary('ICMP.DLL');
  if (HNDicmp <> 0) then
    begin
      @IcmpCreateFile := GetProcAddress(HNDicmp, 'IcmpCreateFile');
      @IcmpCloseHandle := GetProcAddress(HNDicmp, 'IcmpCloseHandle');
      @IcmpSendEcho := GetProcAddress(HNDicmp, 'IcmpSendEcho');
      if (@IcmpCreateFile = nil) or (@IcmpCloseHandle = nil) or (@IcmpSendEcho = nil) then
        begin
          Application.MessageBox('Erro pegando endereзos ICMP', 'Error', MB_OK);
          FreeLibrary(HNDicmp);
        end;
    end;
  Retorno := WSAStartup($0101, wsadt);

  if (Retorno <> 0) then
    begin
      Application.MessageBox('Nгo foi possнvel carregar WinSockets', 'WSAStartup', MB_OK);
      WSACleanup();
      FreeLibrary(HNDicmp);
    end;

  Destino.S_addr := inet_addr('213.180.204.3');
  if (Destino.S_addr = 0) then
    begin
      Host := GetHostbyName('ya.ru');
    end
  else
    begin
      Host := GetHostbyAddr(@Destino, sizeof(in_addr), AF_INET);
    end;

  if (host = nil) then
    begin
      ShowMessage('Непингуется  сервер');
      WSACleanup();
      FreeLibrary(HNDicmp);
      exit;
    end;

  Endereco := @Host.h_addr_list;

  HNDFile := IcmpCreateFile();
  for x := 0 to 4 do
    begin
      Ip.Ttl := char(255);
      Ip.Tos := char(0);
      Ip.IPFlags := char(0);
      Ip.OptSize := char(0);
      Ip.Options := nil;

      dwRetorno := IcmpSendEcho(
        HNDFile,
        Endereco^,
        null,
        0,
        Ip,
        Icmp,
        sizeof(Icmp),
        DWORD(5000));
      Destino.S_addr := icmp.source;
     Showmessage('internet ok');
    end;

  IcmpCLoseHandle(HNDFile);
  FreeLibrary(HNDicmp);
  WSACleanup();
end;