Delphi多线程及消息发送传递结构体参数

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