Sprawdzenie połączenia z Internetem (Neostrada)

Używam poniższej funkcji:

function InternetWlaczony: Boolean;
var
 Flags: DWORD;
begin
 Flags := INTERNET_CONNECTION_MODEM or
          INTERNET_CONNECTION_LAN or
          INTERNET_CONNECTION_PROXY or
          INTERNET_CONNECTION_MODEM_BUSY;

 Result := InternetGetConnectedState(@Flags, 0);
end;

Niestety przy połączeniu przez Neostradę, funkcja zwraca False. Używałem kiedyś dodatkowe sprawdzenia poprzez ICMP

//komponent TidICMPClient (lub dowolny inny icmp)
var
 Polaczenie: Boolean = False;

function TFormTest.InternetWlaczony: Boolean;
begin
 try
   try
    IdIcmpClient.Host := 'www.google.pl';
    IdIcmpClient.Ping;
    Result := Polaczenie;

    {Sprawdź jeszcze z inną stroną}
    if not Result then
      begin
       IdIcmpClient.Host := 'www.microsoft.com';
       IdIcmpClient.Ping;
      end;

   except
   end;
  finally
   Result := Polaczenie;
  end;
end;

procedure TFormTest.IdIcmpClientReply(ASender: TComponent;
  const AReplyStatus: TReplyStatus);
begin
 if AReplyStatus.BytesReceived > 0 then Polaczenie := True;
end;

Ale w tym przypadku wiele programów antywirusowych może się przyczepić, ponieważ ICMP jest używane także do ataków.

Najlepszym rozwiązaniem byłoby zmodyfikowanie pierwszej funkcji do poprawnej pracy z Neostradą.

Jak na mój gust to źle używasz funkcji InternetGetConnectedState
Na http://msdn.microsoft.com/en-us/library/windows/desktop/aa384702(v=vs.85).aspx jest wyraźnie napisane, że parametr lpdwFlags jest wyjściowy. W Twoim przypadku pewnie zwraca False z ustawioną flagą INTERNET_CONNECTION_CONFIGURED co oznacza:

If FALSE is returned, the INTERNET_CONNECTION_CONFIGURED flag may be set to indicate that autodial is configured to "always dial" but is not currently active.

MSDN-InternetGetConnectedState napisał(a)

It does not guarantee that a connection to a specific host can be established.

Skoro sprawdzasz czy internet działa to pewnie w jakimś celu, a skoro masz jakiś cel to czemu od razu nie spróbujesz się połączyć żeby mieć pewność?

pewnie jest jakis sposob poprzez api, ja tam twardo sprawdzalem indy get i jakas stronke.
Najpewnie jakas stronke pokazujaca twoje ip, jak pobierze cos to dobrze a jak juz wyluskasz swoje ip nawet to tym bardziej wiesz, ze dziala :)

mychal napisał(a):

Jak na mój gust to źle używasz funkcji InternetGetConnectedState

Tak jest stosowana ta funkcja we wszystkich przykładach jakie spotkałem.
Sprawdzania dokonuje po to wcześniej, aby nie wywoływać wątku.

Ale może faktycznie rozwiązaniem jest właśnie zapytanie przez Get.

Kiedyś pobrałem taki komponent i u mnie działał, a teraz nie mogę sprawdzić bo nie mam windowsa

 
{*************************************************************}
{            INetDetector Component for Delphi 32             }
{ Version:   2.1                                              }
{ E-Mail:    [email protected]                                }
{ Home Page: http://www.utilmind.com                          }
{ Created:   November 5, 1999                                 }
{ Modified:  November 12, 1999                                }
{ Legal:     Copyright (c) 1999, UtilMind Solutions           }
{*************************************************************}
{ This component determines online status of the computer     }
{ (Connected or Disconnected).                                }
{*************************************************************}
{ PROPERTIES:                                                 }
{   Online: Boolean - Online status of local machine          }
{   DispatchInterval - Determines in milliseconds the         }
{                      intervals of time between checking     }
{                      online of a mode of the computer       }
{   Enabled: Boolean - As usual... =) If True then often      }
{                      queries for Internet Connection        }
{ EVENTS:                                                     }
{   OnChanged - causes if online status changed.              }
{*************************************************************}
{ Please see demo program for more information.               }
{*************************************************************}
{                     IMPORTANT NOTE:                         }
{ This software is provided 'as-is', without any express or   }
{ implied warranty. In no event will the author be held       }
{ liable for any damages arising from the use of this         }
{ software.                                                   }
{ Permission is granted to anyone to use this software for    }
{ any purpose, including commercial applications, and to      }
{ alter it and redistribute it freely, subject to the         }
{ following restrictions:                                     }
{ 1. The origin of this software must not be misrepresented,  }
{    you must not claim that you wrote the original software. }
{    If you use this software in a product, an acknowledgment }
{    in the product documentation would be appreciated but is }
{    not required.                                            }
{ 2. Altered source versions must be plainly marked as such,  }
{    and must not be misrepresented as being the original     }
{    software.                                                }
{ 3. This notice may not be removed or altered from any       }
{    source distribution.                                     }
{*************************************************************}

