隨著網絡的普及越來越多的人開始過起了網絡生涯網站讓你目不暇接可是有的網站卻專門鑽IE的空子當你浏覽了它的主頁之後注冊表就會被禁止還會修改你的其他設置真是害人不淺還有一招更毒的你浏覽它的主頁後它會下載一個撥號器在你的硬盤撥號器會斷開你當前的連接去撥別的號（想一想撥一個長途國際電話一小時多少錢？！）所以我們這些撥號上網的用戶需要一個能隨時監測自己IP地址的軟件當IP發生改變時它會自動的報警;同時它還應該是透明的這樣即使運行時總在最前面也不會影響別的窗體
廢話不多說了馬上開工首先打開Delphi新建一個工程添加一個定時器Timer一個標簽Label一個PopupMenu並且為PopupMenu添加一個Exit菜單項下面就是全部的源代碼:
unit Unit;
interface
uses
Windows Messages SysUtils Variants Classes Graphics Controls Forms
Dialogs Menus StdCtrls ExtCtrls Winsock; //首先要添加winsock
type
TForm = class(TForm)
Timer: TTimer;
Label: TLabel;
PopupMenu: TPopupMenu;
Exit: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure LabelMouseMove(Sender: TObject; Shift: TShiftState; X
Y: Integer);
procedure LabelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X Y: Integer);
procedure ExitClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form: TForm;
oldxoldy: integer;//添加變量用做移動窗體
oldIp: string;
implementation
{$R *dfm}
//下面就是關鍵所在了
function LIP : string;
type
TaPInAddr = array [] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe : PHostEnt;
pptr : PaPInAddr;
Buffer : array [] of char;
I : Integer;
GInitData : TWSADATA;
begin
WSAStartup($ GInitData);
Result := ;
GetHostName(Buffer SizeOf(Buffer));
phe :=GetHostByName(buffer);
if phe = nil then Exit;
pptr := PaPInAddr(Phe^h_addr_list);
I := ;
while pptr^[I] <> nil do begin
result:=StrPas(inet_ntoa(pptr^[I]^));
Inc(I);
end;
WSACleanup;
end;
procedure TFormFormCreate(Sender: TObject);
begin
with Label do //定義屬性
begin
Caption:=;
FontCharset:=ANSI_CHARSET;
FontName:=Arial;
FontSize:=;
FontColor:=clRed;
Align:=alClient;
PopupMenu:=popupmenu;
end;
TimerInterval:=;
TimerEnabled:=true;
LabelCaption:=IP:+LIP; //賦值把Ip賦值給label
oldIp:=LIP;
BorderStyle:=bsNone;
Alphablend:=true; //呵呵這個就是讓窗口變透明的辦法了
Alphablendvalue:=;
FormStyle:=fsStayOnTop; //讓窗體總在最前面
end;
procedure TFormTimerTimer(Sender: TObject);
begin
LabelCaption :=IP:+LIP;
if oldip <> LIP then
Showmessage(IP地址已經改變請檢查!);//提醒用戶
end;
procedure TFormLabelMouseMove(Sender: TObject; Shift: TShiftState; X
Y: Integer);
begin
if ssleft in shift then //移動窗體Form
begin
FormLeft:=FormLeft+xoldx;
FormTop:=Formtop+yoldy;
end;
end;
procedure TFormLabelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X Y: Integer);
begin
oldx:=x;
oldy:=y;
end;
procedure TFormExitClick(Sender: TObject);
begin
Close;
end;
end
程序比較簡單我只想再說說透明窗體使窗體透明的方法有好幾種其中一種是我用的這種方法比較簡單還有一種是調用API函數SetLayeredWindowAttributes它有個參數分別是hwndcrKeybAlpha和dwFlagshwnd指操作的窗口的句柄crKey是指定要透明的顏色值是和第四個參數配合使用的（當第四個參數為LWA_COLORKEY）bAlpha是透明參數當bAlpha為時窗口全透明當值為時為正常的窗口比如要Form透明的話相應的語句是SetLayeredWindowAttributes(formHandle LWA_ALPHA)不過這個API只能在Win下用不支持Win
本程序在Delphi＋Win下調試通過
From:http://tw.wingwit.com/Article/program/Delphi/201311/24998.html
