在Com中创建线程的奇怪问题(不是在线程中使用COM)----问题尚未解决 ( 积分: 100 )

将一个在外面运行良好的线程移植到COM中后，发现居然无法触发OnTerminate事件，
通过跟踪发现执行完Execute过程后就没有执行destructor释放过程，请问各位大虾
该如何解决以及在COM中使用线程要注意哪些问题？？？

注意：是在COM中创建线程，不是在线程里使用COM。

将一个在外面运行良好的线程移植到COM中后，发现居然无法触发OnTerminate事件，
通过跟踪发现执行完Execute过程后就没有执行destructor释放过程，请问各位大虾
该如何解决以及在COM中使用线程要注意哪些问题？？？

注意：是在COM中创建线程，不是在线程里使用COM。

我在com中多次使用线程，从没出现你的问题，如果你是自动释放的线程，检查FreeOnTerminate的值。

我是设置FreeOnTerminate := True;不对吗？

FreeOnTerminate:= True;是对的，还有你的线程中是否用到了Synchronize或消息事件等与主线程交互的东西，因为com中的主线程环境已与exe中的有所改变。

都没有用到，本来我也设想是不是线程里的某些过程函数有问题，
后来就直接做了个空线程（不执行任何事件）也没办法执行OnTerminate，
我是COM新手，不知道是不是我的COM有问题

我用d5写了个测试程序，没有问题：
http://free.ys168.com:8000/ys168up/D1/YY1.aspx?f=050P1D9E6E4E7D5AWA01APAWD6AVI7AVI5G0F9E0D8D9D8D6E4A24D9E3E5E7D8E4C0

To: TYZhang
谢谢你的测试程序。可是到我这里还是没办法触发OnTerminate事件，
不知道是不是我的系统有问题，我用的是WinXP+Delphi7

to zzybbs:
刚才测试了一下，
xp(sp2)+delphi5 成功
xp(sp2)+delphi7 失败（还报错）
2000+delphi5 成功
2000+delphi7 失败
可以肯定是delphi7与delphi5的差异，查看delphi5与delphi7的源码，发现Synchronize这个函数改动较大，机制也变了，而OnTerminate事件正是由这个函数调用的。
具体如何改动还有待试验，期贷更高的手来解决。。。。

看来只能使用API创建线程，但是本人水平有限不知如何创建

刚才在网上查了一下，有人将delphi5的tthread考到delphi7中作为基类，进行使用参考：
http://www.delphibbs.com/delphibbs/dispq.asp?lid=705284

OK，可以了，非常的感谢！
按步骤，将下列代码保存到Delphi5Thread.pas，加入到线程所在
单元uses最后面即可。
unit Delphi5Thread platform;
{
从 Borland 的源代码中剪切、修改。
wxz 2002.3 版权在 Borland 公司.
}
interface

uses
SysUtils, Windows, ActiveX, Classes;

type
{ TThread }
EThread = class(Exception);

TThreadMethod = procedure of object;
TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
tpTimeCritical);

TThread = class
private
FHandle: THandle;
FThreadID: THandle;
FTerminated: Boolean;
FSuspended: Boolean;
FFreeOnTerminate: Boolean;
FFinished: Boolean;
FReturnValue: Integer;
FOnTerminate: TNotifyEvent;
FMethod: TThreadMethod;
FSynchronizeException: TObject;
procedure CallOnTerminate;
function GetPriority: TThreadPriority;
procedure SetPriority(Value: TThreadPriority);
procedure SetSuspended(Value: Boolean);
protected
procedure DoTerminate; virtual;
procedure Execute; virtual; abstract;
procedure Synchronize(Method: TThreadMethod);
property ReturnValue: Integer read FReturnValue write FReturnValue;
property Terminated: Boolean read FTerminated;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure Resume;
procedure Suspend;
procedure Terminate;
function WaitFor: LongWord;
property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
property Handle: THandle read FHandle;
property Priority: TThreadPriority read GetPriority write SetPriority;
property Suspended: Boolean read FSuspended write SetSuspended;
property ThreadID: THandle read FThreadID;
property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
end;

implementation

{ Thread management routines }

const
CM_EXECPROC = $8FFF;
CM_DESTROYWINDOW = $8FFE;

type
PRaiseFrame = ^TRaiseFrame;
TRaiseFrame = record
NextRaise: PRaiseFrame;
ExceptAddr: Pointer;
ExceptObject: TObject;
ExceptionRecord: PExceptionRecord;
end;

var
ThreadLock: TRTLCriticalSection;
ThreadWindow: HWND;
ThreadCount: Integer;

procedure FreeThreadWindow;
begin
if ThreadWindow <> 0 then
begin
DestroyWindow(ThreadWindow);
ThreadWindow := 0;
end;
end;

