1,593
社区成员
发帖
与我相关
我的任务
分享
//接口
ITest = interface(IDispatch)
['{C8E5E6FF-FBF2-4397-A4F3-8041DF9548E8}']
function Test: Boolean; stdcall;
end;
{$m-}{$METHODINFO OFF}
//disp接口
ITestDisp = dispinterface
['{C8E5E6FF-FBF2-4397-A4F3-8041DF9548E8}']
function Test: Boolean; dispid 500;
end;
TTest = class(TInterfacedObject, ITest, IDispatch)
protected
function Test: Boolean; stdcall;
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;
end;
//以下是调用
var
I: ITest;
Disp: ITestDisp;
V: Variant;
begin
//用非disp接口调用, 直接执行到 Test 方法内部
I := TTest.Create;
I.Test;
//用dips接口调用,执行到Invoke,再由 Invoke 执行其它方法
Disp := TTest.Create as ITestDisp;
Disp.Test;
//用Variant调用,首先执行到 GetIDsOfNames 获取方法ID,然后再执行到 Invoke 再由 Invoke 执行其它方法
V := TTest.Create as ITestDisp;
V.Test;
end;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComObj, ObjAuto, ActiveX;
type
{$m+}{$METHODINFO ON} {$P+}
ITest = interface(IDispatch)
['{C8E5E6FF-FBF2-4397-A4F3-8041DF9548E8}']
function Test: Variant;
end;
ITestDisp = dispinterface
['{C8E5E6FF-FBF2-4397-A4F3-8041DF9548E8}']
function Test: Variant; dispid 101;
end;
{$m-}{$METHODINFO OFF}{$P-}
TTest = class(TInterfacedObject, ITest, IDispatch)
protected
//function Invoke(MethodName: string; var Params; var VarResult, ExcepInfo: Pointer): HResult; stdcall;
function Test: Variant;
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;
end;
TForm3 = class(TForm)
btn1: TButton;
procedure btn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.btn1Click(Sender: TObject);
var
Id: ITestDisp;
V: OleVariant;
I: ITest;
begin
I := TTest.Create;
Id := TTest.Create as ITestDisp;
V := TTest.Create as IDispatch;
I.Test;
Id.Test;
V.Test;
I := nil;
Id := nil;
V := Unassigned;
end;
{TTest}
function TTest.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
LocaleID: Integer; DispIDs: Pointer): HResult;
begin
//Variant类型调用将执行到此处
ShowMessage('GetIDsOfNames');
PDispIdList(DispIDs)^[0] := -1;
Result := S_OK;
end;
function TTest.GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult;
begin
Result := S_OK;
end;
function TTest.GetTypeInfoCount(out Count: Integer): HResult;
begin
Result := S_OK;
end;
function TTest.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult;
begin
//难题就在这了, 看看是否是GetIDsOfName中返回的DispID?
//如果是dispinterface调用的将直接传入"function Test: Variant; dispid 101;" 中的dispid 101
ShowMessage(IntToStr(DispID));
//本应该在此处获取方法地址
end;
function TTest.Test: Variant;
begin
Result := 'OK';
ShowMessage('Test!');
end;
//procedure IntefCall(Result: Pointer; const Dispatch: IDispatch;
// DispDesc: PDispDesc; Params: Pointer); cdecl;
//var
// LArgCount: Integer;
// LIdent: string;
//begin
// LArgCount := DispDesc^.CallDesc.ArgCount;
// LIdent := Uppercase(String(PChar(@(DispDesc^.CallDesc).ArgTypes[LArgCount])));
//可在此处通过Dispatch获取实例地址并调用非Invoke方法
//end;
initialization
//此处可重写系统DispCallByIDProc函数
//DispCallByIDProc := @IntefCall;
end.