Delphi实现随时随刻知道自己的IP
2008-02-23 07:20:18来源:互联网 阅读 ()
随着网络的普及,越来越多的人开始过起了网络生涯。网站让你目不暇接,可是有的网站却专门钻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下调试通过。
源程序下载地址: http://www.cfan.net.cn/qikan/cxg/0203sss.zip
上一篇: Delphi让你发送Flash电子邮件(1)
下一篇: Delphi让你发送Flash电子邮件(2)
标签:
版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有
IDC资讯: 主机资讯 注册资讯 托管资讯 vps资讯 网站建设
网站运营: 建站经验 策划盈利 搜索优化 网站推广 免费资源
网络编程: Asp.Net编程 Asp编程 Php编程 Xml编程 Access Mssql Mysql 其它
服务器技术: Web服务器 Ftp服务器 Mail服务器 Dns服务器 安全防护
软件技巧: 其它软件 Word Excel Powerpoint Ghost Vista QQ空间 QQ FlashGet 迅雷
网页制作: FrontPages Dreamweaver Javascript css photoshop fireworks Flash