mainform.pas

delphi com深入编程,非常有收藏价值

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ExtCtrls, ActiveX;
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    treeTI: TTreeView;
    StatusBar1: TStatusBar;
    FileMenu: TMenuItem;
    FileExit1: TMenuItem;
    FileOpen1: TMenuItem;
    OpenDialog1: TOpenDialog;
    procedure FileExit1Click(Sender: TObject);
    procedure FileOpen1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FLib: ITypeLib;
    FEnumRoot: TTreeNode;
    FDispatchRoot: TTreeNode;
    FInterfaceRoot: TTreeNode;
    FCoClassRoot: TTreeNode;
    FUnknownRoot: TTreeNode;
    procedure LoadTypeLibrary;
    procedure LoadEnum(TypeInfo: ITypeInfo; TypeAttr: PTypeAttr);
    procedure LoadInterface(TypeInfo: ITypeInfo; TypeAttr: PTypeAttr);
    procedure LoadCoClass(TypeInfo: ITypeInfo; TypeAttr: PTypeAttr);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  ComObj;

{$R *.DFM}

procedure TForm1.FileExit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.LoadEnum(TypeInfo: ITypeInfo; TypeAttr: PTypeAttr);
var
  TypeLibNode: TTreeNode;
  AName: WideString;
  ADocString: WideString;
  AHelpContext: LongInt;
  ValuesNode: TTreeNode;
  ValueNode: TTreeNode;
  ValueIndex: Integer;
  VarDesc: PVarDesc;
begin
  TypeInfo.GetDocumentation(-1, @AName, @ADocString, @AHelpContext,
    nil);
  TypeLibNode := treeTI.Items.AddChild(FEnumRoot, AName);

  treeTI.Items.AddChild(TypeLibNode, 'Version ' +
    IntToStr(TypeAttr.wMajorVerNum) + '.' +
    IntToStr(TypeAttr.wMinorVerNum));
  if ADocString <> '' then
    treeTI.Items.AddChild(TypeLibNode, 'Help string: ' + ADocString);
  if AHelpContext <> 0 then
    treeTI.Items.AddChild(TypeLibNode, 'Help context: ' +
      IntToStr(AHelpContext));

  ValuesNode := treeTI.Items.AddChild(TypeLibNode, 'Values');
  for ValueIndex := 0 to TypeAttr.cVars - 1 do begin
    TypeInfo.GetVarDesc(ValueIndex, VarDesc);
    try
      TypeInfo.GetDocumentation(VarDesc.memid, @AName, @ADocString,
        @AHelpContext, nil);
      ValueNode := treeTI.Items.AddChild(ValuesNode, AName);
      if ADocString <> '' then
        treeTI.Items.AddChild(ValueNode, 'Help string: ' +
          ADocString);
      if AHelpContext <> 0 then
        treeTI.Items.AddChild(ValueNode, 'Help context: ' +
          IntToStr(AHelpContext));
    finally
      TypeInfo.ReleaseVarDesc(VarDesc);
    end;
  end;
end;

procedure TForm1.LoadInterface(TypeInfo: ITypeInfo;
  TypeAttr: PTypeAttr);
var
  TypeLibNode: TTreeNode;
  AName: WideString;
  ADocString: WideString;
  AHelpContext: LongInt;
  FunctionsNode: TTreeNode;
  FunctionNode: TTreeNode;
  FuncIndex: Integer;
  FuncDesc: PFuncDesc;
  ParametersNode: TTreeNode;
  ParamIndex: Integer;
  Names: PBStrList;
  cNames: Integer;
begin
  TypeInfo.GetDocumentation(-1, @AName, @ADocString, @AHelpContext,
    nil);
  if TypeAttr.typeKind = TKIND_DISPATCH then
    TypeLibNode := treeTI.Items.AddChild(FDispatchRoot, AName)
  else
    TypeLibNode := treeTI.Items.AddChild(FInterfaceRoot, AName);

  treeTI.Items.AddChild(TypeLibNode, GUIDToString(TypeAttr.GUID));
  treeTI.Items.AddChild(TypeLibNode, 'Version ' +
    IntToStr(TypeAttr.wMajorVerNum) + '.' +
    IntToStr(TypeAttr.wMinorVerNum));
  if ADocString <> '' then
    treeTI.Items.AddChild(TypeLibNode, 'Help string: ' + ADocString);
  if AHelpContext <> 0 then
    treeTI.Items.AddChild(TypeLibNode, 'Help context: ' +
      IntToStr(AHelpContext));

  New(Names);
  try
    // load functions
    FunctionsNode := treeTI.Items.AddChild(TypeLibNode, 'Functions');
    for FuncIndex := 0 to TypeAttr.cFuncs - 1 do begin
      TypeInfo.GetFuncDesc(FuncIndex, FuncDesc);
      try
        TypeInfo.GetDocumentation(FuncDesc.memid, @AName,
          @ADocString, @AHelpContext, nil);
        FunctionNode := treeTI.Items.AddChild(FunctionsNode, AName);
        if ADocString <> '' then
          treeTI.Items.AddChild(FunctionNode, 'Help string: ' +
            ADocString);
        if AHelpContext <> 0 then
          treeTI.Items.AddChild(FunctionNode, 'Help context: ' +
            IntToStr(AHelpContext));

        if FuncDesc.cParams > 0 then begin
          // load parameters
          ParametersNode := treeTI.Items.AddChild(FunctionNode,
            'Parameters');

          TypeInfo.GetNames(FuncDesc.memid, Names, sizeof(TBStrList),
            cNames);

          // Skip Names[0] - it's the function name
          for ParamIndex := 1 to FuncDesc.cParams do
            treeTI.Items.AddChild(ParametersNode, Names[ParamIndex]);
        end;
      finally
        TypeInfo.ReleaseFuncDesc(FuncDesc);
      end;
    end;
  finally
    Dispose(Names);
  end;
