shared.pas

UPXShell 压缩解压缩Windows下的exe和dll文件, 其原理基于加壳原理, UPX也是一个Windows下的可执行文件加壳工具

 {**************--===ION Tek===--****************}
 { Shared procedures unit                        }
 {***********************************************}
unit Shared;

interface

uses
  Windows, Forms, Classes, Graphics, Dialogs, Globals;

procedure Split(const Delimiter: Char; Input: string; const Strings: TStrings);
procedure ExtractRes(const ResType, ResName, ResNewName: string); //Extracts upx.exe and ups.exe
function GetPriority: cardinal; //Gets priority selected on the SetupForm
 //Function StrDiv(Const InStr: String): String;
function AlreadyPacked: boolean;
function GetCompressParams: string;
procedure ExtractUPX(const Action: TExtractDelete);
procedure ScrambleUPX;
function GetUPXVersion(const FileName: string): string;
function GetBuild(const BuildInfo: TBuildInfo): string;
procedure DrawGradient(const DrawCanvas: TCanvas;
  const ColorCycles, Height, Width: integer;
  const StartColor, EndColor: TColor);
 //Procedure DrawGradientVertical(Const DrawCanvas: TCanvas;
 //  Const ColorCycles, Height, Width: Integer;
 //  Const StartColor, EndColor: TColor);
function ProcessSize(const Size: integer): string;
//Function AnalyzeFileSize(Const FileName: String): String;
function GetFileSize(const FileName: string): integer;
 //Function TokenizeStr(Const InStr: String): TTokenStr;
 //Function IsNumber(Const InStr: String): Boolean;
 //Procedure WriteLog(Const InStr: String);
function GetStringProperty(Component: TComponent;
  const PropName: string): string;
procedure SetStringProperty(AComp: TComponent; const APropName: string;
  const AValue: string);
function GetComponentTree(Component: TComponent): string;
function IsNumeric(const InStr: string): boolean;
function PropertyExists(Component: TComponent;
  const PropName: string): boolean;

implementation

uses
  SysUtils, TypInfo,
  UPXScrambler, Translator,
  MainFrm, SetupFrm;

procedure Split(const Delimiter: Char; Input: string; const Strings: TStrings);
begin
   Assert(Assigned(Strings)) ;
   Strings.Clear;
   Strings.Delimiter := Delimiter;
   Strings.DelimitedText := Input;
end;

//Extract resources from the upxshell.exe (upx.exe)
procedure ExtractRes(const ResType, ResName, ResNewName: string);
var
  Res: TResourceStream;
begin
  try
    Res := TResourceStream.Create(Hinstance, Resname, PChar(ResType));
    Res.SavetoFile(ResNewName);
  finally
    FreeAndNil(Res);
  end;
end;
 //This one is used for getting the priority of the compression
 //and the scrambler thread
function GetPriority: cardinal;
var
  Priority: integer;
begin
  priority := SetupForm.cmbPriority.ItemIndex;
  case priority of
    0:
    begin
      Result := IDLE_PRIORITY_CLASS;
    end;
    1:
    begin
      Result := NORMAL_PRIORITY_CLASS;
    end;
    2:
    begin
      Result := HIGH_PRIORITY_CLASS;
    end;
    3:
    begin
      Result := REALTIME_PRIORITY_CLASS;
    end;
    else
    begin
      Result := NORMAL_PRIORITY_CLASS;
    end;
  end;
end;

