www.pudn.com > HgzVip1.2_code.rar > unitPEFile.pas
unit unitPEFile;
interface
uses Windows, Classes, SysUtils, ConTnrs, unitResourceDetails, ImageHlp;
type
TPEModule = class;
//----------------------------------------------------------------------
// TImageSection class
TImageSection = class
private
fParent: TPEModule;
fSectionHeader : TImageSectionHeader;
fRawData : TMemoryStream;
fUninitializedDataSize : Integer;
function GetSectionName: string;
public
constructor Create (AParent : TPEModule; const AHeader : TImageSectionHeader; rawData : pointer);
destructor destroy; override;
property Parent : TPEModule read fParent;
property SectionName : string read GetSectionName;
property SectionHeader : TImageSectionHeader read fSectionHeader;
property RawData : TMemoryStream read fRawData;
end;
//----------------------------------------------------------------------
// TPEModule class
TPEModule = class (TResourceModule)
private
fDOSHeader : TImageDosHeader;
fCOFFHeader : TImageFileHeader;
fOptionalHeader : PImageOptionalHeader;
fSectionList : TObjectList; // List of TImageSection objects
fDOSStub : TMemoryStream;
fCommentBlock : PChar;
fCommentSize : Integer;
fEndComment : PChar;
fEndCommentSize : Integer;
function GetOptionalHeader: TImageOptionalHeader;
function GetImageSection(index: Integer): TImageSection;
function GetImageSectionCount: Integer;
function GetDataDictionary(index: Integer): PImageDataDirectory;
function GetDataDictionaryCount: Integer;
function GetDOSHeader: TImageDosHeader;
function GetCOFFHeader: TImageFileHeader;
protected
procedure Decode (memory : pointer; exeSize : Integer); virtual;
procedure Encode; virtual;
property OptionalHeaderPtr : PImageOptionalHeader read fOptionalHeader;
function FindDictionaryEntrySection (entryNo : Integer): Integer;
public
constructor Create;
destructor Destroy; override;
property DOSHeader : TImageDosHeader read GetDOSHeader;
property COFFHeader : TImageFileHeader read GetCOFFHeader;
property OptionalHeader : TImageOptionalHeader read GetOptionalHeader;
property ImageSectionCount : Integer read GetImageSectionCount;
property ImageSection [index : Integer] : TImageSection read GetImageSection;
property DataDictionaryCount : Integer read GetDataDictionaryCount;
property DataDictionary [index : Integer] : PImageDataDirectory read GetDataDictionary;
procedure LoadFromStream (s : TStream); override;
procedure LoadFromFile (const name : string); override;
procedure SaveToStream (s : TStream); override;
procedure SaveToFile (const name : string); override;
end;
//----------------------------------------------------------------------
// TResourceDirectoryTable record
TResourceDirectoryTable = packed record
characteristics : DWORD; // Resource flags, reserved for future use; currently set to zero.
timeDateStamp : DWORD; // Time the resource data was created by the resource compiler.
versionMajor : WORD; // Major version number, set by the user.
versionMinor : WORD; // Minor version number.
cNameEntries : WORD; // Number of directory entries, immediately following the table, that use strings to identify Type, Name, or Language (depending on the level of the table).
cIDEntries : WORD; // Number of directory entries, immediately following the Name entries, that use numeric identifiers for Type, Name, or Language.
end;
PResourceDirectoryTable = ^TResourceDirectoryTable;
//----------------------------------------------------------------------
// TPEModule record
TResourceDirectoryEntry = packed record
name : DWORD; // RVA Address of integer or string that gives the Type, Name, or Language identifier, depending on level of table.
RVA : DWORD; // RVA High bit 0. Address of a Resource Data Entry (a leaf).
// RVA High bit 1. Lower 31 bits are the address of another Resource Directory Table (the next level down).
end;
PResourceDirectoryEntry = ^TResourceDirectoryEntry;
//----------------------------------------------------------------------
// TResourceDirectoryEntry record
TResourceDataEntry = packed record
OffsetToData : DWORD;
Size : DWORD;
CodePage : DWORD;
Reserved : DWORD
end;
PResourceDataEntry = ^TResourceDataEntry;
//----------------------------------------------------------------------
// TPEResourceModule class
TPEResourceModule = class (TPEModule)
private
fDetailList : TObjectList; // List of TResourceDetails objects
function GetResourceSection : TImageSection;
protected
procedure Decode (memory : pointer; exeSize : Integer); override;
procedure Encode; override;
function GetResourceCount: Integer; override;
function GetResourceDetails(idx: Integer): TResourceDetails; override;
public
constructor Create;
destructor Destroy; override;
property ResourceCount : Integer read GetResourceCount;
property ResourceDetails [idx : Integer] : TResourceDetails read GetResourceDetails;
procedure DeleteResource (resourceNo : Integer); override;
procedure InsertResource (idx : Integer; details : TResourceDetails); override;
function AddResource (details : TResourceDetails) : Integer; override;
function IndexOfResource (details : TResourceDetails) : Integer; override;
procedure SortResources; override;
end;
EPEException = class (Exception);
implementation
{ TPEModule }
resourcestring
rstInvalidDOSSignature = 'Invalid DOS signature';
rstInvalidCOFFSignature = 'Invalid COFF signature';
rstInvalidOptionalHeader = 'Invalid Windows Image';
rstBadDictionaryIndex = 'Index exceeds data dictionary count';
rstBadLangID = 'Unsupported non-integer language ID in resource';
rstEncode = 'Error encoding module';
type
TResourceNode = class
count : Integer;
nodes : array of record
id : string;
intID : boolean;
case leaf : boolean of
false : (next : TResourceNode);
true : (data : TMemoryStream; CodePage : DWORD)
end;
constructor Create (const AType, AName : string; ALang : Integer; aData : TMemoryStream; CodePage : DWORD);
constructor CreateNameNode (const AName : string; ALang : Integer; aData : TMemoryStream; CodePage : DWORD);
constructor CreateLangNode (ALang : Integer; aData : TMemoryStream; CodePage : DWORD);
procedure Add (const AType, AName : string; ALang : Integer; aData : TMemoryStream; CodePage : DWORD);
procedure AddName (const AName : string; ALang : Integer; aData : TMemoryStream; CodePage : DWORD);
procedure AddLang (ALang : Integer; aData : TMemoryStream; CodePage : DWORD);
function IsID (idx : Integer): boolean;
destructor Destroy; override;
end;
(*----------------------------------------------------------------------*
| constructor PEModule.Create |
| |
| Constructor for TPEModule instance. Create empty section list |
*----------------------------------------------------------------------*)
constructor TPEModule.Create;
begin
inherited Create;
fSectionList := TObjectList.Create;
fDOSStub := TMemoryStream.Create;
end;
(*----------------------------------------------------------------------*
| procedure PEModule.Decode |
| |
| Decode the PE file. Load the DOS header, the COFF header and the |
| 'optional' header, then load each section into fSectionList |
*----------------------------------------------------------------------*)
procedure TPEModule.Decode (Memory : pointer; exeSize : Integer);
var
offset : LongInt;
i : Integer;
sectionHeader : PImageSectionHeader;
commentOffset : Integer;
begin
fSectionList.Clear;
// Check it's really a PE file.
if PWORD (Memory)^ <> IMAGE_DOS_SIGNATURE then
raise EPEException.Create (rstInvalidDOSSignature);
// Load the DOS header
fDOSHeader := PImageDosHeader (Memory)^;
offset := fDOSHeader._lfanew;
fDOSStub.Write ((PChar (Memory) + sizeof (fDOSHeader))^, fDOSHeader._lfanew - sizeof (fDOSHeader));
// Check the COFF signature
if PDWORD (PChar (Memory) + offset)^ <> IMAGE_NT_SIGNATURE then
raise EPEException.Create (rstInvalidCOFFSignature);
// Load the COFF header
Inc (offset, sizeof (DWORD));
fCOFFHeader := PImageFileHEader (PChar (Memory) + offset)^;
Inc (offset, sizeof (fCOFFHeader));
// Check the Optional Header signature. nb
// the optional header is compulsory for
// 32 bit windows modules!
if PWORD (PChar (Memory) + offset)^ <> IMAGE_NT_OPTIONAL_HDR_MAGIC then
raise EPEException.Create (rstInvalidOptionalHeader);
// Save the 'optional' header
ReallocMem (fOptionalHeader, fCOFFHeader.SizeOfOptionalHeader);
Move ((PChar (Memory) + Offset)^, fOptionalHeader^, fCOFFHeader.SizeOfOptionalHeader);
Inc (offset, fCOFFHeader.SizeOfOptionalHeader);
sectionHeader := PImageSectionHeader (PChar (memory) + offset);
commentOffset := offset + fCOFFHeader.NumberOfSections * sizeof (TImageSectionHeader);
// Save padding between the end of the section headers, and the start of the
// 1st section. TDump reports this as 'comment', and it seems to be important
// to MS clock.exe...
fCommentSize := Integer (sectionHeader^.PointerToRawData) - commentOffset;
if fCommentSize > 0 then
begin
GetMem (fCommentBlock, fCommentSize);
Move ((PChar (memory) + commentOffset)^, fCommentBlock^, fCommentSize)
end;
// Now save each image section in the fSectionList
for i := 0 to fCOFFHeader.NumberOfSections - 1 do
begin
sectionHeader := PImageSectionHeader (PChar (memory) + offset);
fSectionList.Add (TImageSection.Create (self, sectionHeader^, PChar (memory) + sectionHeader^.PointertoRawData));
Inc (offset, sizeof (TImageSectionHeader));
end;
i := sectionHeader^.PointerToRawData + sectionHeader^.SizeOfRawData;
// Save the padding between the last section and the end of the file.
// This appears to hold debug info and things ??
fEndCommentSize := exeSize - i;
if fEndCommentSize > 0 then
begin
GetMem (fEndComment, fEndCommentSize);
Move ((PChar (memory) + i)^, fEndComment^, fEndCommentSize)
end
end;
(*----------------------------------------------------------------------*
| destructor PEModule.Destroy |
| |
| Destructor for TPEModule instance. |
*----------------------------------------------------------------------*)
destructor TPEModule.Destroy;
begin
ReallocMem (fOptionalHeader, 0);
fSectionList.Free;
fDOSStub.Free;
ReallocMem (fCommentBlock, 0);
ReallocMem (fEndComment, 0);
inherited;
end;
(*----------------------------------------------------------------------*
| procedure PEModule.Encode |
| |
| Fix up the data prior to writing to stream. |
| |
| Ensure that the headers match what we've got... |
*----------------------------------------------------------------------*)
procedure TPEModule.Encode;
var
offset : DWORD;
i : Integer;
section : TImageSection;
align : Integer;
addrAlign : Integer;
address : Integer;
alignedSize, AddrAlignedSize : Integer;
codeSize, iDataSize, uDataSize, iSize : Integer;
begin
codeSize := 0;
iDataSize := 0;
uDataSize := 0;
// Use the DOS stub from their .EXE
fDOSHeader._lfanew := sizeof (fDosHeader) + fDOSStub.Size;
// Fixup sections count
fCOFFHeader.NumberOfSections := fSectionList.Count;
iSize := fDOSHeader._lfanew + // File offset for start of sections
SizeOf (DWORD) + // NT signature
sizeof (fCoffHeader) +
fCOFFHeader.SizeOfOptionalHeader +
fSectionList.Count * sizeof (TImageSectionHeader);
offset := iSize + fCommentSize;
align := fOptionalHeader^.FileAlignment;
addrAlign := fOptionalHeader^.SectionAlignment;
address := addrAlign;
offset := DWORD ((integer (offset) + align - 1) div align * align);
// First section starts at $1000 (when loaded)
// and at 'offset' in file.
fOptionalHeader^.SizeOfHeaders := DWORD ((integer (iSize) + align - 1) div align * align);
fOptionalHeader^.BaseOfCode := $ffffffff;
fOptionalHeader^.CheckSum := 0; // Calculate it during 'SaveToStream' when
// we've got all the info.
iSize := DWORD ((integer (iSize) + addrAlign - 1) div addrAlign * addrAlign);
for i := 0 to fSectionList.Count - 1 do // Recalculate the section offsets
begin
section := TImageSection (fSectionList [i]);
section.fSectionHeader.PointerToRawData := offset;
section.fSectionHeader.VirtualAddress := address;
// Virtual size is size of data in memory, and is not padded to an 'alignment'.
//
// SizeOfRawData is size of data in file, padded to (file) alignment.
//
// 1. If VirtualSize < SizeOfRawData, that's simply because the raw data is aligned, and virt data isn't.
//
// 2. If VirtualSize > SizeOfRawData, the additional memory is filled with zeros when it's loaded.
//
// Because SizeOfRawData is padded it's impossible to tell how much Virtual Memory is really required.
//
// We do our best by saving the original difference in '2.' above in fUninitializeDataSize
section.fSectionHeader.Misc.VirtualSize := section.fRawData.Size + section.fUninitializedDataSize;
section.fSectionHeader.SizeOfRawData := (section.fRawData.Size + align - 1) div align * align;
alignedSize := (Integer (section.fSectionHeader.Misc.VirtualSize) + align - 1) div align * align;
addrAlignedSize := (Integer (section.fSectionHeader.Misc.VirtualSize) + addrAlign - 1) div addrAlign * addrAlign;
if (section.fSectionHeader.Characteristics and IMAGE_SCN_MEM_EXECUTE) <> 0 then
begin
Inc (codeSize, alignedSize);
if DWORD (address) < fOptionalHeader^.BaseOfCode then
fOptionalHeader^.BaseOfCode := address
end
else
if (section.fSectionHeader.Characteristics and IMAGE_SCN_CNT_INITIALIZED_DATA) <> 0 then
Inc (iDataSize, alignedSize)
else
if (section.fSectionHeader.Characteristics and IMAGE_SCN_CNT_UNINITIALIZED_DATA) <> 0 then
Inc (uDataSize, alignedSize);
Inc (iSize, addrAlignedSize);
Inc (offset, section.fSectionHeader.SizeOfRawData);
Inc (address, (Integer (section.fSectionHeader.Misc.VirtualSize) + addrAlign - 1) div addrAlign * addrAlign);
end;
fOptionalHeader^.SizeOfCode := codeSize;
fOptionalHeader^.SizeOfInitializedData := iDataSize;
fOptionalHeader^.SizeOfUninitializedData := uDataSize;
i := SizeOf (DWORD) + // NT signature
sizeof (fCoffHeader) +
fCOFFHeader.SizeOfOptionalHeader +
codeSize;
i := (i + addrAlign - 1) div addrAlign * addrAlign;
// With explorer.exe, codeSize is $14800, i is 148E8, so aligned 'i' is $15000
// .. so BaseOfData should be $15000 + BaseOfCode ($1000) = $16000.
//
// ... but it's not - it's $15000, which means that the last $8e8 bytes of code
// should be stampled over by the data!
//
// But obviously explorer.exe works, so I'm, missing a trick here. Never mind - it
// doesn't do any harm making it $16000 instead, and the formula works for everything
// else I've tested...
fOptionalHeader^.BaseOfData := fOptionalHeader.BaseOfCode + DWORD (i);
fOptionalHeader^.SizeOfImage := iSize;
end;
(*----------------------------------------------------------------------*
| function PEModule.FindDictionaryEntrySection |
| |
| Return the index of the specified section. The 'entryNo' to find |
| should be a 'IMAGE_DIRECTORY_ENTRY_xxxx' constant defined in |
| Windows.pas. |
*----------------------------------------------------------------------*)
function TPEModule.FindDictionaryEntrySection (entryNo: Integer): Integer;
var
i : Integer;
p : PImageDataDirectory;
begin
result := -1;
p := DataDictionary [entryNo];
// Find section with matching virt address.
for i := 0 to ImageSectionCount - 1 do
if ImageSection [i].fSectionHeader.VirtualAddress = p^.VirtualAddress then
begin
result := i;
break
end
end;
(*----------------------------------------------------------------------*
| function TPEModule.GetCOFFHeader |
| |
| Return COFF header |
*----------------------------------------------------------------------*)
function TPEModule.GetCOFFHeader: TImageFileHeader;
begin
result := fCoffHeader;
end;
(*----------------------------------------------------------------------*
| function TPEModule.GetDataDictionary |
| |
| Return the data dictionary for a specified |
| IMAGE_DIRECTORY_ENTRY_xxxx index |
*----------------------------------------------------------------------*)
function TPEModule.GetDataDictionary(index: Integer): PImageDataDirectory;
var
p : PImageDataDirectory;
begin
if index < DataDictionaryCount then
begin
p := @fOptionalHeader.DataDirectory [0];
Inc (p, index);
result := p
end
else
raise ERangeError.Create (rstBadDictionaryIndex);
end;
(*----------------------------------------------------------------------*
| function TPEModule.GetDataDictionaryCount |
| |
| Return no of entries in the Data Directory |
*----------------------------------------------------------------------*)
function TPEModule.GetDataDictionaryCount: Integer;
begin
result := fOptionalHeader^.NumberOfRvaAndSizes
end;
(*----------------------------------------------------------------------*
| function TPEModule.GetDosHeader |
| |
| Return DOS header |
*----------------------------------------------------------------------*)
function TPEModule.GetDOSHeader: TImageDosHeader;
begin
result := fDOSHeader;
end;
(*----------------------------------------------------------------------*
| function TPEModule.GetImageSection () : TImageSection |
| |
| Get the specified image section |
*----------------------------------------------------------------------*)
function TPEModule.GetImageSection(index: Integer): TImageSection;
begin
result := TImageSection (fSectionList [index]);
end;
(*----------------------------------------------------------------------*
| function TPEModule.GetImageSectionCount |
| |
| Return no of image sections |
*----------------------------------------------------------------------*)
function TPEModule.GetImageSectionCount: Integer;
begin
result := fSectionList.Count
end;
(*----------------------------------------------------------------------*
| function TPEModule.GetImageSectionCount |
| |
| Get the optional header |
*----------------------------------------------------------------------*)
function TPEModule.GetOptionalHeader: TImageOptionalHeader;
begin
result := fOptionalHeader^
end;
(*----------------------------------------------------------------------*
| procedure TPEModule.LoadFromFile |
| |
| Load the module from a file |
*----------------------------------------------------------------------*)
procedure TPEModule.LoadFromFile(const name: string);
var
f : TFileStream;
begin
f := TFileStream.Create (name, fmOpenRead or fmShareDenyNone);
try
LoadFromStream (f)
finally
f.Free
end
end;
(*----------------------------------------------------------------------*
| procedure TPEModule.LoadFromFile |
| |
| Load the module from a stream |
*----------------------------------------------------------------------*)
procedure TPEModule.LoadFromStream(s: TStream);
var
m : TMemoryStream;
begin
m := TMemoryStream.Create;
try
m.CopyFrom (s, 0);
Decode (m.memory, m.size)
finally
m.Free
end
end;
(*----------------------------------------------------------------------*
| procedure TPEModule.SaveToFile |
| |
| Save the module to a file |
*----------------------------------------------------------------------*)
procedure TPEModule.SaveToFile(const name: string);
var
f : TFileStream;
begin
f := TFileStream.Create (name, fmCreate);
try
SaveToStream (f)
finally
f.Free
end
end;
(*----------------------------------------------------------------------*
| procedure TPEModule.SaveToStream |
| |
| Save the module to a stream |
*----------------------------------------------------------------------*)
procedure TPEModule.SaveToStream(s: TStream);
var
NTSignature : DWORD;
i : Integer;
section : TImageSection;
paddingSize, paddingLen : Integer;
padding : PChar;
f : TMemoryStream;
oldCheckSum, newCheckSum : DWORD;
ntHeaders : PImageNTHEaders;
ckOffset : DWORD;
begin
Encode; // Encode the data.
NTSignature := IMAGE_NT_SIGNATURE;
// Write the DOS stub
s.Write (fDOSHeader, sizeof (fDOSHeader));
s.CopyFrom (fDOSStub, 0);
// Write NT sig and COFF header
s.Write (NTSignature, sizeof (NTSignature));
s.Write (fCOFFHeader, sizeof (fCOFFHeader));
ckOffset := s.Position + Integer (@fOptionalHeader^.CheckSum) - Integer (@fOptionalHeader^);
s.Write (fOptionalHeader^, fCOFFHeader.SizeOfOptionalHeader);
// Write the section headers
for i := 0 to fSectionList.Count - 1 do
begin
section := TImageSection (fSectionList [i]);
s.Write (section.fSectionHeader, sizeof (section.fSectionHeader))
end;
if fCommentSize > 0 then // Save the 'comment' section. See 'Decode' for details
s.Write (fCommentBlock^, fCommentSize);
// Write the sections
padding := Nil;
paddingLen := 0;
try
for i := 0 to fSectionList.Count - 1 do
begin
// Write padding up to file offset of the section
section := TImageSection (fSectionList [i]);
paddingSize := section.fSectionHeader.PointerToRawData - DWORD (s.Position);
if paddingSize > paddingLen then
begin
paddingLen := paddingSize + 65536;
ReallocMem (padding, paddingLen);
ZeroMemory (padding, paddingLen);
end;
if paddingSize > 0 then // Put our signature at the start of the first
s.Write (padding^, paddingSize);
// Write the section data.
s.CopyFrom (section.fRawData, 0);
// Write data
with section.fSectionHeader do
paddingSize := SizeOfRawData - misc.VirtualSize;
// Pad data
if paddingSize > paddingLen then
begin
paddingLen := paddingSize + 65536;
ReallocMem (padding, paddingLen);
ZeroMemory (padding, paddingLen);
end;
if paddingSize > 0 then
s.Write (padding^, paddingSize)
end;
if fEndCommentSize > 0 then // Save the debug info.
s.Write (fEndComment^, fEndCommentSize)
finally
ReallocMem (padding, 0)
end;
f := TMemoryStream.Create; // Now calculate the checksum....
try
s.Seek (0, soFromBeginning);
f.LoadFromStream (s);
ntHeaders := ChecksumMappedFile (f.Memory, f.Size, @oldCheckSum, @newCheckSum);
if Assigned (ntHeaders) then
begin
s.Seek (ckOffset, soFromBeginning);
s.Write (newChecksum, sizeof (newChecksum))
end
finally
f.Free
end;
s.Seek (0, soFromEnd);
end;
{ TImageSection }
(*----------------------------------------------------------------------*
| constructor TImageSection.Create |
| |
| Constructor for TImageSection. |
*----------------------------------------------------------------------*)
constructor TImageSection.Create(AParent: TPEModule;
const AHeader : TImageSectionHeader; rawData : pointer);
begin
fSectionHeader := AHeader;
fRawData := TMemoryStream.Create;
// nb. SizeOfRawData is usually bigger than VirtualSize because it's padded,
// and VirtualSize isn't.
if fSectionHeader.Misc.VirtualSize <= fSectionHeader.SizeOfRawData then
begin
// Some linkers (?) set VirtualSize to 0 - which isn't correct. Work round it.
// (Encountered in MCL Link Lite HHT software )
if fSectionHeader.Misc.VirtualSize = 0 then
fSectionHeader.Misc.VirtualSize := fSectionHeader.SizeOfRawData;
fRawData.Write (rawData^, fSectionHeader.Misc.VirtualSize)
end
else
// nb. If VirtualSize is bigger than SizeOfRawData it implies that extra padding is required.
// Save the amount, so we can get all the COFF header values right. See 'Encode' above.
begin
fRawData.Write (rawData^, fSectionHeader.SizeOfRawData);
fUninitializedDataSize := fSectionHeader.Misc.VirtualSize - fSectionHeader.SizeOfRawData;
end;
fParent := AParent;
end;
(*----------------------------------------------------------------------*
| function TImageSection.GetSectionName |
| |
| Return the section name - eg. .data |
*----------------------------------------------------------------------*)
function TImageSection.GetSectionName: string;
begin
result := PChar (@fSectionHeader.Name)
end;
(*----------------------------------------------------------------------*
| destructor TImageSection.Destroy |
| |
| destructor for TImageSection. |
*----------------------------------------------------------------------*)
destructor TImageSection.destroy;
begin
fRawData.Free;
inherited;
end;
{ TPEResourceModule }
(*----------------------------------------------------------------------*
| function TPEResourceModule. |
| |
| Return the TImageSection that contains 'resource' data. - eg. the |
| .rsrc one. |
*----------------------------------------------------------------------*)
function TPEResourceModule.GetResourceSection : TImageSection;
var
idx : Integer;
begin
idx := FindDictionaryEntrySection (IMAGE_DIRECTORY_ENTRY_RESOURCE);
if idx = -1 then
result := Nil
else
result := ImageSection [idx]
end;
(*----------------------------------------------------------------------*
| procedure TPEResourceModule.DeleteResource |
| |
| Delete the specified resource (by index) |
*----------------------------------------------------------------------*)
procedure TPEResourceModule.DeleteResource(resourceNo: Integer);
var
res : TResourceDetails;
begin
res := ResourceDetails [resourceNo];
inherited;
resourceNo := IndexOfResource (Res);
if resourceNo <> -1 then
fDetailList.Delete (resourceNo);
end;
(*----------------------------------------------------------------------*
| constructor TPEResourceModule.Create |
| |
| Constructor for TPEResourceModule |
*----------------------------------------------------------------------*)
constructor TPEResourceModule.Create;
begin
inherited Create;
fDetailList := TObjectList.Create;
end;
(*----------------------------------------------------------------------*
| destructor TPEResourceModule.Destroy |
| |
| Destructor for TPEResourceModule |
*----------------------------------------------------------------------*)
destructor TPEResourceModule.Destroy;
begin
fDetailList.Free;
inherited;
end;
(*----------------------------------------------------------------------*
| function TPEResourceModule.Decode |
| |
| Decode the section's resource tree into a list of resource details |
*----------------------------------------------------------------------*)
procedure TPEResourceModule.Decode;
var
section : TImageSection;
tp, name : string;
lang : Integer;
// Get string resource name
function GetResourceStr (IdorName : boolean; section : TImageSection; n : DWORD) : string;
var
p : PWideChar;
begin
if IdorName then
result := IntToStr (n)
else
begin
p := PWideChar (PChar (section.fRawData.Memory) + (n and $7fffffff));
result := ResourceWideCharToStr (p)
end
end;
// (recursively) get resources
procedure GetResource (offset, level : Integer);
var
entry : PResourceDirectoryEntry;
i, count : Integer;
IDorName : boolean;
dataEntry : PResourceDataEntry;
table : PResourceDirectoryTable;
details : TResourceDetails;
begin
table := PResourceDirectoryTable (PChar (section.fRawData.memory) + offset);
with table^ do
count := cNameEntries + cIDEntries;
entry := PResourceDirectoryEntry (PChar (section.fRawData.memory) + offset + sizeof (TResourceDirectoryTable));
for i := 0 to count - 1 do
begin
idOrName := i >= table^.cNameEntries;
case level of
0 : tp := GetResourceStr (IDOrName, section, entry^.name);
1 :
name := GetResourceStr (IDOrName, section, entry^.name);
2 :
begin
if not IdOrName then
raise EPEException.Create (rstBadLangID);
lang := entry^.name
end
end;
if (entry^.RVA and $80000000) > 0 then // Not a leaf node - traverse the tree
GetResource (entry^.RVA and $7fffffff, level + 1)
else
begin
// It's a leaf node - create resource details
dataEntry := PResourceDataEntry (PChar (section.fRawData.Memory) + entry^.RVA);
details := TResourceDetails.CreateResourceDetails (self, lang, name, tp, dataEntry^.Size, PChar (section.fRawData.Memory) + dataEntry^.OffsetToData - section.fSectionHeader.VirtualAddress);
details.CodePage := dataEntry^.CodePage;
details.Characteristics := table^.characteristics;
details.DataVersion := DWORD (table^.versionMajor) * 65536 + DWORD (table^.versionMinor);
fDetailList.Add (details);
end;
Inc (entry)
end
end;
begin
inherited;
section := GetResourceSection;
if section <> nil then
GetResource (0, 0)
end;
(*----------------------------------------------------------------------*
| function TPEResourceModule.GetResourceCount |
| |
| Return the number of resources in the resource section |
*----------------------------------------------------------------------*)
function TPEResourceModule.GetResourceCount: Integer;
begin
result := fDetailList.Count
end;
(*----------------------------------------------------------------------*
| function TPEResourceModule.GetResourceDetails |
| |
| Get the resource details for the specified resource. |
*----------------------------------------------------------------------*)
function TPEResourceModule.GetResourceDetails(
idx: Integer): TResourceDetails;
begin
result := TResourceDetails (fDetailList [idx]);
end;
(*----------------------------------------------------------------------*
| function TPEResourceModule.IndexOfResource |
| |
| Return the index of the specified resource details in the resource |
*----------------------------------------------------------------------*)
function TPEResourceModule.IndexOfResource(details: TResourceDetails): Integer;
begin
result := fDetailList.IndexOf (details);
end;
(*----------------------------------------------------------------------*
| function TPEResourceModule.InsertResource |
| |
| Insert a resource in the list. |
*----------------------------------------------------------------------*)
procedure TPEResourceModule.InsertResource(idx: Integer;
details: TResourceDetails);
begin
fDetailList.Insert (idx, details);
end;
(*----------------------------------------------------------------------*
| function TPEResourceModule.Encode |
| |
| Complicated? I'll give you complicated ... |
*----------------------------------------------------------------------*)
procedure TPEResourceModule.Encode;
var
i : Integer;
details : TResourceDetails;
section : TImageSection;
root : TResourceNode;
versMajor, versMinor : word;
TimeStamp : DWORD;
nameSize, nameOffset, namePos, tableOffset : DWORD;
deOffset, dePos, deSize : DWORD;
dataOffset, dataPos, dataSize : DWORD;
nameTable : PChar;
deTable : PChar;
data : PChar;
zeros : PChar;
//------------------------------------------------------------------
// Calculate offset and size of name table and DirectoryEntry table.
// Calculate size of data
procedure GetNameTableSize (node : TResourceNode);
var
i : Integer;
begin
Inc (nameOffset, sizeof (TResourceDirectoryTable));
Inc (deOffset, sizeof (TResourceDirectoryTable));
for i := 0 to node.count - 1 do
begin
Inc (nameOffset, sizeof (TResourceDirectoryEntry));
Inc (deOffset, sizeof (TResourceDirectoryEntry));
if not node.nodes [i].intID then
Inc (nameSize, Length (node.nodes [i].id) * sizeof (WideChar) + sizeof (word));
if not node.nodes [i].leaf then
GetNameTableSize (node.nodes [i].next)
else
begin
Inc (nameOffset, sizeof (TResourceDataEntry));
Inc (deSize, sizeof (TResourceDataEntry));
dataSize := (dataSize + DWORD (node.nodes [i].data.Size) + 3) div 4 * 4;
end
end
end;
//------------------------------------------------------------------
// Save a node to section.fRawData (and save it's child nodes recursively)
procedure SaveToSection (node : TResourceNode);
var
table : TResourceDirectoryTable;
entry : TResourceDirectoryEntry;
dataEntry : PResourceDataEntry;
i, n : Integer;
w : WideString;
wl : word;
//------------------------------------------------------------------
// Save entry (i), and the child nodes
procedure SaveNode (i : Integer);
begin
if node.nodes [i].intID then // id is a simple integer
entry.name := StrToInt (node.nodes [i].id)
else
begin // id is an offset to a name in the
// name table.
entry.name := nameOffset + namePos + $80000000;
w := node.nodes [i].id;
wl := Length (node.nodes [i].id);
Move (wl, nameTable [namePos], sizeof (wl));
Inc (namePos, sizeof (wl));
Move (w [1], nameTable [namePos], wl * sizeof (WideChar));
Inc (namePos, wl * sizeof (WideChar))
end;
if node.nodes [i].leaf then // RVA points to a TResourceDataEntry in the
begin // data entry table.
entry.RVA := deOffset + dePos;
dataEntry := PResourceDataEntry (deTable + dePos);
dataEntry^.CodePage := node.nodes [i].CodePage;
dataEntry^.Reserved := 0;
dataEntry^.Size := node.nodes [i].data.Size;
dataEntry^.OffsetToData := dataOffset + dataPos + section.fSectionHeader.VirtualAddress;
Move (node.nodes [i].data.memory^, data [dataPos], dataEntry^.Size);
Inc (dePos, sizeof (TResourceDataEntry));
dataPos := (dataPos + dataEntry^.size + 3) div 4 * 4;
section.fRawData.Write (entry, sizeof (entry));
end
else // RVA points to another table.
begin
entry.RVA := $80000000 + tableOffset;
section.fRawData.Write (entry, sizeof (entry));
n := section.fRawData.Position;
SaveToSection (node.nodes [i].next);
section.fRawData.Seek (n, soFromBeginning);
end
end;
begin { SaveToSection }
table.characteristics := 0;
table.timeDateStamp := TimeStamp;
table.versionMajor := versMajor;
table.versionMinor := versMinor;
table.cNameEntries := 0;
table.cIDEntries := 0;
// Calculate no of integer and string IDs
for i := 0 to node.count - 1 do
if node.nodes [i].intID then
Inc (table.cIDEntries)
else
Inc (table.cNameEntries);
section.fRawData.Seek (tableOffset, soFromBeginning);
section.fRawData.Write (table, sizeof (table));
tableOffset := tableOffset + sizeof (TResourceDirectoryTable) + DWORD (node.Count) * sizeof (TResourceDirectoryEntry);
// The docs suggest that you save the nodes
// with string entries first. Goodness knows why,
// but play along...
for i := 0 to node.count - 1 do
if not node.nodes [i].intID then
SaveNode (i);
for i := 0 to node.count - 1 do
if node.nodes [i].intID then
SaveNode (i);
section.fRawData.Seek (0, soFromEnd);
end;
begin { Encode }
section := GetResourceSection;
// Get the details in a tree structure
root := Nil;
data := Nil;
deTable := Nil;
zeros := Nil;
try
for i := 0 to fDetailList.Count - 1 do
begin
details := TResourceDetails (fDetailList.Items [i]);
if root = Nil then
root := TResourceNode.Create (details.ResourceType, details.ResourceName, details.ResourceLanguage, details.Data, details.CodePage)
else
root.Add (details.ResourceType, details.ResourceName, details.ResourceLanguage, details.Data, details.CodePage)
end;
// Save elements of their original EXE
versMajor := PResourceDirectoryTable (section.fRawData.Memory)^.versionMajor;
versMinor := PResourceDirectoryTable (section.fRawData.Memory)^.versionMinor;
TimeStamp := PResourceDirectoryTable (section.fRawData.Memory)^.timeDateStamp;
section.fRawData.Clear; // Clear the data. We're gonna recreate
// it from our resource details.
nameSize := 0; nameOffset := 0;
deSize := 0; deOffset := 0;
dataSize := 0;
GetNameTableSize (root); // Calculate sizes and offsets of the
// name table, the data entry table and
// the size of the data.
// Calculate the data offset. Must be aligned.
dataOffset := (nameOffset + nameSize + 15) div 16 * 16;
// Initialize globals...
namePos := 0; // Offset of next entry in the string table
dePos := 0; // Offset of next entry in the data entry table
dataPos := 0; // Offset of next data block.
tableOffset := 0; // Offset of next TResourceDirectoryTable
GetMem (nameTable, nameSize); // Allocate buffers for tables
GetMem (data, dataSize);
GetMem (deTable, deSize);
SaveToSection (root); // Do the work.
// Save the tables
section.fRawData.Write (deTable^, deSize);
section.fRawData.Write (nameTable^, nameSize);
// Add padding so the data goes on a
// 16 byte boundary.
if DWORD (section.fRawData.Position) < dataOffset then
begin
GetMem (zeros, dataOffset - DWORD (section.fRawData.Position));
ZeroMemory (zeros, dataOffset - DWORD (section.fRawData.Position));
section.fRawData.Write (zeros^, dataOffset - DWORD (section.fRawData.Position))
end;
// Write the data.
section.fRawData.Write (data^, dataSize);
inherited; // **** Must call inherited !
finally // Tidy up.
ReallocMem (zeros, 0);
FreeMem (nameTable);
FreeMem (deTable);
FreeMem (data);
root.Free
end
end;
{ TResourceNode }
procedure TResourceNode.Add(const AType, AName: string; ALang: Integer;
aData: TMemoryStream; codePage : DWORD);
var
i : Integer;
begin
for i := 0 to count - 1 do
if AType = nodes [i].id then
begin
nodes [i].next.AddName (AName, ALang, aData, codePage);
exit
end;
Inc (count);
SetLength (nodes, count);
nodes [count - 1].id := AType;
nodes [count - 1].intID := isID (count - 1);
nodes [count - 1].leaf := False;
nodes [count - 1].next := TResourceNode.CreateNameNode (AName, ALang, AData, codePage)
end;
procedure TResourceNode.AddLang(ALang: Integer; aData: TMemoryStream; codePage : DWORD);
var
i : Integer;
begin
for i := 0 to count - 1 do
if IntToStr (ALang) = nodes [i].id then
begin
nodes [i].data := aData;
exit
end;
Inc (count);
SetLength (nodes, count);
nodes [count - 1].id := IntToStr (ALang);
nodes [count - 1].intId := True;
nodes [count - 1].leaf := True;
nodes [count - 1].data := aData;
nodes [count - 1].CodePage := codePage;
end;
procedure TResourceNode.AddName(const AName: string; ALang: Integer;
aData: TMemoryStream; codePage : DWORD);
var
i : Integer;
begin
for i := 0 to count - 1 do
if AName = nodes [i].id then
begin
nodes [i].next.AddLang (ALang, aData, codePage);
exit
end;
Inc (count);
SetLength (nodes, count);
nodes [count - 1].id := AName;
nodes [count - 1].intID := isID (count - 1);
nodes [count - 1].leaf := False;
nodes [count - 1].next := TResourceNode.CreateLangNode (ALang, aData, codePage)
end;
constructor TResourceNode.Create(const AType, AName: string;
ALang: Integer; aData: TMemoryStream; codePage : DWORD);
begin
count := 1;
SetLength (nodes, 1);
nodes [0].id := AType;
nodes [count - 1].intID := isID (count - 1);
nodes [0].leaf := False;
nodes [0].next := TResourceNode.CreateNameNode (AName, ALang, aData, codePage);
end;
constructor TResourceNode.CreateLangNode(ALang: Integer;
aData: TMemoryStream; codePage : DWORD);
begin
count := 1;
SetLength (nodes, 1);
nodes [0].id := IntToStr (ALang);
nodes [count - 1].intID := True;
nodes [0].leaf := True;
nodes [0].data := aData;
nodes [0].CodePage := codePage
end;
constructor TResourceNode.CreateNameNode(const AName: string;
ALang: Integer; aData: TMemoryStream; codePage : DWORD);
begin
count := 1;
SetLength (nodes, 1);
nodes [0].id := AName;
nodes [count - 1].intID := isID (count - 1);
nodes [0].leaf := False;
nodes [0].next := TResourceNode.CreateLangNode (ALang, aData, codePage)
end;
destructor TResourceNode.Destroy;
var
i : Integer;
begin
for i := 0 to count - 1 do
if not nodes [i].leaf then
nodes [i].next.Free;
inherited;
end;
function TResourceNode.IsID (idx : Integer): boolean;
var
i : Integer;
begin
result := True;
for i := 1 to Length (nodes [idx].id) do
if not (nodes [idx].id [i] in ['0'..'9']) then
begin
result := False;
break
end;
if result then
result := IntToStr (StrToInt (nodes [idx].id)) = nodes [idx].id;
end;
function TPEResourceModule.AddResource(details: TResourceDetails): Integer;
begin
Result := fDetailList.Add (details);
end;
procedure TPEResourceModule.SortResources;
begin
fDetailList.Sort (compareDetails);
end;
end.