pe_files.pas

Executable cryptor/protector

    if ShowDebugMessages then DebugMessage(M_NOT_ENOUGHT_MEMORY);
    CloseHandle(hFile);
    FreeMem(Header);
    Exit;
  end;

  FillChar(pMap^, PE_Header.Image_Size, 0);
  Move(Header^, pMap^, PE_Header.Header_Size);
  FreeMem(Header);

  DOS_Header := pMap;
  PE_Header  := Pointer(DOS_Header.e_lfanew + DWord(pMap));

  PObject := Pointer(DWord(PE_Header) + SizeOf(T_PE_Header));
  for I := 1 to PE_Header.Number_Of_Object do begin    // Correct header size.
    if PE_Header.Header_Size > PObject.Section_RVA then
      PE_Header.Header_Size := PObject.Section_RVA;
    Inc(DWord(PObject), SizeOf(T_Object_Entry));
  end;

  GrabInfo;

  File_Size := GetFileSize(hFile, nil);
  if (PreserveOverlay = true) and (File_Size > Data_Size) then begin
    OverlaySize := File_Size - Data_Size;                  // Process overlay.
    GetMem(OverlayData, OverlaySize);
    if OverlayData = nil then begin
      LastError := E_NOT_ENOUGHT_MEMORY;
      if ShowDebugMessages then DebugMessage(M_NOT_ENOUGHT_MEMORY);
      CloseHandle(hFile);
      Exit;
    end;
    SetFilePointer(hFile, Data_Size, nil, FILE_BEGIN);
    ReadFile(hFile, OverlayData^, OverlaySize, Readed, nil);
  end;

  if PE_Header.Number_Of_Object = 0 then begin
    LastError := E_OK;
    CloseHandle(hFile);
    Exit;
  end;

  PObject := Pointer(DWord(PE_Header) + SizeOf(T_PE_Header));
  for I := 1 to PE_Header.Number_Of_Object do begin
    if (PObject.Physical_Offset = 0) and (PObject.Physical_Size <> 0) then
    begin
      { Correct header for ADA and Watcom C++ compiler's }
      PObject.Virtual_Size  := PObject.Physical_Size;
      PObject.Physical_Size := 0;
    end;
    if (PObject.Physical_Offset > 0) and (PObject.Physical_Size > 0) then begin
      SetFilePointer(hFile, PObject.Physical_Offset, nil, FILE_BEGIN);
      ReadFile(hFile, Pointer(DWord(pMap) + PObject.Section_RVA)^,
               PObject.Physical_Size, Readed, nil);
      if Readed <> PObject.Physical_Size then begin
        LastError := E_ERROR_READING;
        if ShowDebugMessages then DebugMessage(M_ERROR_READING + FileName);
        CloseHandle(hFile);
        Exit;
      end;
    end;
    Inc(DWord(PObject), SizeOf(T_Object_Entry));
  end;

  CloseHandle(hFile);
  LastError := E_OK;
end;

{ +===============================+ }
{ | Save mapped image of PE file. | }
{ +===============================+ }
procedure PE_File.SaveToFile(FileName: String);
var
  I       : DWord;
  hFile   : DWord;
  Written : DWord;
begin
  if (pMap = nil) or (not IsPEFile(pMap)) then begin
    LastError := E_INVALID_PE_FILE;
    if ShowDebugMessages then DebugMessage(M_INVALID_PE_FILE);
    Exit;
  end;

  hFile := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE,
                      FILE_SHARE_READ or FILE_SHARE_WRITE, nil,
                      CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  if hFile = INVALID_HANDLE_VALUE then begin
    LastError := E_CANT_OPEN_FILE;
    if ShowDebugMessages then DebugMessage(M_CANT_OPEN_FILE + FileName);
    Exit;
  end;

  File_Size := PE_Header.Header_Size;

  SetFilePointer(hFile, 0, nil, FILE_BEGIN);                 // Save header.
  if (not WriteFile(hFile, pMap^, PE_Header.Header_Size, Written, nil)) or
     (Written <> PE_Header.Header_Size) then
  begin
    LastError := E_ERROR_WRITING;
    if ShowDebugMessages then DebugMessage(M_ERROR_WRITING + FileName);
    CloseHandle(hFile);
    Exit;
  end;

  if PE_Header.Number_Of_Object > 0 then begin         // Save PE Sections.
    PObject := Pointer(DWord(PE_Header) + SizeOf(T_PE_Header));
    for I := 1 to PE_Header.Number_Of_Object do begin     // Copy Sections.
      if (not WriteFile(hFile, Pointer(DWord(pMap) + PObject.Section_RVA)^,
                        PObject.Physical_Size, Written, nil)) or
         (Written <> PObject.Physical_Size) then
      begin
        LastError := E_ERROR_WRITING;
        if ShowDebugMessages then DebugMessage(M_ERROR_WRITING + FileName);
        CloseHandle(hFile);
        Exit;
      end;
      Inc(File_Size, PObject.Physical_Size);
      Inc(DWord(PObject), SizeOf(T_Object_Entry));
    end;
  end;

  if (PreserveOverlay = true) and (OverlaySize > 0) then begin
    Inc(File_Size, OverlaySize);
    SetFilePointer(hFile, 0, nil, FILE_END);                  // Save overlay.
    WriteFile(hFile, OverlayData^, OverlaySize, Written, nil);
  end;

  CloseHandle(hFile);
  LastError := E_OK;
end;

{ +=========================================+ }
{ | Test is Offs aligned to AlignTo or not. | }
{ +=========================================+ }
function PE_File.IsAlignedTo(Offs, AlignTo: DWord): Boolean;
begin
  if (Offs mod AlignTo) = 0 then Result := true else Result := false;
end;

{ +===============================================================+ }
{ | Try to remove zero padding from block (Start - blocks offset; | }
{ | Size - size of block in bytes) and realign block to 200h.     | }
{ | Return new block size.                                        | }
{ +===============================================================+ }
function PE_File.AlignBlock(Start: Pointer; Size: DWord; AlignTo: DWord): DWord;
var
  P : ^Byte;
begin
  Result := 0;
  if Size = 0 then Exit;
  P := Pointer(DWord(Start) + Size - 1);       // Set pointer to end of block.
                                               // Find first non-zero byte.
  while (P^ = 0) and (DWord(P) > DWord(Start)) do Dec(DWord(P));
  if (DWord(P) = DWord(Start)) and (P^ = 0) then Exit;  // Block is empty.
                                                        // Find new alignment.
  while (not IsAlignedTo(DWord(P) - DWord(Start), AlignTo)) and
        (DWord(P) < (DWord(Start) + Size)) do Inc(DWord(P));

  Result := DWord(P) - DWord(Start);
end;

{ +======================================================+ }
{ |  Optimize position of PE header, clear junk from it  | }
{ |  and realign header to minimum safe alignment (200h) | }
{ +======================================================+ }
procedure PE_File.OptimizeHeader(WipeJunk: Boolean);
var
  AllObjSize : DWord;
  NewHdrSize : DWord;
  HdrSize, I : DWord;
  NewHdrOffs : ^Word;
begin
  if (pMap = nil) or (not IsPEFile(pMap)) then begin
    LastError := E_INVALID_PE_FILE;
    if ShowDebugMessages then DebugMessage(M_INVALID_PE_FILE);
    Exit;                                           // Not PE File - aborting.
  end;

  NewHdrOffs := Pointer(DWord(pMap) + $40);  // 40h - minimum posible offset.

  while ((NewHdrOffs^ <> 0) or               // Search new place for PE Header.
         (not IsAlignedTo(DWord(NewHdrOffs) - DWord(pMap), 16)) and
        (DWord(NewHdrOffs) < DWord(PE_Header)) ) do Inc(DWord(NewHdrOffs));

                                               // Save size of Object Table.
  AllObjSize := PE_Header.Number_Of_Object * SizeOf(T_Object_Entry);

  if (DWord(NewHdrOffs) - DWord(pMap)) < DOS_Header^.e_lfanew then
  begin                                             // Save new header offset.
    DOS_Header.e_lfanew := DWord(NewHdrOffs) - DWord(pMap);
                                                               // Copy header.
    Move(PE_Header^, NewHdrOffs^, SizeOf(T_PE_Header) + AllObjSize);
    PE_Header := Pointer(NewHdrOffs);

    if WipeJunk = false then                      // Clear junk after objects.
      FillChar(Pointer(DWord(NewHdrOffs) + SizeOf(T_PE_Header) + AllObjSize)^,
               DWord(PE_Header) - DWord(NewHdrOffs), 0);
  end;

  if WipeJunk = true then begin                    // Get actual header size.
    HdrSize := DOS_Header.e_lfanew + SizeOf(T_PE_Header) + AllObjSize;
                                                               // Clear junk.
    FillChar(Pointer(DWord(pMap) + HdrSize)^, PE_Header.Header_Size-HdrSize, 0);
    if (PE_Header.Bound_Import_RVA  <> 0) or
       (PE_Header.Bound_Import_Size <> 0) then
    begin                                  // Remove Bound Import descriptor.
      PE_Header.Bound_Import_RVA  := 0;
      PE_Header.Bound_Import_Size := 0;
    end;
  end;
                                                   // Calculata opimized size.
  NewHdrSize := AlignBlock(pMap, PE_Header.Header_Size, Minimum_File_Align);

  if NewHdrSize < PE_Header.Header_Size then begin
    if PE_Header.Number_Of_Object > 0 then begin
      PObject := Pointer(DWord(PE_Header) + SizeOf(T_PE_Header));
      for I := 1 to PE_Header.Number_Of_Object do begin    // Update offsets.
        Dec(PObject.Physical_Offset, PE_Header.Header_Size - NewHdrSize);
        Inc(DWord(PObject), SizeOf(T_Object_Entry));
      end;
    end;
    PE_Header.Header_Size := NewHdrSize;             // Save new header size.
  end;

  LastError := E_OK;
end;

{ +==============================================+ }
{ | Fill relocations of mapped PE File by zero.  | }
{ +==============================================+ }
procedure PE_File.FlushRelocs(ProcessDll: Boolean);
begin
  if (pMap = nil) or (not IsPEFile(pMap)) then begin
    LastError := E_INVALID_PE_FILE;
    if ShowDebugMessages then DebugMessage(M_INVALID_PE_FILE);
    Exit;                                           // Not PE File - aborting.
  end;

  LastError := E_OK;
  if (not ProcessDll) and (IsDLL = true) then Exit; // It's DLL - Skipping.

  if (PE_Header.Fix_Up_Table_RVA = 0) or
     (PE_Header.Fix_Up_Data_Size = 0) then Exit;  // No relocations.
                                                  // Fill relocations by zero.
  FillChar(Pointer(DWord(pMap) + PE_Header^.Fix_Up_Table_RVA)^,
           PE_Header^.Fix_Up_Data_Size, 0);

  PE_Header^.Fix_Up_Table_RVA := 0;                      // Update header.
  PE_Header^.Fix_Up_Data_Size := 0;
end;

{ +=======================================+ }
{ |  Realign mapped PE file to 0200h and  | }
{ |  remove empty sections.               | }
{ |  Procedure don't optimize header      | }
{ +=======================================+ }
procedure PE_File.OptimizeFileAlignment;
var
  OldSize  : DWord;
  NewSize  : DWord;
  LastOffs : DWord;
  I        : Integer;
begin
  if (pMap = nil) or (not IsPEFile(pMap)) then begin
    LastError := E_INVALID_PE_FILE;
    if ShowDebugMessages then DebugMessage(M_INVALID_PE_FILE);
    Exit;                                           // Not PE File - aborting.
  end;

  LastError := E_OK;

  PE_Header.File_Align := Minimum_File_Align;
  if PE_Header.Number_Of_Object = 0 then Exit;                // No sections.

  LastOffs := PE_Header.Header_Size;          // Maximum RAW offset.
                                              // Optimize sections alignment.
  PObject := Pointer(DWord(PE_Header) + SizeOf(T_PE_Header));
  for I := 1 to PE_Header.Number_Of_Object do begin
    if (PObject.Physical_Size > 0) and (PObject^.Physical_Offset >=  LastOffs)
    then begin
      OldSize := PObject.Physical_Size;
      NewSize := AlignBlock(Pointer(DWord(pMap) + PObject.Section_RVA),
                            PObject.Physical_Size, Minimum_File_Align);
      if NewSize < OldSize then PObject.Physical_Size := NewSize;
    end;
    PObject.Physical_Offset := LastOffs;      // Update sections RAW offset.
    Inc(LastOffs, PObject.Physical_Size);
    Inc(DWord(PObject), SizeOf(T_Object_Entry));
  end;
end;

{ +=====================================+ }
{ | Set internal file SheckSum to zero. | }
{ +=====================================+ }
procedure PE_File.FlushFileCheckSum;
begin
  PE_Header.File_CheckSum := 0;
end;

{ +===========================================+ }
{ | Optimize file image by all known methods. | }
{ +===========================================+ }
procedure PE_File.OptimizeFile(AlignHeader : Boolean;
                               WipeJunk    : Boolean;
                               KillRelocs  : Boolean;
                               KillInDll   : Boolean);
begin
  if (pMap = nil) or (not IsPEFile(pMap)) then begin
    LastError := E_INVALID_PE_FILE;
    if ShowDebugMessages then DebugMessage(M_INVALID_PE_FILE);
    Exit;                                           // Not PE File - aborting.
  end;

  if AlignHeader then begin
    OptimizeHeader(WipeJunk);
    if LastError <> E_OK then begin
      if ShowDebugMessages then DebugMessage(M_INVALID_PE_FILE);
      Exit;
    end;
  end;

  if KillRelocs then begin
    FlushRelocs(KillInDll);
    if LastError <> E_OK then begin
      if ShowDebugMessages then DebugMessage(M_INVALID_PE_FILE);
      Exit;
    end;
  end;

  OptimizeFileAlignment;
  if LastError <> E_OK then begin
    if ShowDebugMessages then DebugMessage(M_INVALID_PE_FILE);
    Exit;
  end;

  FlushFileCheckSum; 
end;

{ ########################################################################## }

begin
end.