☆Obaby's H4cking W0rld☆

Hack-Crack==Backdoors - RATs - Trojans // Binders-Packers - Rootkits

破解-黑客-零日漏洞-灰鸽子/上兴/PCShare-木马免杀-网站入侵-信息安全

2009年3月2日星期一

PE File Unit

Credits to ErazerZ

{
  Pe File Unit
  by ErazerZ

  Datum: Samstag, 1 Juli 2007
  E-Mail: ErazerZ@gmail.com

  Danke geht an ...
  Olli für Resourcen Namen in Strings umwandeln...

  Log:
  Sonntag, 24 Juni 2007:
  LoadFromFile
  SaveToFile
  ReadPeHeaders
  Align
  SectionNameToString
  StringToSectionName
  SetAddressOfEntryPoint
  SetImageBase
  RvaToFileOffset
  FileOffsetToRva
  VaToFileOffset
  FileOffsetToVa
  VaToRva
  RvaToVa
  InsertBytes
  DeleteBytes

  Montag, 25 Juni 2007:
  RvaToSection
  FileOffsetToSection
  FindCodeCaves
  AddSection
  DeleteSection
  GetCodeSection
  GetDataSection
  GetResourceSection
  GetImportAddressTable

  Dienstag, 26 Juni 2007:
  GetExportsAddressTable
  GetThreadLocalStorage
  GetResources

  Mittwoch, 27. Juni 2007:
  GetResources erweitert (Languages)

  Freitag, 29. Juni 2007:
  AddSection überarbeitet (Prüft ob Platz vorhanden ist, falls nicht wird neuer eingefügt [FILEALIGN])
  GetDebugDirectory
  GetLoadConfigDirectory
  GetEntryExceptionDirectory

  Sonntag, 1. Juli 2007:
  CopyMemoryBuffer

  ToDo:
  *) AddSection weiter anpassen! Mit FileAlign 4 funktioniert es nicht!
  *) IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR Parsen.
  *) Imports einzeln hinzufügen!
  *) Imports, Exports, Resourcen im Speicher änderbar machen
  *) weitere folgen ... :)

  Anmerkung:
  * ) ImageSections sind nicht direkt veränderbar!
  Erst nach dem Aufruf SaveToFile werden diese gespeichert.

  Gib mir Credits falls du diese Unit oder Funktionen dieser Unit benutzts!

  -- ErazerZ
}
unit untPeFile;

interface

uses Windows;