{*************************************************************}
{            --------------------------------------           }
{ Version:   2.1D                                             }
{ Modified:  R.L. Miller                                      }
{ E-Mail:    [email protected]                        }
{ Modified:  December 13, 1999                                }
{ Legal:     Added several r/o properties for diagnostics     }
{*************************************************************}
{ NEW PROPERTIES:                                             }
{  CurrentIP : String (R/O runtime only).Allows me to monitor }
{              what's going on inside IsIPPresent local func  }
{              inside WndProc().                              }
{  pCurrHostEnt : PHostEnt (R/O runtime only).  Same reason   }
{*************************************************************}


unit INetDetector;

interface

uses
  Windows, Messages, Classes, Forms, Winsock;

type
  TINetDetector = class(TComponent)
  private
    FEnabled: Boolean;
    FDispatchInterval: Cardinal;
    FWindowHandle: hWnd;
    FOnline: Boolean;
    FOnChanged: TNotifyEvent;

    FCurrentIP : String;       {<--RLM Diagnostics}
    FpCurrHostEnt : PHostEnt;  {<--RLM Diagnostics}

    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetDispatchInterval(Value: Cardinal);
    procedure SetNoneBool(Value: Boolean);
    procedure WndProc(var Msg: TMessage);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property CurrentIP : String read FCurrentIP;  {<--RLM Diagnostics}
    property pCurrHostEnt : PHostEnt read FpCurrHostEnt;  {<--RLM Diagnostics}

  published
    property Enabled: Boolean read FEnabled write SetEnabled;
    property DispatchInterval: Cardinal read FDispatchInterval write SetDispatchInterval;
    property Online: Boolean read FOnline write SetNoneBool;
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
  end;

procedure Register;

implementation

constructor TINetDetector.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FDispatchInterval := 1000;
  FWindowHandle := AllocateHWnd(WndProc);
  UpdateTimer;
end;

destructor TINetDetector.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TINetDetector.WndProc(var Msg: TMessage);
var
  OldState: Boolean;
  Key: hKey;
  PC: Array[0..4] of Char;
  Size: Integer;
  RegSays : Boolean;  {<-- RLM 12/13/99}

  function IsIPPresent: Boolean;
  type
    TaPInAddr = Array[0..10] of PInAddr;
    PaPInAddr = ^TaPInAddr;
  var
    phe: PHostEnt;
    pptr: PaPInAddr;
    Buffer: Array[0..63] of Char;
    I: Integer;
    GInitData: TWSAData;
    IP: String;
  begin
    WSAStartup($101, GInitData);
    Result := False;
    GetHostName(Buffer, SizeOf(Buffer));
    phe := GetHostByName(buffer);
    FpCurrHostEnt := phe;
    if phe = nil then Exit;
    pPtr := PaPInAddr(phe^.h_addr_list);
    I := 0;
    while pPtr^[I] <> nil do
     begin
      IP := inet_ntoa(pptr^[I]^);
      Inc(I);
     end;
    FCurrentIP := IP;
    WSACleanup;
    Result := (IP <> '') and (IP <> '127.0.0.1');
  end;

  procedure FixOnlineState;
  begin
    if (not OldState and FOnline) or
       (OldState and not FOnline) then
       if Assigned(FOnChanged) then
        FOnChanged(Self);
  end;

begin     
  with Msg do
   if Msg = wm_Timer then
    try
     OldState := FOnline;
     FOnline := IsIPPresent;
     FixOnlineState;

     if RegOpenKey(HKEY_LOCAL_MACHINE, 'System\CurrentControlSet\Services\RemoteAccess', Key) = ERROR_SUCCESS then
      begin
       Size := 4;
       if RegQueryValueEx(Key, 'Remote Connection', nil, nil, @PC, @Size) = ERROR_SUCCESS then
        begin
         {Original}
         {
         FOnline := PC[0] = #1;
         FixOnlineState;
         }
         {Changed 12/13/99 RLM -- AOL leaves PC bytes all 00's}
         RegSays := PC[0] = #1;
         FOnLine := FOnLine or RegSays;
         FixOnlineState;
        end
       else
        begin
         FOnline := IsIPPresent;
         FixOnlineState;
        end;
       RegCloseKey(Key);
      end
     else
      begin
       FOnline := IsIPPresent;
       FixOnlineState;
      end;
    except
     Application.HandleException(Self);
    end
   else
    Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;

procedure TINetDetector.UpdateTimer;
begin
  KillTimer(FWindowHandle, 1);
  if (FDispatchInterval <> 0) and FEnabled then
   SetTimer(FWindowHandle, 1, FDispatchInterval, nil);
end;

procedure TINetDetector.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
   begin
    FEnabled := Value;
    UpdateTimer;
   end;
end;

procedure TINetDetector.SetDispatchInterval(Value: Cardinal);
begin
  if Value <> FDispatchInterval then
   begin
    FDispatchInterval := Value;
    UpdateTimer;
   end;
end;

procedure TINetDetector.SetNoneBool(Value: Boolean); begin {} end;

procedure Register;
begin
  RegisterComponents('UtilMind', [TINetDetector]);
end;

end.