What is the best way to log messages from a thread?

type
  TMyThread = class(TThread)
  private
    fFormMsgHandle: THandle;
  public
    constructor Create(CreateSuspended: Boolean; aFormMsgHandle: THandle);
  end;
 
constructor TMyThread.Create(CreateSuspended: Boolean; aFormMsgHandle: THandle);
begin
  inherited Create(CreateSuspended);
  fFormMsgHandle := aFormMsgHandle;
end;
 
procedure MyThread.LogDebugMessage (s : string) ;
begin
  CS.Enter;
  try
    if Buffer = '' then 
      Buffer := s
    else 
      Buffer := Buffer + #13#10 + s;
  finally
    CS.Leave;
  end;
  PostMessage(fFormMsgHandle, WM_USER, 0, 0); // Notify form of message in buffer
end; 
        
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:

type
  TForm1 = class(TForm)
  private
  protected
    procedure WMUser(var Msg: TMessage); message WM_USER;
  public
  
  end;
 
procedure TForm1.StartThread;
begin
  aThread := TMyThread.Create(False, Self.Handle);
end;
 
procedure TForm1.WMUser(var Msg: TMessage); 
begin
  CS.Enter;
  try
    MyMainForm.Memo1.Lines.Add (FormatDateTime ('c', Now) + ' ' + Buffer);
    Buffer := '';
  finally
    CS.Leave;
  end;
end ;
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

//  in thread
    procedure ReportProgress (BytesSoFar : integer ; TotalBytes: integer ; Msg : string ; var ABortRequest : boolean) ;
 
    begin
    CS.Enter
    // put parameters into mailbox
    mbSoFar := BytesSoFar ;
    mbOutOf := TotalBytes ;
    mbMsg    := Msg ;
 
    // read back abort flag
    AbortRequest := mbAbort ;
    CS.Leave  
    // fire off message to main form
    end ;
 
    begin // execute
    repeat
        ....
        ReportProgress (ByteSoFar, TotalBytesToRead, 'Reading ...', AbortMe) ;
        ....
     until finished or AbortMe ;
    end ;
 
// in the main loop
 
    on message handler, grab the byte counts and string and show them:
 
    on abort signal, set mbAbort := true 
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:

type
  TForm1 = class(TForm)
    Memo1: TRichEdit;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  private
    procedure WMUser(var Msg: TMessage); message WM_USER;
  end;
 
  TMyThread = class(TThread)
  private
    fFormMsgHandle: THandle;
  protected
    procedure Execute; override;
    procedure LogDebugMessage(aMsg : string);
  public
    constructor Create(CreateSuspended: Boolean; aFormMsgHandle: THandle);
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses SyncObjs;
 
{$R *.dfm}
 
var
  mMsgBuffer: TStrings;
  CS: TCriticalSection;
 
function LockBuffer: TStrings;
begin
  CS.Enter;
  if not Assigned(mMsgBuffer) then
  begin
    mMsgBuffer := TStringList.Create;
    mMsgBuffer.StrictDelimiter := True;
  end;
  Result := mMsgBuffer;
end;
 
procedure UnlockBuffer;
begin
  CS.Leave;
end;
 
constructor TMyThread.Create(CreateSuspended: Boolean; aFormMsgHandle: THandle);
begin
  inherited Create(CreateSuspended);
  fFormMsgHandle := aFormMsgHandle;
end;
 
procedure TMyThread.LogDebugMessage(aMsg : string);
begin
  with LockBuffer do
  try
    Add(aMsg);
  finally
    UnlockBuffer;
  end;
  PostMessage(fFormMsgHandle, WM_USER, 0, 0); // Notify form of message in buffer
end;
 
procedure TMyThread.Execute;
var Msg: TStrings;
  I: Integer;
