Чтобы не парится с вызовом 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. Хотя это, наверное, велосипед, и есть готовое(стандартное) решение. Просто я о нем не знаю. |