1. unit2:
Unit unit2; interfaceuses windows, classes, nmicmp, sysutils, stdctrls, messages; const wm_my_ping = wm_user + 1024; Type // message record to be transferred. tpingmsg = record MSG: array [0 .. 1023] of char; ID: integer; handled: Boolean; msg2: string; // It is recommended that you use a list or a character array if you need dynamic management, // If the structure is not properly processed during dynamic use, using string may cause memory leakage. // Of course, it does not matter in this example. end; ppingmsg = ^ tpingmsg; // defines the struct pointer. onpinging = procedure (Context: integer; MSG: strin G) 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; overr IDE; Public // use the function pointer, because if the passed method is a UI control class, this method needs to access the UI elements, and needs to be synchronized, // otherwise, an error may occur. 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; fsequencei D: = 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; Procedure tmypingthread. onping (Sender: tobject; host: string; size, time: integer); var PMSG: ppingmsg; MSG: tpingmsg; begin // The struct cannot be directly defined because it is a local variable, if it is postmessage, it will be released if it does not wait. // but such If the new method is adopted, the program does not actively release the memory, and must be used with the dispose method. new (PMSG); // In this case, the message receiver may not be able to get the correct value. fmsg: = Host + ':' + inttostr (size) + ':' + inttostr (time); strcopy (@ (PMSG. MSG), pchar (fmsg); PMSG. ID: = self. fsequenceid; PMSG. handled: = false; PMSG. msg2: = fmsg + 'xxx'; // Note: The characters are added here, And the sizeof (PMSG ^) MSG cannot be added. msg2: = fmsg + 'xxxx'; // Note: add characters here, and do not add sizeof (MSG) strcopy (@ (MSG. MSG), pchar (fmsg); // postmessage (fwinhandl, wm_my_ping, self. FSE Quenceid, lparam (@ MSG); // Therefore, I think it is better to use sendmessage, so that the memory can be released here, without causing memory leakage. sendmessage (fwinhandl, wm_my_ping, self. fsequenceid, lparam (@ MSG); // This method allows the thread to wait for message processing, which is actually equivalent to the sendmessage method call. {While (PMSG. handled = false) Do begin sleep (10); End ;}// use the wait method to release space here. If the message receiver is used for processing, no release is required here. Dispose (PMSG); // synchronize (handlingping); end.
2 form call unit1
Unit unit1; interfaceuses 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 outputs (Sender: tobject); Private {private Declarations} fthreadcount: integer; Procedure handlingping (Context: integer; MSG: string); Procedure hanglingend (Co Ntext: 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. resum E; 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: I Nteger; 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; Procedure tform1.pingmsghdl (var msg: tmessage); var PMSG: ppingmsg; begin PMSG: = ppingm SG (MSG. lparam); output (MSG. wparam, PMSG. msg2 + '=>' + inttostr (sizeof (PMSG ^); // This is used to wait for the thread, which has been processed. Of course, this is only one method. PMSG. handled: = true; // another method is to release the memory here, but the user may forget to release it. // Dispose (PMSG); end.
PS: I haven't started Delphi for a long time, and I 've turned over many posts and memories throughout the multi-thread process.