Componentes.Terceros.jcl/official/1.96/examples/windows/delphitools/peviewer/PeResView.pas

718 lines
22 KiB
ObjectPascal

{**************************************************************************************************}
{ }
{ 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 PeResView.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: 2005/10/27 01:44:51 $ }
{ }
{**************************************************************************************************}
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]);
RowHeights[I + 1] := Min(Max(MinGraphRowHeight, MaxRowHeight + 4), MaxGraphRowHeight);
TotalMaxRowHeight := Max(TotalMaxRowHeight, MaxRowHeight);
end;
finally
SendMessage(Handle, WM_SETREDRAW, 1, 0);
Invalidate;
end;
end;
end;
procedure TPeResViewChild.GraphDrawGridDrawCell(Sender: TObject; ACol,
ARow: Integer; Rect: TRect; State: TGridDrawState);
var
Text: string;
Item: TPeResItem;
I, W: Integer;
DrawRect: TRect;
begin
with GraphDrawGrid do
begin
if ARow = 0 then
with Canvas do
begin
case ACol of
0: Text := 'Name';
1: Text := 'Graphic';
end;
Brush.Color := clBtnFace;
Font.Color := clBtnText;
Dec(Rect.Bottom, 2);
Dec(Rect.Right);
FillRect(Rect);
TextRect(Rect, Rect.Left + 6, Rect.Top + 2, Text);
DrawEdge(Handle, Rect, EDGE_ETCHED, BF_BOTTOMRIGHT or BF_FLAT);
Pen.Color := Color;
Polyline([Point(Rect.Right, Rect.Top), Point(Rect.Right, Rect.Bottom),
Point(Rect.Left, Rect.Bottom)]);
Inc(Rect.Bottom);
MoveTo(Rect.Left, Rect.Bottom);
LineTo(Rect.Right, Rect.Bottom);
Pen.Color := clBtnFace;
Inc(Rect.Bottom);
MoveTo(Rect.Left, Rect.Bottom);
LineTo(Rect.Right, Rect.Bottom);
end else
begin
if (gdSelected in State) and Focused then
begin
Canvas.Brush.Color := clHighlight;
Canvas.Font.Color := clHighlightText;
Canvas.FillRect(Rect);
DrawFocusRect(Canvas.Handle, Rect);
end else
begin
Canvas.Brush.Color := Color;
Canvas.Font.Color := Font.Color;
Canvas.FillRect(Rect);
end;
InflateRect(Rect, -1, -1);
Item := FCurrentDir[ARow - 1];
case ACol of
0:Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Item.ResName);
1:begin
W := 0;
if not Item.IsList then
begin
FTempGraphic.Assign(Item);
with FTempGraphic do
SetRect(DrawRect, Rect.Left, Rect.Top, Rect.Left + Width, Rect.Top + Height);
if not RectIncludesRect(DrawRect, Rect) then
begin
DrawRect.Right := Min(DrawRect.Right, Rect.Right);
DrawRect.Bottom := Min(DrawRect.Bottom, Rect.Bottom);
Canvas.StretchDraw(DrawRect, FTempGraphic.Graphic);
end
else
Canvas.Draw(Rect.Left + 2, Rect.Top + 2, FTempGraphic.Graphic);
end else
for I := 0 to Item.ItemCount - 1 do
begin
FTempGraphic.Assign(Item[I]);
Canvas.Draw(Rect.Left + 2 + W, Rect.Top + 2, FTempGraphic.Graphic);
Inc(W, FTempGraphic.Width + 5);
end;
end;
end;
end;
end;
end;
procedure TPeResViewChild.AviPlay1Execute(Sender: TObject);
begin
with Animate1 do
Play(1, FrameCount, 1);
AviStop1.Enabled := True;
AviPlay1.Enabled := False;
end;
procedure TPeResViewChild.AviStop1Execute(Sender: TObject);
begin
Animate1.Stop;
AviStop1.Enabled := False;
end;
procedure TPeResViewChild.Animate1Stop(Sender: TObject);
begin
AviPlay1.Enabled := True;
AviStop1.Enabled := False;
end;
procedure TPeResViewChild.StringsListViewSelectItem(Sender: TObject;
Item: TListItem; Selected: Boolean);
begin
if Selected then DetailedStringMemo.Text := Item.SubItems[0];
end;
procedure TPeResViewChild.Animate1Open(Sender: TObject);
begin
with Animate1 do
AviStatusBar.Panels[0].Text := Format(RsAviStatus, [FrameWidth, FrameHeight,
FrameCount]);
end;
procedure TPeResViewChild.Animate1Close(Sender: TObject);
begin
AviStatusBar.Panels[0].Text := '';
end;
procedure TPeResViewChild.AviBkColor1Execute(Sender: TObject);
begin
with ColorDialog1 do
begin
CustomColors.Values['ColorA'] := Format('%.6x', [ColorToRGB(clBtnFace)]);
Color := Animate1.Color;
if Execute then Animate1.Color := Color;
end;
end;
procedure TPeResViewChild.UpdateSelected;
function SpecialDirectoryView: Boolean;
begin
Result := True;
case FCurrentDir.Kind of
rkBitmap, rkCursor, rkIcon:
begin
CreateGraphicList(FCurrentDir);
PageControl1.ActivePage := GraphDirTab;
end;
rkString:
begin
CreateStringsList(TPeResString(FCurrentDir));
PageControl1.ActivePage := StringsTab;
end;
else
Result := False;
end;
end;
procedure DefaultDirectoryView;
begin
DirListView.Items.Count := FCurrentDir.ItemCount;
DirListView.Invalidate;
PageControl1.ActivePage := DirTab;
end;
function SpecialDetailView: Boolean;
begin
Result := True;
case FSelectedItem.Kind of
rkAccelerator:
begin
TextRichEdit.Lines.Assign(TPeResAccelerator(FSelectedItem));
PageControl1.ActivePage := TextTab;
end;
rkAvi:
begin
Animate1.Assign(FSelectedItem);
PageControl1.ActivePage := AviTab;
end;
rkBitmap, rkIcon, rkCursor:
begin
GraphImage.Picture.Assign(FSelectedItem);
if GraphImage.Picture.Graphic is TBitmap then
GraphImage.Picture.Bitmap.Transparent := True;
with TPeResUnkGraphic(FSelectedItem).GraphicProperties do
GraphStatusBar.Panels[0].Text := Format(RsGraphicStatus, [Width, Height, BitsPerPixel]);
PageControl1.ActivePage := GraphTab;
end;
rkString:
begin
CreateStringsList(TPeResString(FSelectedItem));
PageControl1.ActivePage := StringsTab;
end;
rkHTML:
begin
WebBrowser1.Navigate(TPeResHTML(FSelectedItem).ResPath);
PageControl1.ActivePage := HTMLTab;
end;
rkData:
if TPeResRCData(FSelectedItem).DataKind <> dkUnknown then
begin
TextRichEdit.Lines.Assign(TPeResRCData(FSelectedItem));
PageControl1.ActivePage := TextTab;
end else
Result := False;
{ rkDialog:
begin
DialogTestBtn.Enabled := TPeResDialog(FSelectedItem).CanShowDialog;
PageControl1.ActivePage := DialogTab;
end;} { TODO : Check for dialog templates }
rkMessageTable:
begin
CreateStringsList(TPeResUnkStrings(FSelectedItem));
PageControl1.ActivePage := StringsTab;
end;
rkVersion:
begin
TextRichEdit.Lines.Assign(TPeResVersion(FSelectedItem));
PageControl1.ActivePage := TextTab;
end;
else
Result := False;
end;
end;
procedure DefaultDetailView;
begin
HexDumpListView.Items.Count := (FSelectedItem.Size - 1) div 16 + 1;
HexDumpListView.Invalidate;
PageControl1.ActivePage := HexDumpTab;
end;
begin
FSelectedItem := TPeResItem(FSelectedNode.Data);
FCurrentDir := FSelectedItem;
if FSelectedNode.Level = 0 then
begin
// FCurrentDir := FSelectedItem;
if (not FShowSpecialDirView) or (not SpecialDirectoryView) then
DefaultDirectoryView;
end else
begin
if FSelectedItem.IsList then
begin
// FCurrentDir := FSelectedItem;
DefaultDirectoryView;
end else
begin
if FShowAsHexView or (not SpecialDetailView) then
DefaultDetailView;
end;
end;
end;
function TPeResViewChild.CanSaveResource: Boolean;
begin
Result := Assigned(FSelectedItem) and not FSelectedItem.IsList and
ResourceTreeView.Focused;
end;
procedure TPeResViewChild.ResourceTreeViewExpanding(Sender: TObject;
Node: TTreeNode; var AllowExpansion: Boolean);
var
N, L: Integer;
ListNode, ItemNode: TTreeNode;
Item, RootItem: TPeResItem;
begin
if Node.GetFirstChild = nil then with ResourceTreeView do
begin
Items.BeginUpdate;
try
RootItem := TPeResItem(Node.Data);
for N := 0 to RootItem.ItemCount - 1 do
begin
Item := RootItem[N];
ListNode := Items.AddChildObject(Node, Item.ResName, Item);
if Item.IsList then
begin
ListNode.ImageIndex := icoFolderShut;
ListNode.SelectedIndex := icoFolderOpen;
for L := 0 to Item.ItemCount - 1 do
begin
ItemNode := Items.AddChildObject(ListNode, Item[L].ResName, Item[L]);
ItemNode.ImageIndex := icoResItem;
ItemNode.SelectedIndex := icoResItem;
end;
end else
begin
ListNode.ImageIndex := icoResItem;
ListNode.SelectedIndex := icoResItem;
end;
end;
finally
Items.EndUpdate;
end;
end;
end;
procedure TPeResViewChild.SaveResource;
var
FileStream: TFileStream;
begin
with SaveDialog1, (FSelectedItem as TPeResUnknown) do
begin
Filter := Format('*.%s files|*.%s', [FileExt, FileExt]);
FileName := ResName + '.' + FileExt;
if Execute then
begin
FileStream := TFileStream.Create(FileName, fmCreate);
try
SaveToStream(FileStream);
finally
FileStream.Free;
end;
end;
end;
end;
procedure TPeResViewChild.DialogTestBtnClick(Sender: TObject);
var
Res: Integer;
begin
with ResourceTreeView do
while True do
begin
with TPeResDialog(FSelectedItem) do
if CanShowDialog then
Res := ShowDialog(Application.Handle)
else
Res := 1;
if (Res = 1) and (Selected.GetNextSibling <> nil) then
begin
Selected := Selected.GetNextSibling;
Selected.MakeVisible;
ResourceTreeView.Update;
end else
Break;
end;
end;
// History:
// $Log: PeResView.pas,v $
// Revision 1.2 2005/10/27 01:44:51 rrossmair
// - added MPL headers and CVS Log tags
//
end.