PHP DM Gate v0.9 » Обращение к удаленном OLE-объекту

GrBob (27.06.06 11:07) [0]

Здравствуйте.
На удаленном компьютере есть OLE-объект, у которого известно только название. (ну и соответственно легко получается CLSID, в реестре на данном компьютере информация об объекте есть). Вопрос: можно ли как-нибудь к нему обраться? CreateOLEObject работает только на текущей машине, а CreateRemoteComObject возвращает интерфейс, название которого я не знаю. (Как его получить?)
Заранее спасибо за ответы.

<Цитата>
tesseract © (27.06.06 14:57) [1]

> а CreateRemoteComObject возвращает интерфейс, название которого
> я не знаю. (Как его получить?)

enuminterfaces??

описание интерфейса есть?

<Цитата>
GrBob (27.06.06 15:15) [2]

> enuminterfaces??

??

> описание интерфейса есть?

Я знаю его методы и свойства. Мне нужно узнать как он называется. (I...)

<Цитата>
tesseract © (28.06.06 13:56) [3]

Если есть GUID - на кой его по имени знать?

<Цитата>
GrBob (28.06.06 16:47) [4]

Дело в том, что мне его нужно запустить на удаленной машине. CreateOLEObject делает это только на локальной, все замечательно работает. А вот CreateRemoteCOMObject возвращает интерфейс, который нужно чему-то присвоить. Просто IInterface'у его не присвоишь, вернее потом методы не повызываешь.
Согласен, возможно интерфейс знать и не нужно совсем, но тогда как запустить OLE сервер на удаленном компьютере и еще им управлять при этом? :)