end;

procedure TForm1.LoadCoClass(TypeInfo: ITypeInfo;
  TypeAttr: PTypeAttr);
var
  TypeLibNode: TTreeNode;
  AName: WideString;
  ADocString: WideString;
  AHelpContext: LongInt;
  FunctionsNode: TTreeNode;
  FuncIndex: Integer;
  RefType: Cardinal;
  TypeInfo2: ITypeInfo;
begin
  TypeInfo.GetDocumentation(-1, @AName, @ADocString, @AHelpContext,
    nil);
  TypeLibNode := treeTI.Items.AddChild(FCoClassRoot, AName);

  treeTI.Items.AddChild(TypeLibNode, GUIDToString(TypeAttr.GUID));
  if ADocString <> '' then
    treeTI.Items.AddChild(TypeLibNode, 'Help string: ' + ADocString);
  if AHelpContext <> 0 then
    treeTI.Items.AddChild(TypeLibNode, 'Help context: ' +
      IntToStr(AHelpContext));

  FunctionsNode := treeTI.Items.AddChild(TypeLibNode, 'Implements');
  for FuncIndex := 0 to TypeAttr.cImplTypes - 1 do begin
    TypeInfo.GetRefTypeOfImplType(FuncIndex, RefType);
    TypeInfo.GetRefTypeInfo(RefType, TypeInfo2);
    TypeInfo2.GetDocumentation(-1, @AName, nil, nil, nil);
    treeTI.Items.AddChild(FunctionsNode, AName);
  end;
end;

procedure TForm1.LoadTypeLibrary;
var
  LibAttr: PTLibAttr;
  TypeInfo: ITypeInfo;
  TypeLibIndex: Integer;
  AName: WideString;
  ADocString: WideString;
  AHelpContext: LongInt;
  AHelpFile: WideString;
  TypeAttr: PTypeAttr;
  RootNode: TTreeNode;
begin
  Screen.Cursor := crHourglass;
  try
    treeTI.Items.BeginUpdate;
    try
      treeTI.Items.Clear;

      FLib.GetDocumentation(-1, @AName, @ADocString, @AHelpContext,
        @AHelpFile);

      // Load help information
      RootNode := treeTI.Items.AddChild(nil, AName);

      // GUID, version, LCID
      OleCheck(FLib.GetLibAttr(LibAttr));
      try
        treeTI.Items.AddChild(RootNode, GUIDToString(LibAttr.GUID));
        treeTI.Items.AddChild(RootNode, 'Version ' +
          IntToStr(LibAttr.wMajorVerNum) + '.' +
          IntToStr(LibAttr.wMinorVerNum));
        treeTI.Items.AddChild(RootNode, 'LCID: ' +
          IntToStr(LibAttr.lcid));
      finally
        FLib.ReleaseTLibAttr(LibAttr);
      end;

      // Help information
      if ADocString <> '' then
        treeTI.Items.AddChild(RootNode, 'Help string: ' + ADocString);
      if AHelpContext <> 0 then
        treeTI.Items.AddChild(RootNode, 'Help context: ' +
          IntToStr(AHelpContext));
      if AHelpFile <> '' then
        treeTI.Items.AddChild(RootNode, 'Help file: ' + AHelpFile);

      // Set no nodes for various types
      FEnumRoot := treeTI.Items.AddChild(RootNode, 'Enum');
      FDispatchRoot := treeTI.Items.AddChild(RootNode, 'Dispatch');
      FInterfaceRoot := treeTI.Items.AddChild(RootNode, 'Interface');
      FCoClassRoot := treeTI.Items.AddChild(RootNode, 'CoClass');
      FUnknownRoot := treeTI.Items.AddChild(RootNode, 'Unknown');

      for TypeLibIndex := 0 to FLib.GetTypeInfoCount - 1 do begin
        FLib.GetTypeInfo(TypeLibIndex, TypeInfo);
        OleCheck(TypeInfo.GetTypeAttr(TypeAttr));
        try
          case TypeAttr.typeKind of
            TKIND_ENUM:
              LoadEnum(TypeInfo, TypeAttr);

            TKIND_DISPATCH,
            TKIND_INTERFACE:
              LoadInterface(TypeInfo, TypeAttr);

            TKIND_COCLASS:
              LoadCoClass(TypeInfo, TypeAttr);

            else
              treeTI.Items.AddChild(FUnknownRoot,
                'Unrecognized type: ' + IntToStr(TypeAttr.typeKind));
          end;
        finally
          TypeInfo.ReleaseTypeAttr(TypeAttr);
        end;
      end;

      RootNode.Expand(False);
    finally
      treeTI.Items.EndUpdate;
    end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TForm1.FileOpen1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then begin
    OleCheck(LoadTypeLib(PWideChar(WideString(OpenDialog1.FileName)),
      FLib));
    LoadTypeLibrary;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if ParamCount = 1 then begin
    try
      OleCheck(LoadTypeLib(PWideChar(WideString(ParamStr(1))),
        FLib));
      LoadTypeLibrary;
    except
      on E: Exception do begin
        ShowMessage(E.Message);
        Application.Terminate;
      end;
    end;
  end;
end;

end.