VPF::Возможна ли такая реализация....?

vider

Дата 31.7.2012, 13:33 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 31.7.2012

Репутация: нет
Всего: нет

Доброго дня всем!

У меня вопрос к специалистам в области программирования на Delphi с использованием COM+.
Имеется необходимость организовать примерно такую реализацию:

Код


procedure Form1.test(Sender:TObject)
var 
app: variant;
s:string;
res:variant;
begin
app:=TDCOMConnection.AppServer;
//Допустим у интерфейса app есть метод Read, который что то возвращает в переменную res
//и при нормальной реализации нужно вызвать его так
res:=app.read;

//Но нам заранее не известно какой именно метод интерфейса app нам необходимо вызвать
//список методов есть но все их описать не получиться
//поэтому хотелось бы, что-то вроде этого:
s:='Read'; //или 'Read1', 'Read2' ....и т.д.;
res:=app.s;
end;

Вот примерно такая задача. Хотелось бы знать возможно ли вообще такое?
Заранее благодарю.

Это сообщение отредактировал(а) vider - 31.7.2012, 13:34

Чучмек

Дата 10.8.2012, 01:27 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 2
Всего: 41

Вызов variant.metod реализуется через методы IDispatch
Если разберешься с параметрами,то никто не помешает вызвать метод по его имени.

--------------------

умную мысль держи при себе, а дурной - поделись с другими

Чучмек

Дата 10.8.2012, 03:52 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 2
Всего: 41

Вот как будет выглядеть variant.visible:=true и variant.quit()

Код


var
  i:idispatch;
  metodname:widestring;
  params:array[0..7]of variant;
  _DispID:integer;
  cd:TCallDesc;
  _result:variant;
begin
    i:=CreateOleObject('Word.Application');

    metodname:='visible';
    i.GetIDsOfNames(GUID_NULL,@metodname,1,0,@_DispID);
    params[0]:=true;
    cd.CallType:=DISPATCH_PROPERTYPUT;
    cd.ArgCount:=1;
    cd.NamedArgCount:=0;
    cd.ArgTypes[0]:=VarType(params[0]);
    dispatchinvoke(i,@cd,@_DispID,@params,@_result); //сие есть удобней чем вызов i.Invoke

    sleep(2000);

    metodname:='quit';
    i.GetIDsOfNames(GUID_NULL,@metodname,1,0,@_DispID);
    cd.CallType:=DISPATCH_METHOD;
    cd.ArgCount:=0;
    cd.NamedArgCount:=0;
    dispatchinvoke(i,@cd,@_DispID,nil,@_result);

Это сообщение отредактировал(а) Чучмек - 10.8.2012, 04:00

--------------------

умную мысль держи при себе, а дурной - поделись с другими

Чучмек

Дата 10.8.2012, 13:33 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 2
Всего: 41

Чтобы не парится с вызовом GetIDsOfNames/Invoke можно написать класс реализующий IDispatch, который будет подменять имя вызываемого метода.
Вот что у меня получилось менее чем за 5 минут(на предыдущий пример ушло 2 часа).

Код


type
TDispatchCall=class(TInterfacedObject,IDispatch)
 private
  FMetodName:WideString;
  FDispInterface:IDispatch;
  function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
  function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall;
  function GetIDsOfNames(const IID: TGUID; Names: Pointer;
      NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
  function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall;
 public
  property Metod:WideString read FMetodName write FMetodName;
  property DispatchInterface:IDispatch read FDispInterface write FDispInterface;
 end;

{ TDispatchCall }

function TDispatchCall.GetIDsOfNames(const IID: TGUID; Names: Pointer;
  NameCount, LocaleID: Integer; DispIDs: Pointer): HResult;
var
 _names:pointer;
begin
  if (NameCount=1) and
     (CSTR_EQUAL=CompareStringW(LOCALE_SYSTEM_DEFAULT,NORM_IGNORECASE,'Метод',-1,PWideChar(Names^),-1))
    then _names:=@FMetodName  else  _names:=Names;
  result:=FDispInterface.GetIDsOfNames(IID,_names,NameCount,LocaleID,DispIDs);
end;

function TDispatchCall.GetTypeInfo(Index, LocaleID: Integer;
  out TypeInfo): HResult;
begin
  result:=FDispInterface.GetTypeInfo(Index,LocaleID,TypeInfo);
end;

function TDispatchCall.GetTypeInfoCount(out Count: Integer): HResult;
begin
  result:=FDispInterface.GetTypeInfoCount(Count);
end;

function TDispatchCall.Invoke(DispID: Integer; const IID: TGUID;
  LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
  ArgErr: Pointer): HResult;
begin
 result:=FDispInterface.Invoke(DispID,IID,LocaleID,Flags,Params,VarResult,ExcepInfo,ArgErr);
end;

Использование

Код


procedure TForm1.Button1Click(Sender: TObject);
var
 callobj:TDispatchCall;
 v:variant;
begin
  callobj:=TDispatchCall.Create;
  v:=callobj as IDispatch;

  callobj.DispatchInterface:=CreateOleObject('Word.Application');
  callobj.Metod:='visible';
  v.Метод:=true;

  callobj.Metod:='Documents';
  callobj.DispatchInterface:=v.Метод;

  callobj.Metod:='Add';
  callobj.DispatchInterface:=v.Метод;

  callobj.Metod:='Range';
  callobj.DispatchInterface:=v.Метод;

  callobj.Metod:='InsertBefore';
  v.Метод('Hello World');

end;

Это идентично

Код


procedure TForm1.Button2Click(Sender: TObject);
var v:variant;
begin
 v:=CreateOleObject('Word.Application');
 v.visible:=true;
 v:=v.Documents.Add.Range;
 v.InsertBefore('Hello World');
end;

Добавлено @ 13:39
P.S. Хотя это, наверное, велосипед, и есть готовое(стандартное) решение. Просто я о нем не знаю.

Это сообщение отредактировал(а) Чучмек - 10.8.2012, 13:40

--------------------

умную мысль держи при себе, а дурной - поделись с другими

vider

Дата 21.8.2012, 18:16 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 31.7.2012

Репутация: нет
Всего: нет

Чучмек!
Ты просто БОГ!!!
Огромное тебе спасибо!!!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: ActiveX/СОМ/CORBA \| Следующая тема »