- Код: Выделить всё
program thtest;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, ther
{ you can add units after this };
type
{ Tthtest }
Tthtest = class(TCustomApplication)
protected
FHER : TTher;
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
{ Tthtest }
procedure Tthtest.DoRun;
var
ErrorMsg: String;
i : integer;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
Terminate;
Exit;
end;
FHER.Resume;
i:=0;
while i<10 do begin
inc(i);
Sleep(1000);
{ add your program here }
end;
ReadLn;
// stop program loop
Terminate;
end;
constructor Tthtest.Create(TheOwner: TComponent);
begin
FHER := TTher.Create(true);
inherited Create(TheOwner);
end;
destructor Tthtest.Destroy;
begin
FHER.Destroy;
inherited Destroy;
end;
procedure Tthtest.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: Tthtest;
begin
Application:=Tthtest.Create(nil);
Application.Title:='thtest';
Application.Run;
Application.Free;
end.
Поток тоже простой:
- Код: Выделить всё
unit ther;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
type
{ TTher }
TTher = class(TThread)
private
FMess : string;
procedure SendMessLog(strMess : string);
procedure SynchSendMessLog;
protected
procedure Execute;override;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy;override;
end;
implementation
{ TTher }
procedure TTher.SendMessLog(strMess: string);
begin
FMess:=strMess;
Synchronize(@SynchSendMessLog);
end;
procedure TTher.SynchSendMessLog;
begin
writeln(FMess);
end;
procedure TTher.Execute;
begin
SendMessLog('EXECUTE');
sleep(100);
end;
constructor TTher.Create(CreateSuspended: Boolean);
begin
SendMessLog('CREATE');
inherited Create(CreateSuspended);
end;
destructor TTher.Destroy;
begin
SendMessLog('DESTROY');
inherited Destroy;
end;
end.
Такое ощущение, что при вызове SendMessLog в методе Execute он зависает в ожидании. Чувствую что истина где то рядом, но понять не могу. После разрушения потока в консоль выводится два раза DESTROY.