[Alks]

Короче намучился я с этой хренью вдоволь, и решил что лучше не морочить себе голову и делать через таймер.
Привожу исходный код двух основных модулей моего ActiveX-а, который запускает поток из которого совершенно безопасно генерируется событие для Axapta. Казалось бы всё пучком, но возникли две непреодолимые для меня сейчас проблемы:
1. создание и передача "safe" указателя на интерфейс IAxBarScanner драйверу сканнера (который разумеется сам не делает CoGetInterfaceAndReleaseStream, а если пытаться сделать его в основном потоке программы сразу после CoMarshalInterThreadInterfaceInStream, то черезчур умная ф-я возвращает прямой указатель, а не маршализированный).
2. вследствии непонятной мешанины с AddRef/Relese ActiveX застревает в памяти (откуда то берутся целых 5 ссылок на него и он не уничтожается как должен был бы), в результате объекты плодятся безконтрольно и ахапта при выходе остаётся в списке задач

Думаю что всё это вопросы разрешимые, но заниматься ими уже надоело, да и сроки поджимают, времени распылятся по мелочам, когда менее элегантное решение всё таки существует нет.

PHP код:

unit AxBarScannerImpl;

interface

uses
  Windows, ActiveX, Classes, Controls, Graphics, Menus, Forms, StdCtrls,
  ComServ, StdVCL, AXCtrls, AxBarScannerXControl_TLB, SysUtils;

type
  TAxBarScanner = class(TActiveXControl, IAxBarScanner)
  private
    { Private declarations }
    FDelphiControl: TStaticText;
    FEvents: IAxBarScannerEvents;
    FTestThread: TThread;
    procedure ClickEvent(Sender: TObject);
    procedure DblClickEvent(Sender: TObject);
  protected
    { Protected declarations }
    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    procedure InitializeControl; override;
    function Get_Alignment: TxAlignment; safecall;
    function Get_AutoSize: WordBool; safecall;
    function Get_BorderStyle: TxStaticBorderStyle; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Color: OLE_COLOR; safecall;
    function Get_Cursor: Smallint; safecall;
    function Get_DoubleBuffered: WordBool; safecall;
    function Get_DragCursor: Smallint; safecall;
    function Get_DragMode: TxDragMode; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: IFontDisp; safecall;
    function Get_ParentColor: WordBool; safecall;
    function Get_ShowAccelChar: WordBool; safecall;
    function Get_Visible: WordBool; safecall;
    function Get_VisibleDockClientCount: Integer; safecall;
    procedure _Set_Font(const Value: IFontDisp); safecall;
    procedure Set_Alignment(Value: TxAlignment); safecall;
    procedure Set_AutoSize(Value: WordBool); safecall;
    procedure Set_BorderStyle(Value: TxStaticBorderStyle); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Color(Value: OLE_COLOR); safecall;
    procedure Set_Cursor(Value: Smallint); safecall;
    procedure Set_DoubleBuffered(Value: WordBool); safecall;
    procedure Set_DragCursor(Value: Smallint); safecall;
    procedure Set_DragMode(Value: TxDragMode); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(var Value: IFontDisp); safecall;
    procedure Set_ParentColor(Value: WordBool); safecall;
    procedure Set_ShowAccelChar(Value: WordBool); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
    procedure ActivateScanData(const Data: WideString); safecall;
    procedure ShowRefCount; safecall;
  public
    destructor Destroy; override;
    //procedure AfterConstruction; override;
  end;

implementation

uses ComObj, TestThread;

{ TAxBarScanner }

procedure TAxBarScanner.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
  {TODO: Define property pages here.  Property pages are defined by calling
    DefinePropertyPage with the class id of the page.  For example,
      DefinePropertyPage(Class_AxBarScannerPage); }
end;

procedure TAxBarScanner.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IAxBarScannerEvents;
end;

procedure TAxBarScanner.InitializeControl;
begin
  // Это нужно дельфям
  FDelphiControl := Control as TStaticText;
  FDelphiControl.OnClick := ClickEvent;
  FDelphiControl.OnDblClick := DblClickEvent;

  // Создаём поток
  FTestThread := AxTestThread.Create( True );

  // Сериализуем указатель на интерфейс в поток...
  if not Succeeded( CoMarshalInterThreadInterfaceInStream( IID_IAxBarScanner,
    Self as IAxBarScanner, (FtestThread as AxTestThread).Strm ) ) then
  begin
    MessageBox( 0, 'CoMarshal...() error', 'Error', MB_OK );
  end;

  // Если попробовать заменить эту хитрую процедуру простым присваиванием типа:
  // (FTestThread as AxTestThread).Scanner := Self as IAxBarScanner;
  // не пропуская указатель на интерфейс через ф-ии принудительного маршаллинга,
  // то аксапта неминуемо повиснет.
  // После десериализации любые вызовы к интерфейсу будут проходить через механизм
  // single threaded apartment model и, как следствие, выполнятся
  // в рамках работы основного потока программы GetMessage/DispatchMessage.

  // Активируем работу потока
  FTestThread.Resume;
end;

// ... вырезал ненужный код генерируемый дельфи

destructor TAxBarScanner.Destroy;
begin
  // Убиваем поток
  //_AddRef;
  //_AddRef;
  FTestThread.Terminate;
  FTestThread.WaitFor;
  FTestThread.Free;

  inherited;
end;

procedure TAxBarScanner.ActivateScanData(const Data: WideString);
begin
  if FEvents <> nil then
    FEvents.OnScanData( Data );
end;

procedure TAxBarScanner.ShowRefCount;
begin
  MessageBox( 0, PChar( IntToStr( RefCount ) ), 'RefCount', MB_OK );
end;

initialization
  TActiveXControlFactory.Create(
    ComServer,
    TAxBarScanner,
    TStaticText,
    Class_AxBarScanner,
    1,
    '',
    0,
    tmSingle);
end. 


PHP код:

unit TestThread;

interface

uses
  Classes, AxBarScannerImpl, AxBarScannerXControl_TLB, ActiveX;

type
  AxTestThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    Strm: IStream;
    Scanner: IAxBarScanner; // Собственно интерфейс ActiveX объекта
  end;

implementation

uses Windows;

procedure AxTestThread.Execute;
begin
  CoInitializeEx( nil, COINIT_APARTMENTTHREADED );
  Strm._AddRef;
  if not Succeeded( CoGetInterfaceAndReleaseStream( Strm, IID_IAxBarScanner, Scanner ) ) then
  begin
    MessageBox( 0, 'CoGetIface...() error', '', MB_OK );
  end;
  Strm := nil;

  while not Terminated do
  begin
    Sleep( 1000 );
    if not Terminated then
    begin
      Beep( 300, 100 );
      Scanner.ActivateScanData( 'Debil' );
    end;
  end;
  Scanner := nil;
  
  CoUninitialize;
end;

end.