Delphi實現隨時隨刻知道自己的IP

隨時隨刻知道自己的IP

　　隨著網絡的普及，越來越多的人開始過起了網絡生涯。網站讓你目不暇接，可是有的網站卻專門鑽IE的空子，當你浏覽了它的主頁之後，注冊表就會被禁止，還會修改你的其他設置，真是害人不淺。還有一招更毒的，你浏覽它的主頁後，它會下載一個撥號器在你的硬盤，撥號器會斷開你當前的連接去撥別的號（想一想，撥一個長途國際電話，一小時多少錢？！），所以，我們這些撥號上網的用戶需要一個能隨時監測自己IP地址的軟件，當IP發生改變時，它會自動的報警;同時，它還應該是透明的，這樣即使運行時總在最前面，也不會影響別的窗體。

　　廢話不多說了，馬上開工。首先打開Delphi新建一個工程，添加一個定時器Timer1、一個標簽Label1、一個PopupMenu1，並且為PopupMenu1添加一個Exit菜單項。下面就是全部的源代碼:

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, ExtCtrls, Winsock; //首先要添加winsock
type
TForm1 = class(TForm)
Timer1: TTimer;
Label1: TLabel;
PopupMenu1: TPopupMenu;
Exit: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ExitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
oldx,oldy: integer;//添加變量,用做移動窗體
oldIp: string;
implementation
{$R *.dfm}
//下面就是關鍵所在了
function LIP : 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:=StrPas(inet_ntoa(PPTr^[I]^));
Inc(I);
end;
WSACleanup;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
with Label1 do //定義屬性
begin
Caption:='';
Font.Charset:=ANSI_CHARSET;
Font.Name:='Arial';
Font.Size:=10;
Font.Color:=clRed;
Align:=alClIEnt;
PopupMenu:=popupmenu1;
end;

Timer1.Interval:=1000;
Timer1.Enabled:=true;
Label1.Caption:='IP:'+LIP; //賦值，把Ip賦值給label1
oldIp:=LIP;
BorderStyle:=bsNone;
Alphablend:=true; //呵呵，這個就是讓窗口變透明的辦法了
Alphablendvalue:=100;
FormStyle:=fsStayOnTop; //讓窗體總在最前面
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
Label1.Caption :='IP:'+LIP;
if oldip <> LIP then
Showmessage('IP地址已經改變,請檢查!');//提醒用戶
end;

procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssleft in shift then //移動窗體Form1
begin
Form1.Left:=Form1.Left+x-oldx;
Form1.Top:=Form1.top+y-oldy;
end;
end;

procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
oldx:=x;
oldy:=y;
end;

procedure TForm1.ExitClick(Sender: TObject);
begin
Close;
end;
end.

　　程序比較簡單，我只想再說說透明窗體。使窗體透明的方法有好幾種，其中一種是我用的這種，方法比較簡單。還有一種是調用API函數SetLayeredWindowAttributes，它有4個參數，分別是hwnd、crKey、bAlpha和dwFlags。hwnd指操作的窗口的句柄，crKey是指定要透明的顏色值，是和第四個參數配合使用的（當第四個參數為LWA_COLORKEY），bAlpha是透明參數，當bAlpha為0時窗口全透明，當值為255時為正常的窗口。比如要Form1透明的話，相應的語句是SetLayeredWindowAttributes(form1.Handle, 0, 100, LWA_ALPHA)，不過這個API只能在Win2000下用，不支持Win98。

本程序在Delphi6.0＋Win2000下調試通過。