mainfrm.pas

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

 {**************--===ION Tek===--****************}
 { Main UPX Shell unit                           }
 {***********************************************}
 { You may use and modify this unit and any other}
 { unit in this application and distribute it as }
 { you like, with the only condition that your   }
 { work must be stated as:                       }
 { 'Based on ION Tek source code'                }
 {***********************************************}
 { Copyrights by ION Trooper, ION Tek, 2000-2001 }
 {   --== Updated by BlackDex 2004-2005 ==--     }
 {***********************************************}
unit MainFrm;

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, Gauges, {Translator,} Menus;

type
  TMainForm = class(TForm)
    btnAdvanced: TButton;
    btnGo: TButton;
    btnHelp: TButton;
    btnMultiPck: TButton;
    btnOpen: TButton;
    btnRun: TButton;
    bvlCompressor: TBevel;
    bvlOpenLeft: TBevel;
    bvlRatio: TBevel;
    chkAutoCompress: TCheckBox;
    chkBackup: TCheckBox;
    chkExitDone: TCheckBox;
    chkTest: TCheckBox;
    ClearHistory: TMenuItem;
    cmbLanguage: TComboBox;
    dlgOpen: TOpenDialog;
    imgGradient: TImage;
    imgHistory: TImage;
    imgIONTek: TImage;
    imgLogoGrad1: TImage;
    imgLogoGrad2: TImage;
    imgMail: TImage;
    imgUPX: TImage;
    imgWWW: TImage;
    lblBetter: TLabel;
    lblBlaineMail: TLabel;
    lblBuild: TLabel;
    lblBuildCap: TLabel;
    lblCompression: TLabel;
    lblCompressLevel: TLabel;
    lblCompressor: TLabel;
    lblCSize: TLabel;
    lblCSizeCap: TLabel;
    lblEMail: TLabel;
    lblFaster: TLabel;
    lblFName: TLabel;
    lblFNameCap: TLabel;
    lblFSize: TLabel;
    lblFSizeCap: TLabel;
    lblHistory: TLabel;
    lblIns: TLabel;
    lblInsCap: TLabel;
    lblIONT: TLabel;
    lblIONTmail: TLabel;
    lblLanguage: TLabel;
    lblOut: TLabel;
    lblOutCap: TLabel;
    lblProgress: TLabel;
    lblProgressSize: TLabel;
    lblRatio: TLabel;
    lblRatioCap: TLabel;
    lblRelease: TLabel;
    lblReleaseCap: TLabel;
    lblUPX: TLabel;
    lblWWW: TLabel;
    mnuHistory: TPopupMenu;
    N1: TMenuItem;
    pgcMain: TPageControl;
    pnlAbout: TPanel;
    pnlAll: TPanel;
    pnlCompress: TPanel;
    pnlFileInfo: TPanel;
    pnlHelp: TPanel;
    pnlOpen: TPanel;
    pnlOpenLeft: TPanel;
    pnlOptions: TPanel;
    pnlProgress: TPanel;
    pnlProgressSize: TPanel;
    pnlTop: TPanel;
    prbCompress: TGauge;
    prbSize: TGauge;
    stbMain: TStatusBar;
    sttDecomp: TStaticText;
    tbsAbout: TTabSheet;
    tbsCompress: TTabSheet;
    tbsHelp: TTabSheet;
    tbsOpen: TTabSheet;
    tbsOptions: TTabSheet;
    trbCompressLvl: TTrackBar;
    lblBlackDexMail: TLabel;
    lbllns2: TLabel;
    pnlAction: TPanel;
    rgrAction: TRadioGroup;
    chkUPX1: TRadioButton;
    chkUPX2: TRadioButton;
    chkDecomp: TRadioButton;
    tbsUpdate: TTabSheet;
    pnlUpdate: TPanel;
    lblOnlineVersionCap: TLabel;
    lblDownloadCap: TLabel;
    lblDownload: TLabel;
    lblOnlineVersion: TLabel;
    btnChkUpdate: TButton;
    lblReleaseDateCap: TLabel;
    lblReleaseDate: TLabel;
    rchChangeLog: TRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure ClearHistoryClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnOpenClick(Sender: TObject);
    procedure btnGoClick(Sender: TObject);
    procedure tbsOpenShow(Sender: TObject);
    procedure tbsCompressShow(Sender: TObject);
    procedure tbsOptionsShow(Sender: TObject);
    procedure tbsAboutShow(Sender: TObject);
    procedure tbsHelpShow(Sender: TObject);
    procedure trbCompressLvlChange(Sender: TObject);
    procedure btnAdvancedClick(Sender: TObject);
    procedure cmbLanguageChange(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure stbMainMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: integer);
    procedure btnHelpClick(Sender: TObject);
    procedure btnMultiPckClick(Sender: TObject);
    procedure btnRunClick(Sender: TObject);
    procedure imgHistoryMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure FormShow(Sender: TObject);
    procedure HyperClick(Sender: TObject);
    procedure StdUPXVersionClick(Sender: TObject);
    procedure UPXVersionClick(Sender: TObject);
    procedure btnChkUpdateClick(Sender: TObject);
    procedure lblDownloadClick(Sender: TObject);
  private
    procedure HistoryPopUp(Sender: TObject);
    // Declaration of History popup handler
    procedure WMDropfiles(var msg: Tmessage); message WM_DROPFILES;
    procedure ParseCommandLine();
  public
    { Public declarations }
  end;