type
  // Dient der Zwischenspeicherung von Code-Höhlen (Daten die mit 0 Bytes
  // gefüllt sind)
  PCodeCave = ^TCodeCave;
  TCodeCave = packed record
  StartFileOffset: Cardinal;
  StartRVA: Cardinal;
  CaveSize: Cardinal;
  end;

  { IAT }
  PImageImportDescriptor = ^TImageImportDescriptor;
  TImageImportDescriptor = packed record
  OriginalFirstThunk: DWORD;
  TimeDateStamp: DWORD;
  ForwarderChain: DWORD;
  Name: DWORD;
  FirstThunk: DWORD;
  end;
  PImageThunkData = ^TImageThunkData;
  TImageThunkData = packed record
  Name: DWORD;
  end;
  { BOUND IAT }
  PImageBoundImportDescriptor = ^TImageBoundImportDescriptor;
  TImageBoundImportDescriptor = packed record
  TimeDateStamp: DWORD;
  OffsetModuleName: Word;
  NumberOfModuleForwarderRefs: Word;
  end;
  PImageBoundForwarderRef = ^TImageBoundForwarderRef;
  TImageBoundForwarderRef = record
  TimeDateStamp: DWORD;
  OffsetModuleName: Word;
  Reserved: Word;
  end;
  { DELAYED IAT }
  PImgDelayDescr = ^TImgDelayDescr;
  TImgDelayDescr = packed record
  grAttrs: DWORD;
  szName: DWORD;
  phmod: PDWORD;
  pIAT: TImageThunkData;
  pINT: TImageThunkData;
  pBoundIAT: TImageThunkData;
  pUnloadIAT: TImageThunkData;
  dwTimeStamp: DWORD;
  end;

  TImportsType = (itNormal, itBound, itDelay);

  // Dient der Zwischenspeicherung der Imports
  PImportsAPis = ^TImportsAPIs;
  TImportsAPIs = packed record
  ThunkRVA: DWORD;
  ThunkOffset: DWORD;
  ThunkValue: DWORD;
  Hint: Word;
  ApiName: string;
  end;
  PImports = ^TImports;
  TImports = packed record
  LibraryName: string;
  ImportType: TImportsType;
  OriginalFirstThunk: DWORD;
  TimeDateStamp: DWORD;
  ForwarderChain: DWORD;
  Name: DWORD; // Offset
  FirstThunk: DWORD;
  IatFunctions: array of TImportsAPIs;
  end;
  PImportsArray = ^TImportsArray;
  TImportsArray = array of TImports;

  // Dient der Zwischenspeicherung der Exports
  PExportAPIs = ^TExportAPIs;
  TExportAPIs = packed record
  Ordinal: Word;
  Rva: DWORD;
  FileOffset: DWORD;
  ApiName: string;
  end;
  PExports = ^TExports;
  TExports = packed record
  LibraryName: string;
  Base: DWORD;
  Characteristics: DWORD;
  TimeDateStamp: DWORD;
  MajorVersion: Word;
  MinorVersion: Word;
  NumberOfFunctions: DWORD;
  NumberOfNames: DWORD;
  AddressOfFunctions: DWORD;
  AddressOfNames: DWORD;
  AddressOfNameOrdinals: Word;
  ExportFunctions: array of TExportAPIs;
  end;

  { Thread Local Storage }
  PImageTLSDirectory = ^TImageTLSDirectory;
  TImageTLSDirectory = packed record
  StartAddressOfRawData: DWORD;
  EndAddressOfRawData: DWORD;
  AddressOfIndex: DWORD;
  AddressOfCallBacks: DWORD;
  SizeOfZeroFill: DWORD;
  Characteristics: DWORD;
  end;

  { RESOURCES }
  { Resource Dir String }
  PImageResourceDirString = ^TImageResourceDirString;
  TImageResourceDirString = packed record
  Length: Word;
  NameString: array[0..0] of WCHAR;
  end;
  { Data Entry }
  PImageResourceDataEntry = ^TImageResourceDataEntry;
  TImageResourceDataEntry = packed record
  OffsetToData: DWORD;
  Size: DWORD;
  CodePage: DWORD;
  Reserved: DWORD;
  end;
  { Dir Entry }
  PImageResourceDirectoryEntry = ^TImageResourceDirectoryEntry;
  TImageResourceDirectoryEntry = packed record
  Name: DWORD;
  OffsetToData: DWORD;
  end;
  { Directory }
  PImageResourceDirectory = ^TImageResourceDirectory;
  TImageResourceDirectory = packed record
  Characteristics: DWORD;
  TimeDateStamp: DWORD;
  MajorVersion: Word;
  MinorVersion: Word;
  NumberOfNamedEntries: Word;
  NumberOfIdEntries: Word;
  end;
  { Table }
  PImageResourceTableDirectoryEntry = ^TImageResourceTableDirectoryEntry;
  TImageResourceTableDirectoryEntry = packed record
  Table: TImageResourceDirectory;
  Directory: TImageResourceDirectoryEntry;
  end;

  // Dient der Zwischenspeicherung der Resourcen
  // Languages
  PResourceLangs = ^TResourceLangs;
  TResourceLangs = packed record
  dwRVA: DWORD;
  dwFileOffset: DWORD;
  Lang: string;
  end;
  // Namen
  PResourceNames = ^TResourceNames;
  TResourceNames = packed record
  lpNames: string;
  dwRVA: DWORD;
  dwFileOffset: DWORD;
  lpLangs: array of TResourceLangs;
  LangsCount: Integer;
  end;
  // Typen
  PResourcesTyps = ^TResourceTyps;
  TResourceTyps = packed record
  lpTyp: string;
  Names: array of TResourceNames;
  NamesCount: Integer;
  end;
  // Resourcen Block
  PResources = ^TResources;
  TResources = packed record
  Characteristics: DWORD;
  TimeDateStamp: DWORD;
  MajorVersion: Word;
  MinorVersion: Word;
  NumberOfNamedEntries: Word;
  NumberOfIdEntries: Word;
  rtTyps: array of TResourceTyps;
  TypCount: Integer;
  end;

  TPeFile = class(TObject)
  private
  // Datei
  lpBuffer: Pointer; // Datei im Speicher
  FFileSize: Cardinal;
  FFilename: string;
  // NtHeaders
  FNumberOfSections: Word;
  FAddressOfEntryPoint: Cardinal;
  FImageBase: Cardinal;
  FSectionAlign: Cardinal;
  FFileAlign: Cardinal;
  public
  ImageDosHeader: PImageDosHeader;
  ImageNtHeaders: PImageNtHeaders;
  ImageSections: array of TImageSectionHeader; // alle Sektionen-Header
  constructor Create;
  destructor Destroy; override;
  function LoadFromFile(const sFilename: string): Boolean;
  function SaveToFile(const sFilename: string): Boolean;
  function ValidHeaders: Boolean;
  function ReadPeHeaders: Boolean;
  function Align(Value, Align: Cardinal): Cardinal;
  function SectionToString(Section: TImageSectionHeader): string;
  procedure StringToSection(const sSectionName: string; var Section: TImageSectionHeader);
  procedure CopyMemoryBuffer(CopyToOffset: DWORD; Source: Pointer; Length: DWORD);
  // Änderungen
  procedure SetAddressOfEntryPoint(AddressOfEntryPoint: Cardinal);
  procedure SetImageBase(ImageBase: Cardinal);
  // Umrechnungen
  function RvaToFileOffset(dwRVA: Cardinal): Cardinal;
  function FileOffsetToRva(dwFileOffset: Cardinal): Cardinal;
  function VaToFileOffset(dwVA: Cardinal): Cardinal;
  function FileOffsetToVa(dwFileOffset: Cardinal): Cardinal;
  function VaToRva(dwVA: Cardinal): Cardinal;
  function RvaToVa(dwRVA: Cardinal): Cardinal;
  function RvaToSection(dwRVA: Cardinal): Word;
  function FileOffsetToSection(dwFileOffset: Cardinal): Word;
  // Hinzufügen/Entfernen
  function InsertBytes(FromOffset, Count: Cardinal): Cardinal;
  function DeleteBytes(FromOffset, Count: Cardinal): Cardinal;
  function FindCodeCaves(FromOffset, Count: Cardinal): TCodeCave;
  // Sektionen
  function AddSection(const sSectionName: string; VirtualSize: Cardinal; dwCharacteristics: Cardinal = IMAGE_SCN_MEM_WRITE or IMAGE_SCN_MEM_READ or IMAGE_SCN_MEM_EXECUTE or IMAGE_SCN_CNT_CODE): Boolean;
  function DeleteSection(wSection: Word): Boolean;
  function GetCharacteristics(dwCharacteristics: DWORD): string;
  function GetCodeSection: Word;
  function GetDataSection: Word;
  function GetResourceSection: Word;
  procedure GetImportAddressTable(var Imports: TImportsArray);
  procedure GetExportsAddressTable(var ExportData: TExports);
  function GetThreadLocalStorage: PImageTLSDirectory;
  procedure GetResources(var Resources: TResources);
  function GetDebugDirectory: PImageDebugDirectory;
  function GetLoadConfigDirectory: PImageLoadConfigDirectory;
  function GetEntryExceptionDirectory: PImageRuntimeFunctionEntry;

  published
  // Datei
  property FileSize: Cardinal read FFileSize;
  property Filename: string read FFilename;
  // NtHeaders
  property NumberOfSections: Word read FNumberOfSections;
  property AddressOfEntryPoint: Cardinal read FAddressOfEntryPoint write SetAddressOfEntryPoint;
  property ImageBase: Cardinal read FImageBase write SetImageBase;
  property SectionAlign: Cardinal read FSectionAlign;
  property FileAlign: Cardinal read FFileAlign;
  // Noch mehr braucht man eigentlich nicht, man kann ja alles über die
  // ImageNtHeaders erreichen.
  protected

  end;

const
  IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT = 13;
  IMAGE_DIRECTORY_ENTRY_COM_DESCRIPTOR = 14;
  RT_HTML = PChar(23);
  RT_MANIFEST = PChar(24);

var
  // by Olli
  ResourceTypeDefaultNames: array[0..20] of record
  ResType: PChar;
  ResTypeName: string;
  end = (
  (ResType: RT_ACCELERATOR; ResTypeName: 'Accelerator'; ),
  (ResType: RT_ANICURSOR; ResTypeName: 'Animated Cursor'; ),
  (ResType: RT_ANIICON; ResTypeName: 'Animated Icon'; ),
  (ResType: RT_BITMAP; ResTypeName: 'Bitmap'; ),
  (ResType: RT_CURSOR; ResTypeName: 'Cursor'; ),
  (ResType: RT_DIALOG; ResTypeName: 'Dialog'; ),
  (ResType: RT_DLGINCLUDE; ResTypeName: 'Dialog Include'; ),
  (ResType: RT_FONT; ResTypeName: 'Font'; ),
  (ResType: RT_FONTDIR; ResTypeName: 'Font Directory'; ),
  (ResType: RT_GROUP_CURSOR; ResTypeName: 'Group Cursor'; ),
  (ResType: RT_GROUP_ICON; ResTypeName: 'Group Icon'; ),
  (ResType: RT_HTML; ResTypeName: 'Html'; ),
  (ResType: RT_ICON; ResTypeName: 'Icon'; ),
  (ResType: RT_MANIFEST; ResTypeName: 'Manifest'; ),
  (ResType: RT_MENU; ResTypeName: 'Menu'; ),
  (ResType: RT_MESSAGETABLE; ResTypeName: 'Messagetable'; ),
  (ResType: RT_PLUGPLAY; ResTypeName: 'Plugplay'; ),
  (ResType: RT_RCDATA; ResTypeName: 'RC Data'; ),
  (ResType: RT_STRING; ResTypeName: 'String'; ),
  (ResType: RT_VERSION; ResTypeName: 'Version'; ),
  (ResType: RT_VXD; ResTypeName: 'VXD'; )
  );

