推荐订阅源

DFM File(main.dfm):

object MainForm: TMainForm
  Left = 301
  Top = 163
  Width = 696
  Height = 480
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -16
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 19
  object TreeView: TTreeView
    Left = 0
    Top = 0
    Width = 688
    Height = 453
    Align = alClient
    Indent = 19
    TabOrder = 0
    Items.Data = {
      010000001C0000000000000000000000FFFFFFFFFFFFFFFF0000000000000000
      0342504C}
  end
end

PAS File(main.pas):

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, StrUtils, TypInfo;

type
  TMainForm = class(TForm)
    TreeView: TTreeView;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

//==============================================================================
//Form.Unit*****************************************************************
//==============================================================================
procedure EnumPackageInfo(const InfoName: string; NameType: TNameType; Flags: Byte; Param: Pointer);
var Node: TTreeNode;
    i: integer;
begin
  Node := nil;
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  with MainForm.TreeView do
  begin
    for i:=1 to Selected.Count do
    if Selected.Item[i-1].Text=GetEnumName(TypeInfo(TNameType), Ord(NameType))
    then Node := Selected.Item[i-1];
    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    if not Assigned(Node)
    then Node := Items.AddChild(Selected, GetEnumName(TypeInfo(TNameType), Ord(NameType)));
    //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Items.AddChild(Node, InfoName);
  end;
end;

//==============================================================================
//Form.´´½¨´°Ìå*****************************************************************
//==============================================================================
procedure TMainForm.FormCreate(Sender: TObject);
var SystPath: array[0..128] of char;
    DosError: Integer;
    DirInfo: TSearchRec;
    AppName: string;
    HPack: HModule;
    Flags: Integer;
    Desc: string;
begin
  GetSystemDirectory(SystPath, 128);
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  DosError := FindFirst(SystPath+'\*.*', FaAnyfile, DirInfo);
  while DosError=0 do
  begin
    {$IF DEFINED(WIN32) AND DECLARED(UsingVCL)}
    if ((DirInfo.Attr and FaDirectory)<>FaDirectory) and ((DirInfo.Attr and FaVolumeID)<>FaVolumeID)
    {$ELSE}
    if ((DirInfo.Attr and FaDirectory)<>FaDirectory)
    {$IFEND}
    then if UpperCase(Copy(DirInfo.Name,Pos('.',DirInfo.Name)+1,3))='BPL' then
         try
           Desc := GetPackageDescription(PChar(DirInfo.Name));
           if Desc<>'' then Desc := '......('+ Desc +')';
           TreeView.Items.AddChild(TreeView.Items[0], DirInfo.Name + Desc);
           TreeView.Items[0].Item[TreeView.Items[0].Count-1].Selected := True;
           HPack := LoadPackage(DirInfo.Name);
           GetPackageInfo(HPack, Pointer(@HPack), Flags, EnumPackageInfo);
         except
         end;
    DosError := FindNext(DirInfo);
  end;
  SysUtils.FindClose(DirInfo);
  //~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  AppName := ExtractFileName(Application.ExeName);
  TreeView.SaveToFile(ExtractFilePath(Application.ExeName)+Copy(AppName,1,Pos('.',AppName)-1)+'.txt');
end;

end.