Текущий архив: 2009.02.08;
Скачать: CL | DM;

Вниз

Обращение к удаленном OLE-объекту   Найти похожие ветки 

← →
GrBob   (2006-06-27 11:07) [0]

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

---

← →
tesseract ©   (2006-06-27 14:57) [1]

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


enuminterfaces??

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

---

← →
GrBob   (2006-06-27 15:15) [2]

> enuminterfaces??


??


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


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

---

← →
tesseract ©   (2006-06-28 13:56) [3]

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

---

← →
GrBob   (2006-06-28 16:47) [4]

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

---

← →
AbrosimovA ©   (2006-06-29 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   (2006-06-30 09:24) [6]

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

---

← →
AbrosimovA ©   (2006-06-30 12:40) [7]

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

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

---

← →
Медвед   (2006-07-03 10:20) [8]

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

---

← →
GrBob   (2006-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 ©   (2006-07-06 16:54) [10]

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


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

---

← →
GrBob   (2006-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 потом ищет метод, вызывает его ну и т.д., не суть важно. Вроде работает, но надо еще проверять, почему то иногда падает (возможно даже не в этом месте :)).

---

← →
Ломброзо ©   (2006-07-07 02:10) [12]

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

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

---

← →
GrBob   (2006-07-07 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 ©   (2006-07-07 08:10) [14]

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


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

---

← →
GrBob   (2006-07-07 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.

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

---

← →
Ломброзо ©   (2006-07-07 11:38) [16]

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

---

← →
GrBob   (2006-07-07 11:51) [17]

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

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

---

← →
Ломброзо ©   (2006-07-07 12:13) [18]

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

---

← →
GrBob   (2006-07-07 12:24) [19]

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

---

← →
Ломброзо ©   (2006-07-07 12:27) [20]

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

---

← →
GrBob   (2006-07-07 12:37) [21]

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

---

← →
AbrosimovA ©   (2006-07-07 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 ©   (2006-07-07 16:54) [23]

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

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

---

← →
имя   (2006-07-09 20:53) [24]

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

---

← →
GrBob   (2006-07-11 12:31) [25]

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

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

---

← →
AbrosimovA ©   (2006-07-11 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>

---

Страницы: 1 вся ветка

Текущий архив: 2009.02.08;
Скачать: CL | DM;

Наверх

Память: 0.57 MB
Время: 0.01 c