(* //Function not used in UPXShell
//Puts a a space after every third character
Function StrDiv(Const InStr: String): String;
Var
  outstr: Array[1..255] Of Char;
  i, c, m, l: Integer;
Begin
  i := 0;
  c := 0;
  m := length(instr);
  l := m Div 3;
  fillchar(outstr, 255, #0);
  While i <= length(instr) + c Do
  Begin
    inc(i);
    If (i Mod 4 <> 0) Then
      outstr[m + l] := instr[m + c]
    Else
    Begin
      outstr[m + l] := ' ';
      inc(c);
    End;
    dec(m);
  End;
  Result := Trim(outstr);
End;
*)
//Analyzes the file to check if it's already compressed
function AlreadyPacked: boolean;
var
  f: TFileStream;
  GlobalChain: array[1..$3F0] of char;
begin
  try
    f := TFileStream.Create(GlobFileName, fmOpenRead);
    f.Position := 0;
    try
      f.ReadBuffer(GlobalChain, $3EF);
    except
      on E: Exception do
      begin
        //TODO: Change message to something else. Add also for translation.
        MessageBox(0, TranslateMsg(
          'Could not access file. It may be allready open!'),
          TranslateMsg('Error'), MB_ICONERROR or MB_OK);
      end;
    end;
    if pos('UPX', GlobalChain) <> 0 then
    begin
      Result := True;
    end
    else begin
      Result := False;
    end;
    // offset $34b... test the typical string in .EXE & .DLL 'This file is packed with the UPX'
    // offset $1F9... test string in .SCR 'This file is packed with the UPX'
    // offset $55... string 'UPX' in .COM
    // new offset in .EXE in UPX 1.08
    // another offset in .EXE in UPX 1.20
  finally
    FreeAndNil(f);
  end;
end;
//Gets compression parameters to be passed to upx
function GetCompressParams: string;
begin
  with MainForm do
  begin
    Result := workdir + 'upx.exe ' + '"' + GlobFileName + '"';
    if not chkDecomp.Checked then
    begin
      if trbCompressLvl.Position < 10 then
      begin
        Result := Result + ' -' + IntToStr(trbCompressLvl.Position);
      end
      else begin
        Result := Result + ' --best';
      end;
      if SetupForm.chkCompression.Checked then
      begin
        Result := Result + ' --crp-ms=' +
          IntToStr(SetupForm.trbCompression.Position);
      end;
      if SetupForm.chkForce.Checked then
      begin
        Result := Result + ' --force';
      end;
      if SetupForm.chkResources.Checked then
      begin
        Result := Result + ' --compress-resources=1';
      end
      else begin
        Result := Result + ' --compress-resources=0';
      end;
      if SetupForm.chkRelocs.Checked then
      begin
        Result := Result + ' --strip-relocs=1';
      end
      else begin
        Result := Result + ' --strip-relocs=0';
      end;
      if chkBackup.Checked then
      begin
        Result := Result + ' -k';
      end;
      case SetupForm.cmbIcons.ItemIndex of
        0:
        begin
          Result := Result + ' --compress-icons=2';
        end;
        1:
        begin
          Result := Result + ' --compress-icons=1';
        end;
        2:
        begin
          Result := Result + ' --compress-icons=0';
        end;
      end;
      if SetupForm.chkExports.Checked then
      begin
        Result := Result + ' --compress-exports=1';
      end
      else begin
        Result := Result + ' --compress-exports=0';
      end;
      //UPX v1.9x Only
      if MainForm.chkUPX2.Checked then
      begin
        if SetupForm.chkBrute.Checked then
        begin
          Result := Result + ' --brute';
        end
        else
        begin
          if SetupForm.chkMethods.Checked then
          begin
            Result := Result + ' --all-methods';
          end;
          if SetupForm.chkFilters.Checked then
          begin
            Result := Result + ' --all-filters';
          end;
        end;
      end;
      Result := Result + ' ' + SetupForm.edtCommands.Text;
    end
    else begin
      Result := Result + ' -d';
    end;
  end;
end;

procedure ExtractUPX(const Action: TExtractDelete);
var
  sExtractVersion: string;
begin
  SetCurrentDir(WorkDir);
  if Action = edExtract then
  begin
    if FileExists(workdir + 'upx.exe') then
    begin
      UpxExist := True;
    end
    else begin
      UpxExist := False;
      //Check what version to extract
      if MainForm.chkUPX1.Checked then
      begin
        sExtractVersion := '1.25';
      end
      else begin
        if MainForm.chkUPX2.Checked then
        begin
          sExtractVersion := '1.93';
        end
        else begin
          sExtractVersion := sUPXVersion;
        end;
      end;
      if sExtractVersion = '1.93' then
      begin
        //Extract UPX Version 1.93
        ExtractRes('EXEFILE', 'UPX193', WorkDir + 'UPX.EXE');
      end
      else begin
        //Extract UPX Version 1.25
        ExtractRes('EXEFILE', 'UPX125', WorkDir + 'UPX.EXE');
      end;
    end;
  end
  else begin
    if not UpxExist then
    begin
      DeleteFile(workdir + 'UPX.EXE');
    end;
  end;
end;

{*****************************************
* This Function Scrambles the UPXed file *
*****************************************}
procedure ScrambleUPX;
var
  Scrambled: boolean;
begin
  if GlobFileName <> '' then
  begin
    if AlreadyPacked then
    begin
      Scrambled := fScrambleUPX(GlobFileName);
      if Scrambled then
      begin
        MainForm.chkDecomp.Checked  := False;
        MainForm.stbMain.Panels[1].Text :=
          MainForm.stbMain.Panels[1].Text + TranslateMsg(' & scrambled');
      end
      else begin
        MainForm.stbMain.Panels[1].Text :=
          MainForm.stbMain.Panels[1].Text + TranslateMsg(' & scrambled') +
          ' ' + TranslateMsg('Failed');
      end;
    end
    else begin
      if Application.MessageBox(TranslateMsg(
        'This file doesn''t seem to be packed. Run the Scrambler?'),
        TranslateMsg('Confirmation'), MB_YESNO + MB_ICONEXCLAMATION) =
        idYes then
      begin
        Scrambled := fScrambleUPX(GlobFileName);
        if Scrambled then
        begin
          MainForm.chkDecomp.Checked  := False;
          MainForm.stbMain.Panels[1].Text :=
            MainForm.stbMain.Panels[1].Text + TranslateMsg(' & scrambled');
        end
        else begin
          MainForm.stbMain.Panels[1].Text :=
            MainForm.stbMain.Panels[1].Text + TranslateMsg(' & scrambled') +
            ' ' + TranslateMsg('Failed');
        end;
      end;
    end;
  end;
end;

{*****************************************
* This Function extracts the UPX Version *
*****************************************}
function GetUPXVersion(const FileName: string): string;
var
  fsSource:     TFileStream;
  GlobalChain:  array[1..$3F0] of char;
  VersionChain: array[1..$4] of char;
  PosString:    integer;
  UPXVersion:   string;
begin
  try
    fsSource := TFileStream.Create(FileName, fmOpenRead);
    fsSource.Position := 0;
    fsSource.Seek(0, soFromBeginning);
    fsSource.ReadBuffer(GlobalChain, $3EF);
    //Reading old UPX version number
    if pos('$Id: UPX', GlobalChain) <> 0 then
    begin
      PosString := (pos('$Id: UPX', GlobalChain) - 1);
      fsSource.Seek((PosString + 9), soFromBeginning);
      fsSource.ReadBuffer(VersionChain, $4);
      UPXVersion := VersionChain;
      Result     := UPXVersion;
    end
    //Else, reading new UPX version number
    else begin
      if pos(#$00'UPX!', GlobalChain) <> 0 then
      begin
        PosString := (pos(#$00'UPX!', GlobalChain) - 1);
        fsSource.Seek((PosString - 4), soFromBeginning);
        fsSource.ReadBuffer(VersionChain, $4);
        UPXVersion := VersionChain;
        Result     := UPXVersion;
      end;
    end;
  finally
    FreeAndNil(fsSource);
  end;
end;

{ Returns verson info from FileName in dotted decimal string format:
  Release.Major.Minor.Build (biFull)
  or Release.Major.Minor (biNoBuild)
  or Release.MajorMinor (biCute)
  or each one separately (biMajor, biMinor, biRelease, biBuild) }
function GetBuild(const BuildInfo: TBuildInfo): string;
var
  dwI, dwJ: dword;
  VerInfo:  Pointer;