implementation

constructor TPeFile.Create;
begin
  inherited;
end;

destructor TPeFile.Destroy;
begin
  if (lpBuffer <> nil) then
  FreeMem(lpBuffer, FFileSize);
  inherited;
end;

function TPeFile.Align(Value, Align: Cardinal): Cardinal;
begin
  if ((Value mod Align) = 0) then
  Result := Value
  else
  Result := ((Value + Align - 1) div Align) * Align;
end;

function TPeFile.SectionToString(Section: TImageSectionHeader): string;
var
  x: Word;
begin
  Result := '';
  for x := 0 to IMAGE_SIZEOF_SHORT_NAME -1 do
  if (Section.Name[x] <> 0) then
  Result := Result + Chr(Section.Name[x]);
end;

procedure TPeFile.StringToSection(const sSectionName: string; var Section: TImageSectionHeader);
var
  x: Word;
begin
  FillChar(Section.Name, SizeOf(Section.Name), #0);
  for x := 0 to Length(sSectionName) -1 do
  if (x < IMAGE_SIZEOF_SHORT_NAME) then
  Section.Name[x] := Ord(sSectionName[x +1]);
end;

function TPeFile.ValidHeaders: Boolean;
begin
  Result := False;
  if (ImageDosHeader^.e_magic = IMAGE_DOS_SIGNATURE) then
  if (ImageNtHeaders^.Signature = IMAGE_NT_SIGNATURE) then
  Result := True;
end;

function TPeFile.ReadPeHeaders: Boolean;
var
  x: Word;
begin
  Result := False;
  ImageDosHeader := PImageDosHeader(Integer(lpBuffer));
  if (ImageDosHeader^.e_magic = IMAGE_DOS_SIGNATURE) then
  begin
  ImageNtHeaders := PImageNtHeaders(Integer(lpBuffer) + ImageDosHeader._lfanew);
  if (ImageNtHeaders^.Signature = IMAGE_NT_SIGNATURE) then
  begin
  FNumberOfSections := ImageNtHeaders^.FileHeader.NumberOfSections;
  FAddressOfEntryPoint := ImageNtHeaders^.OptionalHeader.AddressOfEntryPoint;
  FImageBase := ImageNtHeaders^.OptionalHeader.ImageBase;
  FFileAlign := ImageNtHeaders^.OptionalHeader.FileAlignment;
  FSectionAlign := ImageNtHeaders^.OptionalHeader.SectionAlignment;
  SetLength(ImageSections, NumberOfSections);
  for x := Low(ImageSections) to High(ImageSections) do
  begin
  CopyMemory(@ImageSections[x],
  Pointer(Integer(lpBuffer) + ImageDosHeader^._lfanew + SizeOf(TImageNtHeaders) + (x * SizeOf(TImageSectionHeader))),
  SizeOf(TImageSectionHeader));
  end;
  Result := True;
  end;
  end;
end;

function TPeFile.LoadFromFile(const sFilename: string): Boolean;
var
  hFile: THandle;
  lpNumberOfBytesRead: DWORD;
begin
  Result := False;
  hFile := CreateFile(PChar(sFilename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if (hFile <> INVALID_HANDLE_VALUE) then
  begin
  FFilename := sFilename;
  FFileSize := GetFileSize(hFile, nil);
  GetMem(lpBuffer, FileSize);
  ReadFile(hFile, lpBuffer^, FileSize, lpNumberOfBytesRead, nil);
  if (FileSize = lpNumberOfBytesRead) then
  begin
  Result := ReadPeHeaders;
  end;
  CloseHandle(hFile);
  end;
end;

function TPeFile.SaveToFile(const sFilename: string): Boolean;
var
  hFile: THandle;
  lpNumberOfBytesWritten,
  dwTemp: DWORD;
  x: Word;
  bZeroAll: Boolean;
begin
  Result := False;
  bZeroAll := True;
  hFile := CreateFile(PChar(sFilename), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);
  if (hFile <> INVALID_HANDLE_VALUE) then
  begin
  if ValidHeaders then
  begin
  CopyMemory(lpBuffer, ImageDosHeader, SizeOf(TImageDosHeader));
  CopyMemory(Pointer(Integer(lpBuffer) + ImageDosHeader._lfanew), ImageNtHeaders, SizeOf(TImageNtHeaders));
  // zuerst prüfen wir mittels dieser kleinen funktion, ob wir irgendwelche
  // brauchbaren daten in den headern haben, falls ja werden diese nicht entfernt,
  dwTemp := ImageDosHeader._lfanew + SizeOf(TImageNtHeaders) + (FNumberOfSections * SizeOf(TImageSectionHeader));
  for x := 0 to IMAGE_NUMBEROF_DIRECTORY_ENTRIES -1 do
  begin
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress <> 0) then
  begin
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress < ImageNtHeaders^.OptionalHeader.SizeOfHeaders) then
  begin
  bZeroAll := False;
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress > dwTemp) then
  begin
  dwTemp := ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress - dwTemp;
  ZeroMemory(Pointer(Integer(lpBuffer) + ImageDosHeader._lfanew + SizeOf(TImageNtHeaders) + (FNumberOfSections * SizeOf(TImageSectionHeader))), dwTemp);
  end else
  bZeroAll := False;
  end;
  end;
  end;
  if (bZeroAll) then
  begin
  dwTemp := ImageDosHeader._lfanew + SizeOf(TImageNtHeaders);
  ZeroMemory(Pointer(Integer(lpBuffer) + ImageDosHeader._lfanew + SizeOf(TImageNtHeaders)), ImageSections[Low(ImageSections)].PointerToRawData - dwTemp);
  end;
  ZeroMemory(Pointer(Integer(lpBuffer) + ImageDosHeader._lfanew + SizeOf(TImageNtHeaders)), FNumberOfSections * SizeOf(TImageSectionHeader));
  CopyMemory(Pointer(Integer(lpBuffer) + ImageDosHeader._lfanew + SizeOf(TImageNtHeaders)), ImageSections, FNumberOfSections * SizeOf(TImageSectionHeader));
  SetFilePointer(hFile, 0, nil, FILE_BEGIN);
  WriteFile(hFile, lpBuffer^, FileSize, lpNumberOfBytesWritten, nil);
  if (FileSize = lpNumberOfBytesWritten) then
  begin
  Result := True;
  end;
  end;
  CloseHandle(hFile);
  end;
end;

