Delphi-PRAXiS - Delphi Prüfen ob Pc online

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]info@utilmind.com[/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]74471.3622@compuserve.com[/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.