begin
  // fast way :
  // LogDebugMessage('Progress=Min=0,Max=100,Value=0,Msg="Starting thread"');
  // easy way :
  Msg := TStringList.Create;
  try
    Msg.Clear;
    Msg.StrictDelimiter := True;
    Msg.Values['Min'] := '0';
    Msg.Values['Max'] := '100';
    Msg.Values['Value'] := '0';
    Msg.Values['Msg'] := 'Starting thread';
    LogDebugMessage('progress=' + Msg.DelimitedText);
    for I := 1 to 100 do
    begin
      Sleep(500);
      Msg.Values['Value'] := IntToStr(I);
      Msg.Values['Msg'] := 'Meter running : ' + IntToStr(I * 10) + '$';
      LogDebugMessage('progress=' + Msg.DelimitedText);
    end;
    Msg.Values['Msg'] := 'Thread finished';
    LogDebugMessage('progress=' + Msg.DelimitedText);
  finally
    Msg.Free;
  end;
end;
 
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  TMyThread.Create(False, Handle);
end;
 
procedure TForm1.WMUser(var Msg: TMessage);
var I, J: Integer;
  temp: TStrings;
begin
  with LockBuffer do
  try
    temp := TStringList.Create;
    try
      temp.StrictDelimiter := True;
      for I := 0 to Count - 1 do
      begin
        if SameText(Names[I], 'progress') then
        begin
          temp.DelimitedText := ValueFromIndex[I];
          Memo1.Lines.Add('Min   = ' + temp.Values['Min']);
          Memo1.Lines.Add('Max   = ' + temp.Values['Max']);
          Memo1.Lines.Add('Value = ' + temp.Values['Value']);
          Memo1.Lines.Add('Msg   = ' + temp.Values['Msg']);
        end;
      end;
    finally
      temp.Free;
    end;
  finally
    UnlockBuffer;
  end;
end;
 
initialization
  CS := TCriticalSection.Create;
finalization
  FreeAndNil(mMsgBuffer);
  CS.Free;
end.
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:

unit Unit1;
 
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
 
Const
  WM_LogMessage = WM_user + 100;
// used in the lParam for threads sending log messages
  tlmtinformation = 1;
  tlmtWarning = 2;
  tlmtError = 4;
// used in the lParam for threads sending log messages
  tldNone = 8;
  tldIn = 16;
  tldOut = 32;
// same as above, but used in the main thread's LogMessage() procedure
type TLogMessageType = (lmtInformation, lmtWarning, lmtError);
type TLogDirection = (ldNone, ldIn, ldOut);
 
type TWorkerThread = class(TThread)
  protected
    procedure execute; override;
  public
    ThreadName: string;
    LogHandle: THandle;
    Frequency: integer;
    Iterations: integer;
    constructor Create(CreateSuspended: Boolean; ThreadName_: string; LogHandle_: THandle; Frequency_, Iterations_: integer);
    procedure LogThreadMessage(LogMessageType: TLogMessageType; LogDirection: TLogDirection; S: string);
  end;
 
type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    bStartThreads: TButton;
    bStopThreads: TButton;
    procedure bStartThreadsClick(Sender: TObject);
    procedure bStopThreadClick(Sender: TObject);
  private
    { Private declarations }
    WatchedThread: TWorkerThread;
    procedure LogMessage(LogMessageType: TLogMessageType;
      LogDirection: TLogDirection; S: string);
    procedure StopThread;
  public
    { Public declarations }
    Procedure Message_Log(var Msg:TMessage);Message WM_LogMessage;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
 
 
{ TForm1 }
 
procedure TForm1.Message_Log(var Msg: TMessage);
var
  PS:PString;
  S: string;
  i: integer;
  LogMessageType: TLogMessageType;
  LogDirection: TLogDirection;
begin
 
  PS:=Pointer(Msg.WParam);
  S := PS^;
 
  i := Msg.LParam;
  if (i and tlmtinformation) = tlmtinformation then LogMessageType := lmtInformation;
  if (i and tlmtwarning) = tlmtwarning then LogMessageType := lmtWarning;
  if (i and tlmterror) = tlmterror then LogMessageType := lmtError;
 
  if (i and tldNone) = tldNone then LogDirection := ldNone;
  if (i and tldIn) = tldIn then LogDirection := ldIn;
  if (i and tldOut) = tldOut then LogDirection := ldOut;
  LogMessage(LogMessageType, LogDirection, S);
 
  //        FS.WriteBuffer(S^[1],Length(S^));
  Dispose(PS);
end;
 
procedure TForm1.LogMessage(LogMessageType: TLogMessageType; LogDirection: TLogDirection; S: string);
var
  FullMsg: string;
