{*************************************************************}
{ 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.