COM Singleton

[STRELOK-2007]

Приветствую!

Где-то слышал, что для межпроцессного взаимодействия можно использовать COM Singleton библиотеку, в этом случае можно будет создать один объект-коннектор на два (или более) процесса.

Это после сокетов, я выбрал на данный момент лучшим вариантом.

1 вопрос:
Действительно ли можно сделать так?

2 вопрос:

Если можно. Что тогда я делаю не так?

Сам класс:

unit COMSingletonCLASS;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, SysUtils, ActiveX, Classes, ComObj, COMSingleton_R_TLB, StdVcl;

type
  TCOMSingletonClass = class(TTypedComObject, ICOMSingletonClass)
   protected
    FCheck: WideString;
    FVerify: HRESULT;
    FInitialized: Boolean;

    function Check: WideString; stdcall;

    procedure InternalCreate; virtual;
    function Verify: HResult; stdcall;
    function Init: HResult; stdcall;

  end;

implementation

uses ComServ;

function TCOMSingletonClass.Check: WideString;
begin
 Result:= StringToOleStr(FCheck);
end;

procedure TCOMSingletonClass.InternalCreate;
var
 G: TGUID;
begin
 CreateGUID(g);
 FCheck:= GUIDToString(G);

 FVerify:= Random(100) * Random(100) * Random(100) * Random(100);
end;

function TCOMSingletonClass.Verify: HResult;
begin
 Result:= FVerify;
end;

function TCOMSingletonClass.Init: HResult;
begin
 if FInitialized then
  Result:=0
 else
  begin

 InternalCreate;
 Result:= 1;
  end;
end;

initialization
  TTypedComObjectFactory.Create(ComServer, TCOMSingletonClass, Class_COMSingletonClass,
    ciMultiInstance, tmApartment);
end.

Библиотека типов:

unit COMSingleton_R_TLB;

/////

var
 FClass: ICOMSingletonClass = nil;

implementation

uses System.Win.ComObj;

class function CoCOMSingletonClass.Create: ICOMSingletonClass;
begin
 if FClass = nil then
  FClass := CreateComObject(CLASS_COMSingletonClass) as ICOMSingletonClass;

 Result:= FClass;
end;

class function CoCOMSingletonClass.CreateRemote(const MachineName: string): ICOMSingletonClass;
begin
 if FClass = nil then
  FClass := CreateRemoteComObject(MachineName, CLASS_COMSingletonClass) as ICOMSingletonClass;

 Result:= FClass;
end;

end.

Так создаю в приложении:

var
 Factory: IUnknown;
begin
 Main:=nil;

 Factory:=CreateComObject(COMSingleton_R_TLB.CLASS_COMSingletonClass);
 Factory.QueryInterface(COMSingleton_R_TLB.IID_ICOMSingletonClass, Main);

 if Main = nil then
  Label5.Caption:='Fail'
 else
  Label5.Caption:='Success';

 UpdateMainClass;
end;

Результат вызова Check:


Заранее спасибо!

[Slym]

http://code.progler.ru/tags/Delphi,%...B8%D1%81%D1%8B

[STRELOK-2007]

Сообщение от Slym

http://code.progler.ru/tags/Delphi,%...B8%D1%81%D1%8B

С кодировкой у сайта какая то шляпа