Delphi internet var mı kontrolü

[ByTEK]

aşağıdaki kod ile internet varmı diye kontrol ediyorum. Fakat bilgisayarın network donanımının bağlı olup olmadığını kontrol ediyor. Oysaki Kablolu bağlı iken gateway vermezsem veya DNS vermezsem yada yanlış IP verirsem gene internet varmış gibi görüp işlem yapınca hata alıyorum. Bu durumda AKTİF ve KULLANILABİLEN bir internetin olup olmadığını nasıl tespit edebilirim ?

function Internetvarmi: Boolean;
const
  INTERNET_CONNECTION_MODEM = 1; // local system uses a modem to connect to the Internet.
  INTERNET_CONNECTION_LAN = 2; // local system uses a local area network to connect to the Internet.
  INTERNET_CONNECTION_PROXY = 4; // local system uses a proxy server to connect to the Internet.
  INTERNET_CONNECTION_MODEM_BUSY = 8; // local system's modem is busy with a non-Internet connection.
var
  dwConnectionTypes: DWORD;
begin
  dwConnectionTypes :=
    INTERNET_CONNECTION_MODEM +
    INTERNET_CONNECTION_LAN +
    INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;

[t2]

uses Ping;
...
const ADP_IP = '77.223.128.170'; 
begin
 If  Ping.Ping(ADP_IP) then 
   ShowMessage('internet var');
end;

unit Ping;

interface
uses
  Windows, SysUtils, Classes;

type
  TSunB = packed record
    s_b1, s_b2, s_b3, s_b4: byte;
  end;

  TSunW = packed record
    s_w1, s_w2: word;
  end;

  PIPAddr = ^TIPAddr;
  TIPAddr = record
    case integer of
      0: (S_un_b: TSunB);
      1: (S_un_w: TSunW);
      2: (S_addr: longword);
  end;

 IPAddr = TIPAddr;

function IcmpCreateFile : THandle; stdcall; external 'icmp.dll';
function IcmpCloseHandle (icmpHandle : THandle) : boolean; 
            stdcall; external 'icmp.dll'
function IcmpSendEcho 
   (IcmpHandle : THandle; DestinationAddress : IPAddr;
    RequestData : Pointer; RequestSize : Smallint;
    RequestOptions : pointer;
    ReplyBuffer : Pointer;
    ReplySize : DWORD;
    Timeout : DWORD) : DWORD; stdcall; external 'icmp.dll';


function Ping(InetAddress : string) : boolean;

implementation

uses
  WinSock;

function Fetch(var AInput: string; 
                      const ADelim: string = ' '; 
                      const ADelete: Boolean = true)
 : string;
var
  iPos: Integer;
begin
  if ADelim = #0 then begin
    // AnsiPos does not work with #0
    iPos := Pos(ADelim, AInput);
  end else begin
    iPos := Pos(ADelim, AInput);
  end;
  if iPos = 0 then begin
    Result := AInput;
    if ADelete then begin
      AInput := '';
    end;
  end else begin
    result := Copy(AInput, 1, iPos - 1);
    if ADelete then begin
      Delete(AInput, 1, iPos + Length(ADelim) - 1);
    end;
  end;
end;

procedure TranslateStringToTInAddr(AIP: string; var AInAddr);
var
  phe: PHostEnt;
  pac: PChar;
  GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  try
    phe := GetHostByName(PChar(AIP));
    if Assigned(phe) then
    begin
      pac := phe^.h_addr_list^;
      if Assigned(pac) then
      begin
        with TIPAddr(AInAddr).S_un_b do begin
          s_b1 := Byte(pac[0]);
          s_b2 := Byte(pac[1]);
          s_b3 := Byte(pac[2]);
          s_b4 := Byte(pac[3]);
        end;
      end
      else
      begin
        raise Exception.Create('Error getting IP from HostName');
      end;
    end
    else
    begin
      raise Exception.Create('Error getting HostName');
    end;
  except
    FillChar(AInAddr, SizeOf(AInAddr), #0);
  end;
  WSACleanup;
end;

function Ping(InetAddress : string) : boolean;
var
 Handle : THandle;
 InAddr : IPAddr;
 DW : DWORD;
 rep : array[1..128] of byte;
begin
  result := false;
  Handle := IcmpCreateFile;
  if Handle = INVALID_HANDLE_VALUE then
   Exit;
  TranslateStringToTInAddr(InetAddress, InAddr);
  DW := IcmpSendEcho(Handle, InAddr, nil, 0, nil, @rep, 128, 0);
  Result := (DW  0);
  IcmpCloseHandle(Handle);
end;

end.

[ByTEK]

@t2 hocam teşekkürler..

Sorunu aştım. Aşağıdaki fonksiyon ile gideceği URL yi check ediyorum. Eğer true dönerse işlem yapıyorum. IP değiştirdim,gateway,dns vermediğim zaman false dönüyor. tam istediğim gibi.

function CheckUrl(url:string):boolean;
var
hSession, hfile, hRequest: hInternet;
dwindex,dwcodelen :dword;
dwcode:array[1..20] of char;
res : pchar;
begin
if pos('http://',lowercase(url))=0 then
url := 'http://'+url;
Result := false;
hSession := InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,nil, nil, 0);
if assigned(hsession) then
begin
hfile := InternetOpenUrl(
hsession,
pchar(url),
nil,
0,
INTERNET_FLAG_RELOAD,
0);
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE,
@dwcode, dwcodeLen, dwIndex);
res := pchar(@dwcode);
result:= (res ='200') or (res ='302');
if assigned(hfile) then
InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;

[MCansız]

Merhaba sercan bende bunu kullanyorum.

site olarak www.google.com seçtim ama bazı bilgisayarlarda çalışmaya biliyor çözüm için fonksiyondaki bölümü aşağıdaki gibi değiştir.

if pos('https://',lowercase(url))=0 then
url := 'https://'+url;

kolay gelsin