peresview.pas

Jedi Code Library JCL JVCL 组件包 JCL+JVCL超过300个组件的非可视/可视大型组件包。

unit PeResView;

{$I JCL.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  JclPeImage, PeResource, JclLogic, JclGraphUtils, ComCtrls, StdCtrls,
  ExtCtrls, Grids, ToolWin, ActnList, OleCtrls, Menus, SHDocVw_TLB;

type
  TPeResViewChild = class(TForm)
    ResourceTreeView: TTreeView;
    PageControl1: TPageControl;
    Splitter1: TSplitter;
    DirTab: TTabSheet;
    HexDumpTab: TTabSheet;
    DirListView: TListView;
    HexDumpListView: TListView;
    StringsTab: TTabSheet;
    StringsListView: TListView;
    GraphDirTab: TTabSheet;
    GraphDrawGrid: TDrawGrid;
    TextTab: TTabSheet;
    TextRichEdit: TRichEdit;
    AviTab: TTabSheet;
    Animate1: TAnimate;
    AviToolBar: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ActionList1: TActionList;
    AviPlay1: TAction;
    AviStop1: TAction;
    HTMLTab: TTabSheet;
    GraphTab: TTabSheet;
    GraphImage: TImage;
    Bevel1: TBevel;
    GraphStatusBar: TStatusBar;
    DetailedStringMemo: TMemo;
    Splitter2: TSplitter;
    Bevel2: TBevel;
    AviStatusBar: TStatusBar;
    AviBkColor1: TAction;
    ColorDialog1: TColorDialog;
    ToolButton3: TToolButton;
    AviPopupMenu: TPopupMenu;
    Play1: TMenuItem;
    Stop1: TMenuItem;
    Color1: TMenuItem;
    DialogTab: TTabSheet;
    SaveDialog1: TSaveDialog;
    DialogTestBtn: TButton;
    Bevel3: TBevel;
    PopupMenu1: TPopupMenu;
    Copytoclipboard1: TMenuItem;
    Savetofile1: TMenuItem;
    N1: TMenuItem;
    Viewdetails1: TMenuItem;
    Viewashex1: TMenuItem;
    Selectall1: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure ResourceTreeViewChange(Sender: TObject; Node: TTreeNode);
    procedure DirListViewData(Sender: TObject; Item: TListItem);
    procedure HexDumpListViewData(Sender: TObject; Item: TListItem);
    procedure StringsListViewData(Sender: TObject; Item: TListItem);
    procedure GraphDrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure AviPlay1Execute(Sender: TObject);
    procedure AviStop1Execute(Sender: TObject);
    procedure Animate1Stop(Sender: TObject);
    procedure StringsListViewSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure Animate1Open(Sender: TObject);
    procedure Animate1Close(Sender: TObject);
    procedure AviBkColor1Execute(Sender: TObject);
    procedure ResourceTreeViewExpanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure DialogTestBtnClick(Sender: TObject);
  private
    FCurrentDir: TPeResItem;
    FOriginalPageControlWndProc: TWndMethod;
    FResourceImage: TPeResImage;
    FSelectedItem: TPeResItem;
    FSelectedNode: TTreeNode;
    FShowAsHexView: Boolean;
    FStringsList: TStringList;
    FShowSpecialDirView: Boolean;
    FTempGraphic: TPicture;
    WebBrowser1: TWebBrowser;
    procedure CreateStringsList(Item: TPeResUnkStrings);
    procedure CreateGraphicList(Item: TPeResItem);
    function GetPeImage: TJclPeImage;
    procedure PageControlWndProc(var Message: TMessage);
    procedure UpdateSelected;
    procedure UpdateView;
    procedure SetShowAsHexView(const Value: Boolean);
    procedure SetShowSpecialDirView(const Value: Boolean);
  public
    constructor CreateEx(AOwner: TComponent; APeImage: TJclPeImage);
    function CanSaveResource: Boolean;
    procedure SaveResource;
    property PeImage: TJclPeImage read GetPeImage;
    property ShowAsHexView: Boolean read FShowAsHexView write SetShowAsHexView;
    property ShowSpecialDirView: Boolean read FShowSpecialDirView write SetShowSpecialDirView;
  end;

var
  PeResViewChild: TPeResViewChild;

implementation

{$R *.DFM}

uses
  CommCtrl, PeViewerMain, ToolsUtils, JclStrings, JclSysUtils;

resourcestring
  RsAviStatus = 'Width: %u, Height: %u, Frames: %u';
  RsGraphicStatus = 'Width: %u, Height: %u, Bits per pixel: %u';
  RsTitle = 'Resources - %s';

const
  MinGraphRowHeight = 18;
  MaxGraphRowHeight = 150;

{ TPeResViewChild }

constructor TPeResViewChild.CreateEx(AOwner: TComponent; APeImage: TJclPeImage);
begin
  inherited Create(AOwner);
  FShowSpecialDirView := True;
  FStringsList := TStringList.Create;
  FTempGraphic := TPicture.Create;
  FResourceImage := TPeResImage.Create;
  FResourceImage.PeImage := APeImage;
  Caption := Format(RsTitle, [ExtractFileName(FResourceImage.FileName)]);
  WebBrowser1 := TWebBrowser.Create(Self);
  TWinControl(WebBrowser1).Parent := HTMLTab;
  WebBrowser1.Align := alClient;
end;

procedure TPeResViewChild.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 TPeResViewChild.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 := DirTab;
    Realign;
  end;
  UpdateView;
end;

procedure TPeResViewChild.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FTempGraphic);
  FreeAndNil(FStringsList);
  FreeAndNil(FResourceImage);
