Проверка интеренет соединения

[HTTqp]

проверяю интерет соединения т.е. есть оно или нет. Вот как я это осуществляю:

const  
 INTERNET_CONNECTION_MODEM      = 1;  
 INTERNET_CONNECTION_LAN        = 2;  
 INTERNET_CONNECTION_PROXY      = 4;  
 INTERNET_CONNECTION_MODEM_BUSY = 8;

function IsInternetConnected: Boolean;
var  
 dwConnectionTypes: DWORD;
begin 
 dwConnectionTypes := INTERNET_CONNECTION_MODEM or 
                      INTERNET_CONNECTION_LAN or 
                      INTERNET_CONNECTION_PROXY;  
 Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if IsInternetConnected then  Label1.Caption:='1' else Label1.Caption:='0';
end;

но уменя всегда получается так как будто соединение все есть, вне зависимости от того включу я инет или нет. Интересует проверка через api без использования так сказать проверки в виде

HTTP.Get('http://ya.ru');

даже не интересует.

[Человек_Борща]

даже не интересует.

Ну удачи вам тогда.

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

Ломитесь в инет, если ответ есть удаленного сервера пришел - вы в интернете, если не пришёл - вы не в интернете. Иных способов просто не существует.

[Stilet]

даже не интересует.

Если не интересует такое то просто пропингуй гугл или яндекс.

[min@y™]

Давно пора написать компонент-наследник TTimer:

type 
  TPingYaRu = class(TTimer)
    //....
    property OnLine: Boolean read ... ;  

    property OnInternetConnect: TNotifyEvent...;
    property OnInternetKirdyk: TNotifyEvent ...;
  end;

Всё руки не дойдут никак...

[beegl]

я так проверял:

uses WinInet;

 function TForm1.GetOnlineStatus: Boolean;
var
  Types: Integer;
begin
  Types := INTERNET_CONNECTION_MODEM +
  INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@Types, 0);
end;

[min@y™]

я так проверял

А если подключение есть, но это просто локальная сеть, то что выдаст твой метод?

[indexx]

Ну так может и спросить тип доступа у win?

[Человек_Борща]

Ну так может и спросить тип доступа у win?

Ну если контингент у вас чисто Win 8+ то проблем не будет. Да и фиг его знает, что винда там проверяет.

У меня нет интернета, а соединение все равно не ограничено и работает.

Решение все равно одно: стучаться к внешнему ресурсу, который 100% вне сети провайдера.

[min@y™]

стучаться к внешнему ресурсу, который 100% вне сети провайдера

Ну да. Могу предложить:

type
  TDnsLookupDone = procedure (Sender: TObject; Error: Word) of object;
  TPingDisplay   = procedure(Sender: TObject; Icmp: TObject; Msg : String) of object;
  TPingReply     = procedure(Sender: TObject; Icmp: TObject; Status : Integer) of object;
  TPingRequest   = procedure(Sender: TObject; Icmp: TObject) of object;
  TPing = class(TComponent)
  private
    FIcmp             : TICMP;
    FWindowHandle     : HWND;
    FDnsLookupBuffer  : array [0..MAXGETHOSTSTRUCT] of char;
    FDnsLookupHandle  : THandle;
    FDnsResult        : String;
    FOnDnsLookupDone  : TDnsLookupDone;
    FOnEchoRequest    : TPingRequest;
    FOnEchoReply      : TPingReply;
    FOnDisplay        : TPingDisplay;
  protected
    procedure   WndProc(var MsgRec: TMessage);
    procedure   WMAsyncGetHostByName(var msg: TMessage); message WM_ASYNCGETHOSTBYNAME;
    procedure   SetAddress(Value : String);
    function    GetAddress : String;
    procedure   SetSize(Value : Integer);
    function    GetSize : Integer;
    procedure   SetTimeout(Value : Integer);
    function    GetTimeout : Integer;
    function    GetReply : TIcmpEchoReply;
    function    GetErrorCode : Integer;
    function    GetErrorString : String;
    function    GetHostName : String;
    function    GetHostIP : String;
    procedure   SetTTL(Value : Integer);
    function    GetTTL : Integer;
    procedure   Setflags(Value : Integer);
    function    Getflags : Integer;
    function    GetICMPHandle : HModule;
//    procedure   SetOnDisplay(Value : TICMPDisplay);
//    function    GetOnDisplay : TICMPDisplay;
//    procedure   SetOnEchoRequest(Value : TNotifyEvent);
//    function    GetOnEchoRequest : TNotifyEvent;
//    procedure   SetOnEchoReply(Value : TICMPReply);
//    function    GetOnEchoReply : TICMPReply;
    procedure   IcmpEchoReply(Sender: TObject; Error : Integer);
    procedure   IcmpEchoRequest(Sender: TObject);
    procedure   IcmpDisplay(Sender: TObject; Msg: String);
  public
    constructor Create(Owner : TComponent); override;
    destructor  Destroy; override;
    function    Ping : Integer; virtual;
    procedure   DnsLookup(HostName : String); virtual;
    procedure   CancelDnsLookup;

    property    Reply         : TIcmpEchoReply read GetReply;
    property    ErrorCode     : Integer        read GetErrorCode;
    property    ErrorString   : String         read GetErrorString;
    property    HostName      : String         read GetHostName;
    property    HostIP        : String         read GetHostIP;
    property    Handle        : HWND           read FWindowHandle;
    property    DnsResult     : String         read FDnsResult;
    property    ICMPDLLHandle : HModule        read GetICMPHandle;
  published
    property    Address     : String         read  GetAddress
                                             write SetAddress;
    property    Size        : Integer        read  GetSize
                                             write SetSize;
    property    Timeout     : Integer        read  GetTimeout
                                             write SetTimeout;
    property    TTL         : Integer        read  GetTTL
                                             write SetTTL;
    property    Flags       : Integer        read  Getflags
                                             write SetFlags;
    property    OnDisplay   : TPingDisplay   read  FOnDisplay
                                             write FOnDisplay;
    property    OnEchoRequest : TPingRequest read  FOnEchoRequest
                                             write FOnEchoRequest;
    property    OnEchoReply   : TPingReply   read  FOnEchoReply
                                             write FOnEchoReply;
    property    OnDnsLookupDone : TDnsLookupDone
                                             read  FOnDnsLookupDone
                                             write FOnDnsLookupDone;
  end;