procedure LoadFile(const FileName: string);
procedure StartCompression();
procedure CalcFileSize();

var
  MainForm: TMainForm;

implementation

uses SysUtils, ShlObj, Wininet, ShellAPI, Registry,
     Globals, Translator, Compression, Shared, UPXScrambler,
     MultiFrm, SetupFrm;

{$R *.dfm}
{$R WinXP.res}
{$R UPX.res}

//This procedure loads application settings from the registry
procedure LoadSettings;
var
  reg: TRegistry;
begin
  bStdUPXVersion := 0;
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey('Software\ION Tek\UPX Shell\3.x', True);
    if reg.ValueExists('InstallPath') then
    begin
      // Get the workdir (this value is set by installer)
      WorkDir := reg.ReadString('InstallPath');
    end
    else begin
      WorkDir := SysUtils.ExtractFileDir(application.ExeName) + '\';
    end;
    if reg.ValueExists('LanguageFile') then
    begin
      LangFile := reg.ReadString('LanguageFile');
    end
    else begin
      LangFile := 'English';
    end;
    if reg.ValueExists('AutoCompress') then
    begin
      MainForm.chkAutoCompress.Checked := reg.ReadBool('AutoCompress');
    end;
    if reg.ValueExists('ExitDone') then
    begin
      MainForm.chkExitDone.Checked := reg.ReadBool('ExitDone');
    end;
    if reg.ValueExists('CreateBackup') then
    begin
      MainForm.chkBackup.Checked := reg.ReadBool('CreateBackup');
    end;
    if reg.ValueExists('TestFile') then
    begin
      MainForm.chkTest.Checked := reg.ReadBool('TestFile');
    end;
    if reg.ValueExists('CompressionLevel') then
    begin
      MainForm.trbCompressLvl.Position := reg.ReadInteger('CompressionLevel');
    end;
    if reg.ValueExists('StdUPXVersion') then
    begin
      bStdUPXVersion := reg.ReadInteger('StdUPXVersion');
    end;
    if bStdUPXVersion = 2 then
    begin
      MainForm.chkUPX2.Checked := True;
    end
    else begin
      MainForm.chkUPX1.Checked := True;
    end;
  finally
    FreeAndNil(reg);
  end;
end;

{ This procedure saves the app settings to registry }
procedure SaveSettings;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey('Software\ION Tek\UPX Shell\3.x', True);
    // The following code saves everything that should be saved
    reg.WriteBool('AutoCompress', MainForm.chkAutoCompress.Checked);
    reg.WriteBool('ExitDone', MainForm.chkExitDone.Checked);
    reg.WriteBool('CreateBackup', MainForm.chkBackup.Checked);
    reg.WriteBool('TestFile', MainForm.chkTest.Checked);
    reg.WriteInteger('CompressionLevel', MainForm.trbCompressLvl.Position);
    //**reg.WriteString('LanguageFile', LangFile);
    reg.WriteString('LanguageFile', MainForm.cmbLanguage.Text);
    if MainForm.chkUPX2.Checked then
    begin
      reg.WriteInteger('StdUPXVersion', 2);
    end
    else begin
      reg.WriteInteger('StdUPXVersion', 1);
    end;
  finally
    FreeAndNil(reg);
  end;
end;
 // Reads registry value from default UPX Shell folder and
 // returns TRegResult