procedure TPeFile.SetAddressOfEntryPoint(AddressOfEntryPoint: Cardinal);
begin
  ImageNtHeaders^.OptionalHeader.AddressOfEntryPoint := AddressOfEntryPoint;
  FAddressOfEntryPoint := AddressOfEntryPoint;
end;

procedure TPeFile.SetImageBase(ImageBase: Cardinal);
begin
  ImageNtHeaders^.OptionalHeader.ImageBase := ImageBase;
  FImageBase := ImageBase;
end;

function TPeFile.RvaToFileOffset(dwRVA: Cardinal): Cardinal;
var
  x: Word;
begin
  Result := 0;
  for x := Low(ImageSections) to High(ImageSections) do
  begin
  if ((dwRVA >= ImageSections[x].VirtualAddress) and (dwRVA < ImageSections[x].VirtualAddress + ImageSections[x].SizeOfRawData)) then
  begin
  Result := dwRVA - ImageSections[x].VirtualAddress + ImageSections[x].PointerToRawData;
  Break;
  end;
  end;
end;

function TPeFile.FileOffsetToRva(dwFileOffset: Cardinal): Cardinal;
var
  x: Word;
begin
  Result := 0;
  for x := Low(ImageSections) to High(ImageSections) do
  begin
  if ((dwFileOffset >= ImageSections[x].PointerToRawData) and (dwFileOffset < ImageSections[x].PointerToRawData + ImageSections[x].SizeOfRawData)) then
  begin
  Result := dwFileOffset - ImageSections[x].PointerToRawData + ImageSections[x].VirtualAddress;
  Break;
  end;
  end;
end;

function TPeFile.VaToFileOffset(dwVA: Cardinal): Cardinal;
begin
  if (dwVA > Cardinal(lpBuffer)) then
  Result := RvaToFileOffset(dwVA - Cardinal(lpBuffer))
  else
  Result := 0;
end;

function TPeFile.FileOffsetToVa(dwFileOffset: Cardinal): Cardinal;
begin
  Result := FileOffsetToRva(dwFileOffset) + Cardinal(lpBuffer);
end;

function TPeFile.VaToRva(dwVA: Cardinal): Cardinal;
begin
  Result := dwVA - Cardinal(lpBuffer);
end;

function TPeFile.RvaToVa(dwRVA: Cardinal): Cardinal;
begin
  Result := RvaToFileOffset(dwRVA) + Cardinal(lpBuffer);
end;

function TPeFile.RvaToSection(dwRVA: Cardinal): Word;
var
  x: Word;
begin
  Result := High(Word);
  for x := Low(ImageSections) to High(ImageSections) do
  begin
  if ((dwRVA >= ImageSections[x].VirtualAddress) and (dwRVA < ImageSections[x].VirtualAddress + ImageSections[x].SizeOfRawData)) then
  begin
  Result := x;
  Break;
  end;
  end;
end;

function TPeFile.FileOffsetToSection(dwFileOffset: Cardinal): Word;
var
  x: Word;
begin
  Result := High(Word);
  for x := Low(ImageSections) to High(ImageSections) do
  begin
  if ((dwFileOffset >= ImageSections[x].PointerToRawData) and (dwFileOffset < ImageSections[x].PointerToRawData + ImageSections[x].SizeOfRawData)) then
  begin
  Result := x;
  Break;
  end;
  end;
end;

{
  Achtung: Rückgabewert ist 0 falls man die Headers verändert, bzw. diese
  ungültig gemacht werden!
}
function TPeFile.InsertBytes(FromOffset, Count: Cardinal): Cardinal;
var
  dwCopyFrom, dwCopyLength: Cardinal;
  lpTemp: Pointer;
begin
  Result := 0;
  if (FromOffset > FFileSize) then
  dwCopyFrom := FFileSize
  else
  dwCopyFrom := FromOffset;
  dwCopyLength := FFileSize - dwCopyFrom;
  ReallocMem(lpBuffer, FFileSize + Count);
  if (dwCopyLength > 0) then
  begin
  GetMem(lpTemp, dwCopyLength);
  CopyMemory(lpTemp, Pointer(Cardinal(lpBuffer) + dwCopyFrom), dwCopyLength);
  CopyMemory(Pointer(Cardinal(lpBuffer) + dwCopyFrom + Count), lpTemp, dwCopyLength);
  FreeMem(lpTemp);
  end;
  ZeroMemory(Pointer(Cardinal(lpBuffer) + dwCopyFrom), Count);
  if ReadPeHeaders then
  begin
  FFileSize := FFileSize + Count;
  Result := FFileSize;
  end;
end;

{
  Achtung: Rückgabewert ist 0 falls man die Headers verändert, bzw. diese
  ungültig gemacht werden!
}
function TPeFile.DeleteBytes(FromOffset, Count: Cardinal): Cardinal;
var
  dwCopyFrom, dwCopyLength: DWORD;
  lpTemp: Pointer;
begin
  Result := 0;
  if (FFileSize >= (FromOffset + Count)) then
  begin
  dwCopyFrom := FromOffset + Count;
  dwCopyLength := FFileSize - dwCopyFrom;
  if (dwCopyLength > 0) then
  begin
  GetMem(lpTemp, dwCopyLength);
  CopyMemory(lpTemp, Pointer(Cardinal(lpBuffer) + dwCopyFrom), dwCopyLength);
  CopyMemory(Pointer(Cardinal(lpBuffer) + FromOffset), lpTemp, dwCopyLength);
  FreeMem(lpTemp);
  end;
  ReallocMem(lpBuffer, FFileSize - Count);
  if ReadPeHeaders then
  begin
  FFileSize := FFileSize - Count;
  Result := FFileSize;
  end;
  end;
end;

{
  Sucht nach 0 Bytes ab einem bestimmten Offset. Dabei werden 4 bytes
  ignoriert weil diese z.B. zum Code gehören können.
}
function TPeFile.FindCodeCaves(FromOffset, Count: Cardinal): TCodeCave;
var
  x, TempCave: Cardinal;
const
  IGNORE_BYTES = 4;
begin
  ZeroMemory(@Result, SizeOf(TCodeCave));
  if (Count > 0) then
  begin
  TempCave := 0;
  for x := 0 to Count do
  begin
  if (PByte(Cardinal(lpBuffer) + FromOffset + x)^ = 0) then
  Inc(TempCave)
  else
  TempCave := 0;
  if ((TempCave > Result.CaveSize) and (TempCave > IGNORE_BYTES)) then
  begin
  with Result do
  begin
  StartFileOffset := FromOffset + (x - TempCave) + IGNORE_BYTES;
  StartRVA := FileOffsetToRva(StartFileOffset);
  CaveSize := TempCave - IGNORE_BYTES;
  end;
  end;
  end;
  end;
end;

