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.