mainunit.pas

Delphi版pe加壳程序

    while pThunk^ <> 0 do
    begin
      if pThunk^ and $80000000 = $80000000 then
      begin
        PDWORD(pName)^ := pThunk^ and $0FFFFFFF;
        if ClearImp then
          pThunk^ := 0;                                //清除原导入表数据
        l := 4;
      end
      else
      begin
        pFuncName := PImageImportByName(PtrAdd(SrcPEPtr, PEAnalyst.RVAtoOffset(pThunk^)));
        l := Length(PChar(@pFuncName^.Name)) + 1;
        CopyMemory(pName, @pFuncName^.Name, l);     
        if ClearImp then
          ZeroMemory(@pFuncName^.Name, l);              //清除原导入表数据
      end;
      inc(PkImportDir^.ImpFuncCount);
      inc(lFunc, l);
      pName := PtrAdd(pName, l);
      inc(pThunk);
    end;
    inc(PEImpDir);
    inc(PkImportDirLength, lFunc + lDll + 8);
    //8 = TImpDir ThunkRVA: DWORD + ImpFuncCount: DWORD
    PkImportDir := PtrAdd(PkImportDir, lFunc + lDll + 8);
  end;
  inc(PkImportDirLength, 4);  //Null结尾

  GetMem(PkImportTab, _aP_max_packed_size(PkImportDirLength));
  GetMem(WorkMem, _aP_workmem_size(PkImportDirLength));
  PkLen := _aP_pack(PkImportBuf^, PkImportTab^, PkImportDirLength, WorkMem^, nil, nil);
  FreeMem(WorkMem);                        //压缩简单格式
  FreeMem(PkImportBuf);

  PkData := PkDataQueue.Get('PkImpData');  //存入列表
  PkData^.Ptr := PkImportTab;
  PkData^.Len := PkLen;
end;

procedure AssembleUnPacker(PEPtr: Pointer);
var
  ProcLength: Cardinal;
  PkData: PPkData;
begin
  ProcLength :=  DWORD(@EndHere) - DWORD(@StartHere);
  //全部需写入文件的解压代码长度
  PDWORD(PtrAdd(@StartHere, ProcLength - 6))^ := DWORD(@DelphiEP) - DWORD(@EndHere) + 2;
  //修正NewEnteryPoint中call DelphiEP代码为正确偏移

  PkData := PkDataQueue.Get('UnPacker');          //存入列表
  PkData^.Ptr := @StartHere;
  PkData^.Len := ProcLength;
  PkData^.Characteristic := $FFFFFFFF;            //表示列表不要释放Ptr指针
end;
                                    
procedure AssemblePkDataHeader;
//组装PkDataHeader
var
  PkData: PPkData;   
  PkDataHeaderPtr: PPkDataHeader;
begin
  GetMem(PkDataHeaderPtr, SizeOf(TPkDataHeader));
  PkData := PkDataQueue.Get('PkDataHeader');       //存入列表
  PkData^.Ptr := PkDataHeaderPtr;
  PkData^.Len := SizeOf(TPkDataHeader);
  PkDataHeaderPtr^.PkSectionDirCount := PEAnalyst.SectionCount - 1;
  PkDataHeaderPtr^.PkSectionDirOffset := PkDataQueue.GetOffset('PkSectionData') -
                                         PkDataQueue.GetOffset('PkDataHeader');
  PkDataHeaderPtr^.PkImpDirOffset := PkDataQueue.GetOffset('PkImpData') -
                                     PkDataQueue.GetOffset('PkDataHeader');

  PkDataHeaderPtr^.ImpSize := PkImportDirLength;
  PkDataHeaderPtr^.EPRVA := PEAnalyst.EntryPointRVA;
  PkDataHeaderPtr^.ResRVA := PEAnalyst.DataDirectorys[2]^.VirtualAddress;
    //保存资源DataDirectorys的RVA
  PkDataHeaderPtr^.ResSize := PEAnalyst.DataDirectorys[2]^.Size;
    //保存资源DataDirectorys的Size
  PkDataHeaderPtr^.DelayImpRVA := PEAnalyst.DataDirectorys[13]^.VirtualAddress;
  PkDataHeaderPtr^.DelayImpSize := PEAnalyst.DataDirectorys[13]^.Size;