end;

procedure TPeResViewChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Fix_ListViewBeforeClose(Self);
  Action := caFree;
end;

procedure TPeResViewChild.UpdateView;
var
  I: Integer;
begin
  with ResourceTreeView do
  begin
    Items.BeginUpdate;
    try
      Items.Clear;
      for I := 0 to FResourceImage.Count - 1 do
        with Items.AddObject(nil, FResourceImage[I].ResName, FResourceImage[I]) do
        begin
          ImageIndex := icoFolderShut;
          SelectedIndex := icoFolderOpen;
          HasChildren := True;
        end;
    finally
      Items.EndUpdate;
    end;
  end;
end;

function TPeResViewChild.GetPeImage: TJclPeImage;
begin
  Result := FResourceImage.PeImage;
end;

procedure TPeResViewChild.ResourceTreeViewChange(Sender: TObject;
  Node: TTreeNode);
begin
  DirListView.Items.Count := 0;
  HexDumpListView.Items.Count := 0;
  StringsListView.Items.Count := 0;
  GraphDrawGrid.RowCount := 2;
  FSelectedNode := Node;
  UpdateSelected;
end;

procedure TPeResViewChild.DirListViewData(Sender: TObject;
  Item: TListItem);
begin
  with Item, FCurrentDir[Item.Index] do
  begin
    Caption := ResName;
    SubItems.Add(Format('%x', [Offset]));
    SubItems.Add(Format('%x', [Size]));
  end;
end;

procedure TPeResViewChild.HexDumpListViewData(Sender: TObject;
  Item: TListItem);
var
  DumpData: PByte;
  Address, EndAddress: Integer;
  Hex, Ascii: string;
  I: Integer;
begin
  with Item do
  begin
    DumpData := PByte(DWORD(FSelectedItem.RawData) + DWORD(Index * 16));
    Address := FSelectedItem.Offset + Index * 16;
    EndAddress := FSelectedItem.Offset + FSelectedItem.Size - 1;
    SetLength(Hex, 3 * 16);
    SetLength(Ascii, 3 * 16);
    Hex := '';
    Ascii := '';
    for I := 0 to 15 do
    begin
      Hex := Hex + Format('%.2x ', [DumpData^]);
      if DumpData^ >= 32 then
        Ascii := Ascii + Chr(DumpData^)
      else
        Ascii := Ascii + '.';
      Inc(DumpData);
      if Address + I >= EndAddress then Break;
    end;
    Item.Caption := Format('%x', [Address]);
    Item.SubItems.Add(Hex);
    Item.SubItems.Add(Ascii);
  end;
end;

procedure TPeResViewChild.SetShowAsHexView(const Value: Boolean);
begin
  if FShowAsHexView <> Value then
  begin
    FShowAsHexView := Value;
    UpdateSelected;
  end;
end;

procedure TPeResViewChild.SetShowSpecialDirView(const Value: Boolean);
begin
  if FShowSpecialDirView <> Value then
  begin
    FShowSpecialDirView := Value;
    UpdateSelected;
  end;
end;

procedure TPeResViewChild.CreateStringsList(Item: TPeResUnkStrings);
var
  I: Integer;
begin
  FStringsList.Clear;
  DetailedStringMemo.Lines.Clear;
  if not Item.IsList then
    TPeResUnkStrings(Item).FillStrings(FStringsList)
  else
    for I := 0 to Item.ItemCount - 1 do
      TPeResUnkStrings(Item[I]).FillStrings(FStringsList);
  StringsListView.Items.Count := FStringsList.Count;
  StringsListView.Invalidate;
end;

procedure TPeResViewChild.StringsListViewData(Sender: TObject; Item: TListItem);
begin
  with Item do
  begin
    Caption := Format('%u', [DWORD(FStringsList.Objects[Index])]);
    SubItems.Add(StrRemoveChars(FStringsList[Index], [AnsiCarriageReturn, AnsiLineFeed]));
  end;
end;

procedure TPeResViewChild.CreateGraphicList(Item: TPeResItem);
var
  I, J, MaxRowHeight, TotalMaxRowHeight: Integer;

  procedure CalculateHeight(Item: TPeResItem);
  var
    H: Integer;
  begin
    case Item.Kind of
      rkCursor:
        H := GetSystemMetrics(SM_CYCURSOR);
      rkIcon:
        H := GetSystemMetrics(SM_CYICON);
      rkBitmap:
        H := TPeResUnkGraphic(Item).GraphicProperties.Height;
    else
      FTempGraphic.Assign(Item);
      H := FTempGraphic.Height;
    end;
    MaxRowHeight := Max(MaxRowHeight, H);
  end;

begin
  TotalMaxRowHeight := 0;
  with GraphDrawGrid do
  begin
    SendMessage(Handle, WM_SETREDRAW, 0, 0);
    try
      RowCount := Item.ItemCount + 1;
      RowHeights[0] := MinGraphRowHeight;
      for I := 0 to Item.ItemCount - 1 do
      begin
        MaxRowHeight := 0;
        if Item[I].IsList then
          for J := 0 to Item[I].ItemCount - 1 do
            CalculateHeight(Item[I][J])
        else
          CalculateHeight(Item[I]);