exeimage.pas

Delphi写的PE查看器

{******************************************************************************}
{Copyright(C) 2007,Pefine Security Lab                                         }
{All rights reserved.                                                          }
{                                                                              }
{Abstract:View Win32 PE file information.                                      }
{                                                                              }
{Version:1.01                                                                  }
{Author:WindRand                                                               }
{Date:2007-01-20                                                               }
{******************************************************************************}
unit ExeImage;

interface

uses
  TypInfo, Classes, SysUtils, Windows, Graphics, RXTypes;

type

{ Exceptions }

  EExeError = class(Exception);

{ Forward Declarations }

  TResourceItem = class;
  TResourceClass = class of TResourceItem;
  TResourceList = class;

{ TExeImage }

  TExeImage = class(TComponent)
  private
    FFileName: string;
    FFileHandle: THandle;
    FFileMapping: THandle;
    FFileBase: Pointer;
    FDosHeader: PIMAGE_DOS_HEADER;
    FNTHeader: PIMAGE_NT_HEADERS;
    FResourceList: TResourceList;
    FIconResources: TResourceItem;
    FCursorResources: TResourceItem;
    FResourceBase: Longint;
    FResourceRVA: Longint;
    function GetResourceList: TResourceList;
    function GetSectionHdr(const SectionName: string;
      var Header: PIMAGE_SECTION_HEADER): Boolean;
  public
    constructor CreateImage(AOwner: TComponent; const AFileName: string);
    destructor Destroy; override;
    property FileName: string read FFileName;
    property Resources: TResourceList read GetResourceList;
  end;

{ TResourceItem }

  TResourceItem = class(TComponent)
  private
    FList: TResourceList;
    FDirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY;
    function DataEntry: PIMAGE_RESOURCE_DATA_ENTRY;
    function FExeImage: TExeImage;
    function FirstChildDirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY;
    function GetResourceItem(Index: Integer): TResourceItem;
    function GetResourceType: TResourceType;
  protected
    function GetName: string; virtual;
    function GetResourceList: TResourceList; virtual;
  public
    constructor CreateItem(AOwner: TComponent; ADirEntry: Pointer);
    function IsList: Boolean; virtual;
    function Offset: Integer;
    function Size: Integer;
    function RawData: Pointer;
    function ResTypeStr: string;
    procedure SaveToFile(const FileName: string);
    procedure SaveToStream(Stream: TStream); virtual;
    property Items[Index: Integer]: TResourceItem read GetResourceItem; default;
    property List: TResourceList read GetResourceList;
    property Name: string read GetName;
    property ResType: TResourceType read GetResourceType;
  end;

{ TIconResource }

  TIconResource = class(TResourceItem)
  protected
    function GetResourceList: TResourceList; override;
  public
    function IsList: Boolean; override;
  end;

{ TIconResEntry }

  TIconResEntry = class(TResourceItem)
  protected
    FResInfo: PIconResInfo;
    function GetName: string; override;
    procedure AssignTo(Dest: TPersistent); override;
  public
    procedure SaveToStream(Stream: TStream); override;
  end;

{ TCursorResource }

  TCursorResource = class(TIconResource)
  protected
    function GetResourceList: TResourceList; override;
  end;

{ TCursorResEntry }

  TCursorResEntry = class(TIconResEntry)
  protected
    FResInfo: PCursorResInfo;
    function GetName: string; override;
  end;

{ TBitmapResource }

  TBitMapResource = class(TResourceItem)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  public
    procedure SaveToStream(Stream: TStream); override;
  end;

{ TStringResource }

  TStringResource = class(TResourceItem)
  protected
    procedure AssignTo(Dest: TPersistent); override;
  end;

{ TMenuResource }

  TMenuResource = class(TResourceItem)
  private
    FNestStr: string;
    FNestLevel: Integer;
    procedure SetNestLevel(Value: Integer);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    property NestLevel: Integer read FNestLevel write SetNestLevel;
    property NestStr: string read FNestStr;
  end;

{ TResourceList }

  TResourceList = class(TComponent)
  protected
    FList: TList;
    FResDir: PIMAGE_RESOURCE_DIRECTORY;
    FExeImage: TExeImage;
    FResType: Integer;
    function List: TList; virtual;
    function GetResourceItem(Index: Integer): TResourceItem;
  public
    constructor CreateList(AOwner: TComponent; ResDirOfs: Longint;
      AExeImage: TExeImage);
    destructor Destroy; override;
    function Count: Integer;
    property Items[Index: Integer]: TResourceItem read GetResourceItem; default;
  end;