begin
  FullMSg := '';
  case LogMessageType of
    lmtInformation: FullMsg := '  ';
    lmtWarning: FullMsg := '? ';
    lmtError: FullMsg := '!  ';
  end;
 
  case LogDirection of
    ldNone: FullMsg := FullMsg + '   ';
    ldIn: FullMsg := FullMsg + '<- ';
    ldOut: FullMsg := FullMsg + '-> ';
  end;
  FullMsg := FullMsg + FormatDateTime('hh":"nn":"ss', Now) + ' ' + S;
  Listbox1.Items.Add(FullMsg);
  while Listbox1.Items.Count > 1000 do Listbox1.Items.Delete(0);
  Listbox1.ItemIndex := pred(Listbox1.Items.Count);
end;
 
procedure TForm1.bStartThreadsClick(Sender: TObject);
begin
  if assigned(WatchedThread) then
  begin
    StopThread;
  end;
  WatchedThread := TWorkerThread.Create(false, 'Watched Thread', self.Handle, 1000, 10);
  TWorkerThread.Create(false, 'Thread 1', self.handle, 1000, 5);
  TWorkerThread.Create(false, 'Thread 2', self.handle, 2000, 5);
  TWorkerThread.Create(false, 'Thread 3', self.handle, 100, 10);
end;
 
procedure TForm1.bStopThreadClick(Sender: TObject);
begin
  StopThread;
end;
 
procedure TForm1.StopThread;
begin
  if assigned(WatchedThread) then
  begin
    WatchedThread.Terminate;
    WatchedThread.Waitfor;
    WatchedThread := nil;
  end;
end;
 
{ TWorkerThread }
 
constructor TWorkerThread.Create(CreateSuspended: Boolean; ThreadName_: string; LogHandle_: THandle; Frequency_,
  Iterations_: integer);
begin
  inherited Create(CreateSuspended);
  ThreadName := ThreadName_;
  Frequency := Frequency_;
  Iterations := Iterations_;
  LogHandle := LogHandle_;
  FreeOnTerminate := True;
  LogThreadMessage(lmtInformation, ldNone, 'Started');
end;
 
procedure TWorkerThread.execute;
var
  i: integer;
begin
  i := 0;
  try
    while (not terminated) and (i < self.Iterations) do
    begin
      sleep(self.Frequency);
      inc(i);
      LogThreadMessage(lmtInformation, ldNone, IntToStr(i));
    end;
    if (terminated) then
      raise exception.Create('asked to terminate! - this is just for demo-ing...');
  except
    on e: exception do
    begin
     // sample only
      LogThreadMessage(lmtError, ldNone, e.Message);
    end;
  end;
  LogThreadMessage(lmtInformation, ldNone, 'Finished');
end;
 
procedure TWorkerThread.LogThreadMessage(LogMessageType: TLogMessageType;
  LogDirection: TLogDirection; S: string);
var
  i: Integer;
  PS: PString;
begin
  New(PS);
  PS^ := Format('(%s)%s', [self.ThreadName, S]);
  i := 0;
  if LogMessageType = lmtInformation then i := tlmtInformation;
  if LogMessageType = lmtWarning then i := tlmtWarning;
  if LogMessageType = lmtError then i := tlmtError;
 
  if LogDirection = ldNone then i := i + tldNone;
  if LogDirection = ldIn then i := i + tldIn;
  if LogDirection = ldOut then i := i + tldOut;
  PostMessage(LogHandle, WM_LogMessage, Integer(PS), i);
end;
 
end.
 
 
**********************
***  FORM FOLLOWS  ***
**********************
 
object Form1: TForm1
  Left = 249
  Top = 183
  Width = 785
  Height = 425
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 16
    Top = 52
    Width = 749
    Height = 289
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 14
    ParentFont = False
    TabOrder = 0
  end
  object bStartThreads: TButton
    Left = 20
    Top = 8
    Width = 75
    Height = 25
    Caption = 'bStartThreads'
    TabOrder = 1
    OnClick = bStartThreadsClick
  end
  object bStopThreads: TButton
    Left = 132
    Top = 8
    Width = 75
    Height = 25
    Caption = 'bStopThreads'
    TabOrder = 2
    OnClick = bStopThreadClick
  end
end

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249: