Работа через IRpcChannelBuffer и CreateXXXXFromTypeInfo
От: SPeller  
Дата: 05.05.09 02:20
Оценка:
Доброго времени суток всем! Пытаюсь наладить связь между интерфейсами через 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(???)


Подскажите пожалуйста, что я делаю не так? Чую что симптомы похожи на проблемы с памятью/стеком, но откуда растут корни не могу понять...
Re: Работа через IRpcChannelBuffer и CreateXXXXFromTypeInfo
От: SPeller  
Дата: 05.05.09 05:56
Оценка:
IDA говорит что количество параметров функций CreateXXXXFromTypeInfo правильное.
Re[2]: Работа через IRpcChannelBuffer и CreateXXXXFromTypeIn
От: SPeller  
Дата: 05.05.09 06:53
Оценка:
Висло при выгрузке из-за того, что из сишного кода перетащил 

  TypInfo._Release;
  Lib._Release;


, в то время как в дельфях правильно 

  TypInfo := nil;
  Lib := nil;


Поменял и выгружается теперь нормально.
Re: Работа через IRpcChannelBuffer и CreateXXXXFromTypeInfo
От: SPeller  
Дата: 05.05.09 08:05
Оценка:
Что интересно:

 Msg: TRpcOleMessage;
 I: Integer;

 FillChar(Msg, SizeOf(Msg), 0);
 Msg.dataRepresentation := 16;
 Msg.Buffer := @I;
 Msg.cbBuffer := 4;
 Msg.iMethod := 7;
 I := 101;
 Stub.Invoke(Msg, Chan as IRpcChannelBuffer);


Работает на ура. Отчего Stub.Invoke не пашет из TMyChannel.SendReceive?
Re[2]: Работа через IRpcChannelBuffer и CreateXXXXFromTypeIn
От: SPeller  
Дата: 05.05.09 22:42
Оценка:
На другом форуме подсказали что проблема была в закомментированных строках
    //message.reserved1 := nil;
    //FillChar(message.reserved2, SizeOf(message.reserved2), 0);

Убрал комментарии и всё заработало. Всем спасибо что выслушали
Re[3]: Работа через IRpcChannelBuffer и CreateXXXXFromTypeIn
От: Аноним  
Дата: 05.05.09 22:58
Оценка: :)
Здравствуйте, SPeller, Вы писали:

SP>На другом форуме подсказали что проблема была в закомментированных строках
SP>
SP>    //message.reserved1 := nil;
SP>    //FillChar(message.reserved2, SizeOf(message.reserved2), 0);
SP>

SP>Убрал комментарии и всё заработало. Всем спасибо что выслушали

И больше не пиши на Дельфи
Re[4]: Работа через IRpcChannelBuffer и CreateXXXXFromTypeIn
От: SPeller  
Дата: 06.05.09 01:15
Оценка:
А>И больше не пиши на Дельфи

А причем тут вообще это?
Re[5]: Работа через IRpcChannelBuffer и CreateXXXXFromTypeIn
От: Аноним  
Дата: 06.05.09 17:09
Оценка:
Здравствуйте, SPeller, Вы писали:

А>>И больше не пиши на Дельфи

SP>А причем тут вообще это?

Меньше вопросов будешь задавать
Re[6]: Работа через IRpcChannelBuffer и CreateXXXXFromTypeIn
От: SPeller  
Дата: 06.05.09 21:42
Оценка:
А>Меньше вопросов будешь задавать

Отдыхай короче
Re: Работа через IRpcChannelBuffer и CreateXXXXFromTypeInfo
От: SPeller  
Дата: 13.05.09 00:27
Оценка:
Тут появилась другая проблема. Создал и зарегистрировал свою фабрику прокси/стаб. При работе внутри процесса теперь интерфейсы маршалируются и работают корректно. Но когда разнес клиента и сервера по разным приложениям, то вызов Stub.Invoke возвращается с ошибкой "Заглушке переданы неправильные данные". Суть кода прежняя, только возвращаемое значение контекста изменено на MSHCTX_CROSSCTX. Если передать MSHCTX_DIFFERENTMACHINE, то буфер, передаваемый в rpcolemessage, содержит сетевые данные, вызов Stub.Invoke вешается пока не завершится процесс клиента (клиент послал сетевой пакет серверу и ждет ответа), а сразу по завершении возвращается с результатом "Интерфейс не поддерживается". Подскажите, как бы мне так передать интерфейс на другой конец, чтобы там он был понят как надо?

Делаю всё для того чтобы через свой канал маршалить ком-объекты без регистрации оных в реестре, но при наличии библиотеки типов, и чтобы работа с такими объектами не отличалась от обычной.
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.