Здравствуйте, SPeller, Вы писали:
SP>На другом форуме подсказали что проблема была в закомментированных строках
SP>SP> //message.reserved1 := nil;
SP> //FillChar(message.reserved2, SizeOf(message.reserved2), 0);
SP>
SP>Убрал комментарии и всё заработало. Всем спасибо что выслушали 
И больше не пиши на Дельфи
Доброго времени суток всем! Пытаюсь наладить связь между интерфейсами через 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(???)
Подскажите пожалуйста, что я делаю не так? Чую что симптомы похожи на проблемы с памятью/стеком, но откуда растут корни не могу понять...
IDA говорит что количество параметров функций CreateXXXXFromTypeInfo правильное.
Висло при выгрузке из-за того, что из сишного кода перетащил
TypInfo._Release;
Lib._Release;
, в то время как в дельфях правильно
TypInfo := nil;
Lib := nil;
Поменял и выгружается теперь нормально.
Что интересно:
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?
На другом форуме подсказали что проблема была в закомментированных строках
//message.reserved1 := nil;
//FillChar(message.reserved2, SizeOf(message.reserved2), 0);
Убрал комментарии и всё заработало. Всем спасибо что выслушали
Здравствуйте, SPeller, Вы писали:
А>>И больше не пиши на Дельфи
SP>А причем тут вообще это?
Меньше вопросов будешь задавать
Тут появилась другая проблема. Создал и зарегистрировал свою фабрику прокси/стаб. При работе внутри процесса теперь интерфейсы маршалируются и работают корректно. Но когда разнес клиента и сервера по разным приложениям, то вызов Stub.Invoke возвращается с ошибкой "Заглушке переданы неправильные данные". Суть кода прежняя, только возвращаемое значение контекста изменено на MSHCTX_CROSSCTX. Если передать MSHCTX_DIFFERENTMACHINE, то буфер, передаваемый в rpcolemessage, содержит сетевые данные, вызов Stub.Invoke вешается пока не завершится процесс клиента (клиент послал сетевой пакет серверу и ждет ответа), а сразу по завершении возвращается с результатом "Интерфейс не поддерживается". Подскажите, как бы мне так передать интерфейс на другой конец, чтобы там он был понят как надо?
Делаю всё для того чтобы через свой канал маршалить ком-объекты без регистрации оных в реестре, но при наличии библиотеки типов, и чтобы работа с такими объектами не отличалась от обычной.
