Prüfen ob Pc online

[DataCool]

Hi,

noch ne Methode, aber gleich vorweg um TeronG ruhig zu stellen
Eine definitiv sichere Methode gibt es nicht :

Delphi-Quellcode:

{*************************************************************}
{            INetDetector Component for Delphi 32             }
{ Version:   2.1                                              }
{ E-Mail:    [email][e-mail][/email]                                }
{ Home Page: [url]http://www.utilmind.com[/url]                          }
{ 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][e-mail][/email]                        }
{ 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

{$R *.dcr}

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('Standard', [TINetDetector]);
end;

end.