{
  Dieser Code war ursprünglich um die 200 Zeilen. Warum? Ich habe alles
  'per Hand' berechnet, war jedoch nicht nötig. :(
}
function TPeFile.AddSection(const sSectionName: string; VirtualSize: Cardinal; dwCharacteristics: Cardinal = IMAGE_SCN_MEM_WRITE or IMAGE_SCN_MEM_READ or IMAGE_SCN_MEM_EXECUTE or IMAGE_SCN_CNT_CODE): Boolean;
var
  Section, LastSection: TImageSectionHeader;
  CodeCave: TCodeCave;
  dwTemp, FileAlign: Cardinal;
  x: Word;
  lpDataDir: Pointer;
begin
  FileAlign := ImageNtHeaders^.OptionalHeader.FileAlignment;
  dwTemp := ImageDosHeader._lfanew + SizeOf(TImageNtHeaders) + (FNumberOfSections * SizeOf(TImageSectionHeader));
  for x := 0 to IMAGE_NUMBEROF_DIRECTORY_ENTRIES -1 do
  begin
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress <> 0) then
  begin
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress < ImageNtHeaders^.OptionalHeader.SizeOfHeaders) then
  begin
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress = dwTemp) then
  begin
  // wir verschieben die daten die unter den sektionen(!) sind, einfach in einer neuen sektion!!!
  GetMem(lpDataDir, ImageNtHeaders^.OptionalHeader.DataDirectory[x].Size);
  CopyMemory(lpDataDir, Pointer(Cardinal(lpBuffer) + dwTemp), ImageNtHeaders^.OptionalHeader.DataDirectory[x].Size);
  ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress := 0;
  AddSection('.bdata', ImageNtHeaders^.OptionalHeader.DataDirectory[x].Size);
  CopyMemory(Pointer(Cardinal(lpBuffer) + ImageSections[High(ImageSections)].PointerToRawData), lpDataDir,
  ImageNtHeaders^.OptionalHeader.DataDirectory[x].Size);
  ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress := ImageSections[High(ImageSections)].VirtualAddress;
  FreeMem(lpDataDir);
  end;
  end;
  end;
  end;
  if (ImageNtHeaders^.OptionalHeader.SizeOfHeaders > dwTemp) then
  CodeCave := FindCodeCaves(dwTemp, ImageNtHeaders^.OptionalHeader.SizeOfHeaders - dwTemp)
  else
  CodeCave := FindCodeCaves(dwTemp, dwTemp - ImageNtHeaders^.OptionalHeader.SizeOfHeaders);
  if (CodeCave.CaveSize < SizeOf(TImageSectionHeader)) then
  begin
  dwTemp := ImageDosHeader._lfanew + SizeOf(TImageNtHeaders) + (FNumberOfSections * SizeOf(TImageSectionHeader));
  // wir fügen einmal FileAlign-bytes ein dann ist mal ruhe für die nächsten 13 sektionen ..
  if (FileAlign <= SizeOf(TImageSectionHeader)) then
  FileAlign := Align(SizeOf(TImageSectionHeader), FileAlign);
  if (InsertBytes(dwTemp, FileAlign) <> 0) then
  begin
  ImageNtHeaders^.OptionalHeader.SizeOfHeaders := ImageNtHeaders^.OptionalHeader.SizeOfHeaders + FileAlign;
  for x := Low(ImageSections) to High(ImageSections) do
  ImageSections[x].PointerToRawData := ImageSections[x].PointerToRawData + FileAlign;
  CopyMemory(Pointer(Integer(lpBuffer) + ImageDosHeader._lfanew + SizeOf(TImageNtHeaders)),
  ImageSections, FNumberOfSections * SizeOf(TImageSectionHeader));
  end;
  FileAlign := ImageNtHeaders^.OptionalHeader.FileAlignment;
  end;
  LastSection := ImageSections[High(ImageSections)];
  StringToSection(sSectionName, Section);
  with Section do
  begin
  VirtualAddress := ImageNtHeaders^.OptionalHeader.SizeOfImage;
  Misc.VirtualSize := Align(VirtualSize, SectionAlign);
  SizeOfRawData := (VirtualAddress div FileAlign +1) * FileAlign - ImageNtHeaders^.OptionalHeader.SizeOfImage;
  PointerToRawData := LastSection.PointerToRawData + LastSection.SizeOfRawData;
  Characteristics := dwCharacteristics;
  end;
  // ok struktur wurde eingelesen
  Inc(ImageNtHeaders^.FileHeader.NumberOfSections);
  FFileSize := FFileSize + Section.SizeOfRawData;
  ImageNtHeaders^.OptionalHeader.SizeOfImage := Align(ImageNtHeaders^.OptionalHeader.SizeOfImage + Section.Misc.VirtualSize, SectionAlign);
  CopyMemory(Pointer(Integer(lpBuffer) + ImageDosHeader._lfanew + SizeOf(TImageNtHeaders) +
  (FNumberOfSections * SizeOf(TImageSectionHeader))), @Section, SizeOf(TImageSectionHeader));
  ReallocMem(lpBuffer, FFileSize);
  Result := ReadPeHeaders;
  ZeroMemory(Pointer(Cardinal(lpBuffer) + FFileSize - Section.SizeOfRawData), Section.SizeOfRawData);
end;

function TPeFile.DeleteSection(wSection: Word): Boolean;
var
  dwTempFileSize, ImageSize, dwTemp,
  SectionOffset, SectionSize, SectionAlign: Cardinal;
  x: Word;
begin
  Result := False;
  if (wSection < FNumberOfSections) then
  begin
  SectionOffset := ImageSections[wSection].PointerToRawData;
  SectionSize := ImageSections[wSection].SizeOfRawData;
  SectionAlign := ImageNtHeaders^.OptionalHeader.SectionAlignment;
  dwTempFileSize := FFileSize;
  DeleteBytes(SectionOffset, SectionSize);
  if (FFileSize = dwTempFileSize - SectionSize) then
  begin
  if (wSection > 0) then
  begin
  for x := Low(ImageSections) to wSection -1 do
  begin
  ImageSections[x].Misc.VirtualSize := Align(ImageSections[x].Misc.VirtualSize, SectionAlign);
  if (x = wSection -1) then
  ImageSections[x].Misc.VirtualSize := Align(ImageSections[x].Misc.VirtualSize + SectionAlign, SectionAlign);
  CopyMemory(
  Pointer(Integer(lpBuffer) + ImageDosHeader^._lfanew + SizeOf(TImageNtHeaders) + (x * SizeOf(TImageSectionHeader))),
  @ImageSections[x],
  SizeOf(TImageSectionHeader));
  end;
  end;
  for x := wSection +1 to FNumberOfSections -1 do
  begin
  ImageSections[x].PointerToRawData := ImageSections[x].PointerToRawData - SectionSize;
  CopyMemory(
  Pointer(Integer(lpBuffer) + ImageDosHeader^._lfanew + SizeOf(TImageNtHeaders) + ((x -1) * SizeOf(TImageSectionHeader))),
  @ImageSections[x],
  SizeOf(TImageSectionHeader));
  end;
  for x := 0 to IMAGE_NUMBEROF_DIRECTORY_ENTRIES -1 do
  begin
  if ((ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress <> 0) and (ImageNtHeaders^.OptionalHeader.DataDirectory[x].Size <> 0)) then
  begin
  dwTemp := RvaToFileOffset(ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress);
  if (dwTemp = 0) then
  dwTemp := ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress;
  if (dwTemp = SectionOffset) then
  begin
  ImageNtHeaders^.OptionalHeader.DataDirectory[x].VirtualAddress := 0;
  ImageNtHeaders^.OptionalHeader.DataDirectory[x].Size := 0;
  end;
  end;
  end;
  if (ImageNtHeaders^.OptionalHeader.SizeOfHeaders mod SectionAlign = 0) then
  ImageSize := ImageNtHeaders^.OptionalHeader.SizeOfHeaders
  else
  ImageSize := Align(ImageNtHeaders^.OptionalHeader.SizeOfHeaders, SectionAlign);
  for x := Low(ImageSections) to High(ImageSections) do
  begin
  if (x <> wSection) then
  ImageSize := ImageSize + Align(ImageSections[x].Misc.VirtualSize, SectionAlign);
  end;
  ImageNtHeaders^.OptionalHeader.SizeOfImage := ImageSize;
  Dec(ImageNtHeaders^.FileHeader.NumberOfSections);
  Dec(FNumberOfSections);
  Result := ReadPeHeaders;
  end;
  end;
