Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit demo2_2;
  2. (************************************************************************
  3.  Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
  4.       Eric W. Engler and Chris Vleghert.
  5.  
  6.    This file is part of TZipMaster Version 1.9.
  7.  
  8.     TZipMaster is free software: you can redistribute it and/or modify
  9.     it under the terms of the GNU Lesser General Public License as published by
  10.     the Free Software Foundation, either version 3 of the License, or
  11.     (at your option) any later version.
  12.  
  13.     TZipMaster is distributed in the hope that it will be useful,
  14.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.     GNU Lesser General Public License for more details.
  17.  
  18.     You should have received a copy of the GNU Lesser General Public License
  19.     along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.
  20.  
  21.     contact: problems@delphizip.org (include ZipMaster in the subject).
  22.     updates: http://www.delphizip.org
  23.     DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
  24. ************************************************************************)
  25.  
  26.  
  27. interface
  28.  
  29. uses
  30.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  31.   Dialogs, StdCtrls, ExtCtrls, ZipSFXPlus, SFXInterface, Buttons, FileCtrl,
  32.   ZipSFXBase;//, DZUtils;
  33.  
  34. type
  35.   TdlgConvertToSFX = class(TForm)
  36.     Panel1: TPanel;
  37.     Button1: TButton;
  38.     lbHeader: TLabel;
  39.     btnPrev: TButton;
  40.     btnNext: TButton;
  41.     Panel2: TPanel;
  42.     Notebook1: TNotebook;
  43.     dlgOpenZip: TOpenDialog;
  44.     dlgSaveSFX: TSaveDialog;
  45.     ZipSFX1: TZipSFXPlus;
  46.     dlgOpenSettings: TOpenDialog;
  47.     rgOverwriteMode: TRadioGroup;
  48.     GroupBox1: TGroupBox;
  49.     cbAskCmdLine: TCheckBox;
  50.     cbAskFiles: TCheckBox;
  51.     cbHideOverwriteBox: TCheckBox;
  52.     cbAutorun: TCheckBox;
  53.     cbNoSuccessMsg: TCheckBox;
  54.     cbExpandVariables: TCheckBox;
  55.     cbInitiallyHideFiles: TCheckBox;
  56.     cbForceHideFiles: TCheckBox;
  57.     cbCanBeCancelled: TCheckBox;
  58.     cbCheckAutoRunFileName: TCheckBox;
  59.     GroupBox2: TGroupBox;
  60.     imgIcon: TImage;
  61.     btnSelectIcon: TButton;
  62.     GroupBox3: TGroupBox;
  63.     edTitle: TEdit;
  64.     GroupBox4: TGroupBox;
  65.     Label4: TLabel;
  66.     edMessage: TEdit;
  67.     Label3: TLabel;
  68.     cbMessageFlags: TComboBox;
  69.     lbDefaultIcon: TLabel;
  70.     btnUseDefaultIcon: TButton;
  71.     GroupBox5: TGroupBox;
  72.     Label1: TLabel;
  73.     edSource: TEdit;
  74.     btnSource: TButton;
  75.     Label2: TLabel;
  76.     edTarget: TEdit;
  77.     btnTarget: TButton;
  78.     GroupBox6: TGroupBox;
  79.     cbDefPath: TComboBox;
  80.     btnLoadSettings: TSpeedButton;
  81.     btnStoreSettings: TSpeedButton;
  82.     dlgSaveSettings: TSaveDialog;
  83.     Label5: TLabel;
  84.     edFailPath: TEdit;
  85.     btnSelPath1: TButton;
  86.     btnSelPath2: TButton;
  87.     GroupBox7: TGroupBox;
  88.     edCommandline: TEdit;
  89.     btnFinish: TButton;
  90.     GroupBox8: TGroupBox;
  91.     cbLanguages: TComboBox;
  92.     cbDetached: TCheckBox;
  93.     procedure Button1Click(Sender: TObject);
  94.     procedure FormCreate(Sender: TObject);
  95.     procedure Notebook1PageChanged(Sender: TObject);
  96.     procedure btnSourceClick(Sender: TObject);
  97.     procedure btnTargetClick(Sender: TObject);
  98.     procedure btnNextClick(Sender: TObject);
  99.     procedure btnPrevClick(Sender: TObject);
  100.     procedure btnLoadSettingsClick(Sender: TObject);
  101.     procedure btnSelectIconClick(Sender: TObject);
  102.     procedure btnUseDefaultIconClick(Sender: TObject);
  103.     procedure btnStoreSettingsClick(Sender: TObject);
  104.     procedure btnSelPath1Click(Sender: TObject);
  105.     procedure btnSelPath2Click(Sender: TObject);
  106.     procedure btnFinishClick(Sender: TObject);
  107.   private
  108.     { Private-Deklarationen }
  109.     FIconIndex: Integer;
  110.     FIconEXE: string;
  111.     FMakeNew : Boolean;
  112.     procedure GotoPage(const iPage: Integer);
  113.     procedure SetZipSFXFromControls;
  114.     procedure SetControlsFromZipSFX;
  115.     procedure Finish;
  116.   public
  117.     { Public-Deklarationen }
  118.     procedure PrepareMakeNew;
  119.   end;
  120.  
  121. var
  122.   dlgConvertToSFX: TdlgConvertToSFX;
  123.  
  124. implementation
  125.  
  126. {$I DELVER.INC}
  127.  
  128. uses ShellAPI, demo2_1;
  129.  
  130. {$R *.dfm}
  131.  
  132. procedure TdlgConvertToSFX.Button1Click(Sender: TObject);
  133. begin
  134.   Close;
  135. end;
  136.  
  137. procedure TdlgConvertToSFX.FormCreate(Sender: TObject);
  138. begin
  139.   // Enumerate all compiled languages
  140.   cbLanguages.Items.Text := TZipSFXPlus.GetSupportedSFXLanguages;
  141.  
  142.   FMakeNew := False;
  143.   SetControlsFromZipSFX;
  144.   GotoPage(0);
  145. end;
  146.  
  147. procedure TdlgConvertToSFX.GotoPage(const iPage: Integer);
  148. begin
  149.   if NoteBook1.PageIndex = iPage
  150.   then
  151.     Notebook1PageChanged(NoteBook1)
  152.   else
  153.     NoteBook1.PageIndex := iPage;
  154.  
  155.   lbHeader.Caption := '  '+NoteBook1.ActivePage;
  156.   btnPrev.Enabled := NoteBook1.PageIndex > 0;
  157.   if (NoteBook1.PageIndex < Pred(NoteBook1.Pages.Count))
  158.   then
  159.     btnNext.Caption := '&Next >>'
  160.   else
  161.     btnNext.Caption := '&Finish';
  162. end;
  163.  
  164. procedure TdlgConvertToSFX.Notebook1PageChanged(Sender: TObject);
  165. begin
  166.   case NoteBook1.PageIndex of
  167.     0:
  168.     begin
  169.       btnNext.Enabled := (FMakeNew or (edSource.Text <> '')) and (edTarget.Text <> '');
  170.       btnFinish.Enabled := btnNext.Enabled;
  171.     end;
  172.   end;
  173. end;
  174.  
  175. procedure TdlgConvertToSFX.btnSourceClick(Sender: TObject);
  176. begin
  177.   with dlgOpenZip do
  178.   begin
  179.     if FileExists(edSource.Text)
  180.     then
  181.       FileName := edSource.Text;
  182.     if Execute
  183.     then
  184.       edSource.Text := FileName;
  185.   end;
  186. end;
  187.  
  188. procedure TdlgConvertToSFX.btnTargetClick(Sender: TObject);
  189. begin
  190.   with dlgSaveSFX do
  191.   begin
  192.     if FileExists(edSource.Text) and (edTarget.Text = '')
  193.     then
  194.       FileName := ChangeFileExt(edSource.Text, '.exe')
  195.     else
  196.       if edTarget.Text <> ''
  197.       then
  198.         FileName := edTarget.Text;
  199.  
  200.     if Execute
  201.     then
  202.       edTarget.Text := FileName;
  203.   end;
  204.  
  205. end;
  206.  
  207. procedure TdlgConvertToSFX.btnNextClick(Sender: TObject);
  208. begin
  209.   if Notebook1.PageIndex = Pred(NoteBook1.Pages.Count)
  210.   then
  211.     Finish
  212.   else
  213.     GotoPage(NoteBook1.PageIndex +1);
  214. end;
  215.  
  216. procedure TdlgConvertToSFX.btnPrevClick(Sender: TObject);
  217. begin
  218.   GotoPage(NoteBook1.PageIndex -1);
  219. end;
  220.  
  221. procedure TdlgConvertToSFX.btnLoadSettingsClick(Sender: TObject);
  222. begin
  223.   with dlgOpenSettings
  224.   do
  225.     if Execute then
  226.     begin
  227.       SetZipSFXFromControls;
  228.       try
  229.         ZipSFX1.LoadFromFile(FileName);
  230.       finally
  231.         SetControlsFromZipSFX;
  232.       end;
  233.     end;
  234. end;
  235.  
  236. procedure TdlgConvertToSFX.SetControlsFromZipSFX;
  237. begin
  238.   with ZipSFX1 do
  239.   begin
  240.     edSource.Text := SourceFile;
  241.     edTarget.Text := TargetFile;
  242.  
  243.     rgOverwriteMode.ItemIndex := Integer(OverwriteMode);
  244.  
  245.     cbAskCmdLine.Checked := soAskCmdLine in Options;
  246.     cbAskFiles.Checked := soAskFiles in Options;
  247.     cbHideOverWriteBox.Checked := soHideOverWriteBox in Options;
  248.     cbAutoRun.Checked := soAutoRun in Options;
  249.     cbNoSuccessMsg.Checked := soNoSuccessMsg in Options;
  250.     cbExpandVariables.Checked := soExpandVariables in Options;
  251.     cbInitiallyHideFiles.Checked := soInitiallyHideFiles in Options;
  252.     cbForceHideFiles.Checked := soForceHideFiles in Options;
  253.     cbCheckAutoRunFileName.Checked := soCheckAutoRunFileName in Options;
  254.     cbDetached.Checked := soDetached in Options;
  255.     cbCanBeCancelled.Checked := soCanBeCancelled in Options;
  256.  
  257.     imgIcon.Picture.Icon.Assign(Icon);
  258.     lbDefaultIcon.Visible := imgIcon.Picture.Icon.Empty;
  259.     btnUseDefaultIcon.Enabled := not lbDefaultIcon.Visible;
  260.  
  261.     edTitle.Text := DialogTitle;
  262.     cbDefPath.Text := DefaultExtractPath;
  263.     edFailPath.Text := FallbackExtractPath;
  264.     edCommandline.Text := CommandLine;
  265.  
  266.     // show language
  267.     cbLanguages.Text := SFXLanguage;
  268.  
  269.     edMessage.Text := Message;
  270.     case MessageFlags of
  271.       MB_OK: cbMessageFlags.ItemIndex := 0;
  272.       MB_ICONINFORMATION or MB_OKCANCEL: cbMessageFlags.ItemIndex := 2;
  273.       MB_ICONQUESTION or MB_YESNO: cbMessageFlags.ItemIndex := 1;
  274.     else
  275.       cbMessageFlags.Text := IntToStr(MessageFlags);
  276.     end;
  277.   end;
  278. end;
  279.  
  280. procedure TdlgConvertToSFX.SetZipSFXFromControls;
  281. var
  282.   FOpts: TSFXOptions;
  283. begin
  284.   with ZipSFX1 do
  285.   begin
  286.     SourceFile := edSource.Text;
  287.     TargetFile := edTarget.Text;
  288.  
  289.     OverwriteMode := TSFXOverwriteMode(rgOverwriteMode.ItemIndex);
  290.  
  291.     FOpts := [];
  292.     if cbAskCmdLine.Checked then Include(FOpts,  soAskCmdLine);
  293.     if cbAskFiles.Checked then Include(FOpts,  soAskFiles);
  294.     if cbHideOverWriteBox.Checked then Include(FOpts,  soHideOverWriteBox);
  295.     if cbAutoRun.Checked then Include(FOpts,  soAutoRun);
  296.     if cbNoSuccessMsg.Checked then Include(FOpts,  soNoSuccessMsg);
  297.     if cbExpandVariables.Checked then Include(FOpts,  soExpandVariables);
  298.     if cbInitiallyHideFiles.Checked then Include(FOpts,  soInitiallyHideFiles);
  299.     if cbForceHideFiles.Checked then Include(FOpts,  soForceHideFiles);
  300.     if cbCheckAutoRunFileName.Checked then Include(FOpts,  soCheckAutoRunFileName);
  301.     if cbDetached.Checked then Include(FOpts, soDetached);
  302.     if cbCanBeCancelled.Checked then Include(FOpts,  soCanBeCancelled);
  303.     Options := FOpts;
  304.  
  305.     Icon.Assign(imgIcon.Picture.Icon);
  306.  
  307.     DialogTitle := edTitle.Text;
  308.     DefaultExtractPath := cbDefPath.Text;
  309.     FallbackExtractPath := edFailPath.Text;
  310.     CommandLine := edCommandline.Text;
  311.  
  312.     // set language
  313.     SFXLanguage := cbLanguages.Text;
  314.  
  315.     Message := edMessage.Text;
  316.     case cbMessageFlags.Items.IndexOf(cbMessageFlags.Text) of
  317.       0: MessageFlags := MB_OK;
  318.       1: MessageFlags := MB_ICONQUESTION or MB_YESNO;
  319.       2: MessageFlags := MB_ICONINFORMATION or MB_OKCANCEL;
  320.     else
  321.       try
  322.         MessageFlags := {$IFDEF DELPHI4UP}StrToInt64{$ELSE}StrToInt{$ENDIF}(cbMessageFlags.Text);
  323.       except
  324.         GoToPage(2);
  325.         cbMessageFlags.SetFocus;
  326.         raise;
  327.       end;
  328.     end;
  329.   end;
  330. end;
  331.  
  332. procedure TdlgConvertToSFX.btnSelectIconClick(Sender: TObject);
  333. var
  334.   hIco: HICON;
  335. begin
  336.   if PickIcon(Handle, FIconExe, FIconIndex) then
  337.   begin
  338.     hIco := ExtractIcon(HInstance, PChar(FIconExe), FIconIndex);
  339.     if hIco < 2
  340.     then
  341.       {$IFDEF DELPHI4UP}
  342.       RaiseLastWin32Error
  343.       {$ELSE}
  344.       Raise Exception.Create(SysErrorMessage(GetLastError))
  345.       {$ENDIF}
  346.     else
  347.     begin
  348.       imgIcon.Picture.Icon.Handle := hIco;
  349.       lbDefaultIcon.Visible := False;
  350.       btnUseDefaultIcon.Enabled := not lbDefaultIcon.Visible
  351.     end;
  352.   end;
  353. end;
  354.  
  355. procedure TdlgConvertToSFX.btnUseDefaultIconClick(Sender: TObject);
  356. begin
  357.   imgIcon.Picture.Bitmap.FreeImage;
  358.   imgIcon.Picture.Icon.ReleaseHandle;
  359.   lbDefaultIcon.Visible := True;
  360.   btnUseDefaultIcon.Enabled := not lbDefaultIcon.Visible
  361. end;
  362.  
  363. procedure TdlgConvertToSFX.btnStoreSettingsClick(Sender: TObject);
  364. begin
  365.   with dlgSaveSettings
  366.   do
  367.     if Execute then
  368.     begin
  369.       SetZipSFXFromControls;
  370.       ZipSFX1.SaveToFile(FileName);
  371.     end;
  372. end;
  373.  
  374. procedure TdlgConvertToSFX.btnSelPath1Click(Sender: TObject);
  375. var
  376.   s: string;
  377. begin
  378.   s := cbDefPath.Text;
  379.   {$IFDEF DELPHI4UP}
  380.   if SelectDirectory('Select default extraction path','',s)
  381.   {$ELSE}
  382.   if SelectDirectory(s,[],0)
  383.   {$ENDIF}
  384.   then
  385.     cbDefPath.Text := s;
  386. end;
  387.  
  388. procedure TdlgConvertToSFX.btnSelPath2Click(Sender: TObject);
  389. var
  390.   s: string;
  391. begin
  392.   s := edFailPath.Text;
  393.   {$IFDEF DELPHI4UP}
  394.   if SelectDirectory('Select default fallback extraction path','',s)
  395.   {$ELSE}
  396.   if SelectDirectory(s,[],0)
  397.   {$ENDIF}
  398.   then
  399.     edFailPath.Text := s;
  400. end;
  401.  
  402. procedure TdlgConvertToSFX.btnFinishClick(Sender: TObject);
  403. begin
  404.   Finish;
  405. end;
  406.  
  407. procedure TdlgConvertToSFX.Finish;
  408. begin
  409.   SetZipSFXFromControls;
  410.   ZipSFX1.StartWaitCursor;
  411.   try
  412.     if not FMakeNew
  413.     then
  414.       ZipSFX1.ConvertToSFX
  415.     else
  416.       ZipSFX1.CreateNewSFX;
  417.   finally
  418.     ZipSFX1.StopWaitCursor;
  419.   end;
  420.  
  421.   if MessageDlg('Self extracting archive '+ZipSFX1.TargetFile+#13#10+
  422.     'has been created. Do you want to test it?', mtConfirmation, [mbYes, mbNo], 0) = mrYes
  423.   then
  424.     if WinExec(PChar(ZipSFX1.TargetFile) , SW_SHOW) < 32
  425.     then
  426.       {$IFDEF DELPHI4UP}
  427.       RaiseLastWin32Error;
  428.       {$ELSE}
  429.       Raise Exception.Create(SysErrorMessage(GetLastError));
  430.       {$ENDIF}
  431.  
  432.   Close;
  433. end;
  434.  
  435. procedure TdlgConvertToSFX.PrepareMakeNew;
  436. begin
  437.   Caption := 'Create an empty .EXE SFX';
  438.   FMakeNew := True;
  439.   edTarget.Left := edSource.Left;
  440.   Label2.Left := Label1.Left;
  441.   btnTarget.Left := btnSource.Left;
  442.   edSource.Hide;
  443.   Label1.Hide;
  444.   btnSource.Hide;
  445. end;
  446.  
  447. end.
  448.