我做了个多线程的Ping 程序,我把它贴出来(我写的不好,不要见怪)!
主文件:Main.pas
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Spin, StdCtrls, Buttons,ThreadPing,winsock;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Search: TSpeedButton;
Label4: TLabel;
IP1: TEdit;
IP2: TEdit;
M1: TMemo;
MaxThread: TSpinEdit;
procedure SearchClick(Sender: TObject);
procedure IP1Change(Sender: TObject);
private
ScIP1,ScIP2,IPIndex
word;
Ping_ThreadCount
word;
procedure SearchOK;
procedure SearchST;
procedure ThreadDone(Sender: TObject);
{ Private declarations }
public
StopThread:boolean; //停止线程标记
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.SearchClick(Sender: TObject);
begin
if search.tag =0 then begin
SearchST(); //开始
end
else begin
m1.Lines.Add('[用户中断]');
SearchOK();
end;
end;
procedure TForm1.IP1Change(Sender: TObject);
var
Address
word;
i,j:integer;
begin
j:=0;
for i:=1 to length(ip1.text) do
begin
if ip1.text
='.' then j:=j+1;
end;
if j>=3 then begin
Address:=inet_addr(pchar(ip1.text));
if (Address = INADDR_NONE) then exit;
address:=address or $FF000000;
ip2.Text :=AddrtoIP(address);
end
else begin
ip2.text:=ip1.text;
end;
end;
procedure Tform1.SearchST();
var
i,TempIP1,TempIP2word;
j:integer;
TempThread:TPing;
begin
//Ping_ThreadCount:=0;
StopThread:=false;
TempIP1:=inet_addr(pchar(ip1.text)); //把IP转为数值
TempIP2:=inet_addr(pchar(ip2.text)); //把IP转为数值
if (TempIP1 = INADDR_NONE) or (TempIP2 = INADDR_NONE) then begin
ShowMessage('IP输入错误!');
exit;
end;
ScIP1:=DwordHH(tempip1);
ScIP2:=DwordHH(tempip2);
IPIndex:=scip1;
if ScIP1 > ScIP2 then begin
ShowMessage('IP1大于IP2错误!');
exit;
end;
search.Caption :='暂止扫描';
search.tag:=1;
m1.Lines.Clear;
m1.Lines.Add(
'正在列举打开的IP....'#13#10 +
'[ IP地址 ] [ 时间 ]'#13#10 +
'------------------------------------------'
);
m1.Update;
j:=MaxThread.Value-1;
if (j>(scip2-scip1)) then j:=scip2-scip1;
for i := 0 to j do
begin
TempThread:=Tping.Create(m1,DwordHH(IPIndex)); //创建线程
TempThread.OnTerminate :=ThreadDone; //线程处理完后要处理的事
end;
form1.caption:='正在扫描' + AddrtoIP(DwordHH(ipindex));
Ping_ThreadCount:=j;
IPIndex:=IPIndex+1;
end;
procedure TForm1.SearchOK();
begin
m1.Lines.Add('------------------------------------------'#13#10'扫描完成。');
StopThread:=true;
search.Caption :='开始扫描';
search.tag:=0;
end;
procedure TForm1.ThreadDone(Sender: TObject);
var
TempThread:Tping;
begin
//Label3.Caption :='线程数: ' + inttostr(Ping_ThreadCount);
if (Ping_ThreadCount =0) and (StopThread=false) then begin
SearchOK;
exit;
end;
Ping_ThreadCount:=Ping_ThreadCount-1;
if (IPIndex > scip2) or StopThread then exit;
TempThread:=Tping.Create(m1,DwordHH(IPIndex)); //创建线程
TempThread.OnTerminate :=ThreadDone; //线程处理完后要处理的事
Ping_ThreadCount:=Ping_ThreadCount+1;
form1.caption:='正在扫描' + AddrtoIP(DwordHH(ipindex));
IPIndex:=IPIndex+1;
end;
//===== END =====
end.
线程文件:ThreadPing.pas
unit ThreadPing;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls,winsock;
type
DWORD=LongWord;
THandle=LongWord;
PIPOptionInformation = ^TIPOptionInformation;
TIPOptionInformation = record
TTL: Byte;
TOS: Byte;
Flags: Byte;
OptionsSize: Byte;
OptionsData: PChar;
end;
PIcmpEchoReply = ^TIcmpEchoReply;
TIcmpEchoReply = record
Address: DWORD;
Status: DWORD;
RTT: DWORD;
DataSize:Word;
Reserved: Word;
Data: Pointer;
Options: TIPOptionInformation;
end;
TRePingData =Record //返回的Ping数据
Address:in_addr; //IP地址
RTTWORD; //所用的时间!
ErrorWORD; //错误信息
end;
function DwordHH(addrword)word;
function HostNameToIP(S:string)Word;
function AddrtoIP(addrword):string;
function IcmpCreateFile():THandle;stdcall external 'ICMP.dll';
function IcmpCloseHandle(Handle:THandle):Boolean;stdcall external 'ICMP.dll';
function IcmpSendEcho(Handle:THandle;DestAddrWORD;
RequestData: Pointer;RequestSize: Word;RequestOptions: PIPOptionInformation;
ReplyBuffer: Pointer;ReplySize: DWORD;Timeout: DWORD): DWORD;stdcall external 'ICMP.dll';
function ICMP_Ping(IPAddrWORD;TimeOut:Word;nTTL:Byte;var Re:TRePingData):Boolean;
type
TPing = class(TThread)
public
constructor Create(Show_Config:TMemo;ip1Word); //创建线程
private
tShowConfig:TMemo;
Thip1word;
PingRe:TRePingData;
procedure AddPing;
// ShowData:string;
{ Private declarations }
protected
procedure Execute; override;
end;
implementation
uses main;
//地址《=》Dword 互换
function DwordHH(addrword)word;
var
oldstr:string;
Newstr:string;
begin
oldstr:=inttohex(addr,8);
newstr:=oldstr[7]+oldstr[8] +oldstr[5]+oldstr[6] +oldstr[3]+oldstr[4] +oldstr[1]+oldstr[2];
Result:=strtoint('$' +newstr);
end;
//==== 域名、IP自动转为IP ====
function HostNameToIP(S:string)Word;
var
HostHostent;
AddressWord;
begin
Address := inet_addr(PChar(S));
if (Address = INADDR_NONE) then begin
Host:=GetHostByName(Pchar(S));
if Host = nil then begin
HostNameToIP:=INADDR_NONE;
exit;
end
else begin
hostNametoip:=longint(pointer(Host^.h_addr_list^)^);
exit;
end;
end
else begin
HostNameToIP:=Address;
exit;
end;
end;
//==== END ====
function AddrtoIP(addrword):string;
begin
Result:=format('%d.%d.%d.%d',[Lo(Loword(addr)), //最底位
Hi(Loword(addr)),
Lo(Hiword(addr)),
Hi(Hiword(addr))]); //最高位
end;
// ====== Ping ======
function ICMP_Ping(IPAddrWORD;TimeOut:Word;nTTL:Byte;var Re:TRePingData):Boolean;
const Size = 56;
var
hICMP:THandle; //ICMP 句柄
BufferSize, nPkts: Integer;
pReqData, pData: Pointer;
pIPE: PIcmpEchoReply; // ICMP 回应报文
IPOpt: TIPOptionInformation; // 需要发送的 IP Options 数据包
begin
hIcmp:=IcmpCreateFile(); //创建ICMP句柄
//--- 检测 ---
// 创建ICMP出错 IP出错
if (hICMP=INVALID_HANDLE_VALUE) or (IPAddr = INADDR_NONE) then begin
ShowMessage('创建ICMP出错/IP出错');
Result:=false;
exit;
end;
BufferSize := SizeOf(TICMPEchoReply) + Size;
GetMem(pReqData, Size);
GetMem(pData, Size);
GetMem(pIPE, BufferSize);
FillChar(pReqData^, Size, $AA);
pIPE^.Data := pData;
FillChar(IPOpt, SizeOf(IPOpt), 0);
IPOpt.TTL := nTTL;
NPkts := IcmpSendEcho(hICMP, //DLL句柄
IPAddr, //目标地址
pReqData, //数据
Size, //数据长度
@IPOpt, //Ping Option 的地址
pIPE, //
BufferSize, //包大小
TimeOut); //超时时间
if Npkts =0 then begin
re.Error := GetLastError(); //得到错误!
result:=false;
end
else begin
re.Address.S_addr :=pIPE^.Address;
re.RTT :=pipe^.RTT;
Result:=true;
end;
end;
//======================================
{ 线程 }
//======================================
constructor TPing.Create(Show_Config:TMemo;ip1Word); //创建线程
begin
inherited Create(False);
tShowConfig:=Show_Config; //绑定控件
Thip1:=ip1;
FreeOnTerminate := True; //确定当线程终止时是否自动删除线程对象。TRUE 为删除!
end;
//-Ping输出
procedure TPing.AddPing;
begin
if form1.StopThread then exit; //如果已按了停止按钮就退出(即不再输出扫描到的端口)
tshowconfig.Lines.Add(format('%-15s %d 毫秒',[AddrtoIP(Thip1),PingRe.RTT]));
end;
procedure TPing.Execute;
begin
if ICMP_Ping(Thip1,5000,64,PingRe) then begin
Synchronize(AddPing); //如果端口打开就把内容显示在文本框中
end;
if Terminated then Exit;
end;
end.