function ThreadWndProc(Window: HWND; Message, wParam, lParam: Longint): Longint; stdcall;
begin
case Message of
CM_EXECPROC:
with TThread(lParam) do
begin
Result := 0;
try
FSynchronizeException := nil;
FMethod;
except
if RaiseList <> nil then
begin
FSynchronizeException := PRaiseFrame(RaiseList)^.ExceptObject;
PRaiseFrame(RaiseList)^.ExceptObject := nil;
end;
end;
end;
CM_DESTROYWINDOW:
begin
EnterCriticalSection(ThreadLock);
try
Dec(ThreadCount);
if ThreadCount = 0 then
FreeThreadWindow;
finally
LeaveCriticalSection(ThreadLock);
end;
Result := 0;
end;
else
Result := DefWindowProc(Window, Message, wParam, lParam);
end;
end;

var
ThreadWindowClass: TWndClass = (
style: 0;
lpfnWndProc: @ThreadWndProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: 0;
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: 'TThreadWindow');

procedure AddThread;

function AllocateWindow: HWND;
var
TempClass: TWndClass;
ClassRegistered: Boolean;
begin
ThreadWindowClass.hInstance := HInstance;
ClassRegistered := GetClassInfo(HInstance, ThreadWindowClass.lpszClassName,
TempClass);
if not ClassRegistered or (TempClass.lpfnWndProc <> @ThreadWndProc) then
begin
if ClassRegistered then
Windows.UnregisterClass(ThreadWindowClass.lpszClassName, HInstance);
Windows.RegisterClass(ThreadWindowClass);
end;
Result := CreateWindow(ThreadWindowClass.lpszClassName, '', 0,
0, 0, 0, 0, 0, 0, HInstance, nil);
end;

begin
EnterCriticalSection(ThreadLock);
try
if ThreadCount = 0 then
ThreadWindow := AllocateWindow;
Inc(ThreadCount);
finally
LeaveCriticalSection(ThreadLock);
end;
end;

procedure RemoveThread;
begin
EnterCriticalSection(ThreadLock);
try
if ThreadCount = 1 then
PostMessage(ThreadWindow, CM_DESTROYWINDOW, 0, 0);
finally
LeaveCriticalSection(ThreadLock);
end;
end;

{ TThread }

function ThreadProc(Thread: TThread): Integer;
var
FreeThread: Boolean;
begin
try
Thread.Execute;
finally
FreeThread := Thread.FFreeOnTerminate;
Result := Thread.FReturnValue;
Thread.FFinished := True;
Thread.DoTerminate;
if FreeThread then Thread.Free;
EndThread(Result);
end;
end;

constructor TThread.Create(CreateSuspended: Boolean);
var
Flags: DWORD;
begin
inherited Create;
AddThread;
FSuspended := CreateSuspended;
Flags := 0;
if CreateSuspended then Flags := CREATE_SUSPENDED;
FHandle := BeginThread(nil, 0, @ThreadProc, Pointer(Self), Flags, FThreadID);
end;

destructor TThread.Destroy;
begin
if not FFinished and not Suspended then
begin
Terminate;
WaitFor;
end;
if FHandle <> 0 then CloseHandle(FHandle);
inherited Destroy;
RemoveThread;
end;

procedure TThread.CallOnTerminate;
begin
if Assigned(FOnTerminate) then FOnTerminate(Self);
end;

procedure TThread.DoTerminate;
begin
if Assigned(FOnTerminate) then Synchronize(CallOnTerminate);
end;

const
Priorities: array [TThreadPriority] of Integer =
(THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);

function TThread.GetPriority: TThreadPriority;
var
P: Integer;
I: TThreadPriority;
begin
P := GetThreadPriority(FHandle);
Result := tpNormal;
for I := Low(TThreadPriority) to High(TThreadPriority) do
if Priorities = P then Result := I;
end;

procedure TThread.SetPriority(Value: TThreadPriority);
begin
SetThreadPriority(FHandle, Priorities[Value]);
end;

procedure TThread.Synchronize(Method: TThreadMethod);
begin
FSynchronizeException := nil;
FMethod := Method;
SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self));
if Assigned(FSynchronizeException) then raise FSynchronizeException;
end;

procedure TThread.SetSuspended(Value: Boolean);
begin
if Value <> FSuspended then
if Value then
Suspend else
Resume;
end;

procedure TThread.Suspend;
begin
FSuspended := True;
SuspendThread(FHandle);
end;

procedure TThread.Resume;
begin
if ResumeThread(FHandle) = 1 then FSuspended := False;
end;

procedure TThread.Terminate;
begin
FTerminated := True;
end;

function TThread.WaitFor: LongWord;
var
Msg: TMsg;
H: THandle;
begin
H := FHandle;
if GetCurrentThreadID = MainThreadID then
while MsgWaitForMultipleObjects(1, H, False, INFINITE,
QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE)
else WaitForSingleObject(H, INFINITE);
GetExitCodeThread(H, Result);
end;

initialization
InitializeCriticalSection(ThreadLock);

finalization
FreeThreadWindow;
DeleteCriticalSection(ThreadLock);
end.