Форум программистов [Powered by Invision Power Board]

Код

...
initialization
  TAutoObjectFactory.Create(ComServer, TControlWindow, Class_ControlWindow,
    ciMultiInstance, tmBoth);  // Последние два параметра менял в разных вариациях
...

  TUptateThread = class(TThread)
  ...
  public
    FEvent:THandle;
  ...
  end;
  TfmWin = class(TForm)
    ...
    FUpdateThread:TUptateThread;
    ...
  end;
...
constructor TUptateThread.Create(...);
begin
 inherited Create(true);
 ...
 FreeOnTerminate:=false;
 FEvent:=CreateEvent(nil, TRUE, FALSE, 'MyCustomEvent');
 Resume;
end;

destructor TUptateThread.Destroy;
begin
  CloseHandle(FEvent);
  inherited;
end;

procedure TUptateThread.Execute;
var
 FApplication:OleVariant;
 ...
 hr:HRESULT;
 WValue,LValue: integer;
begin
  hr:=CoInitializeEx(nil,COINIT_MULTITHREADED);  // Пытался и COINIT_APARTMENTTHREADED

  FApplication := GetActiveOleObject('Интерфейс вызвавшего приложения');
  
  ... // Инициализация внутренних переменных на основе методов FApplication 
  { Place thread code here }
  while not Terminated do
   begin
    // Работа с FApplication 
    ...
    if (Условие) then PostMessage(FMainForm,WM_USER+NNN,WValue,LValue);  // Форма только отображает полученные от потока значения, сама с интерфейсом не взаимодействует
    Sleep(50);
   end;
  ... // Деинициализация внутренних переменных
  FApplication:=Unassigned;
  SetEvent(FEvent);          // Вот тут сигнализирую об окончании потока, потому что ждать сам поток бессмысленно, ибо зависает
  SetErrorInfo(0,nil);         // Где-то слышал звон, что может помочь... нифига...
  if (hr=S_OK)or(hr=S_FALSE) then CoUninitialize;   // Как показало вскрытие - вот тут происходит зависание
end;

constructor TfmWin.Create(AIndex:integer);
begin
 inherited Create(nil);
 FUpdateThread:=TUptateThread.Create(...);
end;

destructor TfmWin.Destroy;
begin
 try
  ResetEvent(FUpdateThread.FEvent);
  FUpdateThread.Terminate;         // Вот после этого поток может зависнуть, а может и нет
  // MessageBox(0,'Удаление потока','Ахтунг!',0); // Раскомментирование этой магической строчки снимает проблему, но само является проблемой.
  if WaitForSingleObject(FUpdateThread.FEvent ,5000)<>WAIT_OBJECT_0 then 
    TerminateThread(FUpdateThread.Handle,0);
  FUpdateThread.Free;
 finally
  FUpdateThread:=nil;
 end;
 inherited;
end;