sábado, 14 de abril de 2012

Verificar se há conexão com a Internet no Delphi 7

Veja neste artigo como verificar se o computador no qual sua aplicação está rodando está conectado à Internet.


Primeiramente declare na Uses do seu Form a seguinte unit:


 uses  
  WinInet;  


Após isso, digite o que está abaixo na procedure
onClick do botão:


 procedure TForm1.Button1Click(Sender: TObject);  
 var  
  Flags : Cardinal;  
 begin  
  if not InternetGetConnectedState(@Flags, 0) then  
   ShowMessage('Não há conexão com a Internet')  
  else  
  if (Flags and INTERNET_CONNECTION_LAN) <> 0 then  
   ShowMessage('Há conexão com a Internet através de um roteador')  
  else  
  if (Flags and INTERNET_CONNECTION_PROXY) <> 0 then  
   ShowMessage('Há conexão com a Internet através de um proxy')  
  else  
   ShowMessage('Há conexão com a Internet');  
 end;  


Conclusões

Notamos neste artigo a facilidade em verificar se há conexão com a
Internet utilizando a ferramente Delphi 7. Forte abraço e até o
próximo tutorial.

--

16 comentários:

  1. Este comentário foi removido pelo autor.

    ResponderExcluir
  2. Este comentário foi removido pelo autor.

    ResponderExcluir
  3. Deu erro bem aqui:

    if Flags and INTERNET_CONNECTION_LAN <> 0 then
    ShowMessage('Há conexão com a Internet através de um roteador')

    ResponderExcluir
    Respostas
    1. Amigo o código está correto.

      Tu lembraste de declarar o WinInet na cláusula Uses?

      uses
      WinInet;

      Excluir
  4. declarando a USES e a var. deu certinho.

    Funcionou 100%.
    Compilou no Delphi XE, XE2 e XE3.

    Vlw amigo, Obrigado.

    ResponderExcluir
    Respostas
    1. Que bom que deu certo Oni (Latino).

      As vezes demoramos horrores atrás da bendita cláusula Uses a ser usada.

      Abraço.

      Excluir
  5. Funciona bacana o código. Foi o mais curto que encontrei. Os de mais era imensos. Porém encontrei uma restrição: Se vc estiver conectado a um modem e este não a internet, será considerado "Conectado".
    Eu preciso saber se estou conectado a internet, independente do meio. Tem algo que possa ajudar?

    ResponderExcluir
    Respostas
    1. Boa noite Airton.

      Rapaz pior que lá na empresa só testei esse código conectado à Net e à Oi.

      De qualquer forma valeu pela dica, o código acabou ficando com essa pendência.

      Excluir
    2. É Renato, aqui a mesma coisa... a net aqui é Oi, mas se o roteador estiver ligado e o modem ADSL não, ele diz que está conectado, ou seja, esse código só verifica se a placa de rede está conectada, e não se tem internet, talvez algum código que faça um ping externo seja a solução não?

      Excluir
    3. Renato, encontrei esse código, que funciona perfeitamente, caso ajude:

      Uses
      WinInet;


      function IsConectadoNaInternet: Boolean;
      begin
      Result := InternetCheckConnection('http://www.google.com.br/', 1, 0);
      end;

      Excluir
    4. Obrigado pela dica Nicolau, realmente essa questão de modem tinha ficado em aberto.

      Abraço.

      Excluir
  6. Se você simular uma falta de internet, mudando o gateway padrão da placa de rede...ele diz que tem internet. Abre o navegador e não abre pagina. Por tanto não funciona..

    ResponderExcluir
    Respostas
    1. Realmente não tinha observado esse caso Marcos. Obrigado pela colocação.

      Excluir
  7. que é isso ??? basta dar um ping no endereço, e verificar, isto vale pra qualquer tipo de conexão, se pingar tem conexão, se não, não tem.

    ResponderExcluir
  8. //-------------------------------------------------------------------------------
    function RunProg(Cmd, WorkDir: String): string;
    var
    tsi: TStartupInfo;
    tpi: TProcessInformation;
    nRead: DWORD;
    aBuf: Array[0..101] of char;
    sa: TSecurityAttributes;
    hOutputReadTmp, hOutputRead, hOutputWrite, hInputWriteTmp, hInputRead, hInputWrite, hErrorWrite: THandle;
    FOutput: String;
    begin
    FOutput := '';
    sa.nLength := SizeOf(TSecurityAttributes);
    sa.lpSecurityDescriptor := nil;
    sa.bInheritHandle := True;
    CreatePipe(hOutputReadTmp, hOutputWrite, @sa, 0);
    DuplicateHandle(GetCurrentProcess(), hOutputWrite, GetCurrentProcess(), @hErrorWrite, 0, true, DUPLICATE_SAME_ACCESS);
    CreatePipe(hInputRead, hInputWriteTmp, @sa, 0);

    // Create new output read handle and the input write handle. Set
    // the inheritance properties to FALSE. Otherwise, the child inherits

    // the these handles; resulting in non-closeable handles to the pipes
    // being created.
    DuplicateHandle(GetCurrentProcess(), hOutputReadTmp, GetCurrentProcess(), @hOutputRead, 0, false, DUPLICATE_SAME_ACCESS);
    DuplicateHandle(GetCurrentProcess(), hInputWriteTmp, GetCurrentProcess(), @hInputWrite, 0, false, DUPLICATE_SAME_ACCESS);
    CloseHandle(hOutputReadTmp);
    CloseHandle(hInputWriteTmp);

    FillChar(tsi, SizeOf(TStartupInfo), 0);
    tsi.cb := SizeOf(TStartupInfo);
    tsi.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
    tsi.hStdInput := hInputRead;
    tsi.hStdOutput := hOutputWrite;
    tsi.hStdError := hErrorWrite;

    CreateProcess(nil, PChar(Cmd), @sa, @sa, true, 0, nil, PChar(WorkDir), tsi, tpi);
    CloseHandle(hOutputWrite);
    CloseHandle(hInputRead );
    CloseHandle(hErrorWrite);
    Application.ProcessMessages;

    repeat
    if (not ReadFile(hOutputRead, aBuf, 16, nRead, nil)) or (nRead = 0) then begin
    if GetLastError = ERROR_BROKEN_PIPE then Break else MessageDlg('Pipe read error, could not execute file', mtError, [mbOK], 0);
    end;
    aBuf[nRead] := #0;
    FOutput := FOutput + PChar(@aBuf[0]);
    Application.ProcessMessages;

    until False;

    Result := FOutput;
    //GetExitCodeProcess(tpi.hProcess, nRead) = True;
    end;
    //-------------------------------


    function Ping(Ip: String; Tempo: Integer): Boolean;
    var
    S: String;
    begin
    S:= RunProg('ping '+ip+' -n 1 -w '+IntToStr(Tempo),'C:\');
    if Pos('Recebidos = 1', S) > 0 then Result:= True else Result:= False;
    end;

    // usar assim
    //If ping('www.uol.com.br', 300) Then ShowMessage('Esta conectado a Internet');

    ResponderExcluir