function ReadKey(const Name: string; KeyType: TKeyType): TRegValue;
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey('Software\ION Tek\UPX Shell\3.x', True);
    if reg.ValueExists(Name) then
    begin
      case KeyType of // Checks the type of key and retrieves it
        ktString:
        begin
          Result.Str := reg.ReadString(Name);
        end;
        ktInteger:
        begin
          Result.Int := reg.ReadInteger(Name);
        end;
        ktBoolean:
        begin
          Result.Bool := reg.ReadBool(Name);
        end;
      end;
    end
    else begin
      case KeyType of // Checks the type of key and retrieves it
        ktString:
        begin
          Result.Str := '';
        end;
        ktInteger:
        begin
          Result.Int := -1;
        end;
        ktBoolean:
        begin
          Result.Bool := False;
        end;
      end;
    end;
  finally
    FreeAndNil(reg);
  end;
end;
// And this one saves a specified key to registry
procedure StoreKey(const Name: string; const Value: TRegValue;
  KeyType: TKeyType);
var
  reg: TRegistry;
begin
  reg := TRegistry.Create;
  try
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey('Software\ION Tek\UPX Shell\3.x', True);
    case KeyType of
      ktString:
      begin
        reg.WriteString(Name, Value.Str);
      end;
      ktInteger:
      begin
        reg.WriteInteger(Name, Value.Int);
      end;
      ktBoolean:
      begin
        reg.WriteBool(Name, Value.Bool);
      end;
    end;
  finally
    FreeAndNil(reg);
  end;
end;