end;

procedure ProcTls(PEPtr: Pointer);
//处理tls表,将tls表的数据直接copy到加壳后的文件中,修正DataDirectorys的RVA
var
  pTls: Pointer;
  PkData: PPkData;
begin
  if PEAnalyst.HasTls then    //有TLS表
  begin
    PkData := PkDataQueue.Get('Tls');
    pTls := PtrAdd(PEPtr, PEAnalyst.RVAtoOffset(PEAnalyst.DataDirectorys[9]^.VirtualAddress));
    PkData^.Ptr := pTls;
    PkData^.Len := $18;
    PkData^.Characteristic := $FFFFFFFF;         //表示列表不要释放Ptr指针
    PEAnalyst.DataDirectorys[9]^.VirtualAddress := pPackerSection^.VirtualAddress +
                                                   PkDataQueue.GetOffset('Tls');
  end;
end;

procedure AssembleMainIcon(hIcon: Cardinal);
var
  PkData: PPkData;
  IconStream: TMemoryStream;
  ResBuf: Pointer;
  ResRVA, ResSize: Cardinal;
begin
  if hIcon = 0 then
    exit;
  IconStream := TMemoryStream.Create;
  WriteIcon(IconStream, hIcon);
  ResRVA := pPackerSection^.VirtualAddress + PkDataQueue.GetOffset('MainIcon');
  PoorCreateMainIcon(IconStream, ResRVA);
  ResSize := IconStream.Size;
  ResBuf := AllocMem(ResSize);
  CopyMemory(ResBuf, IconStream.Memory, ResSize);

  PkData := PkDataQueue.Get('MainIcon');
  PkData^.Ptr := ResBuf;
  PkData^.Len := ResSize;
  IconStream.Free;
end;

procedure AddOverLayData(PEPtr: Pointer);
//处理OverLay数据,直接copy到加壳后的文件末尾
var
  PkData: PPkData;
begin
  if PEAnalyst.HasOverlay then      //有OverLay数据
  begin
    PkData := PkDataQueue.Get('OverLayData');
    PkData^.Ptr := PtrAdd(PEPtr, PEAnalyst.OverlayOffset);
    PkData^.Len := PEAnalyst.OverlaySize;
    PkData^.Characteristic := $FFFFFFFF;
  end;
end;

procedure FinalProc(PEPtr: Pointer);
//最后的处理:
//修正导入表的RVA和Size
//修改Section Header,增加可写属性
//清理无用DataDirectorys
const
  UselessDataDir: Array [1..6] of integer = (5, 6, 10, 11, 12, 13);
//需清理的DataDirectorys
var
  i: integer;
  PkData: PPkData;
begin
  PkData := PkDataQueue.Get('ImpTab');         //fix import DataDirectorys
  PEAnalyst.DataDirectorys[1]^.VirtualAddress := pPackerSection^.VirtualAddress + PkDataQueue.GetOffset('ImpTab');
  PEAnalyst.DataDirectorys[1]^.Size := PkData.Len;

  for i := 0 to PEAnalyst.SectionCount - 2 do               //clear sectionheaders
  begin                                                     //don't change the last(new) sectionheader
    PEAnalyst.SectionHeaders[i]^.PointerToRawData := 0;
    PEAnalyst.SectionHeaders[i]^.SizeOfRawData := 0;
    if PEAnalyst.SectionHeaders[i]^.Characteristics and $80000000 <> $80000000 then
      PEAnalyst.SectionHeaders[i]^.Characteristics := PEAnalyst.SectionHeaders[i]^.Characteristics + $80000000;
  end;
                                                     //clear useless DataDirectorys
  for i :=Low(UselessDataDir) to High(UselessDataDir) do
  begin
    PEAnalyst.DataDirectorys[UselessDataDir[i]]^.VirtualAddress := 0;
    PEAnalyst.DataDirectorys[UselessDataDir[i]]^.Size := 0;
  end;
        
  PkData := PkDataQueue.Get('MainIcon');
  if Assigned(PkData) then
  begin
    PEAnalyst.DataDirectorys[2]^.VirtualAddress := pPackerSection^.VirtualAddress + PkDataQueue.GetOffset('MainIcon');
    PEAnalyst.DataDirectorys[2]^.Size := PkData^.Len;
  end;

  PEAnalyst.UpdateImageSize;
