1、Unit2:
[delphi]
unit Unit2;
interface
uses windows,classes,NMICMP,SysUtils,StdCtrls,messages;
const WM_MY_PING = WM_USER +1024;
type
//要传递的消息记录.
TPingMsg = record
msg : array[0..1023] of char;
id : integer;
Handled : boolean;
msg2 : string; //建议如果需要动态管理，比如采用List,采用字符数组的方式会比较好，
//因为在动态使用结构时，如过没有处理好，采用string就可能会造成内存泄露.
//当然在这里例子中没关系.
end;
pPingMsg = ^TPingMsg;//定义结构体指针.
OnPinging = procedure(Context: integer;Msg : string) of object;
ThreadEnd = procedure(Context: integer;Msg:string) of object;
TMyPingThread = class(TThread)
private
FPingEvent : OnPinging;
FEndEvent : ThreadEnd;
FMsg : string;
FSequenceID : integer;
FWinHandl : Hwnd;
procedure OnPing(Sender: TObject; Host: String; Size, Time: Integer);
procedure HandlingEnd;
procedure HandlingPing;
protected
procedure Execute;override;
procedure DoTerminate;override;
public
//采用函数指针的方式，因为传递过来如果是UI控件类的方法，该方法需要访问UI元素，则需要做同步处理,
//否则可能会导致错误.
constructor Create(WinHandl : Hwnd; SequenceID : integer;OutPut: OnPinging;EndEvent: ThreadEnd);overload;
end;
implementation
{ TMyPingThread }
constructor TMyPingThread.Create(WinHandl : Hwnd;SequenceID : integer;OutPut: OnPinging; EndEvent: ThreadEnd);
begin
self.FPingEvent := OutPut;
self.FEndEvent := EndEvent;
FSequenceID := SequenceID;
FWinHandl := WinHandl;
inherited Create(true);
end;
procedure TMyPingThread.DoTerminate;
begin
inherited;
Synchronize(HandlingEnd);
end;
procedure TMyPingThread.HandlingEnd();
begin
if Assigned(self.FEndEvent) then
self.FEndEvent(FSequenceID,FMsg);
end;
procedure TMyPingThread.HandlingPing();
begin
if assigned(self.FPingEvent) then
FPingEvent(FSequenceID,FMsg);
end;
procedure TMyPingThread.Execute;
var
PingObj : TNMPing;
begin
self.FreeOnTerminate := true;
PingObj := TNMPing.Create(nil);
PingObj.OnPing := OnPing;
try
PingObj.Pings := 30;
PingObj.Host := 'www.sohu.com';
PingObj.Ping;
finally
PingObj.Free;
end;
end;
procedure TMyPingThread.OnPing(Sender: TObject; Host: String; Size,
Time: Integer);
var
pMsg : pPingMsg;
Msg : TPingMsg;
begin
//不能直接定义结构体，因为是局部变量，如果是PostMessage,不会等待，会释放的.
//但如果采用如下的new方式，程序不会主动释放内存，需要配合Dispose方法用.
new(pmsg);
//这种情况下，消息接收方不一定能获取到正确的值.
FMsg := host+':'+ inttostr(size)+':'+inttostr(Time);
strcopy(@(pmsg.msg),pchar(FMsg));
pmsg.id := self.FSequenceID;
pmsg.Handled := false;
pmsg.msg2 := FMsg+'xxx';//注意，这里增加字符，并不能增加sizeof(pmsg^)
Msg.msg2 := FMsg+'xxxx';//注意，这里增加字符，并不能增加sizeof(Msg)
strcopy(@(Msg.msg),pchar(FMsg));
//postmessage(FWinHandl,WM_MY_PING, self.FSequenceID,LPARAM(@Msg));
//因此我觉得采用SendMessage比较好，这样内存的释放可以在这里进行，不会造成内存泄露.
Sendmessage(FWinHandl,WM_MY_PING, self.FSequenceID,LPARAM(@Msg));
//这种方法是让线程等待消息处理，实际上等效于SendMessage方法调用.
{while (pmsg.Handled=false) do
begin
sleep(10);
end;
}
//采用等待方法则在这里释放空间。如果采用消息接收方处理，则这里不需要释放。
Dispose(Pmsg);
//Synchronize(HandlingPing);
end;
end.
2 form 调用Unit1
[delphi]
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,Unit2, StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
FThreadCount : integer;
procedure HandlingPing(Context:integer;Msg : string);
procedure HanglingEnd(Context:integer;Msg : string);
procedure OutPut(Context:integer;Msg : string);
procedure PingMsgHdl(var Msg:TMessage);message WM_MY_PING;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
AThread : TMyPingThread;
begin
FThreadCount := 4;
AThread := TMyPingThread.Create(self.Handle, 1,HandlingPing,HanglingEnd);
AThread.Resume;
AThread := TMyPingThread.Create(self.Handle,2,HandlingPing,HanglingEnd);
AThread.Resume;
AThread := TMyPingThread.Create(self.Handle,3,HandlingPing,HanglingEnd);
AThread.Resume;
AThread := TMyPingThread.Create(self.Handle,4,HandlingPing,HanglingEnd);
AThread.Resume;
end;
procedure TForm1.HandlingPing(Context:integer;Msg: string);
begin
OutPut(Context,Msg);
end;
procedure TForm1.HanglingEnd(Context:integer;Msg: string);
begin
OutPut(Context,Msg);
FThreadCount := FThreadCount -1;
OutPut(1,inttostr(FThreadCount));
end;
procedure TForm1.OutPut(Context: integer; Msg: string);
begin
case context of
1:
memo1.Lines.Append(Msg);
2:
memo2.Lines.Append(Msg);
3:
memo3.Lines.Append(Msg);
4:
memo4.Lines.Append(Msg);
end;
end;
procedure TForm1.PingMsgHdl(var Msg:TMessage);
var
pMsg : pPingMsg;
begin
pMsg := pPingMsg(Msg.LParam);
OutPut(Msg.WParam, pmsg.msg2+'=>'+inttostr(sizeof(pmsg^)));
//这个用于等待线程，这里已经处理完毕。当然这只是一种方法.
pMsg.Handled := true;
//另外一种方法是在这里释放内存，但用户又可能会忘记释放。
//dispose(pMsg);
end;
end.