end;

function TPeFile.GetCharacteristics(dwCharacteristics: DWORD): string;
type
  TCharacteristics = packed record
  Mask: DWORD;
  InfoChar: Char;
  end;
const
  Info: array[0..8] of TCharacteristics = (
  (Mask: IMAGE_SCN_CNT_CODE; InfoChar: 'C'),
  (Mask: IMAGE_SCN_MEM_EXECUTE; InfoChar: 'E'),
  (Mask: IMAGE_SCN_MEM_READ; InfoChar: 'R'),
  (Mask: IMAGE_SCN_MEM_WRITE; InfoChar: 'W'),
  (Mask: IMAGE_SCN_MEM_NOT_PAGED; InfoChar: 'P'),
  (Mask: IMAGE_SCN_CNT_INITIALIZED_DATA; InfoChar: 'I'),
  (Mask: IMAGE_SCN_CNT_UNINITIALIZED_DATA; InfoChar: 'U'),
  (Mask: IMAGE_SCN_MEM_SHARED; InfoChar: 'S'),
  (Mask: IMAGE_SCN_MEM_DISCARDABLE; InfoChar: 'D'));
var
  x: Word;
begin
  for x := Low(Info) to High(Info) do
  begin
  if ((dwCharacteristics and Info[x].Mask) = Info[x].Mask) then
  Result := Result + Info[x].InfoChar;
  end;
end;

function TPeFile.GetCodeSection: Word;
begin
  Result := RvaToSection(ImageNtHeaders^.OptionalHeader.BaseOfCode);
end;

function TPeFile.GetDataSection: Word;
begin
  Result := RvaToSection(ImageNtHeaders^.OptionalHeader.BaseOfData);
end;

function TPeFile.GetResourceSection: Word;
var
  dwTemp: Cardinal;
begin
  Result := High(Word);
  dwTemp := ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress;
  if (dwTemp <> 0) then
  Result := RvaToSection(dwTemp);
end;

procedure TPeFile.GetImportAddressTable(var Imports: TImportsArray);
var
  x, y: Cardinal;
  ImportDescriptor: PImageImportDescriptor;
  DelayDescriptor: PImgDelayDescr;
  BoundImportDescriptor: PImageBoundImportDescriptor;
  lpszLibraryName: PChar;
  ImageThunk: PImageThunkData;
  lpszAPIName: PChar;
  { Is Import By Ordinal? }
  function IsImportByOrdinal(ImportDescriptor: DWORD): Boolean;
  begin
  Result := (ImportDescriptor and $80000000) <> 0;
  end;
begin
  x := 0;
  SetLength(Imports, 1);
  ZeroMemory(Imports, SizeOf(Imports) * High(Imports));
  // NORMALE IAT
  ImportDescriptor := PImageImportDescriptor(RvaToVa(ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress));
  while (ImportDescriptor^.Name <> 0) do
  begin
  SetLength(Imports, x +1);
  lpszLibraryName := PChar(RvaToVa(ImportDescriptor^.Name));
  Imports[x].LibraryName := lpszLibraryName;
  Imports[x].ImportType := itNormal;
  Imports[x].OriginalFirstThunk := ImportDescriptor^.OriginalFirstThunk;
  Imports[x].TimeDateStamp := ImportDescriptor^.TimeDateStamp;
  Imports[x].ForwarderChain := ImportDescriptor^.ForwarderChain;
  Imports[x].Name := ImportDescriptor^.Name;
  Imports[x].FirstThunk := ImportDescriptor^.FirstThunk;
  if (ImportDescriptor^.OriginalFirstThunk <> 0) then
  ImageThunk := PImageThunkData(RvaToVa(ImportDescriptor^.OriginalFirstThunk))
  else
  ImageThunk := PImageThunkData(RvaToVa(ImportDescriptor^.FirstThunk));
  y := 0;
  while (ImageThunk^.Name <> 0) do
  begin
  SetLength(Imports[x].IatFunctions, y +1);
  if IsImportByOrdinal(ImageThunk^.Name) then
  begin
  lpszAPIName := '(by ordinal)';
  Imports[x].IatFunctions[y].Hint := ImageThunk^.Name and $ffff;
  end else
  begin
  lpszAPIName := PChar(RvaToVa(ImageThunk^.Name + SizeOf(Word)));
  Imports[x].IatFunctions[y].Hint := 0;
  end;
  Imports[x].IatFunctions[y].ThunkOffset := Cardinal(ImageThunk) - Cardinal(lpBuffer);
  if (ImportDescriptor^.OriginalFirstThunk <> 0) then
  Imports[x].IatFunctions[y].ThunkRVA := ImportDescriptor^.OriginalFirstThunk + DWORD(y * SizeOf(DWORD))
  else
  Imports[x].IatFunctions[y].ThunkRVA := ImportDescriptor^.FirstThunk + DWORD(y * SizeOf(DWORD));
  Imports[x].IatFunctions[y].ThunkValue := ImageThunk^.Name;
  Imports[x].IatFunctions[y].ApiName := lpszAPIName;
  Inc(y);
  Inc(ImageThunk);
  end;
  Inc(x);
  Inc(ImportDescriptor);
  end;
  // DELAYED IAT
  DelayDescriptor := PImgDelayDescr(RvaToVa(ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT].VirtualAddress));
  while (DelayDescriptor^.szName <> 0) do
  begin
  SetLength(Imports, x +1);
  lpszLibraryName := PChar(RvaToVa(DelayDescriptor^.szName));
  Imports[x].LibraryName := lpszLibraryName;
  Imports[x].OriginalFirstThunk := DelayDescriptor^.pINT.Name;
  Imports[x].ImportType := itDelay;
  Imports[x].TimeDateStamp := DelayDescriptor^.dwTimeStamp;
  Imports[x].FirstThunk := PImageImportDescriptor(DelayDescriptor)^.FirstThunk;
  ImageThunk := PImageThunkData(RvaToVa(DelayDescriptor^.pINT.Name));
  y := 0;
  while (ImageThunk^.Name <> 0) do
  begin
  SetLength(Imports[x].IatFunctions, y +1);
  if IsImportByOrdinal(ImageThunk^.Name) then
  begin
  lpszAPIName := '(by ordinal)';
  Imports[x].IatFunctions[y].Hint := ImageThunk^.Name and $ffff;
  end else
  begin
  lpszAPIName := PChar(RvaToVa(ImageThunk^.Name + SizeOf(Word)));
  Imports[x].IatFunctions[y].Hint := 0;
  end;
  Imports[x].IatFunctions[y].ThunkOffset := Cardinal(ImageThunk) - Cardinal(lpBuffer);
  Imports[x].IatFunctions[y].ThunkRVA := DelayDescriptor^.pINT.Name + DWORD(y * SizeOf(DWORD));
  Imports[x].IatFunctions[y].ThunkValue := ImageThunk^.Name;
  Imports[x].IatFunctions[y].ApiName := lpszAPIName;
  Inc(y);
  Inc(ImageThunk);
  end;
  Inc(x);
  Inc(DelayDescriptor);
  end;
  // BOUND IAT
  BoundImportDescriptor := PImageBoundImportDescriptor(Cardinal(lpBuffer) + ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT].VirtualAddress);
  while (BoundImportDescriptor^.OffsetModuleName <> 0) do
  begin
  SetLength(Imports, x +1);
  lpszLibraryName := PChar(Integer(lpBuffer) + ImageDosHeader^._lfanew + SizeOf(TImageNtHeaders) + (FNumberOfSections * SizeOf(TImageSectionHeader)) + BoundImportDescriptor^.OffsetModuleName);
  Imports[x].TimeDateStamp := BoundImportDescriptor.TimeDateStamp;
  Imports[x].LibraryName := lpszLibraryName;
  Imports[x].ImportType := itBound;
  Imports[x].Name := BoundImportDescriptor^.OffsetModuleName;
  if (BoundImportDescriptor^.NumberOfModuleForwarderRefs > 0) then
  begin
  for y := 0 to BoundImportDescriptor^.NumberOfModuleForwarderRefs -1 do
  begin
  Inc(PImageBoundForwarderRef(BoundImportDescriptor));
  end;
  end;
  Inc(x);
  Inc(BoundImportDescriptor);
  end;
  // ToDo: COM IAT