end;

procedure SavePkFile(PkFn: String);
var
  PkFile: TMemoryStream;
  PkData: TPkData;
  i: integer;
begin
  PkFile := TMemoryStream.Create;
  PkFile.Write(PEAnalyst.PEHeaderPtr^, PEAnalyst.HeaderSize);
  for i := 0 to PkDataQueue.Count - 1 do
  begin
    PkData := PkDataQueue[i]^;
    if not Assigned(PkData.Ptr) then
      Continue;
    PkFile.Write(PkData.Ptr^, PkData.Len);
  end;
  try
    PkFile.SaveToFile(PkFn);
  except
    on EFCreateError do
      Showmessage('');
  end;
  PkFile.Free;
end;

function CallBack(w0, w1, w2 : DWORD; cbparam : Pointer) : DWORD; cdecl;
begin
  with Form1 do
  begin
    PB.Progress := Round(w1/ w0 * PDWORD(cbparam)^ / SectionDataSize * 100);
    Application.ProcessMessages;
    Result := aP_pack_continue;
  end;
end;

function TForm1.BackupFile(const FileName: String): integer;
var
  I: Integer;
begin
  result := 0;
  I := LastDelimiter('.' + PathDelim + DriveDelim, Filename);
  if (I = 0) or (FileName[I] <> '.') then I := MaxInt;
  BackFn := Copy(FileName, 1, I - 1) + '_Backup' + ExtractFileExt(Filename);
  if FileExists(BackFn) then
    case MessageBox(0, PChar('File' + ExtractFileName(BackFn) + ' exists, overwrite?'),
                  'Alert', MB_OKCANCEL) of
      IDOK:
      begin
        DeleteFile(BackFn); 
        result := 1;
      end;
    end;
  if not RenameFile(FileName, BackFn) then
    result := 2;
end;

procedure TForm1.DoPack;
var
  PEPtr: Pointer;
  PkData: PPkData;
  i: cardinal;
  pLocalVar: PDWORD;
  lBuf: Cardinal;
