PE File Unit by 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;

    sLang: string;

  end;

  // Namen

  PResourceNames = ^TResourceNames;

  TResourceNames = packed record

    sName: string;

    dwRVA: DWORD;

    dwFileOffset: DWORD;

    lpLangs: array of TResourceLangs;

    LangsCount: Integer;

  end;

  // Typen

  PResourcesTyps = ^TResourceTyps;

  TResourceTyps = packed record

    sTyp: string;

    lpNames: 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 DumpSection(wSection: Word; sFilename: string): 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

  if ((ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress <> 0) and

      (ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size <> 0)) then

  begin

    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;

  end;

  // DELAYED IAT

  if ((ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT].VirtualAddress <> 0) and

      (ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DELAY_IMPORT].Size <> 0)) then

  begin

    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;

  end;

  // BOUND IAT

  if ((ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT].VirtualAddress <> 0) and

      (ImageNtHeaders^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BOUND_IMPORT].Size <> 0)) then

  begin

    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;

  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].sTyp := lpTyp;

            Inc(Resources.TypCount);

            Inc(TypCount);

          end;

        1:

          begin

            // Namen

            lpName := GetResourceStr(IsResId, False, Entry^.Name);

            SetLength(Resources.rtTyps[TypCount -1].lpNames, NameCount +1);

            Resources.rtTyps[TypCount -1].lpNames[NameCount].sName := lpName;

            Resources.rtTyps[TypCount -1].lpNames[NameCount].dwRVA := VA + (Entry^.OffsetToData and $7fffffff);

            Resources.rtTyps[TypCount -1].lpNames[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].lpNames[(NameCountPublic-1) + LangsCount].lpLangs, LangsCount +1);

            Resources.rtTyps[TypCount -1].lpNames[(NameCountPublic-1) + LangsCount].lpLangs[LangsCount].sLang := lpLang;

            Resources.rtTyps[TypCount -1].lpNames[(NameCountPublic-1) + LangsCount].lpLangs[LangsCount].dwRVA := VA + (Entry^.OffsetToData and $7fffffff);

            Resources.rtTyps[TypCount -1].lpNames[(NameCountPublic-1) + LangsCount].lpLangs[LangsCount].dwFileOffset := RvaToFileOffset(VA + (Entry^.OffsetToData and $7fffffff));

            Inc(Resources.rtTyps[TypCount -1].lpNames[(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;

function TPeFile.DumpSection(wSection: Word; sFilename: string): Boolean;

var

  hFile: THandle;

  lpNumberOfBytesWritten: DWORD;

  lpBuff: Pointer;

begin

  Result := False;

  if (wSection <> High(Word)) then

  begin

    hFile := CreateFile(PChar(sFilename), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, 0, 0);

    if (hFile <> INVALID_HANDLE_VALUE) then

    begin

      lpBuff := Pointer(Cardinal(lpBuffer) + ImageSections[wSection].PointerToRawData);

      WriteFile(hFile, lpBuff^, ImageSections[wSection].SizeOfRawData, lpNumberOfBytesWritten, nil);

      Result := lpNumberOfBytesWritten = ImageSections[wSection].SizeOfRawData;

      CloseHandle(hFile);

    end;

  end;

end;

end.