Получить члены COM-объекта через Тип Delphi Olevariant

можно ли получить список членов (свойств, функций, процедур) для COM-объекта через Тип OleVariant?

например,

var
  wscript: Olevariant;
begin
  wscript := CreateOleObject("WScript.Shell");
  ...
end;

и мне особенно интересно получить список функций, таких как WScript.Echo, WScript.Бросить и т. д.

Я хочу иметь эту функцию, потому что хорошо реализовать автоматическое завершение кода.

7
com delphi

2 ответов

можно использовать GetTypeInfo способ и ITypeInfo интерфейс.

попробуйте этот пример кода (не завершен, но вы можете использовать его в качестве отправной точки)

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ActiveX,
  ComObj,
  Variants;

//http://spec.winprog.org/typeinfo/
//http://spec.winprog.org/typeinf2/
//http://spec.winprog.org/typeinf3/

function GetTypeStr(tdesc : TTypeDesc; Context : ActiveX.ITypeinfo):string;
var
  tinfo    : ActiveX.ITypeInfo;
  bstrName : WideString;
begin
   case tdesc.vt of
     VT_PTR   : Result:=GetTypeStr(tdesc.ptdesc^,Context);
     VT_ARRAY : Result:=Format('Array of %s',[GetTypeStr(tdesc.padesc^.tdescElem,Context)]);
     VT_USERDEFINED : begin
                        context.GetRefTypeInfo(tdesc.hreftype, tinfo);
                        tinfo.GetDocumentation(-1, @bstrName, nil, nil, nil);
                        Result:=bstrName;
                      end
   else
     Result:=VarTypeAsText(tdesc.vt);
   end;
end;


//http://msdn.microsoft.com/en-us/magazine/dd347981.aspx
Procedure InspectCOMOnbject(const ClassName: string);
Var
  ComObject     : OleVariant;
  Dispatch      : IDispatch;
  Count         : Integer;
  i,j,k         : Integer;
  Typeinfo      : ActiveX.ITypeinfo;
  ptypeattr     : ActiveX.PTypeAttr;
  pfuncdesc     : ActiveX.PFuncDesc;//http://msdn.microsoft.com/en-us/library/microsoft.visualstudio.vswizard.tagfuncdesc.aspx
  rgbstrNames   : TBStrList;
  cNames        : Integer;
  bstrName      : WideString;
  bstrDocString : WideString;
  sValue        : string;
  sinvkind      : string;
begin
  ComObject     := CreateOleObject(ClassName);
  Dispatch      := IUnknown(ComObject) as IDispatch;
  OleCheck(Dispatch.GetTypeInfoCount(Count));
  for i := 0 to Count-1 do
    begin
       OleCheck(Dispatch.GetTypeInfo(i,0,Typeinfo));
       OleCheck(Typeinfo.GetTypeAttr(ptypeattr));
       try
        case ptypeattr^.typekind of
         TKIND_INTERFACE,
         TKIND_DISPATCH :
          begin
            for j:=0 to ptypeattr^.cFuncs-1 do
            begin
               OleCheck(Typeinfo.GetFuncDesc(j, pfuncdesc));
               try
                 OleCheck(Typeinfo.GetNames(pfuncdesc.memid, @rgbstrNames, pfuncdesc.cParams + 1, cNames));
                 OleCheck(Typeinfo.GetDocumentation(pfuncdesc.memid,@bstrName,@bstrDocString,nil,nil));

                 if 1=1 then //pfuncdesc.elemdescFunc.tdesc.vt<>18 then
                 begin
                   //pfuncdesc.elemdescFunc.paramdesc
                   case pfuncdesc.invkind of
                    INVOKE_FUNC           : if pfuncdesc.elemdescFunc.tdesc.vt = VT_VOID then sinvkind :='procedure' else sinvkind :='function';
                    INVOKE_PROPERTYGET    : sinvkind :='get property';
                    INVOKE_PROPERTYPUT    : sinvkind :='put property';
                    INVOKE_PROPERTYPUTREF : sinvkind :='ref property';
                   else
                     sinvkind :='unknow';
                   end;


                    {
                   if bstrDocString<>'' then
                    Writeln(Format('// %s',[bstrDocString]));
                     }
                    if pfuncdesc.cParams<=1 then
                    begin
                       if pfuncdesc.elemdescFunc.tdesc.vt = VT_VOID then
                        Writeln(Format('%s %s;',[sinvkind,bstrName]))
                       else
                        Writeln(Format('%s %s : %s;',[sinvkind,bstrName,GetTypeStr(pfuncdesc.elemdescFunc.tdesc, Typeinfo)]));
                    end
                    else
                    begin
                      sValue:='';
                      for k := 1 to pfuncdesc.cParams do
                      begin
                        //Writeln(Format('%s : %d',[rgbstrNames[k], pfuncdesc.lprgelemdescParam[k-1].tdesc.vt]));
                        sValue:= sValue + Format('%s : %s',[rgbstrNames[k], GetTypeStr(pfuncdesc.lprgelemdescParam[k-1].tdesc,Typeinfo)]);
                        if k<pfuncdesc.cParams then
                          sValue:=sValue+';';
                      end;

                      if pfuncdesc.elemdescFunc.tdesc.vt = VT_VOID then
                        Writeln(Format('%s %s (%s);',[sinvkind, bstrName, sValue]))
                      else
                        Writeln(Format('%s %s (%s) : %s;',[sinvkind, bstrName,SValue,GetTypeStr(pfuncdesc.elemdescFunc.tdesc, Typeinfo)]))
                    end;
                      //Writeln(pfuncdesc.elemdescFunc.tdesc.vt);
                 end;
               finally
                 Typeinfo.ReleaseFuncDesc(pfuncdesc);
               end;
            end;
          end;
        end;
       finally
          Typeinfo.ReleaseTypeAttr(ptypeattr);
       end;
    end;
end;



begin
 try
    CoInitialize(nil);
    try
      //InspectCOMOnbject('WbemScripting.SWbemLocator');
      InspectCOMOnbject('Excel.Application');
      //InspectCOMOnbject('Schedule.Service');
      //InspectCOMOnbject('WScript.Shell');
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.
7

объект может реализовать IDispatchEx можно использовать GetNextDispID перечислить все члены и GetMemberName и GetMemberProperties чтобы узнать некоторую (минимальную) информацию о каждом члене.

или объект может реализовать IDispatch и в частности IDispatch::GetTypeInfo, то вы можете (с некоторым трудом) извлечь информацию о своих членах из

2