1、Unit2:

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

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了，整个多线程都翻了好多帖子和记忆.