mitec_pe.pas

一个很不错的系统信息控件

unit MiTeC_PE;

interface

uses
  Windows, SysUtils, Classes, Graphics, Messages;

const
  SDotTextSectionTag = '.text';
  SCODESectionTag = 'CODE';
  DFM_Signature = $30465054;

  cResources: array[0..18] of record
                                ID: PAnsiChar;
                                Name: string;
                              end = ((ID:RT_CURSOR; Name:'CURSOR'),
                                     (ID:RT_BITMAP; Name:'BITMAP'),
                                     (ID:RT_ICON; Name:'ICON'),
                                     (ID:RT_MENU; Name:'MENU'),
                                     (ID:RT_DIALOG; Name:'DIALOG'),
                                     (ID:RT_STRING; Name:'STRING'),
                                     (ID:RT_FONTDIR; Name:'FONTDIR'),
                                     (ID:RT_FONT; Name:'FONT'),
                                     (ID:RT_ACCELERATOR; Name:'ACCELERATOR'),
                                     (ID:RT_RCDATA; Name:'RCDATA'),
                                     (ID:RT_MESSAGETABLE; Name:'MESSAGETABLE'),
                                     (ID:RT_GROUP_CURSOR; Name:'GROUP_CURSOR'),
                                     (ID:RT_GROUP_ICON; Name:'GROUP_ICON'),
                                     (ID:RT_VERSION; Name:'VERSION'),
                                     (ID:RT_DLGINCLUDE; Name:'DLGINCLUDE'),
                                     (ID:RT_PLUGPLAY; Name:'PLUGPLAY'),
                                     (ID:RT_VXD; Name:'VXD'),
                                     (ID:RT_ANICURSOR; Name:'ANICURSOR'),
                                     (ID:RT_ANIICON; Name:'ANIICON'));

  IMAGE_FILE_MACHINE_IA64      = $0200; // Intel 64
  IMAGE_FILE_MACHINE_AMD64     = $8664; // AMD64 (K8)

  IMAGE_RESOURCE_NAME_IS_STRING    = Cardinal($80000000);
  IMAGE_RESOURCE_DATA_IS_DIRECTORY = Cardinal($80000000);

  IMAGE_ORDINAL_FLAG32 = Cardinal($80000000);

