pedump.pas

全世界知名的Open Source Delphi开发组织JCL的作品。JCL包含了很多Delphi和C++Builder中的可重用单元

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL) - Delphi Tools                                                   }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is PeDump.pas.                                                                 }
{                                                                                                  }
{ The Initial Developer of the Original Code is Petr Vones. Portions created by Petr Vones are     }
{ Copyright (C) of Petr Vones. All Rights Reserved.                                                }
{                                                                                                  }
{ Contributor(s):                                                                                  }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Last modified: $Date: 2006-05-30 00:02:45 +0200 (mar., 30 mai 2006) $                                                      }
{                                                                                                  }
{**************************************************************************************************}

unit PeDump;

{$I jcl.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  JclPeImage, ComCtrls, ExtCtrls, Menus;

type
  TPeDumpViewCategory = (vcHeader, vcDirectory, vcSection, vcLoadConfig,
    vcImport, vcExport, vcResource, vcRelocation, vcDebug);

  TPeDumpChild = class(TForm)
    SectionTreeView: TTreeView;
    Splitter1: TSplitter;
    PageControl1: TPageControl;
    ItemsTab: TTabSheet;
    DirectoryTab: TTabSheet;
    ItemsListView: TListView;
    DirectoryListView: TListView;
    ImportTab: TTabSheet;
    ImportListView: TListView;
    ExportTab: TTabSheet;
    ExportListView: TListView;
    PopupMenu1: TPopupMenu;
    Copytoclipboard1: TMenuItem;
    Selectall1: TMenuItem;
    N1: TMenuItem;
    Openlibrary1: TMenuItem;
    FindinWin32APIhelp1: TMenuItem;
    ResourceTab: TTabSheet;
    ResourceListView: TListView;
    SectionTab: TTabSheet;
    SectionListView: TListView;
    ResourceDirTab: TTabSheet;
    ResourceDirListView: TListView;
    ExportStatusBar: TStatusBar;
    ImportStatusBar: TStatusBar;
    RelocTab: TTabSheet;
    RelocListView: TListView;
    RelocStatusBar: TStatusBar;
    DebugTab: TTabSheet;
    DebugListView: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ItemsListViewData(Sender: TObject; Item: TListItem);
    procedure SectionTreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure DirectoryListViewData(Sender: TObject; Item: TListItem);
    procedure ImportListViewColumnClick(Sender: TObject;
      Column: TListColumn);
    procedure ImportListViewData(Sender: TObject; Item: TListItem);
    procedure FormDestroy(Sender: TObject);
    procedure ExportListViewData(Sender: TObject; Item: TListItem);
    procedure ExportListViewColumnClick(Sender: TObject;
      Column: TListColumn);
    procedure SectionTreeViewDblClick(Sender: TObject);
    procedure SectionListViewData(Sender: TObject; Item: TListItem);
    procedure ResourceListViewData(Sender: TObject; Item: TListItem);
    procedure ResourceDirListViewData(Sender: TObject; Item: TListItem);
    procedure ImportListViewDblClick(Sender: TObject);
    procedure DirectoryListViewCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure SectionTreeViewExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure RelocListViewData(Sender: TObject; Item: TListItem);
    procedure DebugListViewData(Sender: TObject; Item: TListItem);
    procedure ItemsListViewInfoTip(Sender: TObject; Item: TListItem;
      var InfoTip: String);
  private
    FCurrentResourceDirectory: TJclPeResourceItem;
    FCurrentImportIndex: Integer;
    FCurrentRelocationIndex: Integer;
    FOriginalPageControlWndProc: TWndMethod;
    FPeImage: TJclPeImage;
    FGroupImports: Boolean;
    FUpdatingView: Boolean;
    FUnmangleNames: Boolean;
    function GetFileName: TFileName;
    function GetHasDirectory(const Directory: DWORD): Boolean;
    function GetNodeCategory(Node: TTreeNode): TPeDumpViewCategory;
    procedure ExportListViewSort;
    procedure ImportListViewSort;
    function IsListViewActiveAndFocused(ListView: TListView): Boolean;
    procedure PageControlWndProc(var Message: TMessage);
    procedure UpdateView;
    procedure UpdateImportView(Node: TTreeNode);
    procedure UpdateRelocationView(Node: TTreeNode);
    procedure UpdateResourceDir;
    procedure UpdateResourceView(Directory: TJclPeResourceItem);
    class procedure UpdateSortData(Column: TListColumn);
    procedure SetGroupImports(const Value: Boolean);
    procedure SetUnmangleNames(const Value: Boolean);
    function FunctionName(const Name: string): string;
    function HeadersRemark(HeaderItem: TJclPeHeader): string;
  public
    constructor CreateEx(AOwner: TComponent; APeImage: TJclPeImage);
    function ActiveLibName: string;
    function ActiveWin32Function: string;
    property FileName: TFileName read GetFileName;
    property HasDirectory[const Directory: DWORD]: Boolean read GetHasDirectory;
    property GroupImports: Boolean read FGroupImports write SetGroupImports;
    property PeImage: TJclPeImage read FPeImage;
    property UnmangleNames: Boolean read FUnmangleNames write SetUnmangleNames;
  end;

var
  PeDumpChild: TPeDumpChild;

implementation

{$R *.DFM}

uses
  CommCtrl, PeViewerMain, ToolsUtils, PeResource, JclStrings, JclWin32;

resourcestring
  RsHeader = 'Header';
  RsDirectory = 'Directory';
  RsSection = 'Sections';
  RsLoadConfig = 'Load config';
  RsImport = 'Imports';
  RsExport = 'Exports';
  RsRelocation = 'Relocations';
  RsResource = 'Resources';
  RsDebug = 'Debug';
  RsNumberOfNames = 'Names: %d';
  RsNumberOfFunctions = 'Functions: %d';
  RsLinkerProducer = 'Linker: %s';
  RsOrdinalBase = 'Ordinal base: %d';
  RsAddresses = 'Addresses: %d';

function GetCategoryName(Category: TPeDumpViewCategory): string;
begin
  case Category of
    vcHeader: Result := RsHeader;
    vcDirectory: Result := RsDirectory;
    vcSection: Result := RsSection;
    vcLoadConfig: Result := RsLoadConfig;
    vcImport: Result := RsImport;
    vcExport: Result := RsExport;
    vcResource: Result := RsResource;
    vcRelocation: Result := RsRelocation;
    vcDebug: Result := RsDebug;
  end;
end;

function ImageIndexFromImportKind(Kind: TJclPeImportKind): Integer;
begin
  case Kind of
    ikImport:
      Result := icoImports;
    ikDelayImport:
      Result := icoDelayImport;
    ikBoundImport:
      Result := icoBoundImport;
  else
    Result := 0;
  end;
end;

{ TPeDumpChild }

function TPeDumpChild.ActiveLibName: string;
begin
  with SectionTreeView do
    if (Selected <> nil) and (Selected.Level = 1) and
      (TPeDumpViewCategory(Selected.Parent.Data) = vcImport) then
      Result := FPeImage.ExpandBySearchPath(Selected.Text, ExtractFilePath(FileName))
    else
      Result := '';
end;

function TPeDumpChild.ActiveWin32Function: string;
begin
  Result := '';
  if IsListViewActiveAndFocused(ImportListView) then
    Result := ImportListView.ItemFocused.Caption
  else
    if IsListViewActiveAndFocused(ExportListView) then
      Result := ExportListView.ItemFocused.Caption
    else
      Result := '';
  if Pos('@', Result) > 0 then
    Result := ''
  else
    Result := StrRemoveChars(Result, ['[', ']']);  
end;

constructor TPeDumpChild.CreateEx(AOwner: TComponent; APeImage: TJclPeImage);
begin
  inherited Create(AOwner);
  FPeImage := APeImage;
  Caption := ExtractFileName(FileName);
  {$IFDEF COMPILER5_UP}
  ItemsListView.OnInfoTip := ItemsListViewInfoTip;
  {$ENDIF COMPILER5_UP}
end;

function TPeDumpChild.GetFileName: TFileName;
begin
  if FPeImage = nil then Result := '' else Result := FPeImage.FileName;
end;

function TPeDumpChild.GetHasDirectory(const Directory: DWORD): Boolean;
begin
  if FPeImage = nil then
    Result := False
  else
    Result := FPeImage.DirectoryExists[Directory];
end;

procedure TPeDumpChild.PageControlWndProc(var Message: TMessage);
begin
// remove PageControl's border
  FOriginalPageControlWndProc(Message);
  with Message do
    if (Msg = TCM_ADJUSTRECT) and (Message.WParam = 0) then
      InflateRect(PRect(LParam)^, 4, 4);
end;

procedure TPeDumpChild.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  with PageControl1 do
  begin
    for I := 0 to PageCount - 1 do Pages[I].TabVisible := False;
    FOriginalPageControlWndProc := WindowProc;
    WindowProc := PageControlWndProc;
    ActivePage := ItemsTab;
    Realign;
  end;

  ImportListView.Tag := $100;
  UpdateSortData(ImportListView.Columns[0]);
  ExportListView.Tag := $100;
  UpdateSortData(ExportListView.Columns[0]);

  UpdateView;
end;

procedure TPeDumpChild.FormClose(Sender: TObject; var Action: TCloseAction);
var
  F: TForm;
begin
  Fix_ListViewBeforeClose(Self);
  F := MainForm.FindPeResourceView(FPeImage);
  if F <> nil then F.Close;
  Action := caFree;
end;

procedure TPeDumpChild.UpdateView;

  procedure BuildImageTree;
var
  Category: TPeDumpViewCategory;
  TempNode: TTreeNode;

  function AddCategoryNode(ImageIndex: Integer): TTreeNode;
begin
  Result := SectionTreeView.Items.AddChildObject(nil, GetCategoryName(Category),
    Pointer(Category));
  Result.ImageIndex := ImageIndex;
  Result.SelectedIndex := ImageIndex;
end;

begin
  FPeImage.TryGetNamesForOrdinalImports;
  with SectionTreeView do
  begin
    Items.BeginUpdate;
    try
      Items.Clear;
      for Category := Low(Category) to High(Category) do
        case Category of
          vcHeader:
            AddCategoryNode(icoHeader);
          vcDirectory:
            AddCategoryNode(icoDirectory);
          vcSection:
            AddCategoryNode(icoSection);