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.
PS:好久沒搞Delphi了，整個多線程都翻了好多帖子和記憶
作者 Cannel_2020