type
  TIIDUnion = record
    case Integer of
      0: (Characteristics: Cardinal);         // 0 for terminating null import descriptor
      1: (OriginalFirstThunk: Cardinal);      // RVA to original unbound IAT (PIMAGE_THUNK_DATA)
  end;

  TImageImportDescriptor = record
    Union: TIIDUnion;
    TimeDateStamp: Cardinal;                  // 0 if not bound,
                                           // -1 if bound, and real date\time stamp
                                           //     in IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT (new BIND)
                                           // O.W. date/time stamp of DLL bound to (Old BIND)

    ForwarderChain: Cardinal;                 // -1 if no forwarders
    Name: Cardinal;
    FirstThunk: Cardinal;                     // RVA to IAT (if bound this IAT has actual addresses)
  end;
  PImageImportDescriptor = ^TImageImportDescriptor;

  TImageThunkData = record
    case Integer of
      0: (ForwarderString: Cardinal);   // PBYTE
      1: (Function_: Cardinal);         // PCardinal
      2: (Ordinal: Cardinal);
      3: (AddressOfData: Cardinal);     // PIMAGE_IMPORT_BY_NAME
  end;
  PImageThunkData = ^TImageThunkData;

  TImgDelayDescr = packed record
    grAttrs: Cardinal;                 // attributes
    szName: Cardinal;                  // pointer to dll name
    phmod: PCardinal;                  // address of module handle
    { TODO : probably wrong declaration }
    pIAT: TImageThunkData;          // address of the IAT
    { TODO : probably wrong declaration }
    pINT: TImageThunkData;          // address of the INT
    { TODO : probably wrong declaration }
    pBoundIAT: TImageThunkData;     // address of the optional bound IAT
    { TODO : probably wrong declaration }
    pUnloadIAT: TImageThunkData;    // address of optional copy of original IAT
    dwTimeStamp: Cardinal;             // 0 if not bound,
                                    // O.W. date/time stamp of DLL bound to (Old BIND)
  end;
  PImgDelayDescr = ^TImgDelayDescr;

  TImageBoundImportDescriptor = record
    TimeDateStamp: Cardinal;
    OffsetModuleName: Word;
    NumberOfModuleForwarderRefs: Word;
    // Array of zero or more IMAGE_BOUND_FORWARDER_REF follows
  end;
  PImageBoundImportDescriptor = ^TImageBoundImportDescriptor;

  TImageBoundForwarderRef = record
    TimeDateStamp: Cardinal;
    OffsetModuleName: Word;
    Reserved: Word;
  end;
  PImageBoundForwarderRef = ^TImageBoundForwarderRef;

  TImageImportByName = record
    Hint: Word;
    Name: array [0..0] of AnsiChar;
  end;
  PImageImportByName = ^TImageImportByName;

  TImageResourceDirectory = record
    Characteristics: cardinal;
    TimeDateStamp: cardinal;
    MajorVersion: Word;
    MinorVersion: Word;
    NumberOfNamedEntries: Word;
    NumberOfIdEntries: Word;
  end;
  PImageResourceDirectory = ^TImageResourceDirectory;

  TImageResourceDirectoryEntry = record
    case Integer of
      0: (
        // Cardinal NameOffset:31;
        // Cardinal NameIsString:1;
        NameOffset: Cardinal;
        OffsetToData: Cardinal
      );
      1: (
        Name: Cardinal;
        // Cardinal OffsetToDirectory:31;
        // Cardinal DataIsDirectory:1;
        OffsetToDirectory: Cardinal;
      );
      2: (
        Id: WORD;
      );
  end;
  PImageResourceDirectoryEntry = ^TImageResourceDirectoryEntry;

  TImageResourceDataEntry = record
    OffsetToData: Cardinal;
    Size: Cardinal;
    CodePage: Cardinal;
    Reserved: Cardinal;
  end;
  PImageResourceDataEntry = ^TImageResourceDataEntry;

  TImageResourceDirectoryString = record
    Length: Word;
    NameString: array [0..0] of CHAR;
  end;
  PImageResourceDirectoryString = ^TImageResourceDirectoryString;

  TImageResourceDirStringU = record
    Length: Word;
    NameString: array [0..0] of WCHAR;
  end;
  PImageResourceDirStringU = ^TImageResourceDirStringU;

  PAccelTableEntry = ^TAccelTableEntry;
  TAccelTableEntry = packed record
    fFlags: Word;
    wAnsi: Word;
    wId: Word;
    padding: Word;
  end;

  PMessageResourceBlock = ^TMessageResourceBlock;
  TMessageResourceBlock = packed record
    LowId: ULONG;
    HighId: ULONG;
    OffsetToEntries: ULONG;
  end;

  PMessageResourceData = ^TMessageResourceData;
  TMessageResourceData = packed record
    NumberOfBlocks: ULONG;
    // Blocks: array[0..0] of TMessageResourceBlock;
  end;

  PMessageResourceEntry = ^TMessageResourceEntry;
  TMessageResourceEntry = packed record
    Length: Word;
    Flags: Word;
    // Text: array[0..0] of Char;
  end;

  PResourceItem = ^TResourceItem;
  TResourceItem = record
    Typ: Longint;
    TypeName,
    Name: string;
  end;

  PResourceData = ^TResourceData;
  TResourceData = array of TResourceItem;

  TSectionItem = record
    Name: string;
    Data: TImageSectionHeader;
  end;

  TDirectoryItem = record
    Name: string;
    Section: string;
    Data: TImageDataDirectory;
  end;

  TExportItem = record
    Name: string;
    Ordinal: Word;
    Address: Cardinal;
  end;

  TExportData = array of TExportItem;

  TImportItem = record
    Name: string;
    ThunkData: TImageThunkData;
    Functions: TExportData;
  end;

  TImportData = array of TImportItem;

  TMiTeC_PE = class
  private
    ImageNTHeaders: PImageNtHeaders;
    FET: TExportData;
    FIT: TImportData;
    FCL: TList;
    FRP,FCU,FDFM,FHDR,FVER: TStringList;
    FRD: TResourceData;
    FH: THandle;
    FFilename: string;
    FDesc: string;
    FFlags: Integer;
    FKeep: Boolean;
    FSize: Int64;
    FLinker: string;
    procedure SetFilename(const Value: string);
    procedure ReadInfo;
    procedure CreateExportList;
    procedure CreateImportList;
    procedure CreateClassList;
    procedure CreateVerList;
    function RvaToVa(Rva: Cardinal): Pointer;
    function RvaToVaEx(Rva: Cardinal): Pointer;
    function DirectoryEntryToData(Directory: Word): Pointer;
    function ValidMSEXEModule: Boolean;
    function ValidReadableNTPEModule: Boolean;

    function GetClassCount: Cardinal;
    function GetClassItem(Index: cardinal): TClass;
    function GetPkgCount: Cardinal;
    function GetPkgItem(Index: Cardinal): string;
    function GetUnitCount: Cardinal;
    function GetUnitItem(Index: Cardinal): string;
    function GetFormCount: Cardinal;
    function GetFormItem(Index: Cardinal): string;
    function GetResCount: Cardinal;
    function GetResItem(Index: Cardinal): TResourceItem;
    function GetSecCount: Cardinal;
    function GetSecItem(Index: Cardinal): TSectionItem;
    function GetDirCount: Cardinal;
    function GetDirItem(Index: Cardinal): TDirectoryItem;
    function GetExpCount: Cardinal;
    function GetExpItem(Index: Cardinal): TExportItem;
    function GetImpCount: Cardinal;
    function GetImpItem(Index: Cardinal): TImportItem;
    function GetHeadCount: Cardinal;
    function GetHeadName(Index: Cardinal): string;
    function GetHeadValue(Index: Cardinal): string;
    function GetVerCount: Cardinal;
    function GetVerName(Index: Cardinal): string;
    function GetVerValue(Index: Cardinal): string;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Close;

    function SectionExists(ASectionName: string; var AHeader: Pointer): Boolean;

    property FileName: string read FFilename write SetFilename;
    property FileHandle: THandle read FH;

    property ClassCount: Cardinal read GetClassCount;
    property Classes[Index: Cardinal]: TClass read GetClassItem;

    property PackageCount: Cardinal read GetPkgCount;
    property Packages[Index: Cardinal]: string read GetPkgItem;

    property UnitCount: Cardinal read GetUnitCount;
    property Units[Index: Cardinal]: string read GetUnitItem;

    property FormCount: Cardinal read GetFormCount;
    property Forms[Index: Cardinal]: string read GetFormItem;

    property ResourceCount: Cardinal read GetResCount;
    property Resources[Index: Cardinal]: TResourceItem read GetResItem;

    property SectionCount: Cardinal read GetSecCount;
    property Sections[Index: Cardinal]: TSectionItem read GetSecItem;

    property DirectoryCount: Cardinal read GetDirCount;
    property Directories[Index: Cardinal]: TDirectoryItem read GetDirItem;

    property ExportCount: Cardinal read GetExpCount;
    property ExportItems[Index: Cardinal]: TExportItem read GetExpItem;

    property ImportCount: Cardinal read GetImpCount;
    property ImportItems[Index: Cardinal]: TImportItem read GetImpItem;

    property HeaderCount: Cardinal read GetHeadCount;
    property HeaderNames[Index: Cardinal]: string read GetHeadName;
    property HeaderValues[Index: Cardinal]: string read GetHeadValue;

    property VersionCount: Cardinal read GetVerCount;
    property VersionNames[Index: Cardinal]: string read GetVerName;
    property VersionValues[Index: Cardinal]: string read GetVerValue;

    property PackageDescription: string read FDesc;
    property PackageFlags: Integer read FFlags;
    property LinkerProdurer: string read FLinker;
    property Size: Int64 read FSize;
  end;

