beh.tehrani
04-15-2009, 12:41 AM
unit OnlineIP;
interface
uses
Windows, Messages, Winsock, Classes, Forms;
type
TOnlineIP = class(TComponent)
private
FEnabled: Boolean;
FDispatchInterval: Cardinal;
FWindowHandle: hWnd;
FOnline: Boolean;
FIP: String;
FOnChanged: TNotifyEvent;
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetDispatchInterval(Value: Cardinal);
procedure SetNoneBool(Value: Boolean);
procedure SetNoneStr(Value: String);
procedure WndProc(var Msg: TMessage);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Enabled: Boolean read FEnabled write SetEnabled;
property DispatchInterval: Cardinal read FDispatchInterval write SetDispatchInterval;
property Online: Boolean read FOnline write SetNoneBool;
property IP: String read FIP write SetNoneStr;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;
procedure Register;
implementation
function LocalIP: String;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^[I] <> nil do
begin
Result := inet_ntoa(pptr^[I]^);
Inc(I);
end;
WSACleanup;
end;
constructor TOnlineIP.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := True;
FDispatchInterval := 1000;
FWindowHandle := AllocateHWnd(WndProc);
UpdateTimer;
end;
destructor TOnlineIP.Destroy;
begin
FEnabled := False;
UpdateTimer;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TOnlineIP.WndProc(var Msg: TMessage);
var
OldState: Boolean;
begin
with Msg do
if Msg = wm_Timer then
try
FIP := LocalIP;
OldState := FOnline;
FOnline := (FIP <> '') and (FIP <> '127.0.0.1');
if (not OldState and FOnline) or
(OldState and not FOnline) then
if Assigned(FOnChanged) then FOnChanged(Self);
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure TOnlineIP.UpdateTimer;
begin
KillTimer(FWindowHandle, 1);
if (FDispatchInterval <> 0) and FEnabled then
SetTimer(FWindowHandle, 1, FDispatchInterval, nil);
end;
procedure TOnlineIP.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;
procedure TOnlineIP.SetDispatchInterval(Value: Cardinal);
begin
if Value <> FDispatchInterval then
begin
FDispatchInterval := Value;
UpdateTimer;
end;
end;
procedure TOnlineIP.SetNoneBool(Value: Boolean); begin {} end;
procedure TOnlineIP.SetNoneStr(Value: String); begin {} end;
procedure Register;
begin
RegisterComponents('Xacker', [TOnlineIP]);
end;
end.
i'm using delphi 2009
interface
uses
Windows, Messages, Winsock, Classes, Forms;
type
TOnlineIP = class(TComponent)
private
FEnabled: Boolean;
FDispatchInterval: Cardinal;
FWindowHandle: hWnd;
FOnline: Boolean;
FIP: String;
FOnChanged: TNotifyEvent;
procedure UpdateTimer;
procedure SetEnabled(Value: Boolean);
procedure SetDispatchInterval(Value: Cardinal);
procedure SetNoneBool(Value: Boolean);
procedure SetNoneStr(Value: String);
procedure WndProc(var Msg: TMessage);
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Enabled: Boolean read FEnabled write SetEnabled;
property DispatchInterval: Cardinal read FDispatchInterval write SetDispatchInterval;
property Online: Boolean read FOnline write SetNoneBool;
property IP: String read FIP write SetNoneStr;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
end;
procedure Register;
implementation
function LocalIP: String;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
begin
WSAStartup($101, GInitData);
Result := '';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then Exit;
pPtr := PaPInAddr(phe^.h_addr_list);
I := 0;
while pPtr^[I] <> nil do
begin
Result := inet_ntoa(pptr^[I]^);
Inc(I);
end;
WSACleanup;
end;
constructor TOnlineIP.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := True;
FDispatchInterval := 1000;
FWindowHandle := AllocateHWnd(WndProc);
UpdateTimer;
end;
destructor TOnlineIP.Destroy;
begin
FEnabled := False;
UpdateTimer;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TOnlineIP.WndProc(var Msg: TMessage);
var
OldState: Boolean;
begin
with Msg do
if Msg = wm_Timer then
try
FIP := LocalIP;
OldState := FOnline;
FOnline := (FIP <> '') and (FIP <> '127.0.0.1');
if (not OldState and FOnline) or
(OldState and not FOnline) then
if Assigned(FOnChanged) then FOnChanged(Self);
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure TOnlineIP.UpdateTimer;
begin
KillTimer(FWindowHandle, 1);
if (FDispatchInterval <> 0) and FEnabled then
SetTimer(FWindowHandle, 1, FDispatchInterval, nil);
end;
procedure TOnlineIP.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;
procedure TOnlineIP.SetDispatchInterval(Value: Cardinal);
begin
if Value <> FDispatchInterval then
begin
FDispatchInterval := Value;
UpdateTimer;
end;
end;
procedure TOnlineIP.SetNoneBool(Value: Boolean); begin {} end;
procedure TOnlineIP.SetNoneStr(Value: String); begin {} end;
procedure Register;
begin
RegisterComponents('Xacker', [TOnlineIP]);
end;
end.
i'm using delphi 2009