Subversion Repositories autosfx

unit demo2_2;

(************************************************************************

 Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,

      Eric W. Engler and Chris Vleghert.

   This file is part of TZipMaster Version 1.9.

    TZipMaster is free software: you can redistribute it and/or modify

    it under the terms of the GNU Lesser General Public License as published by

    the Free Software Foundation, either version 3 of the License, or

    (at your option) any later version.

    TZipMaster is distributed in the hope that it will be useful,

    but WITHOUT ANY WARRANTY; without even the implied warranty of

    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License

    along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.

    contact: problems@delphizip.org (include ZipMaster in the subject).

    updates: http://www.delphizip.org

    DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip

************************************************************************)

interface

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, ExtCtrls, ZipSFXPlus, SFXInterface, Buttons, FileCtrl,

  ZipSFXBase;//, DZUtils;

type

  TdlgConvertToSFX = class(TForm)

    Panel1: TPanel;

    Button1: TButton;

    lbHeader: TLabel;

    btnPrev: TButton;

    btnNext: TButton;

    Panel2: TPanel;

    Notebook1: TNotebook;

    dlgOpenZip: TOpenDialog;

    dlgSaveSFX: TSaveDialog;

    ZipSFX1: TZipSFXPlus;

    dlgOpenSettings: TOpenDialog;

    rgOverwriteMode: TRadioGroup;

    GroupBox1: TGroupBox;

    cbAskCmdLine: TCheckBox;

    cbAskFiles: TCheckBox;

    cbHideOverwriteBox: TCheckBox;

    cbAutorun: TCheckBox;

    cbNoSuccessMsg: TCheckBox;

    cbExpandVariables: TCheckBox;

    cbInitiallyHideFiles: TCheckBox;

    cbForceHideFiles: TCheckBox;

    cbCanBeCancelled: TCheckBox;

    cbCheckAutoRunFileName: TCheckBox;

    GroupBox2: TGroupBox;

    imgIcon: TImage;

    btnSelectIcon: TButton;

    GroupBox3: TGroupBox;

    edTitle: TEdit;

    GroupBox4: TGroupBox;

    Label4: TLabel;

    edMessage: TEdit;

    Label3: TLabel;

    cbMessageFlags: TComboBox;

    lbDefaultIcon: TLabel;

    btnUseDefaultIcon: TButton;

    GroupBox5: TGroupBox;

    Label1: TLabel;

    edSource: TEdit;

    btnSource: TButton;

    Label2: TLabel;

    edTarget: TEdit;

    btnTarget: TButton;

    GroupBox6: TGroupBox;

    cbDefPath: TComboBox;

    btnLoadSettings: TSpeedButton;

    btnStoreSettings: TSpeedButton;

    dlgSaveSettings: TSaveDialog;

    Label5: TLabel;

    edFailPath: TEdit;

    btnSelPath1: TButton;

    btnSelPath2: TButton;

    GroupBox7: TGroupBox;

    edCommandline: TEdit;

    btnFinish: TButton;

    GroupBox8: TGroupBox;

    cbLanguages: TComboBox;

    cbDetached: TCheckBox;

    procedure Button1Click(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure Notebook1PageChanged(Sender: TObject);

    procedure btnSourceClick(Sender: TObject);

    procedure btnTargetClick(Sender: TObject);

    procedure btnNextClick(Sender: TObject);

    procedure btnPrevClick(Sender: TObject);

    procedure btnLoadSettingsClick(Sender: TObject);

    procedure btnSelectIconClick(Sender: TObject);

    procedure btnUseDefaultIconClick(Sender: TObject);

    procedure btnStoreSettingsClick(Sender: TObject);

    procedure btnSelPath1Click(Sender: TObject);

    procedure btnSelPath2Click(Sender: TObject);

    procedure btnFinishClick(Sender: TObject);

  private

    { Private-Deklarationen }

    FIconIndex: Integer;

    FIconEXE: string;

    FMakeNew : Boolean;

    procedure GotoPage(const iPage: Integer);

    procedure SetZipSFXFromControls;

    procedure SetControlsFromZipSFX;

    procedure Finish;

  public

    { Public-Deklarationen }

    procedure PrepareMakeNew;

  end;

var

  dlgConvertToSFX: TdlgConvertToSFX;

implementation

{$I DELVER.INC}

uses ShellAPI, demo2_1;

{$R *.dfm}

procedure TdlgConvertToSFX.Button1Click(Sender: TObject);

begin

  Close;

end;

procedure TdlgConvertToSFX.FormCreate(Sender: TObject);

begin

  // Enumerate all compiled languages

  cbLanguages.Items.Text := TZipSFXPlus.GetSupportedSFXLanguages;

  FMakeNew := False;

  SetControlsFromZipSFX;

  GotoPage(0);

end;

procedure TdlgConvertToSFX.GotoPage(const iPage: Integer);

begin

  if NoteBook1.PageIndex = iPage

  then

    Notebook1PageChanged(NoteBook1)

  else

    NoteBook1.PageIndex := iPage;

  lbHeader.Caption := '  '+NoteBook1.ActivePage;

  btnPrev.Enabled := NoteBook1.PageIndex > 0;

  if (NoteBook1.PageIndex < Pred(NoteBook1.Pages.Count))

  then

    btnNext.Caption := '&Next >>'

  else

    btnNext.Caption := '&Finish';

end;

procedure TdlgConvertToSFX.Notebook1PageChanged(Sender: TObject);

begin

  case NoteBook1.PageIndex of

    0:

    begin

      btnNext.Enabled := (FMakeNew or (edSource.Text <> '')) and (edTarget.Text <> '');

      btnFinish.Enabled := btnNext.Enabled;

    end;

  end;

end;

procedure TdlgConvertToSFX.btnSourceClick(Sender: TObject);

begin

  with dlgOpenZip do

  begin

    if FileExists(edSource.Text)

    then

      FileName := edSource.Text;

    if Execute

    then

      edSource.Text := FileName;

  end;

end;

procedure TdlgConvertToSFX.btnTargetClick(Sender: TObject);

begin

  with dlgSaveSFX do

  begin

    if FileExists(edSource.Text) and (edTarget.Text = '')

    then

      FileName := ChangeFileExt(edSource.Text, '.exe')

    else

      if edTarget.Text <> ''

      then

        FileName := edTarget.Text;

    if Execute

    then

      edTarget.Text := FileName;

  end;

end;

procedure TdlgConvertToSFX.btnNextClick(Sender: TObject);

begin

  if Notebook1.PageIndex = Pred(NoteBook1.Pages.Count)

  then

    Finish

  else

    GotoPage(NoteBook1.PageIndex +1);

end;

procedure TdlgConvertToSFX.btnPrevClick(Sender: TObject);

begin

  GotoPage(NoteBook1.PageIndex -1);

end;

procedure TdlgConvertToSFX.btnLoadSettingsClick(Sender: TObject);

begin

  with dlgOpenSettings

  do

    if Execute then

    begin

      SetZipSFXFromControls;

      try

        ZipSFX1.LoadFromFile(FileName);

      finally

        SetControlsFromZipSFX;

      end;

    end;

end;

procedure TdlgConvertToSFX.SetControlsFromZipSFX;

begin

  with ZipSFX1 do

  begin

    edSource.Text := SourceFile;

    edTarget.Text := TargetFile;

    rgOverwriteMode.ItemIndex := Integer(OverwriteMode);

    cbAskCmdLine.Checked := soAskCmdLine in Options;

    cbAskFiles.Checked := soAskFiles in Options;

    cbHideOverWriteBox.Checked := soHideOverWriteBox in Options;

    cbAutoRun.Checked := soAutoRun in Options;

    cbNoSuccessMsg.Checked := soNoSuccessMsg in Options;

    cbExpandVariables.Checked := soExpandVariables in Options;

    cbInitiallyHideFiles.Checked := soInitiallyHideFiles in Options;

    cbForceHideFiles.Checked := soForceHideFiles in Options;

    cbCheckAutoRunFileName.Checked := soCheckAutoRunFileName in Options;

    cbDetached.Checked := soDetached in Options;

    cbCanBeCancelled.Checked := soCanBeCancelled in Options;

    imgIcon.Picture.Icon.Assign(Icon);

    lbDefaultIcon.Visible := imgIcon.Picture.Icon.Empty;

    btnUseDefaultIcon.Enabled := not lbDefaultIcon.Visible;

    edTitle.Text := DialogTitle;

    cbDefPath.Text := DefaultExtractPath;

    edFailPath.Text := FallbackExtractPath;

    edCommandline.Text := CommandLine;

    // show language

    cbLanguages.Text := SFXLanguage;

    edMessage.Text := Message;

    case MessageFlags of

      MB_OK: cbMessageFlags.ItemIndex := 0;

      MB_ICONINFORMATION or MB_OKCANCEL: cbMessageFlags.ItemIndex := 2;

      MB_ICONQUESTION or MB_YESNO: cbMessageFlags.ItemIndex := 1;

    else

      cbMessageFlags.Text := IntToStr(MessageFlags);

    end;

  end;

end;

procedure TdlgConvertToSFX.SetZipSFXFromControls;

var

  FOpts: TSFXOptions;

begin

  with ZipSFX1 do

  begin

    SourceFile := edSource.Text;

    TargetFile := edTarget.Text;

    OverwriteMode := TSFXOverwriteMode(rgOverwriteMode.ItemIndex);

    FOpts := [];

    if cbAskCmdLine.Checked then Include(FOpts,  soAskCmdLine);

    if cbAskFiles.Checked then Include(FOpts,  soAskFiles);

    if cbHideOverWriteBox.Checked then Include(FOpts,  soHideOverWriteBox);

    if cbAutoRun.Checked then Include(FOpts,  soAutoRun);

    if cbNoSuccessMsg.Checked then Include(FOpts,  soNoSuccessMsg);

    if cbExpandVariables.Checked then Include(FOpts,  soExpandVariables);

    if cbInitiallyHideFiles.Checked then Include(FOpts,  soInitiallyHideFiles);

    if cbForceHideFiles.Checked then Include(FOpts,  soForceHideFiles);

    if cbCheckAutoRunFileName.Checked then Include(FOpts,  soCheckAutoRunFileName);

    if cbDetached.Checked then Include(FOpts, soDetached);

    if cbCanBeCancelled.Checked then Include(FOpts,  soCanBeCancelled);

    Options := FOpts;

    Icon.Assign(imgIcon.Picture.Icon);

    DialogTitle := edTitle.Text;

    DefaultExtractPath := cbDefPath.Text;

    FallbackExtractPath := edFailPath.Text;

    CommandLine := edCommandline.Text;

    // set language

    SFXLanguage := cbLanguages.Text;

    Message := edMessage.Text;

    case cbMessageFlags.Items.IndexOf(cbMessageFlags.Text) of

      0: MessageFlags := MB_OK;

      1: MessageFlags := MB_ICONQUESTION or MB_YESNO;

      2: MessageFlags := MB_ICONINFORMATION or MB_OKCANCEL;

    else

      try

        MessageFlags := {$IFDEF DELPHI4UP}StrToInt64{$ELSE}StrToInt{$ENDIF}(cbMessageFlags.Text);

      except

        GoToPage(2);

        cbMessageFlags.SetFocus;

        raise;

      end;

    end;

  end;

end;

procedure TdlgConvertToSFX.btnSelectIconClick(Sender: TObject);

var

  hIco: HICON;

begin

  if PickIcon(Handle, FIconExe, FIconIndex) then

  begin

    hIco := ExtractIcon(HInstance, PChar(FIconExe), FIconIndex);

    if hIco < 2

    then

      {$IFDEF DELPHI4UP}

      RaiseLastWin32Error

      {$ELSE}

      Raise Exception.Create(SysErrorMessage(GetLastError))

      {$ENDIF}

    else

    begin

      imgIcon.Picture.Icon.Handle := hIco;

      lbDefaultIcon.Visible := False;

      btnUseDefaultIcon.Enabled := not lbDefaultIcon.Visible

    end;

  end;

end;

procedure TdlgConvertToSFX.btnUseDefaultIconClick(Sender: TObject);

begin

  imgIcon.Picture.Bitmap.FreeImage;

  imgIcon.Picture.Icon.ReleaseHandle;

  lbDefaultIcon.Visible := True;

  btnUseDefaultIcon.Enabled := not lbDefaultIcon.Visible

end;

procedure TdlgConvertToSFX.btnStoreSettingsClick(Sender: TObject);

begin

  with dlgSaveSettings

  do

    if Execute then

    begin

      SetZipSFXFromControls;

      ZipSFX1.SaveToFile(FileName);

    end;

end;

procedure TdlgConvertToSFX.btnSelPath1Click(Sender: TObject);

var

  s: string;

begin

  s := cbDefPath.Text;

  {$IFDEF DELPHI4UP}

  if SelectDirectory('Select default extraction path','',s)

  {$ELSE}

  if SelectDirectory(s,[],0)

  {$ENDIF}

  then

    cbDefPath.Text := s;

end;

procedure TdlgConvertToSFX.btnSelPath2Click(Sender: TObject);

var

  s: string;

begin

  s := edFailPath.Text;

  {$IFDEF DELPHI4UP}

  if SelectDirectory('Select default fallback extraction path','',s)

  {$ELSE}

  if SelectDirectory(s,[],0)

  {$ENDIF}

  then

    edFailPath.Text := s;

end;

procedure TdlgConvertToSFX.btnFinishClick(Sender: TObject);

begin

  Finish;

end;

procedure TdlgConvertToSFX.Finish;

begin

  SetZipSFXFromControls;

  ZipSFX1.StartWaitCursor;

  try

    if not FMakeNew

    then

      ZipSFX1.ConvertToSFX

    else

      ZipSFX1.CreateNewSFX;

  finally

    ZipSFX1.StopWaitCursor;

  end;

  if MessageDlg('Self extracting archive '+ZipSFX1.TargetFile+#13#10+

    'has been created. Do you want to test it?', mtConfirmation, [mbYes, mbNo], 0) = mrYes

  then

    if WinExec(PChar(ZipSFX1.TargetFile) , SW_SHOW) < 32

    then

      {$IFDEF DELPHI4UP}

      RaiseLastWin32Error;

      {$ELSE}

      Raise Exception.Create(SysErrorMessage(GetLastError));

      {$ENDIF}

  Close;

end;

procedure TdlgConvertToSFX.PrepareMakeNew;

begin

  Caption := 'Create an empty .EXE SFX';

  FMakeNew := True;

  edTarget.Left := edSource.Left;

  Label2.Left := Label1.Left;

  btnTarget.Left := btnSource.Left;

  edSource.Hide;

  Label1.Hide;

  btnSource.Hide;

end;

end.