<Цитата>
AbrosimovA © (29.06.06 15:53) [5]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComObj, AxCtrls, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
btnReadProp: TButton;
ListBox1: TListBox;
ServNameEdit: TEdit;
Label1: TLabel;
Label4: TLabel;
btnExec: TButton;
Timer1: TTimer;
ValuePropEdit: TEdit;
btnReadInterf: TButton;
btnConnect: TButton;
BtnRemConnect: TButton;
StatusBar1: TStatusBar;
procedure btnReadPropClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure btnExecClick(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure btnReadInterfClick(Sender: TObject);
procedure BtnRemConnectClick(Sender: TObject);
private
ServerName: string[255];
procedure SetInvoke(const ID: integer; const Command: OleVariant);
public
end;

var
Form1: TForm1;
Srv: IDispatch;
ID,DID: integer;
iIndex: integer;

implementation

{$R *.dfm}
uses ActiveX;

//Перечисление свойств
procedure EnumProperties(Dispatch: IDispatch; Entries: TStrings);
var iDispID,i: integer;
NameRefs: array[0..0] of PWideChar;
HR: HResult;
begin
Entries.Clear;
Entries.NameValueSeparator:='-';
EnumDispatchProperties(Dispatch, GUID_NULL, VT_EMPTY, Entries);
for i:=0 to Entries.Count-1 do begin
NameRefs[0]:=PWideChar(WideString(Entries[i]));
HR:=Dispatch.GetIDsOfNames(GUID_NULL, @NameRefs, 1,
LOCALE_SYSTEM_DEFAULT, @iDispID);
if HR=S_OK then
Entries.Strings[i]:= Format('%d-%s',[iDispID,Entries[i]]);
end
end;

//Перечисление интерфейсов
procedure EnumInterface(Dispatch: IDispatch; Entries: TStrings; Functions: Boolean);
var
TypeInfo: ITypeInfo;
TypeAttr: PTypeAttr;
FuncDesc: PFuncDesc;
Vardesc: PVarDesc;
hr: HResult;
iMethode: Integer;
nNames : integer;
sNameLst: TBSTRList;
begin
Dispatch.GetTypeInfoCount(iMethode);
if iMethode > 0 then
begin
hr := Dispatch.GetTypeInfo(0,GetUserDefaultLCID,TypeInfo);
OleCheck(hr);
hr := TypeInfo.GetTypeAttr(TypeAttr);
OleCheck(hr);
if Functions then
begin
for iMethode := 0 to TypeAttr.cFuncs-1 do
begin
hr := TypeInfo.GetFuncDesc(iMethode, FuncDesc);
OleCheck(hr);
hr := TypeInfo.GetNames(FuncDesc.memid, @sNameLst,1,nNames);
OleCheck(hr);
Entries.Add(Format('%d-%s', [FuncDesc.memid, sNameLst[0]]));
end;
end
else
begin
for iMethode := 0 to TypeAttr.cVars-1 do
begin
hr := TypeInfo.GetVarDesc(iMethode, Vardesc);
OleCheck(hr);
hr := TypeInfo.GetNames(Vardesc.memid, @sNameLst,1,nNames);
OleCheck(hr);
Entries.Add(Format('%d-%s', [Vardesc.memid, sNameLst[0]]));
end;
end;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Srv:=nil;
end;

function GetDispIDFromName(const Disp: IDispatch; const PropertyName: WideString;
var iDispID: Integer): OleVariant;
var
PName: PWideChar;
ExcepInfo: TExcepInfo;
DispParams: TDispParams;
Status: HResult;
begin
if Disp = nil then Exit;
PName := PWideChar(PropertyName);
if PropertyName = '' then
Result := DISPID_UNKNOWN
else
Disp.GetIDsOfNames(GUID_NULL, @PName, 1, GetThreadLocale, @iDispID);
FillChar(DispParams, SizeOf(DispParams), 0);

Status := Disp.Invoke(iDispID, GUID_NULL, 0, DISPATCH_PROPERTYGET, DispParams,
@Result, @ExcepInfo, nil);
if Status <> S_OK then
DispatchInvokeError(Status, ExcepInfo);
end;

procedure TForm1.SetInvoke(const ID: integer; const Command: OleVariant);
var
vSet : OLEVariant;
aDispParams : TDispParams;
aDispId : TDispId;
aEI : TExcepInfo;
iError : UINT;
ptinfo: ITypeInfo;
begin
vSet := Command;
FillChar(aDispParams, SizeOf (aDispParams), 0);
with aDispParams do begin
rgvarg := @vSet;
cArgs := 1;
cNamedArgs := 1;
end;
aDispId := DISPID_PROPERTYPUT;
aDispParams.rgdispidNamedArgs := @aDispId;
OleCheck (Srv.Invoke (ID, GUID_NULL, LOCALE_SYSTEM_DEFAULT,
DISPATCH_PROPERTYPUT, aDispParams, NIL, @aEI, @iError));
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
iIndex:=Listbox1.ItemIndex;
if (iIndex<>-1)and(Tag=1) then
ValuePropEdit.Text:=GetDispIDFromName(Srv, Listbox1.Items.ValueFromIndex[iIndex],DID)
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
btnExec.Enabled:=(iIndex<>-1)and(Tag=1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
iIndex:=-1;
end;

//интерфейсы
procedure TForm1.btnReadInterfClick(Sender: TObject);
begin
Tag:=2;
ListBox1.Clear;
ValuePropEdit.Clear;
if Assigned(Srv) then EnumInterface(Srv,ListBox1.Items,True)
end;

//свойства
procedure TForm1.btnReadPropClick(Sender: TObject);
begin
Tag:=1;
ListBox1.Clear;
ValuePropEdit.Clear;
if Assigned(Srv) then begin
EnumProperties(Srv,ListBox1.Items);
end;
end;

//Изменение свойств
procedure TForm1.btnExecClick(Sender: TObject);
begin
if (ValuePropEdit.Text = '')or(Tag=2) then Exit;
try
SetInvoke(DID, ValuePropEdit.Text);
except
end
end;

//Запуск
procedure TForm1.BtnRemConnectClick(Sender: TObject);
var CLSID: TGUID;
begin
//для Word.Application
CLSID:=StringToGUID('{000209FF-0000-0000-C000-000000000046}');
try
Srv:=CreateRemoteComObject('Server5',CLSID) as IDispatch;
except
Exit;
end;
btnReadProp.Enabled:=True;
btnReadInterf.Enabled:=True;
end;

end.

<Цитата>
GrBob (30.06.06 09:24) [6]

Огромное спасибо, тут я более-менее разобрался, осталось узнать как вызывать методы, а не только менять свойства.
PS. Методы возвращают другие COM-объекты.
Жду с большим нетерпением подсказки, наконец я хоть немного продвинулся.

<Цитата>
AbrosimovA © (30.06.06 12:40) [7]

> осталось узнать как вызывать методы

Так как, я проект давно забросил, то в этом направлении я не копал.
Но думаю, в Invoke нужно использовать DISPATCH_METHOD и правильно заполнить DispParams

<Цитата>
Медвед (03.07.06 10:20) [8]

нужно написать прокси-объект, реализующий IDispatch
пример есть в исходниках Borland Socket Server

<Цитата>
GrBob (06.07.06 15:54) [9]

Мне кажется, что писать для этого дополнительный объект - все же перебор. Продолжая разбираться со стандартным IDispatch'ем и его Invoke'ом я смог вызвать методы без параметров. С параметрами все намного грустнее. Нашел вот такой кусок кода:
var O : IDispatch;
Disp: TDispParams;
Args: array[0..2] of TVariantArg;
begin
O := CreateOleObject('Project1.Test');

// Присваиваю аргументы
OleVariant(Args[0]) := 1;
OleVariant(Args[1]) := 2;
OleVariant(Args[2]) := 3;

with Disp do begin
rgvarg := @Args;
cArgs := 3;
rgdispidNamedArgs := nil;
cNamedArgs := 0;
end;

O.Invoke(1,GUID_NULL,GetThreadLocale,DISPATCH_METHOD,Disp,nil,nil,nil);
end;

Я и сам пытался написать что-то подобное (естественно, уходя от CreateOLEObject), но он падает на преобразовании TVariantArg'a к ОлеВарианту. В МСДН вроде написано, что должно работать, да и у автора этого кода тоже все работало. У меня же - Invalid Variant type. Подскажите, в чем дело?

<Цитата>
AbrosimovA © (06.07.06 16:54) [10]

> OleVariant(Args[0]) := 1; OleVariant(Args[1]) := 2; OleVariant(Args[2])
> := 3;

Так ли уж необходимо преобразовывать к олевариантному типу?

<Цитата>
GrBob (06.07.06 17:09) [11]

Да, необходимо. Но я еще поковырялся и нашел немного другой способ:

procedure TForm1.Button2Click(Sender: TObject);
var
DispParams: TDispParams;
egin
FillChar(DispParams, SizeOf (DispParams), 0);
DispParams.cArgs := 2;
GetMem(DispParams.rgvarg, DispParams.cArgs * SizeOf(TVariantArg));
try
DispParams.rgvarg[0] := TVariantArg(OleVariant('aaa'));
DispParams.rgvarg[1] := TVariantArg(OleVariant('bbb'));
Exec(Self.Caption, DispParams);
finally
FreeMem(DispParams.rgvarg, DispParams.cArgs * SizeOf(TVariantArg));
end;
end;

Функция Exec потом ищет метод, вызывает его ну и т.д., не суть важно. Вроде работает, но надо еще проверять, почему то иногда падает (возможно даже не в этом месте :)).

<Цитата>
Ломброзо © (07.07.06 02:10) [12]

Может я чего-то недопонимаю, но OleVariant устроен таким образом, что в том случае, если переменная типа OleVariant содержит указатель на интерфейс IDispatch, то все вызовы к "свойствам" и "методам" этой переменной транслируются в вызов IDispatch::Invoke(). Так что пользоваться IDispatch совершенно излишне. То бишь тот указатель на интерфейс, который был отмаршаллен с другого хоста, можно смело присвоить переменной типа OleVariant и вызывать всякие свойства и методы. Компилятор с разруливанием вызовов расправится сам.

Более того. Если эта библиотека, содержащая определение коклассов и интерфейсов, написана как положено и позволяет получить IDL, ничто не мешает импортировать библиотеку типов, сгенерировать из неё паскалевские заглушки и включить в проект.

<Цитата>
GrBob (07.07.06 08:07) [13]

Предположим, так:
CLSID := ProgIDToClassID('Bla.Bla');
try
RemoteComp := ServNameEdit.Text;
Srv := CreateRemoteComObject(RemoteComp, CLSID) as IDispatch;
OleVariant(Srv).Start;
except
Exit;
end;

Получаю при вызове метода Start "Разрушительный сбой". Да и написана эта библиотека так, что библиотеки типов просто нет в списке импортируемых.

<Цитата>
AbrosimovA © (07.07.06 08:10) [14]

> Ломброзо © (07.07.06 02:10) [12]
> можно смело присвоить переменной типа OleVariant и вызывать
> всякие свойства и методы

Если только тебе заранее известны все методы и свойства исследуемого интерфейса.

<Цитата>
GrBob (07.07.06 09:06) [15]

> AbrosimovA © (07.07.06 08:10) [14]
> Если только тебе заранее известны все методы и свойства
> исследуемого интерфейса.

Дак они мне известны (по крайней мере те, которые я хочу использовать), почему-то не работает :(

В общем вот такие вот первые итоги: привожу на примере службы индексирования, она описана в MSDN и стоит на Windows Server 2003 по умолчанию, да и не главное это :) Просто у Ворда слишком заумные методы, чтобы на нем тесты ставить:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, StdCtrls, ActiveX;

type
TForm1 = class(TForm)
ListBox1: TListBox;
ServNameEdit: TEdit;
Label4: TLabel;
ValuePropEdit: TEdit;
btnReadInterf: TButton;
BtnRemConnect: TButton;
StatusBar1: TStatusBar;
Button1: TButton;
AddCatalog: TButton;
GroupBox1: TGroupBox;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
GroupBox2: TGroupBox;
Start: TButton;
Button4: TButton;
procedure BtnRemConnectClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure AddCatalogClick(Sender: TObject);
procedure StartClick(Sender: TObject);
private
procedure Invoke(const ID: integer; const DispParams: TDispParams);
procedure SetInvoke(const ID: integer);
procedure Exec(const Name: WideString; const DispParams: TDispParams);
public
end;

var
Form1: TForm1;
Srv: IDispatch;
DID: integer;
iIndex: integer;

implementation

{$R *.dfm}
uses ComObj, AxCtrls;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Srv := nil;
end;

procedure TForm1.SetInvoke(const ID: integer);
var
aDispParams: TDispParams;
aEI: TExcepInfo;
iError: UINT;
Command: OleVariant;
begin
FillChar(aDispParams, SizeOf (aDispParams), 0);
aDispParams.cArgs := 1;
Command := True;
GetMem(aDispParams.rgvarg, aDispParams.cArgs * SizeOf(TVariantArg));
aDispParams.rgvarg[0] := TVariantArg(OleVariant('C:\'));
aDispParams.rgvarg[1] := TVariantArg(OleVariant('D:\'));
OleCheck(Srv.Invoke(ID, GUID_NULL, 0,
DISPATCH_PROPERTYPUT, aDispParams, NIL, @aEI, @iError));
end;

procedure TForm1.Invoke(const ID: integer; const DispParams: TDispParams);
var
aDispParams: TDispParams;
aEI: TExcepInfo;
iError: UINT;
begin
aDispParams := DispParams;
OleCheck(Srv.Invoke(ID, GUID_NULL, 0,
DISPATCH_METHOD, aDispParams, NIL, @aEI, @iError));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
iIndex := -1;
end;

procedure TForm1.BtnRemConnectClick(Sender: TObject);
var
CLSID: TGUID;
RemoteComp: WideString;
begin
CLSID := ProgIDToClassID('Microsoft.IsAdm');
try
RemoteComp := ServNameEdit.Text;
Srv := CreateRemoteComObject(RemoteComp, CLSID) as IDispatch;
except
Exit;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
PName: PWideChar;
iDispID: Integer;
Name : WideString;
begin
iIndex := Listbox1.ItemIndex;
ListBox1.Items.NameValueSeparator := '-';
Name := Listbox1.Items.ValueFromIndex[iIndex];
PName := PWideChar(Name);
if Srv.GetIDsOfNames(GUID_NULL, @PName, 1, GetThreadLocale, @iDispID) = S_OK then
SetInvoke(iDispID);
end;

procedure TForm1.Exec(const Name: WideString; const DispParams: TDispParams);
var
PName: PWideChar;
iDispID: Integer;
begin
PName := PWideChar(Name);
Srv.GetIDsOfNames(GUID_NULL, @PName, 1, GetThreadLocale, @iDispID);
Invoke(iDispID, DispParams);
end;

procedure TForm1.AddCatalogClick(Sender: TObject);
var
DispParams: TDispParams;
Catalog, Place: WideString;
begin
FillChar(DispParams, SizeOf (DispParams), 0);
DispParams.cArgs := 2;
GetMem(DispParams.rgvarg, DispParams.cArgs * SizeOf(TVariantArg));
try
Catalog := Edit1.Text;
Place := Edit2.Text;
DispParams.rgvarg[0] := TVariantArg(OleVariant(Place));
DispParams.rgvarg[1] := TVariantArg(OleVariant(Catalog));
Exec('AddCatalog', DispParams);
finally
FreeMem(DispParams.rgvarg, DispParams.cArgs * SizeOf(TVariantArg));
end;
end;

procedure TForm1.StartClick(Sender: TObject);
var
DispParams: TDispParams;
begin
FillChar(DispParams, SizeOf (DispParams), 0);
DispParams.cArgs := 0;
GetMem(DispParams.rgvarg, DispParams.cArgs * SizeOf(TVariantArg));
try
Exec('Start', DispParams);
finally
FreeMem(DispParams.rgvarg, DispParams.cArgs * SizeOf(TVariantArg));
end;
end;

end.

Что дальше - ума не приложу. Инвоке возвращает очень содержательную ошибку с текстом "Ошибка" :( В чем может быть дело?

<Цитата>
Ломброзо © (07.07.06 11:38) [16]

> Инвоке возвращает очень содержательную ошибку с текстом "Ошибка"
Скопируйте эту вашу библиотеку на свою машину и зарегистрируйте её через regsvr32

<Цитата>
GrBob (07.07.06 11:51) [17]

> Скопируйте эту вашу библиотеку на свою машину и зарегистрируйте
> её через regsvr32

Она у меня зарегестрирована :) На своей машине прекрасно работает, а эта ошибка выдается даже если указать в качестве удаленной машины - свою.

<Цитата>
Ломброзо © (07.07.06 12:13) [18]

Да я так, на всякий случай.
Продолжаем разбираться дальше )
Как обстоят дела с настройками DCOM и правами?

<Цитата>
GrBob (07.07.06 12:24) [19]

Права - я администратор как на своей, так и на удаленной (в данном случае опять же своей :) ) машине. Что необходимо настроить в DCOM?

<Цитата>
Ломброзо © (07.07.06 12:27) [20]

Зайти в оснастку "Component Services" (на XP)->Свойства компьютера или dcomcnfg, проверить опцию, разрешающую использование DCOM.

<Цитата>
GrBob (07.07.06 12:37) [21]

Аааа, ну это то конечно установлено :)

<Цитата>
AbrosimovA © (07.07.06 14:44) [22]

Проверено на методе Add интерфейса Documents объекта Word.Application - работает.

var iSrv: IDispatch;
DID: integer;
Value: OleVariant;

DID:=StrToInt(ListView2.Selected.Caption);
Value:=GetDispIDFromName(iSrv, ListView2.Items[iIndex].SubItems[0], DID);
case VarType(Value) of
varDispatch:
begin
//Connect;
ISrv:=IDispatch(Value);
end;
varEmpty:
begin
//Exec;
try
SetInvokeMethod(iSrv,DID);
except
on E: Exception do begin
StatusBar1.SimpleText:=E.Message;
end
end
end;
end;

procedure SetInvokeMethod(const Dispatch: IDispatch; const ID: integer);
var
DispParams: TDispParams;
Args: array[0..1] of TVariantArg;
ExcepInfo : TExcepInfo;
iError : UINT;
begin
Args[0].vt:= VT_ERROR;
Args[0].scode := DISP_E_PARAMNOTFOUND;
Args[1].vt:= VT_ERROR;
Args[1].scode := DISP_E_PARAMNOTFOUND;
FillChar(DispParams, SizeOf (DispParams), 0);
with DispParams do begin
rgvarg := @Args;
cArgs := 2;
cNamedArgs := 0;
end;
OleCheck (Dispatch.Invoke(ID, GUID_NULL, LOCALE_SYSTEM_DEFAULT,
DISPATCH_METHOD, DispParams, nil, @ExcepInfo, @iError));
end;

<Цитата>
AbrosimovA © (07.07.06 16:54) [23]

Не могу найти ответа на следующий вопрос:

Как программно узнать, что нужно передавать через DispParams для безошибочного выполнения методов через IDispatch.Invoke

<Цитата>
~~имя~~ (09.07.06 20:53) [24]

Удалено модератором

<Цитата>
GrBob (11.07.06 12:31) [25]

> Как программно узнать, что нужно передавать через DispParams
> для безошибочного выполнения методов через IDispatch.Invoke

Советую взглянуть в сторону интерфейсов ITypeLib и ITypeInfo. Сам еще не разобрался, но имхо должно подойти. Мне как раз сейчас это тоже понадобилось, просто времени совсем нет читать, если разберешься, отпишись :)

<Цитата>
AbrosimovA © (11.07.06 14:27) [26]

Это дополнение к коду из 5-го поста для процедуры
procedure EnumInterface(Dispatch: IDispatch; Entries: TStrings; Functions: Boolean); :

type TArgInfo = record
Total: integer;
Optional: integer;
ArgsType: array[0..100] of TVARTYPE;
end;

var ArgInfo: array of TArgInfo;

SetLength(ArgInfo,TypeAttr.cFuncs);
//Общее число параметров метода
ArgInfo[iMethod].Total:=FuncDesc.cParams;
//Число необязательных параметров из них
ArgInfo[iMethod].Optional:=FuncDesc.cParamsOpt;параметров
//типы всех параметров
for i:=0 to FuncDesc.cParams-1 do ArgInfo[iMethod].ArgsType[i]:=TVARTYPE(FuncDesc.lprgelemdescParam[i].tdesc.vt);< /CODE>

<Цитата>