{ TIconResourceList }

  TIconResourceList = class(TResourceList)
  protected
    function List: TList; override;
  end;

{ TCursorResourceList }

  TCursorResourceList = class(TResourceList)
  protected
    function List: TList; override;
  end;

implementation

{ This function maps a resource type to the associated resource class }

function GetResourceClass(ResType: Integer): TResourceClass;
const
  TResourceClasses: array[TResourceType] of TResourceClass = (
    TResourceItem,      { rtUnknown0 }
    TCursorResEntry,    { rtCursorEntry }
    TBitmapResource,    { rtBitmap }
    TIconResEntry,      { rtIconEntry }
    TMenuResource,      { rtMenu }
    TResourceItem,      { rtDialog }
    TStringResource,    { rtString }
    TResourceItem,      { rtFontDir }
    TResourceItem,      { rtFont }
    TResourceItem,      { rtAccelerators }
    TResourceItem,      { rtRCData }
    TResourceItem,      { rtMessageTable }
    TCursorResource,    { rtGroupCursor }
    TResourceItem,      { rtUnknown13 }
    TIconResource,      { rtIcon }
    TResourceItem,      { rtUnknown15 }
    TResourceItem);     { rtVersion }
begin
  if (ResType >= Integer(Low(TResourceType))) and
    (ResType <= Integer(High(TResourceType))) then
    Result := TResourceClasses[TResourceType(ResType)] else
    Result := TResourceItem;
end;

{ Utility Functions }

function Min(A, B: Integer): Integer;
begin
  if A < B then Result := A
  else Result := B;
end;

{ This function checks if an offset is a string name, or a directory }
{Assumes: IMAGE_RESOURCE_NAME_IS_STRING = IMAGE_RESOURCE_DATA_IS_DIRECTORY}

function HighBitSet(L: Longint): Boolean;
begin
  Result := (L and IMAGE_RESOURCE_DATA_IS_DIRECTORY) <> 0;
end;

function StripHighBit(L: Longint): Longint;
begin
  Result := L and IMAGE_OFFSET_STRIP_HIGH;
end;

function StripHighPtr(L: Longint): Pointer;
begin
  Result := Pointer(L and IMAGE_OFFSET_STRIP_HIGH);
end;

{ This function converts a pointer to a wide char string into a pascal string }

function WideCharToStr(WStr: PWChar; Len: Integer): string;
begin
  if Len = 0 then Len := -1;
  Len := WideCharToMultiByte(CP_ACP, 0, WStr, Len, nil, 0, nil, nil);
  SetLength(Result, Len);
  WideCharToMultiByte(CP_ACP, 0, WStr, Len, PChar(Result), Len, nil, nil);
end;

{ Exceptions }

procedure ExeError(const ErrMsg: string);
begin
  raise EExeError.Create(ErrMsg);
end;

{ TExeImage }