end;

procedure TPeFile.GetExportsAddressTable(var ExportData: TExports);
type
  PDWORDArray = ^TDWORDArray;
  TDWORDArray = array[Word] of DWORD;
  PWordArray = ^TWordArray;
  TWordArray = array[Word] of Word;
var
  ExportDirectory: PImageExportDirectory;
  Functions: PDWORDArray;
  Ordinals: PWordArray;
  Names: PDWORDArray;
  CounterFunctions, CounterOrdinals: DWORD;
  VA: DWORD;
  sName: string;
  x: Integer;
begin
  SetLength(ExportData.ExportFunctions, 1);
  if ((ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress <> 0) and
  (ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].Size <> 0)) then
  begin
  ExportDirectory := PImageExportDirectory(RvaToVa(ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress));
  Functions := Pointer(RvaToVa(Cardinal(ExportDirectory^.AddressOfFunctions)));
  Ordinals := Pointer(RvaToVa(Cardinal(ExportDirectory^.AddressOfNameOrdinals)));
  Names := Pointer(RvaToVa(Cardinal(ExportDirectory^.AddressOfNames)));
  with ExportData do
  begin
  LibraryName := PChar(RvaToVa(ExportDirectory^.Name));
  Base := ExportDirectory^.Base;
  Characteristics := ExportDirectory^.Characteristics;
  TimeDateStamp := ExportDirectory^.TimeDateStamp;
  MajorVersion := ExportDirectory^.MajorVersion;
  MinorVersion := ExportDirectory^.MinorVersion;
  NumberOfFunctions := ExportDirectory^.NumberOfFunctions;
  NumberOfNames := ExportDirectory^.NumberOfNames;
  AddressOfFunctions := DWORD(ExportDirectory^.AddressOfFunctions);
  AddressOfNames := DWORD(ExportDirectory^.AddressOfNames);
  AddressOfNameOrdinals := Word(ExportDirectory^.AddressOfNameOrdinals);
  end;
  if (Functions <> nil) then
  begin
  x := 0;
  for CounterFunctions := 0 to ExportDirectory^.NumberOfFunctions -1 do
  begin
  sName := '';
  if (Functions[CounterFunctions] = 0) then
  continue;
  SetLength(ExportData.ExportFunctions, x +1);
  ExportData.ExportFunctions[x].Ordinal := CounterFunctions + ExportDirectory^.Base;
  if (Ordinals <> nil) and (Names <> nil) then
  begin
  for CounterOrdinals := 0 to ExportDirectory^.NumberOfNames -1 do
  begin
  if (Ordinals[CounterOrdinals] = CounterFunctions) then
  begin
  sName := PChar(RvaToVa(Names[CounterOrdinals]));
  Break;
  end;
  end;
  end;
  VA := Functions[CounterFunctions];
  if DWORD(VA - ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress) <
  ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].Size then
  begin
  sName := PChar(RvaToVa(Va));
  VA := 0;
  end;
  ExportData.ExportFunctions[x].Rva := VA;
  ExportData.ExportFunctions[x].FileOffset := RvaToFileOffset(VA);
  ExportData.ExportFunctions[x].ApiName := sName;
  Inc(x);
  end;
  end;
  end;
end;

function TPeFile.GetThreadLocalStorage: PImageTLSDirectory;
begin
  Result := nil;
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].VirtualAddress <> 0) then
  begin
  Result := PImageTLSDirectory(RvaToVa(ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_TLS].VirtualAddress));
  end;
end;

