Доброго времени суток всем! Пытаюсь наладить связь между интерфейсами через IRpcChannelBuffer, пока локально внутри одного приложения. Успех пока сомнительный, т.е. вызов происходит при совпадении фазы луны, а не всегда. В недрах rpcrt4.dll происходит AV: The memory could not be read, который передается приложению как OLE Error C0000005 (AV выудил при отладке в IDA). При запуске без отладчика иногда работает при определенных условиях. Поэтому хотелось бы получить совет от форумчан куда и что поменять чтобы наконец-то победить эту беду.

Пишу на Дельфи 2009. Код такой:

  IMyRpcChannelBuffer = interface(IUnknown)
    ['{D5F56B60-593B-101A-B569-08002B2DBF7A}']
    function GetBuffer(var message: TRpcOleMessage; const iid: TIID): HResult; stdcall;
    function SendReceive(var message: TRpcOleMessage; var status: Longint): HResult; stdcall;
    function FreeBuffer(var message: TRpcOleMessage): HResult; stdcall;
    function GetDestCtx(var dwDestContext: Longint; var pvDestContext: Pointer): HResult; stdcall;
    function IsConnected: HResult; stdcall;
  end;

  ITestIntf = interface(IDispatch)
    ['{A95C745C-DD9C-4B79-9402-2E5891D9BB51}']
    procedure TestMethod; safecall;
  end;

  TTestImpl = class(TAutoObject, ITestIntf)
    procedure TestMethod; safecall;
  end;

  TMyChannel = class(TInterfacedObject, IMyRpcChannelBuffer)
  private
    FStub: IRpcStubBuffer;
  public
    property Stub: IRpcStubBuffer read FStub write FStub;

    function GetBuffer(var message: TRpcOleMessage; const iid: TIID): HResult; stdcall;
    function SendReceive(var message: TRpcOleMessage; var status: Longint): HResult; stdcall;
    function FreeBuffer(var message: TRpcOleMessage): HResult; stdcall;
    function GetDestCtx(var dwDestContext: Longint; var pvDestContext: Pointer): HResult; stdcall;
    function IsConnected: HResult; stdcall;
  end;


function CreateStubFromTypeInfo(
  const pTypeInfo: ITypeInfo; const riid: TGUID; const pUnkServer: IInterface;
  out ppStub: IRpcStubBuffer): HRESULT; stdcall; external RPCDLL;
function CreateProxyFromTypeInfo(
  const pTypeInfo: ITypeInfo; const pUnkOuter: IInterface; const riid: TGUID;
  out ppProxy: IRpcProxyBuffer; out ppv: Pointer): HRESULT; stdcall; external RPCDLL;


{ TTestImpl }

procedure TTestImpl.TestMethod;
begin
  ShowMessage('TestMethod');
end;

{ TMyChannel }

function TMyChannel.FreeBuffer(var message: TRpcOleMessage): HResult;
begin
  FreeMem(message.Buffer);
  Result := S_OK;
end;

function TMyChannel.GetBuffer(var message: TRpcOleMessage; const iid: TIID): HResult;
begin
  try
    //message.reserved1 := nil;
    //FillChar(message.reserved2, SizeOf(message.reserved2), 0);
    //message.cbBuffer := 2500;
    GetMem(message.Buffer, message.cbBuffer);
    FillChar(message.Buffer^, message.cbBuffer, 0);
    Result := S_OK;
  except
    Result := E_OUTOFMEMORY;
  end;
end;

function TMyChannel.GetDestCtx(var dwDestContext: Integer;
  var pvDestContext: Pointer): HResult;
begin
  dwDestContext := MSHCTX_DIFFERENTMACHINE;
  Result := S_OK;
end;

function TMyChannel.IsConnected: HResult;
begin
  if (FStub <> nil) then
    Result := S_OK
  else
    Result := S_FALSE;
end;

function TMyChannel.SendReceive(var message: TRpcOleMessage;
  var status: Integer): HResult;
var
  C: IRpcChannelBuffer;
begin
  C := Self as IRpcChannelBuffer;
  Result := E_FAIL;
  try
    if (Stub <> nil) then
      Result := Stub.Invoke(message, C);
  finally
    C := nil;
    if Succeeded(Result) and (status <> 0) then
      status := 0;
  end;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  Lib: ITypeLib;
  TypInfo: ITypeInfo;
  Chan: TMyChannel;
  Stub: IRpcStubBuffer;
  Proxy: IRpcProxyBuffer;
  ppv: Pointer;
begin
  CoInitialize(nil);
  FObj := TTestImpl.Create;
  FObj._AddRef;

  Lib := LoadTypeLibrary(ShortToLongFileName(GetModuleFileName));
  Lib.GetTypeInfoOfGuid(IID_ITestIntf, TypInfo);

  OleCheck(CreateStubFromTypeInfo(TypInfo, IID_ITestIntf, nil, Stub));
  OleCheck(CreateProxyFromTypeInfo(TypInfo, nil, IID_ITestIntf, Proxy, ppv));
  TypInfo._Release;
  Lib._Release;

  Chan := TMyChannel.Create;
  Chan._AddRef;

  Proxy.Connect(Chan as IRpcChannelBuffer);
  Chan.Stub := Stub;
  Stub.Connect(FObj);


  try
    ITestIntf(ppv).TestMethod;
  finally
    ITestIntf(ppv)._Release;
    Stub.Disconnect;
    Stub := nil;
    Proxy.Disconnect;
    Proxy := nil;
    Chan._Release;
  end;
end;

Описание интерфейса IRpcChannelBuffer продублировал для исправления описания метода GetBuffer этого интерфейса, которому в модуле ActiveX не хватает const перед параметром iid.

После небольших правок под отладчиком ошибка OLE изменилась на C0000096, без отладчика осталась прежней C000005. При всем этом при закрытии приложения процесс виснет со 100%-ной загрузкой процессора. Если закомментировать инструкции try-finally-end в TForm1.FormCreate, то без отладчика TTestImpl.TestMethod выполняется, вижу заветный MessageBox, но при закрытии всё так же виснет.

Через мой код выполнение проходит в таком порядке:

TMyChannel.GetDestCtx
TMyChannel.GetBuffer
TMyChannel.SendReceive
TMyChannel.GetDestCtx
Эксепшин

Во втором вызове TMyChannel.GetDestCtx стек вызова выглядит так:

unit_srv.TMyChannel.GetDestCtx(2,nil)
:77ef4c42 RPCRT4.NdrStubInitialize + 0x3b
:77e8a4fb ; C:\WINDOWS\system32\RPCRT4.dll
:77ef414f ; C:\WINDOWS\system32\RPCRT4.dll
:77ef5ea5 ; C:\WINDOWS\system32\RPCRT4.dll
unit_srv.TMyChannel.SendReceive($12FAB4,1243872)
:77ef4db5 RPCRT4.NdrProxySendReceive + 0x40
:77ef4ead ; C:\WINDOWS\system32\RPCRT4.dll
:77ef4e42 RPCRT4.NdrProxySendReceive + 0xcd
:77e8a83b RPCRT4.RpcBindingSetObject + 0x4d
unit_srv.TForm1.FormCreate(???)

Подскажите пожалуйста, что я делаю не так? Чую что симптомы похожи на проблемы с памятью/стеком, но откуда растут корни не могу понять...