{ This one loads a list of previously opened files and adds'em to History menu }
procedure LoadHistory;
var
  strings: TStrings;
  i: integer;
  MenuItem: TMenuItem; // To add to the History menu
begin
  strings := TStringList.Create;
  try
    strings.CommaText := ReadKey('History', ktString).Str;
    // Load the file history
    for i := strings.Count - 1 downto 0 do
    begin
      MenuItem := TMenuItem.Create(MainForm);
      MenuItem.Caption := strings.Strings[i];
      MenuItem.OnClick := MainForm.HistoryPopUp;
      MainForm.mnuHistory.Items.Add(MenuItem);
    end;
  finally
    FreeAndNil(Strings);
  end;
end;

// Adds an item to the History menu and stores it to registry
procedure WriteHistory(const FileName: string);
var
  strings: TStrings;
  Value:   TRegValue;

  { This nested procedure adds a new menu item to the History menu }
  procedure AddNewMenuItem;
  var
    MenuItem: TMenuItem; // To add to the History menu
  begin
    MenuItem := TMenuItem.Create(MainForm);
    MenuItem.Caption := FileName;
    MenuItem.OnClick := MainForm.HistoryPopUp;
    MainForm.mnuHistory.Items.Add(MenuItem);
  end;

begin
  strings := TStringList.Create;
  try
    strings.CommaText := ReadKey('History', ktString).Str;
    // Load the file history
    if strings.IndexOf(FileName) = -1 then // If item isn't already in the list
    begin
      strings.Add(FileName);
      Value.Str := strings.CommaText;
      StoreKey('History', Value, ktString);
      AddNewMenuItem;
    end;
  finally
    FreeAndNil(strings);
  end;
end;

procedure TMainForm.ParseCommandLine;
var
  i: integer;
begin
  for i := 1 to ParamCount() do
  begin
    if ParamStr(i) = '--debug' then
    begin
      Globals.Config.DebugMode := True;
    end;
  end;
end;

// This procedure handles the History Menu
procedure TMainForm.HistoryPopUp(Sender: TObject);
begin
  LoadFile((Sender as TMenuItem).Caption);
end;

//Calculates file size
procedure CalcFileSize;
begin
  FileSize := GetFileSize(GlobFileName);
  MainForm.lblFSize.Caption := ProcessSize(FileSize);
end;

{ Opens the specified file for the further compression..
  Contains a lot of nested procedures:}
procedure LoadFile(const FileName: string);
//This function unsets the ReadOnly attribute of the file
  function SetFileAttrib: boolean;
  var
    Attrib: cardinal;
  begin
    Result := True;
    Attrib := GetFileAttributes(PChar(FileName));
    if (Attrib and FILE_ATTRIBUTE_READONLY) > 0 then
    begin
      if Application.MessageBox(TranslateMsg(
        'The file attribute is set to ReadOnly. To proceed it must be unset. Continue?'),
        TranslateMsg('Confirmation'), MB_YESNO + MB_ICONQUESTION) = idYes then
      begin
        SetFileAttributes(PChar(FileName), Attrib - FILE_ATTRIBUTE_READONLY);
        Result := True;
      end
      else begin
        Result := False;
      end;
    end;
  end;
  //This one resets all visual controls to default state
  procedure ResetVisuals;
  begin
    MainForm.lblCSizeCap.Visible := False;
    MainForm.lblCSize.Visible    := False;
    MainForm.bvlRatio.Visible    := False;
    MainForm.lblRatioCap.Visible := False;
    MainForm.lblRatio.Visible    := False;
    MainForm.btnRun.Visible      := False;
    MainForm.pgcMain.ActivePageIndex := 1;
    MainForm.prbCompress.Progress := 0;
    MainForm.prbSize.Progress    := 0;
    MainForm.sttDecomp.Width     := 0;
  end;

  //Extracts file name out of a path
  procedure ExtractName;
  var
    temp: string;
  begin
    temp := SysUtils.ExtractFileName(FileName);
    MainForm.lblFName.Caption := temp;
    MainForm.stbMain.Panels[0].Text := temp;
  end;
  //Start main procedure
begin
  if (FileName <> '') and (FileExists(FileName)) and (SetFileAttrib) then
    //Unsets read-only attribute of a file
  begin
    GlobFileName := FileName; //Assign a global filename variable
    ResetVisuals(); //Resets visual controls
    if AlreadyPacked then
    begin
      //This one checks if the file is compressed and sets RadioButton
      MainForm.chkDecomp.Checked := True;
      sUPXVersion := GetUPXVersion(GlobFileName);
      MainForm.chkUPX1.Enabled := False;
      MainForm.chkUPX2.Enabled := False;
    end
    else begin
      MainForm.chkDecomp.Checked := False;
      sUPXVersion := '';
      MainForm.chkUPX1.Enabled := True;
      MainForm.chkUPX2.Enabled := True;
      if bStdUPXVersion = 2 then
      begin
        MainForm.chkUPX2.Checked := True;
      end
      else begin
        MainForm.chkUPX1.Checked := True;
      end;
    end;
    ExtractName();  //Extracts a file name and puts it on a label & statusbar
    CalcFileSize(); //Extracts file size and puts it on another label
    WriteHistory(FileName); //Add item to History menu
    if MainForm.chkAutoCompress.Checked then
    begin
      StartCompression();
    end;
  end;
end;

 //This procedure is responsible for changing of the
 //track bar label from digits to 'best' and vice versa:-)
procedure TrackBest;
begin
  if MainForm.trbCompressLvl.Position < 10 then
  begin
    MainForm.lblCompression.Caption :=
      IntToStr(MainForm.trbCompressLvl.Position);
  end
  else begin
    MainForm.lblCompression.Caption := TranslateMsg('Best');
  end;
end;

{ Loads visual settings, gets upx version... }
procedure LoadVisualSettings;
//This is used for getting the version of upx.exe
  function GetUPXOut: string;
  var
    f:     TFileStream;
    chain: array[1..$4] of char; //This will contain something like '1.20'
  begin
    if FileExists(workdir + 'upx.exe') then
    begin
      try
        f := TFileStream.Create(workdir + 'upx.exe', fmOpenRead);
        f.Position := 1;
        f.Seek($3DB, soFromBeginning);
        f.ReadBuffer(chain, $4);
        Result := chain;
      finally
        FreeAndNil(f);
      end;
    end
    else begin
      Result := IntToStr( -1);
    end;
  end;

var
  UPXOutStr: string;
begin
  //Checks if there is newer upx installed and sets it
  with MainForm do
  begin
    UPXOutStr := GetUPXOut;
    if (UPXOutStr <> lblIns.Caption) and (UPXOutStr <> IntToStr( -1)) then
    begin
      DecimalSeparator := '.';
      if strtofloat(UPXOutStr) < strtofloat(lblIns.Caption) then
      begin
        lblIns.Font.Color := clRed;
      end
      else begin
        lblIns.Font.Color := clNavy;
      end;
      lblIns.Caption := UPXOutStr;
    end;
    //Checks UPX Shell release and buil numbers
    lblRelease.Caption := GetBuild(biNoBuild);
    lblBuild.Caption   := GetBuild(biBuild);
    lblOut.Caption     := GetBuild(biCute);