{*************************************************************} 
 {            INetDetector Component for Delphi 32             } 
 { Version:   2.1                                              } 
 { E-Mail:    info@utilmind.com                                } 
 { 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.                                     } 
 {*************************************************************} 


 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: AnsiString;  { <--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);
     procedure  fCheckOnline(ReactOnChange: Boolean);
   protected 
   public 
     constructor  Create(AOwner: TComponent); override;
     destructor  Destroy; override;

     property  CurrentIP: AnsiString read FCurrentIP;  { <--RLM Diagnostics } 
     property  pCurrHostEnt: PHostEnt read FpCurrHostEnt;  { <--RLM Diagnostics } 
     procedure  CheckOnline;
   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.fCheckOnline(ReactOnChange: Boolean);
 var 
  OldState: Boolean;
  Key: hKey;
  PC:  array  [ 0  ..  4 ]  of  AnsiChar;
  Size: Integer;
  RegSays: Boolean;

   function  IsIPPresent: Boolean;
   type 
    TaPInAddr =  array  [ 0  ..  10 ]  of  PInAddr;
    PaPInAddr = ^TaPInAddr;
   var 
    phe: PHostEnt;
    pptr: PaPInAddr;
    Buffer:  array  [ 0  ..  63 ]  of  AnsiChar;
    I: Integer;
    GInitData: TWSAData;
    IP: AnsiString;
   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^ <>  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  ReactOnChange  then 
       if  ( not  OldState  and  FOnline)  or  (OldState  and   not  FOnline)  then 
         if  Assigned(FOnChanged)  then 
          FOnChanged(Self);
   end ;

 begin 
   try 
    OldState := FOnline;
    FOnline := IsIPPresent;

     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 
        RegSays := PC[ 0 ] = # 1 ;
        FOnline := FOnline  or  RegSays;
       end 
       else 
        FOnline := IsIPPresent;
      RegCloseKey(Key);
     end 
     else 
      FOnline := IsIPPresent;
    FixOnlineState;
   except 
    Application.HandleException(Self);
   end 
 end ;

 procedure  TINetDetector.CheckOnline;
 begin 
  fCheckOnline(False);
 end ;

 procedure  TINetDetector.WndProc( var  Msg: TMessage);
 begin 
   with  Msg  do 
     if  Msg = wm_Timer  then 
      fCheckOnline(True)
     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   [i]{ }   end ;

 procedure  register;
 begin 
  RegisterComponents('Linguisitor', [TINetDetector]);
 end ;

 end .