begin
  PB.Progress := 0;
  ShowMsg('Packing section data...');
  SrcPE := TMemoryStream.Create;
  PkDataQueue := TPkDataQueue.Create;
  PEAnalyst := TPEAnalyst.Create;
  try
    SrcPE.LoadFromFile(SrcFn);
    PEPtr := SrcPE.Memory;

    if cbBackup.Checked then
    begin
      case BackupFile(SrcFn) of
        0:
          ShowMsg('Rename source file to ' + ExtractFileName(BackFn));
        1:
          ShowMsg('Overwrite exist backup ' + ExtractFileName(BackFn) + '!');
        2:
          ShowMsg('Fail to create backup!');
      end;
    end;

    PEAnalyst.Assign(PEPtr, SrcPE.Size);
    SectionDataSize := 0;
    for i := 0 to PEAnalyst.SectionCount - 1 do
      Inc(SectionDataSize, PEAnalyst.SectionHeaders[i]^.SizeOfRawData);
    VirtualProtect(@StartHere, DWORD(@EndHere) - DWORD(@StartHere), PAGE_EXECUTE_READWRITE, @i);
    //使ShellCode部分代码可写,后面修改用

    //顺序可以改变!
    PkDataQueue.Add('ImpTab');
    PkDataQueue.Add('UnPacker');
    PkDataQueue.Add('Tls');
    PkDataQueue.Add('PkDataHeader');
    PkDataQueue.Add('PkSectionData');
    PkDataQueue.Add('PkImpData');
    PkDataQueue.Add('MainIcon');
    PkDataQueue.Add('OverLayData');       //Must be the last

    //顺序可以改变!
    AssembleImpTab;
    PackImports(PEPtr, cbClearImp.Checked);
    PackSection(PEPtr);
    AssembleUnPacker(PEPtr);

    pPackerSection := PEAnalyst.AddSection(0);      //Add section after PackSection!
    CopyMemory(@pPackerSection^.Name[0], PChar(PkSectionName), 8);
    pPackerSection^.PointerToRawData := PEAnalyst.HeaderSize;

    ProcTls(PEPtr);                                   //Must be called after AddSection
    AssemblePkDataHeader;
    if not PEAnalyst.IsDll then
      AssembleMainIcon(ImgIcon.Picture.Icon.Handle);    //Must be called in the last
    AddOverLayData(PEPtr);

    lBuf := PkDataQueue.Len;  //壳及压缩数据的总长度
    pPackerSection^.SizeOfRawData := lBuf - PkDataQueue.Get('OverLayData')^.Len;
    pPackerSection^.Misc.VirtualSize := PEAnalyst.PEHeader.CalcSectionAilgnment(lBuf);
    PEAnalyst.EntryPointRVA := pPackerSection^.VirtualAddress + PkDataQueue.GetOffset('UnPacker') +
                               DWORD(@NewEnteryPoint) - DWORD(@StartHere);
    //更新EP为NewEnteryPoint

    pLocalVar := LocalVar;
    pLocalVar^ := pPackerSection^.VirtualAddress + PkDataQueue.GetOffset('PkDataHeader');
    //save PkDataHeader's RVA to Shellcode

    PkData := PkDataQueue.Get('ImpTab');
    FixImpRVA(PkData.Ptr, pPackerSection^.VirtualAddress + PkDataQueue.GetOffset('ImpTab'));
    FixImpThunk(PkData.Ptr, pPackerSection^.VirtualAddress + PkDataQueue.GetOffset('UnPacker') +
                DWORD(LocalVar) - DWORD(@StartHere) + SizeOf(DWORD));
    //FixImpThunk

    FinalProc(PEPtr);
    SavePkFile(SrcFn);
  finally
    PEAnalyst.Free;
    PkDataQueue.Free;
    SrcPE.Free;
  end;
  ShowMsg('Process finished!');
  ShowMsg('------------------------');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, true);
end;

procedure TForm1.ShowMsg(Msg: String);
begin
  RichEdit1.Lines.Add(Msg);
end;

procedure TForm1.WithDropFiles(var Msg: TMessage);
Var
  Buffer: PChar;
  i: integer;
begin
  i := DragQueryFile(Msg.WParam, 0, nil, 0) + 1;
  GetMem(Buffer, i);
  try
    DragQueryFile(Msg.WParam, 0, Buffer, i);
    DragFinish(Msg.WParam);
    SrcFn := Buffer;
    UpdateUi;
    SetForeGroundWindow(Handle);
  finally
    FreeMem(Buffer);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DoPack;
end;

procedure TForm1.UpdateUi;
begin
  leSrcFn.Text := SrcFn;
  ShowMsg('Source file: ' + SrcFn);
  PkSectionName := leSectionName.Text;
  ImgIcon.Picture.Icon.Handle := ExtractIcon(Application.Handle, PChar(SrcFn), 0);
  ImgIcon.Refresh;
  Button1.Enabled := true;    
  PB.Progress := 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

end.