{
  Resourcen sind einwenig blöd aufgebaut, aber anhand der Count-Variable in jedem
  Block braucht man kein High mehr benützen ..
}
procedure TPeFile.GetResources(var Resources: TResources);
var
  Table: PImageResourceDirectory;
  VA: DWORD;
  TypCount, NameCountPublic: Integer;

  function WideCharToMultiByteEx(var lp: PWideChar): string;
  var
  len: Word;
  begin
  len := Word(lp^);
  SetLength(Result, len);
  Inc(lp);
  WideCharToMultiByte(CP_ACP, 0, lp, Len, PChar(Result), Len +1, nil, nil);
  Inc(lp, len);
  Result := PChar(Result);
  end;
  
  function GetResourceStr(IsResID: Boolean; IsType: Boolean; Addr: DWORD): string;
  var
  lpTmp: PWideChar;
  x: Word;
  begin
  if IsResID then
  begin
  if IsType then
  begin
  for x := 0 to Length(ResourceTypeDefaultNames) -1 do
  begin
  if (MAKEINTRESOURCE(Addr) = MAKEINTRESOURCE(ResourceTypeDefaultNames[x].ResType)) then
  begin
  Result := ResourceTypeDefaultNames[x].ResTypeName;
  Exit;
  end;
  end;
  end;
  Str(Addr, Result);
  end else
  begin
  lpTmp := PWideChar(RvaToVa(VA + (Addr and $7fffffff)));
  Result := WideCharToMultiByteEx(lpTmp);
  end;
  end;

  procedure ParseResources(Offset: DWORD; Level: Byte);
  var
  Table: PImageResourceDirectory;
  Entry: PImageResourceDirectoryEntry;
  i, Count: Integer;
  IsResID: Boolean;
  NameCount, LangsCount: Integer;
  lpTyp, lpName, lpLang: string;
  begin
  NameCount := 0;
  LangsCount := 0;
  Table := Pointer(RvaToVa(VA + Offset));
  Count := Table^.NumberOfNamedEntries + Table^.NumberOfIdEntries;
  Entry := Pointer(RvaToVa(VA + Offset + SizeOf(TImageResourceDirectory)));
  for i := 0 to Count -1 do
  begin
  IsResID := i >= Table^.NumberOfNamedEntries;
  case Level of
  0:
  begin
  // Typen
  NameCountPublic := 0;
  lpTyp := GetResourceStr(IsResId, True, Entry^.Name);
  SetLength(Resources.rtTyps, TypCount +1);
  Resources.rtTyps[TypCount].lpTyp := lpTyp;
  Inc(Resources.TypCount);
  Inc(TypCount);
  end;
  1:
  begin
  // Namen
  lpName := GetResourceStr(IsResId, False, Entry^.Name);
  SetLength(Resources.rtTyps[TypCount -1].Names, NameCount +1);
  Resources.rtTyps[TypCount -1].Names[NameCount].lpNames := lpName;
  Resources.rtTyps[TypCount -1].Names[NameCount].dwRVA := VA + (Entry^.OffsetToData and $7fffffff);
  Resources.rtTyps[TypCount -1].Names[NameCount].dwFileOffset := FileOffsetToRva(VA + (Entry^.OffsetToData and $7fffffff));
  Inc(Resources.rtTyps[TypCount -1].NamesCount);
  Inc(NameCount);
  Inc(NameCountPublic);
  end;
  2:
  begin
  // Langs
  lpLang := GetResourceStr(IsResId, False, Entry^.Name);
  SetLength(Resources.rtTyps[TypCount -1].Names[(NameCountPublic-1) + LangsCount].lpLangs, LangsCount +1);
  Resources.rtTyps[TypCount -1].Names[(NameCountPublic-1) + LangsCount].lpLangs[LangsCount].Lang := lpLang;
  Resources.rtTyps[TypCount -1].Names[(NameCountPublic-1) + LangsCount].lpLangs[LangsCount].dwRVA := VA + (Entry^.OffsetToData and $7fffffff);
  Resources.rtTyps[TypCount -1].Names[(NameCountPublic-1) + LangsCount].lpLangs[LangsCount].dwFileOffset := RvaToFileOffset(VA + (Entry^.OffsetToData and $7fffffff));
  Inc(Resources.rtTyps[TypCount -1].Names[(NameCountPublic-1) + LangsCount].LangsCount);
  Inc(LangsCount);
  end;
  end;
  if (Entry^.OffsetToData and $80000000) > 0 then
  ParseResources(Entry^.OffsetToData and $7fffffff, Level +1);
  Inc(Entry);
  end;
  end;
begin
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress <> 0) then
  begin
  TypCount := 0;
  VA := ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE].VirtualAddress;
  FillChar(Resources, SizeOf(TResources), #0);
  Table := Pointer(RvaToVa(VA));
  with Resources do
  begin
  Characteristics := Table^.Characteristics;
  TimeDateStamp := Table^.TimeDateStamp;
  MajorVersion := Table^.MajorVersion;
  MinorVersion := Table^.MinorVersion;
  NumberOfNamedEntries := Table^.NumberOfNamedEntries;
  NumberOfIdEntries := Table^.NumberOfIdEntries;
  end;
  ParseResources(0, 0);
  end;
end;

function TPeFile.GetDebugDirectory: PImageDebugDirectory;
begin
  Result := nil;
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DEBUG].VirtualAddress <> 0) then
  begin
  Result := PImageDebugDirectory(RvaToVa(ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DEBUG].VirtualAddress));
  end;
end;

function TPeFile.GetLoadConfigDirectory: PImageLoadConfigDirectory;
begin
  Result := nil;
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG].VirtualAddress <> 0) then
  begin
  Result := PImageLoadConfigDirectory(RvaToVa(ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_LOAD_CONFIG].VirtualAddress));
  end;
end;

function TPeFile.GetEntryExceptionDirectory: PImageRuntimeFunctionEntry;
begin
  Result := nil;
  if (ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXCEPTION].VirtualAddress <> 0) then
  begin
  Result := PImageRuntimeFunctionEntry(RvaToVa(ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXCEPTION].VirtualAddress));
  end;
end;

procedure TPeFile.CopyMemoryBuffer(CopyToOffset: DWORD; Source: Pointer; Length: DWORD);
begin
  CopyMemory(Pointer(Cardinal(lpBuffer) + CopyToOffset), Source, Length);
end;

end.

// Example of using PE File Unit
uses untPeFile;
...
procedure TForm1.FormCreate(Sender: TObject);
var
  PE: TPeFile;
  x: Word;
  Imports: TImportsArray;
const
  sSection = 'Name: %s' + #13#10 +
  'Sektion: %d/%d' + #13#10 +
  'Start der Sektion: %d' + #13#10 +
  'Größe der Sektion: %d';
  sImports = 'Bound Import Lib: %s';

begin
  PE := TPeFile.Create;
  // Datei Laden ..
  if PE.LoadFromFile('C:\WINDOWS\Notepad.exe') then
  begin
  // Alle Sektionen ausgeben
  for x := Low(PE.ImageSections) to High(PE.ImageSections) do
  ShowMessage(Format(sSection, [PE.SectionToString(PE.ImageSections[x]), x, PE.NumberOfSections -1, PE.ImageSections[x].PointerToRawData, PE.ImageSections[x].SizeOfRawData]));
  // Imports Auslesen
  PE.GetImportAddressTable(Imports);
  // Nur die Bound IAT ausgeben
  for x := Low(Imports) to High(Imports) do
  if Imports[x].ImportType = itBound then
  ShowMessage(Format(sImports, [Imports[x].LibraryName]));
  // Neue Sektion anlegen
  PE.AddSection('NewSec', $200);
  // Die angelegte Sektion wieder entfernen
  PE.DeleteSection(PE.NumberOfSections -1);
  // Speichern ...
  PE.SaveToFile('C:\NOTEPAD_TMP.exe');
  end;
  // Freigeben...
  PE.Free;
end;

0 评论:

发表评论