constructor TExeImage.CreateImage(AOwner: TComponent; const AFileName: string);
begin
  inherited Create(AOwner);
  FFileName := AFileName;
  FFileHandle := CreateFile(PChar(FFileName), GENERIC_READ, FILE_SHARE_READ,
    nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if FFileHandle = INVALID_HANDLE_VALUE then ExeError('Couldn''t open: '+FFileName);
    FFileMapping := CreateFileMapping(FFileHandle, nil, PAGE_READONLY, 0, 0, nil);
  if FFileMapping = 0 then ExeError('CreateFileMapping failed');
    FFileBase := MapViewOfFile(FFileMapping, FILE_MAP_READ, 0, 0, 0);
  if FFileBase = nil then ExeError('MapViewOfFile failed');
    FDosHeader := PIMAGE_DOS_HEADER(FFileBase);
  if not FDosHeader.e_magic = IMAGE_DOS_SIGNATURE then
    ExeError('unrecognized file format');
  FNTHeader := PIMAGE_NT_HEADERS(Longint(FDosHeader) + FDosHeader.e_lfanew);
  if IsBadReadPtr(FNTHeader, sizeof(IMAGE_NT_HEADERS)) or
     (FNTHeader.Signature <> IMAGE_NT_SIGNATURE) then
    ExeError('Not a PE (WIN32 Executable) file');
 end;

destructor TExeImage.Destroy;
begin
  if FFileHandle <> INVALID_HANDLE_VALUE then
  begin
    UnmapViewOfFile(FFileBase);
    CloseHandle(FFileMapping);
    CloseHandle(FFileHandle);
  end;
  inherited Destroy;
end;

function TExeImage.GetSectionHdr(const SectionName: string;
  var Header: PIMAGE_SECTION_HEADER): Boolean;
var
  I: Integer;
begin
  Header := PIMAGE_SECTION_HEADER(FNTHeader);
  Inc(PIMAGE_NT_HEADERS(Header));
  Result := True;
  for I := 0 to FNTHeader.FileHeader.NumberOfSections - 1 do
  begin
    if Strlicomp(Header.Name, PChar(SectionName), IMAGE_SIZEOF_SHORT_NAME) = 0 then Exit;
    Inc(Header);
  end;
  Result := False;
end;

function TExeImage.GetResourceList: TResourceList;
var
  ResSectHdr: PIMAGE_SECTION_HEADER;
begin
  if not Assigned(FResourceList) then
  begin
    if GetSectionHdr('.rsrc', ResSectHdr) then
    begin
      FResourceBase := ResSectHdr.PointerToRawData + LongWord(FDosHeader);
      FResourceRVA := ResSectHdr.VirtualAddress;
      FResourceList := TResourceList.CreateList(Self, FResourceBase, Self);
    end
    else
      ExeError('No resources in this file.');
  end;
  Result := FResourceList;
end;

{ TResourceItem }

constructor TResourceItem.CreateItem(AOwner: TComponent; ADirEntry: Pointer);
begin
  inherited Create(AOwner);
  FDirEntry := ADirEntry;
end;

function TResourceItem.DataEntry: PIMAGE_RESOURCE_DATA_ENTRY;
begin
  Result := PIMAGE_RESOURCE_DATA_ENTRY(FirstChildDirEntry.OffsetToData
    + Cardinal(FExeImage.FResourceBase));
end;

function TResourceItem.FirstChildDirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY;
begin
  Result := PIMAGE_RESOURCE_DIRECTORY_ENTRY(StripHighBit(FDirEntry.OffsetToData) +
    FExeImage.FResourceBase + SizeOf(IMAGE_RESOURCE_DIRECTORY));
end;

function TResourceItem.FExeImage: TExeImage;
begin
  Result := (Owner as TResourceList).FExeImage;
end;

function TResourceItem.GetResourceItem(Index: Integer): TResourceItem;
begin
  Result := List[Index];
end;

function TResourceItem.GetResourceType: TResourceType;
begin
  Result := TResourceType((Owner as TResourceList).FResType);
end;

function TResourceItem.IsList: Boolean;
begin
  Result := HighBitSet(FirstChildDirEntry.OffsetToData);
end;

function TResourceItem.GetResourceList: TResourceList;
begin
  if not IsList then ExeError('ResourceItem is not a list');
  if not Assigned(FList) then
    FList := TResourceList.CreateList(Self, StripHighBit(FDirEntry.OffsetToData) +
      FExeImage.FResourceBase, FExeImage);
  Result := FList;
end;

function TResourceItem.GetName: string;
var
  PDirStr: PIMAGE_RESOURCE_DIR_STRING_U;
begin
  { Check for Level1 entries, these are resource types. }
  if (Owner.Owner = FExeImage) and not HighBitSet(FDirEntry.Name) and
    (FDirEntry.Name <= 16) then
  begin
    Result := Copy(GetEnumName(TypeInfo(TResourceType), FDirEntry.Name), 3, 20);
    Exit;
  end;

  if HighBitSet(FDirEntry.Name) then
  begin
    PDirStr := PIMAGE_RESOURCE_DIR_STRING_U(StripHighBit(FDirEntry.Name) +
      FExeImage.FResourceBase);
    Result := WideCharToStr(@PDirStr.NameString, PDirStr.Length);
    Exit;
  end;
  Result := Format('%d', [FDirEntry.Name]);
end;

function TResourceItem.Offset: Integer;
begin
  if IsList then
    Result := StripHighBit(FDirEntry.OffsetToData)
  else
    Result := DataEntry.OffsetToData;
end;

function TResourceItem.RawData: Pointer;
begin
  with FExeImage do
    Result := pointer(FResourceBase - FResourceRVA + LongInt(DataEntry.OffsetToData));
end;

function TResourceItem.ResTypeStr: string;
begin
  Result := Copy(GetEnumName(TypeInfo(TResourceType), Ord(ResType)), 3, 20);