procedure SaveResourceAsBitmap(ASource: TResourceStream; ADest: TStream);
procedure SaveResourceAsCursor(ASource: TResourceStream; ADest: TStream);
procedure SaveResourceAsIcon(ASource: TResourceStream; ADest: TStream);
procedure SaveResourceAsStrings(ASource: TResourceStream; ADest: TStrings);
procedure SaveResourceAsAccelerators(ASource: TResourceStream; ADest: TStrings);
procedure SaveResourceAsMessageTable(ASource: TResourceStream; ADest: TStrings);
function CanShowResourceAsDialog(ASource: TResourceStream): Boolean;
function ShowResourceAsDialog(ASource: TResourceStream): Integer;

function GetResourceTypeName(ATyp: PAnsiChar): string;

implementation

uses MiTeC_Routines;

procedure SaveResourceAsBitmap(ASource: TResourceStream; ADest: TStream);

  function GetDInColors(BitCount: Word): Integer;
  begin
    case BitCount of
      1, 4, 8: Result:=1 shl BitCount;
    else
      Result:=0;
    end;
  end;

var
  BH: TBitmapFileHeader;
  BI: PBitmapInfoHeader;
  BC: PBitmapCoreHeader;
  ClrUsed: Integer;
begin
  FillChar(BH,sizeof(BH), #0);
  BH.bfType:=$4D42;
  BH.bfSize:=ASource.Size+SizeOf(BH);
  BI:=PBitmapInfoHeader(ASource.Memory);
  if BI.biSize=SizeOf(TBitmapInfoHeader) then begin
    ClrUsed:=BI.biClrUsed;
    if ClrUsed=0 then
      ClrUsed:=GetDInColors(BI.biBitCount);
    BH.bfOffBits:=ClrUsed*SizeOf(TRgbQuad)+SizeOf(TBitmapInfoHeader)+SizeOf(BH);
  end else begin
    BC:=PBitmapCoreHeader(ASOurce.Memory);
    ClrUsed:=GetDInColors(BC.bcBitCount);
    BH.bfOffBits:=ClrUsed*SizeOf(TRGBTriple)+SizeOf(TBitmapCoreHeader)+SizeOf(BH);
  end;
  ASource.Position:=0;
  ADest.Position:=0;
  ADest.Write(BH,SizeOf(BH));
  ADest.Write(ASource.Memory^,ASource.Size);
  ADest.Position:=0;
end;

procedure SaveResourceAsCursor(ASource: TResourceStream; ADest: TStream);
begin
  with TIcon.Create do
    try
      Handle:=CreateIconFromResource(ASource.Memory,ASource.Size,False,$30000);
      SaveToStream(ADest);
      ADest.Position:=0;
    finally
      Free;
    end;
end;

function CanShowResourceAsDialog;
begin
  Result:=Windows.PDlgTemplate(ASource.Memory)^.style and DS_CONTROL=0;
end;

function ShowResourceAsDialog;
var
  LastFocus: HWND;
  MemHandle: THandle;
  P: Windows.PDlgTemplate;

  function DialogProc(hwndDlg: HWND; uMsg: UINT; W: WPARAM; L: LPARAM): BOOL; stdcall;
  begin
    Result := False;
    case uMsg of
      WM_INITDIALOG: Result:=True;
      WM_LBUTTONDBLCLK: EndDialog(hwndDlg,0);
      WM_RBUTTONUP: EndDialog(hwndDlg,1);
      WM_SYSCOMMAND: if W and $FFF0 = SC_CLOSE then
                        EndDialog(hwndDlg, 0);
    end;
  end;

begin
  LastFocus:=GetFocus;
  MemHandle:=GlobalAlloc(GMEM_ZEROINIT,ASource.Size);
  P:=GlobalLock(MemHandle);
  Move(ASource.Memory^,P^,ASource.Size);
  GlobalUnlock(MemHandle);
  Result:=DialogBoxIndirect(hinstance,Windows.PDlgTemplate(MemHandle)^,0,@DialogProc);
  GlobalFree(MemHandle);
  SetFocus(LastFocus);
end;

procedure SaveResourceAsStrings;
var
  P: PWChar;
  ID: Integer;
  Cnt: Cardinal;
  Len: Word;
  S: string;
begin
  P:=ASource.Memory;
  Cnt:=0;
  while Cnt<16 do begin
    Len:=Word(P^);
    if Len>0 then begin
      Inc(P);
      S:=Trim(WideCharLenToString(P,Len));
      ADest.Add(S);
      Inc(P,Len);
    end else