interface

uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, Buttons, ExtCtrls, SysUtils;

type TAboutBox = class(TForm) OKButton: TButton; Panel1: TPanel; ProgramIcon: TImage; ProgramName: TLabel; Copyright: TLabel; procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end;

var AboutBox: TAboutBox;

procedure ShowAboutBox;

implementation

{$R *.DFM}

procedure ShowAboutBox; begin with TAboutBox.Create(Application) do try ShowModal; finally Free; end; end;

procedure TAboutBox.FormCreate(Sender: TObject); begin Caption := Format('About %s', [Application.Title]); ProgramIcon.Picture.Assign(Application.Icon); ProgramName.Caption := Application.Title; end;

end.

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; FSections: TList; 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 Create(AOwner: TComponent; const AFileName: string); destructor Destroy; 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 Create(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 Create(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 := lstrlenw(WStr); 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.Create(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 + Longint(FDosHeader); FResourceRVA := ResSectHdr.VirtualAddress; FResourceList := TResourceList.Create(Self, FResourceBase, Self); end else ExeError('No resources in this file.'); end; Result := FResourceList; end;

{ TResourceItem }

constructor TResourceItem.Create(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 + 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.Create(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 + DataEntry.OffsetToData); end;

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

procedure TResourceItem.SaveToFile(const FileName: string); var FS: TFileStream; begin FS := TFileStream.Create(FileName, fmCreate); try Self.SaveToStream(FS); finally FS.Free; end; end;

procedure TResourceItem.SaveToStream(Stream: TStream); begin Stream.Write(RawData^, Size); end;

function TResourceItem.Size: Integer; begin if IsList then Result := 0 else Result := DataEntry.Size; end;

{ TBitmapResource }

procedure TBitmapResource.AssignTo(Dest: TPersistent); var MemStr: TMemoryStream; BitMap: TBitMap; begin if (Dest is TPicture) then begin BitMap := TPicture(Dest).Bitmap; MemStr := TMemoryStream.Create; try SaveToStream(MemStr); MemStr.Seek(0,0); BitMap.LoadFromStream(MemStr); finally MemStr.Free; end end else inherited AssignTo(Dest); end;

procedure TBitmapResource.SaveToStream(Stream: 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 := Self.Size + sizeof(BH); BI := PBitmapInfoHeader(RawData); 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(RawData); ClrUsed := GetDInColors(BC.bcBitCount); BH.bfOffBits := ClrUsed * SizeOf(TRGBTriple) + sizeof(TBitmapCoreHeader) + sizeof(BH); end; Stream.Write(BH, SizeOf(BH)); Stream.Write(RawData^, Self.Size); end;

{ TIconResource }

function TIconResource.GetResourceList: TResourceList; begin if not Assigned(FList) then FList := TIconResourceList.Create(Owner, LongInt(RawData), FExeImage); Result := FList; end;

function TIconResource.IsList: Boolean; begin Result := True; end;

{ TIconResEntry }

procedure TIconResEntry.AssignTo(Dest: TPersistent); var hIco: HIcon; begin if Dest is TPicture then begin hIco := CreateIconFromResource(RawData, Size, (ResType = rtIconEntry), $30000); TPicture(Dest).Icon.Handle := hIco; end else inherited AssignTo(Dest); end;

function TIconResEntry.GetName: string; begin if Assigned(FResInfo) then with FResInfo^ do Result := Format('%d X %d %d Colors', [bWidth, bHeight, bColorCount]) else Result := inherited GetName; end;

procedure TIconResEntry.SaveToStream(Stream: TStream); begin with TIcon.Create do try Handle := CreateIconFromResource(RawData, Self.Size, (ResType <> rtIcon), $30000); SaveToStream(Stream); finally Free; end; end;

{ TCursorResource }

function TCursorResource.GetResourceList: TResourceList; begin if not Assigned(FList) then FList := TCursorResourceList.Create(Owner, LongInt(RawData), FExeImage); Result := FList; end;

{ TCursorResEntry }

function TCursorResEntry.GetName: string; begin if Assigned(FResInfo) then with FResInfo^ do Result := Format('%d X %d %d Bit(s)', [wWidth, wWidth, wBitCount]) else Result := inherited GetName; end;

{ TStringResource }

procedure TStringResource.AssignTo(Dest: TPersistent); var P: PWChar; ID: Integer; Cnt: Integer; Len: Word; begin if (Dest is TStrings) then with TStrings(Dest) do begin BeginUpdate; try Clear; P := RawData; Cnt := 0; while Cnt < StringsPerBlock do begin Len := Word(P^); Inc(P); if Len > 0 then begin ID := ((FDirEntry.Name - 1) shl 4) + Cnt; Add(Format('%d, "%s"', [ID, WideCharToStr(P, Len)])); Inc(P, Len); end; Inc(Cnt); end; finally EndUpdate; end; end else inherited AssignTo(Dest); end;

{ TMenuResource }

procedure TMenuResource.SetNestLevel(Value: Integer); begin FNestLevel := Value; SetLength(FNestStr, Value * 2); FillChar(FNestStr[1], Value * 2, ' '); end;

procedure TMenuResource.AssignTo(Dest: TPersistent); var IsPopup: Boolean; Len: Word; MenuData: PWord; MenuEnd: PChar; MenuText: PWChar; MenuID: Word; MenuFlags: Word; S: string; begin if (Dest is TStrings) then with TStrings(Dest) do begin BeginUpdate; try Clear; MenuData := RawData; MenuEnd := PChar(RawData) + Size; Inc(MenuData, 2); NestLevel := 0; while PChar(MenuData) < MenuEnd do begin MenuFlags := MenuData^; Inc(MenuData); IsPopup := (MenuFlags and MF_POPUP) = MF_POPUP; if not IsPopup then begin MenuID := MenuData^; Inc(MenuData); end; MenuText := PWChar(MenuData); Len := lstrlenw(MenuText); if Len = 0 then S := 'MENUITEM SEPARATOR' else begin S := WideCharToStr(MenuText, Len); if IsPopup then S := Format('POPUP "%s"', [S]) else S := Format('MENUITEM "%s", %d', [S, MenuID]); end; Inc(MenuData, Len + 1); Add(NestStr + S); if (MenuFlags and MF_END) = MF_END then begin NestLevel := NestLevel - 1; Add(NestStr + 'ENDPOPUP'); end; if IsPopup then NestLevel := NestLevel + 1; end; finally EndUpdate; end; end else inherited AssignTo(Dest); end;

{ TResourceList }

constructor TResourceList.Create(AOwner: TComponent; ResDirOfs: Longint; AExeImage: TExeImage); var DirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY; begin inherited Create(AOwner); FExeImage := AExeImage; FResDir := Pointer(ResDirOfs); if AOwner <> AExeImage then if AOwner.Owner.Owner = AExeImage then begin DirEntry := PIMAGE_RESOURCE_DIRECTORY_ENTRY(FResDir); inc(PIMAGE_RESOURCE_DIRECTORY(DirEntry)); FResType := TResourceItem(Owner).FDirEntry.Name; end else FResType := (AOwner.Owner.Owner as TResourceList).FResType; end;

destructor TResourceList.Destroy; begin inherited Destroy; FList.Free; end;

function TResourceList.List: TList; var I: Integer; DirEntry: PIMAGE_RESOURCE_DIRECTORY_ENTRY; DirCnt: Integer; ResItem: TResourceItem; begin if not Assigned(FList) then begin FList := TList.Create; DirEntry := PIMAGE_RESOURCE_DIRECTORY_ENTRY(FResDir); inc(PIMAGE_RESOURCE_DIRECTORY(DirEntry)); DirCnt := FResDir.NumberOfNamedEntries + FResDir.NumberOfIdEntries - 1; for I := 0 to DirCnt do begin { Handle Cursors and Icons specially } ResItem := GetResourceClass(FResType).Create(Self, DirEntry); if Owner = FExeImage then if (TResourceType(DirEntry.Name) in [rtCursorEntry, rtIconEntry]) then begin if TResourceType(DirEntry.Name) = rtCursorEntry then FExeImage.FCursorResources := ResItem else FExeImage.FIconResources := ResItem; Inc(DirEntry); Continue; end; FList.Add(ResItem); Inc(DirEntry); end; end; Result := FList; end;

function TResourceList.Count: Integer; begin Result := List.Count; end;

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

{ TIconResourceList }

function TIconResourceList.List: TList; var I, J, Cnt: Integer; ResData: PIconResInfo; ResList: TResourceList; ResOrd: Integer; IconResource: TIconResEntry; begin if not Assigned(FList) then begin FList := TList.Create; Cnt := PIconHeader(FResDir).wCount; PChar(ResData) := PChar(FResDir) + SizeOf(TIconHeader); ResList := FExeImage.FIconResources.List; for I := 0 to Cnt - 1 do begin ResOrd := ResData.wNameOrdinal; for J := 0 to ResList.Count - 1 do begin if ResOrd = ResList[J].FDirEntry.Name then begin IconResource := ResList[J] as TIconResEntry; IconResource.FResInfo := ResData; FList.Add(IconResource); end; end; Inc(ResData); end; end; Result := FList; end;

{ TCursorResourceList }

function TCursorResourceList.List: TList; var I, J, Cnt: Integer; ResData: PCursorResInfo; ResList: TResourceList; ResOrd: Integer; CursorResource: TCursorResEntry; begin if not Assigned(FList) then begin FList := TList.Create; Cnt := PIconHeader(FResDir).wCount; PChar(ResData) := PChar(FResDir) + SizeOf(TIconHeader); ResList := FExeImage.FCursorResources.List; for I := 0 to Cnt - 1 do begin ResOrd := ResData.wNameOrdinal; for J := 0 to ResList.Count - 1 do begin if ResOrd = ResList[J].FDirEntry.Name then begin CursorResource := ResList[J] as TCursorResEntry; CursorResource.FResInfo := ResData; FList.Add(CursorResource); end; end; Inc(ResData); end; end; Result := FList; end;

end.

interface

uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

const MAXDIGITS = 16;

{ THexDump }

type

THexStr = array[0..2] of Char; THexStrArray = array[0..MAXDIGITS-1] of THexStr;

THexDump = class(TCustomControl) private FActive: Boolean; FAddress: Pointer; FDataSize: Integer; FTopLine: Integer; FCurrentLine: Integer; FVisibleLines: Integer; FLineCount: Integer; FBytesPerLine: Integer; FItemHeight: Integer; FItemWidth: Integer; FFileColors: array[0..2] of TColor; FShowCharacters: Boolean; FShowAddress: Boolean; FBorder: TBorderStyle; FHexData: THexStrArray; FLineAddr: array[0..15] of char; FCharData: array[0..MAXDIGITS] of char;

procedure CheckActive; procedure CalcPaintParams; procedure SetTopLine(Value: Integer); procedure SetCurrentLine(Value: Integer); procedure SetFileColor(Index: Integer; Value: TColor); function GetFileColor(Index: Integer): TColor; procedure SetShowCharacters(Value: Boolean); procedure SetShowAddress(Value: Boolean); procedure SetBorder(Value: TBorderStyle); procedure SetAddress(Value: Pointer); procedure SetDataSize(Value: Integer); procedure AdjustScrollBars; function LineAddr(Index: Integer): PChar; function LineData(Index: Integer): PChar; function LineChars(Index: Integer): PChar; function ScrollIntoView: Boolean; procedure InvalidateLine(Index: Integer); procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER; procedure CMExit(var Message: TCMLostFocus); message CM_EXIT; procedure WMSize(var Message: TWMSize); message WM_SIZE; procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL; procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE; protected procedure CreateParams(var Params: TCreateParams); override; procedure Paint; override; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property CurrentLine: Integer read FCurrentLine write SetCurrentLine; property Address: Pointer read FAddress write SetAddress; property DataSize: Integer read FDataSize write SetDataSize; published property Align; property Border: TBorderStyle read FBorder write SetBorder; property Color default clWhite; property Ctl3D; property Font; property TabOrder; property TabStop; property ShowAddress: Boolean read FShowAddress write SetShowAddress default True; property ShowCharacters: Boolean read FShowCharacters write SetShowCharacters default True; property AddressColor: TColor index 0 read GetFileColor write SetFileColor default clBlack; property HexDataColor: TColor index 1 read GetFileColor write SetFileColor default clBlack; property AnsiCharColor: TColor index 2 read GetFileColor write SetFileColor default clBlack; end;

function CreateHexDump(AOwner: TWinControl): THexDump;

implementation

{ Form Methods }

function CreateHexDump(AOwner: TWinControl): THexDump; begin Result := THexDump.Create(AOwner); with Result do begin Parent := AOwner; Font.Name := 'FixedSys'; ShowCharacters := True; Align := alClient; end; end;

{ THexDump }

constructor THexDump.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := [csFramed]; FBorder := bsSingle; Color := clWhite; FShowAddress := True; FShowCharacters := True; Width := 300; Height := 200; FillChar(FHexData, SizeOf(FHexData), #9); end;

destructor THexDump.Destroy; begin inherited Destroy; end;

procedure THexDump.CheckActive; begin if not FActive then raise Exception.Create('Operation not allowed unless viewing data'); end;

procedure THexDump.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); with Params do begin if FBorder = bsSingle then Style := Style or WS_BORDER; Style := Style or WS_VSCROLL; end; end;

{ VCL Command Messages }

procedure THexDump.CMFontChanged(var Message: TMessage); begin inherited; Canvas.Font := Self.Font; FItemHeight := Canvas.TextHeight('A') + 2; FItemWidth := Canvas.TextWidth('D') + 1; CalcPaintParams; AdjustScrollBars; end;

procedure THexDump.CMEnter; begin inherited; { InvalidateLineMarker; } end;

procedure THexDump.CMExit; begin inherited; { InvalidateLineMarker; } end;

{ Windows Messages }

procedure THexDump.WMSize(var Message: TWMSize); begin inherited; CalcPaintParams; AdjustScrollBars; end;

procedure THexDump.WMGetDlgCode(var Message: TWMGetDlgCode); begin Message.Result := DLGC_WANTARROWS; end;

procedure THexDump.WMVScroll(var Message: TWMVScroll); var NewTopLine: Integer; LinesMoved: Integer; R: TRect; begin inherited; NewTopLine := FTopLine; case Message.ScrollCode of SB_LINEDOWN: Inc(NewTopLine); SB_LINEUP: Dec(NewTopLine); SB_PAGEDOWN: Inc(NewTopLine, FVisibleLines - 1); SB_PAGEUP: Dec(NewTopLine, FVisibleLines - 1); SB_THUMBPOSITION, SB_THUMBTRACK: NewTopLine := Message.Pos; end;

if NewTopLine < 0 then NewTopLine := 0; if NewTopLine >= FLineCount then NewTopLine := FLineCount - 1;

if NewTopLine <> FTopLine then begin LinesMoved := FTopLine - NewTopLine; FTopLine := NewTopLine; SetScrollPos(Handle, SB_VERT, FTopLine, True);

if Abs(LinesMoved) = 1 then begin R := Bounds(0, 0, ClientWidth, ClientHeight - FItemHeight); if LinesMoved = 1 then OffsetRect(R, 0, FItemHeight);

ScrollWindow(Handle, 0, FItemHeight * LinesMoved, @R, nil);

if LinesMoved = -1 then begin R.Top := ClientHeight - FItemHeight; R.Bottom := ClientHeight; end else begin R.Top := 0; R.Bottom := FItemHeight; end;

Windows.InvalidateRect(Handle, @R, False);

end else Invalidate; end; end;

{ Painting Related }

procedure THexDump.CalcPaintParams; const Divisor: array[boolean] of Integer = (3,4); var CharsPerLine: Integer;

begin if FItemHeight < 1 then Exit; FVisibleLines := (ClientHeight div FItemHeight) + 1; CharsPerLine := ClientWidth div FItemWidth; if FShowAddress then Dec(CharsPerLine, 10); FBytesPerLine := CharsPerLine div Divisor[FShowCharacters]; if FBytesPerLine < 1 then FBytesPerLine := 1 else if FBytesPerLine > MAXDIGITS then FBytesPerLine := MAXDIGITS; FLineCount := (DataSize div FBytesPerLine); if Boolean(DataSize mod FBytesPerLine) then Inc(FLineCount); end;

procedure THexDump.InvalidateLine(Index: Integer); var R: TRect; begin if (Index >= FTopLine) and (Index <= FTopLine + FVisibleLines - 1) then begin R := Rect(0, 0, ClientWidth, FItemHeight); OffsetRect(R, 0, (Index - FTopLine) * FItemHeight); Windows.InvalidateRect(Handle, @R, False); end; end;

procedure THexDump.AdjustScrollBars; begin SetScrollRange(Handle, SB_VERT, 0, FLineCount - 1, True); end;

function THexDump.ScrollIntoView: Boolean; begin Result := False; if FCurrentLine < FTopLine then begin Result := True; SetTopLine(FCurrentLine); end else if FCurrentLine >= (FTopLine + FVisibleLines) - 1 then begin SetTopLine(FCurrentLine - (FVisibleLines - 2)); Result := True; end; end;

procedure THexDump.SetTopLine(Value: Integer); var LinesMoved: Integer; R: TRect; begin if Value <> FTopLine then begin if Value < 0 then Value := 0; if Value >= FLineCount then Value := FLineCount - 1;

LinesMoved := FTopLine - Value; FTopLine := Value; SetScrollPos(Handle, SB_VERT, FTopLine, True);

if Abs(LinesMoved) = 1 then begin R := Bounds(1, 0, ClientWidth, ClientHeight - FItemHeight); if LinesMoved = 1 then OffsetRect(R, 0, FItemHeight);

ScrollWindow(Handle, 0, FItemHeight * LinesMoved, @R, nil);

if LinesMoved = -1 then begin R.Top := ClientHeight - FItemHeight; R.Bottom := ClientHeight; end else begin R.Top := 0; R.Bottom := FItemHeight; end;

InvalidateRect(Handle, @R, False);

end else Invalidate; end; end;

procedure THexDump.SetCurrentLine(Value: Integer); var R: TRect; begin if Value <> FCurrentLine then begin if Value < 0 then Value := 0; if Value >= FLineCount then Value := FLineCount - 1;

if (FCurrentLine >= FTopLine) and (FCurrentLine < FTopLine + FVisibleLines - 1) then begin R := Bounds(0, 0, 1, FItemHeight); OffsetRect(R, 0, (FCurrentLine - FTopLine) * FItemHeight); Windows.InvalidateRect(Handle, @R, True); end; FCurrentLine := Value;

R := Bounds(0, 0, 1, FItemHeight); OffsetRect(R, 0, (FCurrentLine - FTopLine) * FItemHeight); Windows.InvalidateRect(Handle, @R, True); ScrollIntoView; end; end;

procedure THexDump.Paint; var R: TRect; I: Integer; AddressWidth: Integer; TabStop: Integer; ByteCnt: Integer; begin inherited Paint; Canvas.Brush.Color := Self.Color; if FShowAddress then AddressWidth := FItemWidth*10 else AddressWidth := 0; R := Bounds(1, 0, ClientWidth, FItemHeight); TabStop := FItemWidth*3; Canvas.Font.Color := FFileColors[1]; ByteCnt := FBytesPerLine; for I := 0 to FVisibleLines - 1 do begin R.Left := 1; if I + FTopLine < FLineCount then begin if FShowAddress then begin Canvas.Font.Color := FFileColors[0]; R.Right := R.Left + AddressWidth; ExtTextOut(Canvas.Handle, R.Left, R.Top, ETO_OPAQUE or ETO_CLIPPED, @R, LineAddr(I+FTopLine), 9, nil); R.Left := R.Right; R.Right := ClientWidth; Canvas.Font.Color := FFileColors[1]; end; if (I+FTopLine = FLineCount-1) and ((DataSize mod FBytesPerLine) > 0) then ByteCnt := DataSize mod FBytesPerLine; TabbedTextOut(Canvas.Handle, R.Left, R.Top, LineData(I+FTopLine), (ByteCnt*3)-1, 1, TabStop, R.Left); if FShowCharacters then begin R.Left := AddressWidth+(FItemWidth*(FBytesPerLine*3)); Canvas.Font.Color := FFileColors[2]; ExtTextOut(Canvas.Handle, R.Left, R.Top, ETO_OPAQUE or ETO_CLIPPED, @R, LineChars(I+FTopLine), ByteCnt, nil); end; end else ExtTextOut(Canvas.Handle, R.Left, R.Top, ETO_OPAQUE or ETO_CLIPPED, @R, nil, 0, nil); OffsetRect(R, 0, FItemHeight); end; end;

{ Event Overrides }

procedure THexDump.KeyDown(var Key: Word; Shift: TShiftState); begin inherited KeyDown(Key, Shift); if not FActive then Exit;

case Key of VK_DOWN: CurrentLine := CurrentLine + 1; VK_UP: CurrentLine := CurrentLine - 1; VK_NEXT: CurrentLine := CurrentLine + FVisibleLines; VK_PRIOR: CurrentLine := CurrentLine - FVisibleLines; VK_HOME: CurrentLine := 0; VK_END: CurrentLine := FLineCount - 1; end; end;

procedure THexDump.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if not Focused then SetFocus; if (Button = mbLeft) and FActive then CurrentLine := FTopLine + (Y div FItemHeight); end;

{ Property Set/Get Routines }

procedure THexDump.SetBorder(Value: TBorderStyle); begin if Value <> FBorder then begin FBorder := Value; RecreateWnd; end; end;

procedure THexDump.SetShowAddress(Value: Boolean); begin if FShowAddress <> Value then begin FShowAddress := Value; Invalidate; end; end;

procedure THexDump.SetShowCharacters(Value: Boolean); begin if Value <> FShowCharacters then begin FShowCharacters := Value; Invalidate; end; end;

procedure THexDump.SetFileColor(Index: Integer; Value: TColor); begin if FFileColors[Index] <> Value then begin FFileColors[Index] := Value; Invalidate; end; end;

function THexDump.GetFileColor(Index: Integer): TColor; begin Result := FFileColors[Index]; end;

procedure THexDump.SetAddress(Value: Pointer); begin FActive := Value <> nil; FAddress := Value; Invalidate; end;

procedure THexDump.SetDataSize(Value: Integer); begin FDataSize := Value; CalcPaintParams; Invalidate; AdjustScrollBars; end;

function THexDump.LineAddr(Index: Integer): PChar; begin Result := StrFmt(FLineAddr, '%p:', [Pointer(PChar(Address)+Index*FBytesPerLine)]); end;

function THexDump.LineData(Index: Integer): PChar;

procedure SetData(P: PChar); const HexDigits : array[0..15] of Char = '0123456789ABCDEF'; var I: Integer; B: Byte; begin for I := 0 to FBytesPerLine-1 do begin try B := Byte(P[I]); FHexData[I][0] := HexDigits[B SHR $04]; FHexData[I][1] := HexDigits[B AND $0F]; except FHexData[I][0] := '?'; FHexData[I][1] := '?'; end;

end; end;

begin SetData(PChar(FAddress) + Index*FBytesPerLine); Result := FHexData[0]; end;

function THexDump.LineChars(Index: Integer): PChar; begin Result := PChar(FAddress) + Index*FBytesPerLine; end;

end.

{ This program provides an example of how to use the TreeView and ListView components in a fashion similar to the Microsoft Windows Explorer.

It is not intended to be a fully functional resource viewer. }

interface

uses SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, ExeImage, StdCtrls, Buttons, ExtCtrls, ComCtrls, Menus, RXMisc, HexDump;

type TMainForm = class(TForm) StatusBar: TStatusBar; TreeViewPanel: TPanel; Panel1: TPanel; ImageViewer: TImage; ListView: TListView; TreeView: TTreeView; Splitter: TPanel; Notebook: TNotebook; ListViewPanel: TPanel; ListViewCaption: TPanel; FileOpenDialog: TOpenDialog; FileSaveDialog: TSaveDialog; MainMenu: TMainMenu; miFile: TMenuItem; miFileExit: TMenuItem; miFileSave: TMenuItem; miFileOpen: TMenuItem; miView: TMenuItem; miViewStatusBar: TMenuItem; miViewLargeIcons: TMenuItem; miViewSmallIcons: TMenuItem; miViewList: TMenuItem; miViewDetails: TMenuItem; miHelp: TMenuItem; miHelpAbout: TMenuItem; Small: TImageList; Large: TImageList; StringViewer: TMemo; procedure FileExit(Sender: TObject); procedure FileOpen(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ListViewEnter(Sender: TObject); procedure SaveResource(Sender: TObject); procedure SelectListViewType(Sender: TObject); procedure ShowAboutBox(Sender: TObject); procedure ToggleStatusBar(Sender: TObject); procedure TreeViewChange(Sender: TObject; Node: TTreeNode); procedure SplitterMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure SplitterMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure SplitterMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ViewMenuDropDown(Sender: TObject); procedure NotebookEnter(Sender: TObject); private FExeFile: TExeImage; HexDump: THexDump; SplitControl: TSplitControl; procedure LoadResources(ResList: TResourceList; Node: TTreeNode); procedure DisplayResources; procedure UpdateViewPanel; procedure UpdateListView(ResList: TResourceList); procedure UpdateStatusLine(ResItem: TResourceItem); end;

var MainForm: TMainForm;

implementation

uses About, RXTypes;

{$R *.DFM} {$R RXIMAGES.RES}

const itBitmap: TResType = Controls.rtBitmap; // Reference for duplicate identifier ImageMap: array[TResourceType] of Byte = (2,4,5,3,2,2,2,2,2,2,2,2,2,2,2,2,2); ResFiltMap: array[TResourceType] of Byte = (1,4,2,3,1,1,1,1,1,1,1,1,1,1,1,1,1);

SCopyright = 'Copyright © 1996 Borland International'; SNoResSelected = 'No resource selected'; SFormCaption = 'Resource Explorer'; SSaveFilter = 'Other Resource (*.*)|*.*|Bitmaps (*.BMP)|*.BMP|'+ 'Icons (*.ICO)|*.ICO|Cursor (*.CUR)|*.CUR'; SOpenFilter = 'Executable File Images (*.EXE;*.DLL)|*.EXE;*.DLL|'+ 'All Files (*.*)|*.*';

{ Utility Functions }

procedure Error(const ErrMsg: string); begin raise Exception.Create(ErrMsg); end;

procedure ErrorFmt(const ErrMsg: string; Params: array of const); begin raise Exception.Create(format(ErrMsg, Params)); end;

function Confirm(const AMsg: String): Boolean; begin Result := MessageDlg(AMsg, mtConfirmation, mbYesNoCancel, 0) = idYes; end;

{ Non Event Handlers }

procedure TMainForm.LoadResources(ResList: TResourceList; Node: TTreeNode); var I: Integer; CNode: TTreeNode; begin for I := 0 to ResList.Count - 1 do with ResList[I] do begin CNode := TreeView.Items.AddChildObject(Node, Name, ResList[I]); if IsList then begin CNode.SelectedIndex := 1; LoadResources(List, CNode); end else begin CNode.ImageIndex := ImageMap[ResList[I].ResType]; CNode.SelectedIndex := CNode.ImageIndex; end;

end; end;

procedure TMainForm.DisplayResources; begin ListView.Items.Clear; TreeView.Selected := nil; TreeView.Items.Clear; LoadResources(FExeFile.Resources, nil); Caption := Format('%s - %s', [SFormCaption, LowerCase(FExeFile.FileName)]); with TreeView do begin SetFocus; Selected := Items[0]; end; end;

procedure TMainForm.UpdateViewPanel; var R: TResourceItem; begin with TreeView do begin if Visible and Assigned(Selected) then begin R := TResourceItem(Selected.Data); if R.IsList then UpdateListView(R.List) else begin case R.ResType of rtBitmap, rtIconEntry, rtCursorEntry: begin ImageViewer.Picture.Assign(R); Notebook.PageIndex := 1; end; rtString, rtMenu: begin StringViewer.Lines.Assign(R); StringViewer.SelStart := 0; Notebook.PageIndex := 2; end else begin HexDump.Address := R.RawData; HexDump.DataSize := R.Size; Notebook.PageIndex := 3; end; end; end; UpdateStatusLine(R); end; end; end;

procedure TMainForm.UpdateListView(ResList: TResourceList); var I: Integer; begin ListView.Items.Clear; for I := 0 to ResList.Count-1 do with ResList[I], ListView.Items.Add do begin Data := ResList[I]; Caption := Name; SubItems.Add(Format('%.7x', [Offset])); SubItems.Add(Format('%.5x', [Size])); ImageIndex := ImageMap[ResType]; end; Notebook.PageIndex := 0; end;

procedure TMainForm.UpdateStatusLine(ResItem: TResourceItem); begin if ResItem.IsList then begin ListViewCaption.Caption := ' '+TreeView.Selected.Text; StatusBar.Panels[0].Text := Format(' %d object(s)', [ListView.Items.Count]); StatusBar.Panels[1].Text := Format(' Offset: %x', [ResItem.Offset]); end else with ResItem do begin ListViewCaption.Caption := Format(' %s: %s', [ResTypeStr, Name]); StatusBar.Panels[0].Text := ''; StatusBar.Panels[1].Text := Format(' Offset: %x Size: %x', [Offset, Size]); end; end;

{ Form Initialization }

procedure TMainForm.FormCreate(Sender: TObject); begin SplitControl := TSplitControl.Create(Self); HexDump := CreateHexDump(TWinControl(NoteBook.Pages.Objects[3])); FileOpenDialog.Filter := SOpenFilter; FileSaveDialog.Filter := SSaveFilter; Small.ResourceLoad(itBitmap, 'SmallImages', clOlive); Large.ResourceLoad(itBitmap, 'LargeImages', clOlive); Notebook.PageIndex := 0; if (ParamCount > 0) and FileExists(ParamStr(1)) then begin Show; FExeFile := TExeImage.Create(Self, ParamStr(1)); DisplayResources; end; end;

{ Menu Event Handlers }

procedure TMainForm.FileOpen(Sender: TObject); var TmpExeFile: TExeImage; begin with FileOpenDialog do begin if not Execute then Exit; TmpExeFile := TExeImage.Create(Self, FileName); if Assigned(FExeFile) then FExeFile.Destroy; FExeFile := TmpExeFile; DisplayResources; end; end;

procedure TMainForm.FileExit(Sender: TObject); begin Close; end;

procedure TMainForm.ListViewEnter(Sender: TObject); begin with ListView do if (Items.Count > 1) and (Selected = nil) then begin Selected := Items[0]; ItemFocused := Selected; end; end;

procedure TMainForm.SaveResource(Sender: TObject); var ResItem: TResourceitem;

function TreeViewResourceSelected: Boolean; begin Result := Assigned(TreeView.Selected) and Assigned(TreeView.Selected.Data) and not TResourceItem(TreeView.Selected.Data).IsList; if Result then ResItem := TResourceItem(TreeView.Selected.Data); end;

function ListViewResourceSelected: Boolean; begin Result := Assigned(ListView.Selected) and Assigned(ListView.Selected.Data) and not TResourceItem(ListView.Selected.Data).IsList; if Result then ResItem := TResourceItem(ListView.Selected.Data); end;

begin if TreeViewResourceSelected or ListViewResourceSelected then with FileSaveDialog do begin FilterIndex := ResFiltMap[ResItem.ResType]; if Execute then ResItem.SaveToFile(FileName) end else Error(SNoResSelected); end;

procedure TMainForm.SelectListViewType(Sender: TObject); begin ListView.ViewStyle := TViewStyle(TComponent(Sender).Tag); end;

procedure TMainForm.ShowAboutBox(Sender: TObject); begin About.ShowAboutBox; end;

procedure TMainForm.ToggleStatusBar(Sender: TObject); begin StatusBar.Visible := not StatusBar.Visible; end;

procedure TMainForm.TreeViewChange(Sender: TObject; Node: TTreeNode); begin UpdateViewPanel; end;

procedure TMainForm.ViewMenuDropDown(Sender: TObject); var I: Integer; begin miViewStatusBar.Checked := StatusBar.Visible; for I := 0 to miView.Count-1 do with miView.Items[I] do if GroupIndex = 1 then Checked := (Tag = Ord(ListView.ViewStyle)); end;

procedure TMainForm.SplitterMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) and (Shift = [ssLeft]) then SplitControl.BeginSizing(Splitter, TreeViewPanel); end;

procedure TMainForm.SplitterMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin with SplitControl do if Sizing then ChangeSizing(X, Y); end;

procedure TMainForm.SplitterMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin with SplitControl do if Sizing then EndSizing; end;

procedure TMainForm.NotebookEnter(Sender: TObject); var Page: TWinControl; begin with NoteBook do begin Page := TWinControl(Pages.Objects[PageIndex]); if (Page.ControlCount > 0) and (Page.Controls[0] is TWinControl) then TWinControl(Page.Controls[0]).SetFocus; end; end;

end.

interface

uses Windows, Forms, Controls;

type TSplitControl = class private FForm: TForm; FSplitControl, FSizeTarget: TControl; FVertical: Boolean; FSplit: TPoint; function GetSizing: Boolean; procedure DrawSizingLine; public constructor Create(AForm: TForm); procedure BeginSizing(ASplitControl, ATargetControl: TControl); procedure ChangeSizing(X, Y: Integer); procedure EndSizing; property Sizing: Boolean read GetSizing; end;

implementation

uses SysUtils, Classes;

function CToC(C1, C2: TControl; P: TPoint): TPoint; begin Result := C1.ScreenToClient(C2.ClientToScreen(P)); end;

{ TSplitControl }

constructor TSplitControl.Create(AForm: TForm); begin FForm := AForm; end;

function TSplitControl.GetSizing: Boolean; begin Result := FSplitControl <> nil; end;

procedure TSplitControl.DrawSizingLine; var P: TPoint; begin P := CToC(FForm, FSplitControl, FSplit); with FForm.Canvas do begin MoveTo(P.X, P.Y); if FVertical then LineTo(CToC(FForm, FSplitControl, Point(FSplitControl.Width, 0)).X, P.Y) else LineTo(P.X, CToC(FForm, FSplitControl, Point(0, FSplitControl.Height)).Y) end; end;

procedure TSplitControl.BeginSizing(ASplitControl, ATargetControl: TControl); begin FSplitControl := ASplitControl; FSizeTarget := ATargetControl; SetCaptureControl(FSplitControl); FVertical := ASplitControl.Width > ASplitControl.Height; if FVertical then FSplit := Point(0, ASplitControl.Top) else FSplit := Point(ASplitControl.Left, 0); FForm.Canvas.Handle := GetDCEx(FForm.Handle, 0, DCX_CACHE or DCX_CLIPSIBLINGS or DCX_LOCKWINDOWUPDATE); with FForm.Canvas do begin Pen.Color := clWhite; if FVertical then Pen.Width := ASplitControl.Height else Pen.Width := ASplitControl.Width; Pen.Mode := pmXOR; end; DrawSizingLine; end;

procedure TSplitControl.ChangeSizing(X, Y: Integer); begin DrawSizingLine; if FVertical then FSplit.Y := Y else FSplit.X := X; DrawSizingLine; end;

procedure TSplitControl.EndSizing; var DC: HDC; P: TPoint; begin DrawSizingLine; P := CToC(FSizeTarget, FSplitControl, FSplit); SetCaptureControl(nil); FSplitControl := nil; with FForm do begin DC := Canvas.Handle; Canvas.Handle := 0; ReleaseDC(Handle, DC); end; if FVertical then FSizeTarget.Height := P.Y else FSizeTarget.Width := P.X; end;

end.

interface

uses Windows;

const IMAGE_DOS_SIGNATURE = $5A4D; { MZ } IMAGE_OS2_SIGNATURE = $454E; { NE } IMAGE_OS2_SIGNATURE_LE = $454C; { LE } IMAGE_VXD_SIGNATURE = $454C; { LE } IMAGE_NT_SIGNATURE = $00004550; { PE00 }

IMAGE_SIZEOF_SHORT_NAME = 8; IMAGE_SIZEOF_SECTION_HEADER = 40; IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16; IMAGE_RESOURCE_NAME_IS_STRING = $80000000; IMAGE_RESOURCE_DATA_IS_DIRECTORY = $80000000; IMAGE_OFFSET_STRIP_HIGH = $7FFFFFFF;

type PIMAGE_DOS_HEADER = ^IMAGE_DOS_HEADER; IMAGE_DOS_HEADER = packed record { DOS .EXE header } e_magic : WORD; { Magic number } e_cblp : WORD; { Bytes on last page of file } e_cp : WORD; { Pages in file } e_crlc : WORD; { Relocations } e_cparhdr : WORD; { Size of header in paragraphs } e_minalloc : WORD; { Minimum extra paragraphs needed } e_maxalloc : WORD; { Maximum extra paragraphs needed } e_ss : WORD; { Initial (relative) SS value } e_sp : WORD; { Initial SP value } e_csum : WORD; { Checksum } e_ip : WORD; { Initial IP value } e_cs : WORD; { Initial (relative) CS value } e_lfarlc : WORD; { File address of relocation table } e_ovno : WORD; { Overlay number } e_res : packed array [0..3] of WORD; { Reserved words } e_oemid : WORD; { OEM identifier (for e_oeminfo) } e_oeminfo : WORD; { OEM information; e_oemid specific } e_res2 : packed array [0..9] of WORD; { Reserved words } e_lfanew : Longint; { File address of new exe header } end;

PIMAGE_FILE_HEADER = ^IMAGE_FILE_HEADER; IMAGE_FILE_HEADER = packed record Machine : WORD; NumberOfSections : WORD; TimeDateStamp : DWORD; PointerToSymbolTable : DWORD; NumberOfSymbols : DWORD; SizeOfOptionalHeader : WORD; Characteristics : WORD; end;

PIMAGE_DATA_DIRECTORY = ^IMAGE_DATA_DIRECTORY; IMAGE_DATA_DIRECTORY = packed record VirtualAddress : DWORD; Size : DWORD; end;

PIMAGE_OPTIONAL_HEADER = ^IMAGE_OPTIONAL_HEADER; IMAGE_OPTIONAL_HEADER = packed record { Standard fields. } Magic : WORD; MajorLinkerVersion : Byte; MinorLinkerVersion : Byte; SizeOfCode : DWORD; SizeOfInitializedData : DWORD; SizeOfUninitializedData : DWORD; AddressOfEntryPoint : DWORD; BaseOfCode : DWORD; BaseOfData : DWORD; { NT additional fields. } ImageBase : DWORD; SectionAlignment : DWORD; FileAlignment : DWORD; MajorOperatingSystemVersion : WORD; MinorOperatingSystemVersion : WORD; MajorImageVersion : WORD; MinorImageVersion : WORD; MajorSubsystemVersion : WORD; MinorSubsystemVersion : WORD; Reserved1 : DWORD; SizeOfImage : DWORD; SizeOfHeaders : DWORD; CheckSum : DWORD; Subsystem : WORD; DllCharacteristics : WORD; SizeOfStackReserve : DWORD; SizeOfStackCommit : DWORD; SizeOfHeapReserve : DWORD; SizeOfHeapCommit : DWORD; LoaderFlags : DWORD; NumberOfRvaAndSizes : DWORD; DataDirectory : packed array [0..IMAGE_NUMBEROF_DIRECTORY_ENTRIES-1] of IMAGE_DATA_DIRECTORY; end;

PIMAGE_SECTION_HEADER = ^IMAGE_SECTION_HEADER; IMAGE_SECTION_HEADER = packed record Name : packed array [0..IMAGE_SIZEOF_SHORT_NAME-1] of Char; PhysicalAddress : DWORD; // or VirtualSize (union); VirtualAddress : DWORD; SizeOfRawData : DWORD; PointerToRawData : DWORD; PointerToRelocations : DWORD; PointerToLinenumbers : DWORD; NumberOfRelocations : WORD; NumberOfLinenumbers : WORD; Characteristics : DWORD; end;

PIMAGE_NT_HEADERS = ^IMAGE_NT_HEADERS; IMAGE_NT_HEADERS = packed record Signature : DWORD; FileHeader : IMAGE_FILE_HEADER; OptionalHeader : IMAGE_OPTIONAL_HEADER; end;

{ Resources }

PIMAGE_RESOURCE_DIRECTORY = ^IMAGE_RESOURCE_DIRECTORY; IMAGE_RESOURCE_DIRECTORY = packed record Characteristics : DWORD; TimeDateStamp : DWORD; MajorVersion : WORD; MinorVersion : WORD; NumberOfNamedEntries : WORD; NumberOfIdEntries : WORD; end;

PIMAGE_RESOURCE_DIRECTORY_ENTRY = ^IMAGE_RESOURCE_DIRECTORY_ENTRY; IMAGE_RESOURCE_DIRECTORY_ENTRY = packed record Name: DWORD; // Or ID: Word (Union) OffsetToData: DWORD; end;

PIMAGE_RESOURCE_DATA_ENTRY = ^IMAGE_RESOURCE_DATA_ENTRY; IMAGE_RESOURCE_DATA_ENTRY = packed record OffsetToData : DWORD; Size : DWORD; CodePage : DWORD; Reserved : DWORD; end;

PIMAGE_RESOURCE_DIR_STRING_U = ^IMAGE_RESOURCE_DIR_STRING_U; IMAGE_RESOURCE_DIR_STRING_U = packed record Length : WORD; NameString : array [0..0] of WCHAR; end;

{ /* Predefined resource types */ #define RT_NEWRESOURCE 0x2000 #define RT_ERROR 0x7fff #define RT_CURSOR 1 #define RT_BITMAP 2 #define RT_ICON 3 #define RT_MENU 4 #define RT_DIALOG 5 #define RT_STRING 6 #define RT_FONTDIR 7 #define RT_FONT 8 #define RT_ACCELERATORS 9 #define RT_RCDATA 10 #define RT_MESSAGETABLE 11 #define RT_GROUP_CURSOR 12 #define RT_GROUP_ICON 14 #define RT_VERSION 16 #define RT_NEWBITMAP (RT_BITMAP|RT_NEWRESOURCE) #define RT_NEWMENU (RT_MENU|RT_NEWRESOURCE) #define RT_NEWDIALOG (RT_DIALOG|RT_NEWRESOURCE)

}

type TResourceType = ( rtUnknown0, rtCursorEntry, rtBitmap, rtIconEntry, rtMenu, rtDialog, rtString, rtFontDir, rtFont, rtAccelerators, rtRCData, rtMessageTable, rtCursor, rtUnknown13, rtIcon, rtUnknown15, rtVersion);

{ Resource Type Constants }

const StringsPerBlock = 16;

{ Resource Related Structures from RESFMT.TXT in WIN32 SDK }

type

PIconHeader = ^TIconHeader; TIconHeader = packed record wReserved: Word; { Currently zero } wType: Word; { 1 for icons } wCount: Word; { Number of components } end;

PIconResInfo = ^TIconResInfo; TIconResInfo = packed record bWidth: Byte; bHeight: Byte; bColorCount: Byte; bReserved: Byte; wPlanes: Word; wBitCount: Word; lBytesInRes: DWORD; wNameOrdinal: Word; { Points to component } end;

PCursorResInfo = ^TCursorResInfo; TCursorResInfo = packed record wWidth: Word; wHeight: Word; wPlanes: Word; wBitCount: Word; lBytesInRes: DWORD; wNameOrdinal: Word; { Points to component } end;

implementation

end.