home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 39 / IOPROG_39.ISO / SOFT / vbasic / xceedzip.exe / 16-bit / Samples / Delphi1 / MAINFM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-11-18  |  46.4 KB  |  1,300 lines
  1. unit MainFm;
  2.  
  3. {===========================================================
  4.     DESCRIPTION:  Xceed Zip Delphi 1.0 Sample Application
  5.     COPYRIGHT:    ⌐ Copyright 1995-1998 Xceed Software Inc.,
  6.                   All Rights Reserved.
  7.  ===========================================================}
  8.  
  9. interface
  10.  
  11. uses
  12.   XceedZip,
  13.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, FileCtrl,
  14.   Forms, Dialogs, Menus, ExtCtrls, StdCtrls, Gauges, Buttons,sfxfm;
  15.  
  16. type
  17.   TMainFormFm = class(TForm)
  18.     FilesLb: TListBox;
  19.     FilesHd: THeader;
  20.     MainMn: TMainMenu;
  21.     StatusPn: TPanel;
  22.     Bevel1: TBevel;
  23.     SpacePn: TPanel;
  24.     StatusLb: TLabel;
  25.     Panel1: TPanel;
  26.     ProgressGa: TGauge;
  27.     FileMn: TMenuItem;
  28.     FileNewMn: TMenuItem;
  29.     FileOpenMn: TMenuItem;
  30.     FileCloseMn: TMenuItem;
  31.     N1: TMenuItem;
  32.     FileExitMn: TMenuItem;
  33.     HelpMn: TMenuItem;
  34.     HelpAboutMn: TMenuItem;
  35.     EditMn: TMenuItem;
  36.     EditAddMn: TMenuItem;
  37.     EditDeleteMn: TMenuItem;
  38.     EditExtractMn: TMenuItem;
  39.     N2: TMenuItem;
  40.     EditSelectAllMn: TMenuItem;
  41.     AddFilesDg: TOpenDialog;
  42.     NewZipDg: TSaveDialog;
  43.     OpenZipDg: TOpenDialog;
  44.     Panel2: TPanel;
  45.     AbortSb: TSpeedButton;
  46.     N3: TMenuItem;
  47.     EditUpdateMn: TMenuItem;
  48.     N4: TMenuItem;
  49.     EditUpdateZIPDateMn: TMenuItem;
  50.     HintLb: TLabel;
  51.     FileDeleteMn: TMenuItem;
  52.     FileTestMn: TMenuItem;
  53.     FileFixMn: TMenuItem;
  54.     MainXz: TXceedZip;
  55.     OptionsMn: TMenuItem;
  56.     OptionsUseTempFileMn: TMenuItem;
  57.     Fastestcompression: TMenuItem;
  58.     Normalcompression: TMenuItem;
  59.     Bestcompression: TMenuItem;
  60.     FixNormal1: TMenuItem;
  61.     FixAgressive1: TMenuItem;
  62.     MultidiskmodeMn: TMenuItem;
  63.     N6: TMenuItem;
  64.     ClearDisksMn: TMenuItem;
  65.     NoCompression: TMenuItem;
  66.     N7: TMenuItem;
  67.     N5: TMenuItem;
  68.     SelfExtractingMnu: TMenuItem;
  69.     SelfextractorOptionsmnu: TMenuItem;
  70.     procedure FilesLbDrawItem(Control: TWinControl; Index: Integer;
  71.       Rect: TRect; State: TOwnerDrawState);
  72.     procedure FilesLbMeasureItem(Control: TWinControl; Index: Integer;
  73.       var Height: Integer);
  74.     procedure FileNewMnClick(Sender: TObject);
  75.     procedure FileOpenMnClick(Sender: TObject);
  76.     procedure FileCloseMnClick(Sender: TObject);
  77.     procedure FileExitMnClick(Sender: TObject);
  78.     procedure EditAddMnClick(Sender: TObject);
  79.     procedure EditDeleteMnClick(Sender: TObject);
  80.     procedure EditExtractMnClick(Sender: TObject);
  81.     procedure EditSelectAllMnClick(Sender: TObject);
  82.     procedure HelpAboutMnClick(Sender: TObject);
  83.     procedure FormCreate(Sender: TObject);
  84.     procedure MainXzAdding(XceedZip: TXceedZip;
  85.       const FileStats: TXcdFileStats);
  86.     procedure MainXzDeleting(XceedZip: TXceedZip;
  87.       const FileName: String);
  88.     procedure MainXzFixing(XceedZip: TXceedZip;
  89.       const FileName: String);
  90.     procedure MainXzStatus(XceedZip: TXceedZip;
  91.       const FileStats: TXcdFileStats);
  92.     procedure MainXzUpdating(XceedZip: TXceedZip;
  93.       const FileStats: TXcdFileStats);
  94.     procedure AbortSbClick(Sender: TObject);
  95.     procedure EditMnClick(Sender: TObject);
  96.     procedure FileMnClick(Sender: TObject);
  97.     procedure EditUpdateMnClick(Sender: TObject);
  98.     procedure EditUpdateZIPDateMnClick(Sender: TObject);
  99.     procedure MainXzListing(XceedZip: TXceedZip;
  100.       const FileStats: TXcdFileStats);
  101.     procedure FileDeleteMnClick(Sender: TObject);
  102.     procedure FileTestMnClick(Sender: TObject);
  103.     procedure MainXzTesting(XceedZip: TXceedZip;
  104.       const FileStats: TXcdFileStats);
  105.     procedure MainXzExtracting(XceedZip: TXceedZip;
  106.       const FileStats: TXcdFileStats);
  107.     procedure OptionsMnClick(Sender: TObject);
  108.     procedure OptionsUseTempFileMnClick(Sender: TObject);
  109.     procedure MainXzSkippingFile(XceedZip: TXceedZip;
  110.       const Skipping: TXcdSkipping);
  111.     procedure MainXzReplace(XceedZip: TXceedZip; var Replace: TXcdReplace);
  112.     procedure FastestcompressionClick(Sender: TObject);
  113.     procedure NormalcompressionClick(Sender: TObject);
  114.     procedure BestcompressionClick(Sender: TObject);
  115.     procedure FixNormal1Click(Sender: TObject);
  116.     procedure FixAgressive1Click(Sender: TObject);
  117.     procedure MainXzNewdisk(XceedZip: TXceedZip;
  118.       const Disknumber: Integer);
  119.     procedure MultidiskmodeMnClick(Sender: TObject);
  120.     procedure NoCompressionClick(Sender: TObject);
  121.     procedure ClearDisksMnClick(Sender: TObject);
  122.     procedure MainXzGlobalStatus(XceedZip: TXceedZip;
  123.       const GlobalStats: TXcdGlobalStats);
  124.     procedure SelfExtractingMnuClick(Sender: TObject);
  125.     procedure SelfextractorOptionsmnuClick(Sender: TObject);
  126.     procedure SetSfxConfiguration;
  127.   private
  128.     { Private declarations }
  129.     MinWidth: Integer;
  130.     TotalSize,
  131.     TotalZipSize: LongInt;
  132.     FilesLbBytes: LongInt;
  133.     Testing: Boolean;
  134.  
  135.     procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
  136.       message WM_GETMINMAXINFO;
  137.  
  138.     procedure StatusBarShowHint(Sender: TObject);
  139.     procedure EnableInterface(Enable: Boolean);
  140.  
  141.     procedure LoadFileList;
  142.   public
  143.     { Public declarations }
  144.   end;
  145.  
  146. var
  147.   MainFormFm: TMainFormFm;
  148.  
  149. implementation
  150.  
  151. {$R *.DFM}
  152.  
  153. procedure FileFix(Agressive: Boolean); forward;
  154.  
  155. { The ParseTab function extracts a field from a string containing tab-separated
  156.   fields. For example, this function can extract the third item in a string that
  157.   was assigned the value of an item in a multi-column listbox, since items in
  158.   each column of a listbox are separated by tabs. Pass the column number in the
  159.   FieldIndex parameter. The variable passed in the FieldIndex parameter will be
  160.   incremented. The return value of ParseTab is the extracted string. }
  161.  
  162. function ParseTab(const Str: String;  var FieldIndex: Integer): String;
  163. var
  164.   I: Integer;
  165. begin
  166.   Result := '';
  167.   if (FieldIndex > 0) and (FieldIndex <= Length(Str)) then
  168.     begin
  169.       for I := FieldIndex to Length(Str) + 1 do
  170.         if (I <= Length(Str)) and (Str[I] = #9) then
  171.           Break;
  172.  
  173.       if (I <= Length(Str)) then
  174.         begin
  175.           Result := Copy(Str, FieldIndex, I - FieldIndex);
  176.           FieldIndex := I + 1;
  177.         end
  178.       else
  179.         begin
  180.           Result := Copy(Str, FieldIndex, SizeOf(String));
  181.           FieldIndex := 0;
  182.         end;
  183.     end
  184.   else
  185.     FieldIndex := 0;
  186. end;
  187.  
  188. { The AssignFromLb procedure takes all the entries in the first column of a
  189.   listbox and places them in a TStringList. In this sample application,
  190.   AssignFromLb is used to take all the path and filenames and place them
  191.   in a TStringList. When the demo is running, it may look as if only
  192.   filenames appear in the first column, and the pathnames are in column 7,
  193.   but that is only on screen. In reality, the data in column 1 contains
  194.   paths and filenames. }
  195.  
  196. procedure AssignFromLb(SourceLb: TListBox; DestList: TStringList);
  197. var
  198.   I, C: Integer;
  199. begin
  200.   if (SourceLb.SelCount > 0) then
  201.     for I := 0 to SourceLb.Items.Count - 1 do
  202.       if SourceLb.Selected[I] then
  203.         begin
  204.           C := 1;
  205.           DestList.Add(ParseTab(SourceLb.Items[I], C));
  206.         end;
  207. end;
  208.  
  209. { The DoubleBackslashFix procedure fixes a bug in Delphi 1.0's file dialog
  210.   box. The problem was when selecting multiple files from any root directory,
  211.   filenames would be listed with a double backslash after the drive name.
  212.   For example: 'c:\\hi.txt' This function removes one of the two backslashes. }
  213.  
  214. procedure DoubleBackslashFix(var FileList: TStrings);
  215. var
  216.   I: Integer;
  217. begin
  218.   for I := 0 to Pred(FileList.Count) do
  219.     if ((Length(FileList[I])>4) and (Copy(FileList[I],2,3) = ':\\')) then
  220.       FileList[I] := Copy(FileList[I], 1, 3) +
  221.         Copy(FileList[I], 5, Length(FileList[I])-4);
  222. end;
  223.  
  224. { The HandleError function is a sample error handling routine for the purposes
  225.   of this sample application, but can be used in your own programs as well.
  226.   When an error occurs, it displays a message box indicating the nature of
  227.   the error. If a warning occurs, an information message box will be shown.
  228.   The function also returns a result of 0 if ErrorCode was 0, 1 if a warning
  229.   occured, or 2 if an error occured. }
  230.  
  231. function HandleError(ErrorCode: Integer; DoingWhat: String): Integer;
  232. var
  233.   EDesc: String;
  234.   InfoOnly: Boolean;
  235.   ErrorType: Integer;
  236. begin
  237.   EDesc := '';
  238.   InfoOnly := False;
  239.   ErrorType := 2;
  240.  
  241.   if ErrorCode > XcdSuccess then
  242.     case ErrorCode of
  243.  
  244.     XcdWarningGeneral,
  245.     XcdWarningNoZipFile,
  246.     XcdErrorNothingToDo:
  247.     { Do not show a message box for these three warning codes. }
  248.       begin
  249.         EDesc := '';
  250.         ErrorType := 1;
  251.       end;
  252.     XcdWarningFilesSkipped:
  253.       begin
  254.         EDesc := 'Some files were skipped while ' + DoingWhat + '.';
  255.         InfoOnly := True;
  256.         ErrorType := 1;
  257.       end;
  258.     XcdWarningEmptyZipfile:
  259.       begin
  260.         EDesc := 'The Zip file is empty.';
  261.         InfoOnly := True;
  262.         ErrorType := 1;
  263.       end;
  264.     XcdErrorUserAbort:
  265.       begin
  266.         EDesc := 'The ' + DoingWhat + ' operation was aborted.';
  267.         InfoOnly := True;
  268.       end;
  269.     XcdErrorNoZipFile:
  270.       EDesc := 'Could not find the archive file.';
  271.     XcdErrorEOF,
  272.     XcdErrorZipStruct:
  273.       EDesc := 'The archive file is corrupted. Try using the Fix option on it.';
  274.     XcdErrorMemory:
  275.       EDesc := 'Ran out of memory while ' + DoingWhat + '.';
  276.     XcdErrorDiskFull:
  277.       EDesc := 'Disk full while ' + DoingWhat + '.';
  278.     XcdErrorTestFailed:
  279.       EDesc := 'Test failed - Errors in the archive.';
  280.     XcdErrorZeroTested:
  281.       EDesc := 'No files ended up being tested in the archive.';
  282.     XcdErrorDLLNotFound:
  283.       EDesc := 'The XCDZIP.DLL or the XCDUNZIP.DLL file could not be found.';
  284.     XcdErrorTempFile:
  285.       EDesc := 'Problem with the temporary file.';
  286.     XcdErrorLatest:
  287.       EDesc := 'Could not update the Zip archive date. Archive only contains ' +
  288.         'directories or is empty.';
  289.     XcdErrorLibInUse:
  290.       EDesc := 'Another application is currently using the Xceed Zip component. ' +
  291.         'Wait until the other application has completed its operation.';
  292.     XcdErrorParentDir:
  293.       EDesc := 'Attempt to remove parent directory.';
  294.     XcdErrorDosError:
  295.       EDesc := 'Read/Write error with the Zip file or one of the files to process.';
  296.     XcdErrorNameRepeat:
  297.       EDesc := 'Names repeated in archive after discarding pathnames.';
  298.     XcdErrorMultidisk:
  299.       EDesc := 'Attempt to work with a multiple-disk Zip archive, but not in multidisk mode.';
  300.     XcdErrorWrongDisk:
  301.       EDesc := 'Wrong disk was inserted too many times.';
  302.     XcdErrorMultiDiskBadCall:
  303.       EDesc := 'Function cannot be used with multidisk mode.';
  304.     XcdErrorCantOpenBinary:
  305.       EDesc := 'Could not open the self-extractor binary.';
  306.     XcdErrorCantOpenSFXConfig:
  307.       EDesc := 'Could not open the self-extractor configuration file';
  308.     XcdErrorInvalidEventParam:
  309.       EDesc := 'Invalid command parameter passed to an Xceed Zip event.';
  310.     XcdErrorCantWriteSfx:
  311.       EDesc := 'Not enough space on first disk to write self-extractor.';
  312.     XcdErrorRead:
  313.       EDesc := 'Problem reading from file while ' + DoingWhat + '.';
  314.     XcdErrorWrite:
  315.       EDesc := 'Problem writing to file while ' + DoingWhat + '.';
  316.     XcdErrorBinaryVersion:
  317.       EDesc := 'Invalid self-extractor binary version.';
  318.     XcdErrorCantCreateDir:
  319.       EDesc := 'Problem creating destination directory while ' + DoingWhat + '.';
  320.     XcdErrorBadCall: { Programming error, your fault ! }
  321.       EDesc := 'Invalid property settings. Programming error.';
  322.     else
  323.       EDesc := 'An error occured while '+ DoingWhat + ' the specified files.';
  324.     end
  325.   else
  326.     ErrorType := 0;
  327.  
  328.   if EDesc <> '' then
  329.     if InfoOnly then
  330.       MessageDlg(EDesc, mtInformation, [mbOK], 0)
  331.     else
  332.       MessageDlg(EDesc, mtError, [mbOK], 0);
  333.  
  334.   Result := ErrorType;
  335.  
  336. end;
  337.  
  338. { TMainFormFm }
  339. procedure TMainFormFm.FormCreate(Sender: TObject);
  340. begin
  341.   Application.OnHint := StatusBarShowHint;
  342.  
  343.   MinWidth := Width;
  344.  
  345.   Caption := 'Untitled - Xceed Zip Delphi 1.0 Sample Application';
  346.   Application.Title := Caption;
  347.   SetSfxConfiguration;
  348. end;
  349.  
  350. procedure TMainFormFm.WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo);
  351. begin
  352.   if Visible then
  353.     Message.MinMaxInfo^.ptMinTrackSize.X := MinWidth;
  354. end;
  355.  
  356. procedure TMainFormFm.StatusBarShowHint(Sender: TObject);
  357. begin
  358.   StatusLb.Visible := (Application.Hint = '');
  359.   HintLb.Visible := (Application.Hint <> '');
  360.   HintLb.Caption := Application.Hint;
  361. end;
  362.  
  363. { The EnableInterface procedure is used to 'shut down' parts of the graphical
  364.   interface of this sample application while the TXceedZip component is
  365.   working. It turns off menus, changes the cursor to an hourglass, etc.
  366.   It can also be called to turn everything back on. }
  367.  
  368. procedure TMainFormFm.EnableInterface(Enable: Boolean);
  369. const
  370.   DisableCount: Integer = 0;
  371. begin
  372.   if Enable then
  373.     { Keep track of multiple disables/enables, and enable interface only when
  374.       there are as many 'enables' as there were 'disables'. }
  375.     DisableCount := DisableCount - 1
  376.   else
  377.     DisableCount := DisableCount + 1;
  378.  
  379.   if (DisableCount < 0) then
  380.     DisableCount := 0;
  381.  
  382.   FileMn.Enabled := (DisableCount = 0);
  383.   EditMn.Enabled := (DisableCount = 0);
  384.   OptionsMn.Enabled := (DisableCount = 0);
  385.   HelpMn.Enabled := (DisableCount = 0);
  386.   FilesLb.Enabled := (DisableCount = 0);
  387.   { Do not allow abort when not using a temp file, it can corrupt the archive. }
  388.   AbortSb.Enabled := (DisableCount <> 0) and (MainXz.UseTempFile = True);
  389.  
  390.   if (DisableCount = 0) then
  391.     Cursor := crDefault
  392.   else
  393.     Cursor := crHourglass;
  394.  
  395.   if Enable then
  396.   begin
  397.     ProgressGa.Progress := 0;
  398.     StatusLb.Caption := IntToStr(FilesLb.Items.Count) + ' Entries, ' +
  399.       FloatToStrF(TotalSize div 1024, ffFixed, 10, 0) + 'K original size, ' +
  400.       FloatToStrF(TotalZipSize div 1024, ffFixed, 10, 0) + 'K compressed size.';
  401.   end;
  402.  
  403.   HintLb.Caption := '';
  404.  
  405.   { The HintLb and StatusLb labels are one on top of the other. }
  406.  
  407.   HintLb.Visible := (DisableCount = 0);
  408.   StatusLb.Visible := (DisableCount <> 0);
  409.  
  410. end;
  411.  
  412. { The LoadFileList procedure asks the TXceedZip component for a list of files
  413.   contained in the current archive. It calls the List method and expects to
  414.   receive all the information via the OnListing event. See the MainXzListing
  415.   procedure to see how the information is placed into the sample application's
  416.   main listbox. }
  417.  
  418. procedure  TMainFormFm.LoadFileList;
  419. var
  420.   Err: Integer;
  421. begin
  422.   TotalSize := 0;
  423.   TotalZipSize := 0;
  424.  
  425.   FilesLb.Items.Clear;
  426.   FilesLbBytes := 0;
  427.   FilesLb.Items.BeginUpdate;
  428.   Err := MainXz.List;
  429.   if (Err <> XcdErrorNoZipFile) then
  430.     HandleError(Err, 'reading archive contents');
  431.   FilesLb.Items.EndUpdate;
  432.  
  433.   ProgressGa.Progress := 0;
  434. end;
  435.  
  436. { The FileMnClick procedure makes sure that the proper items are enabled in the
  437.   File menu. }
  438.  
  439. procedure TMainFormFm.FileMnClick(Sender: TObject);
  440. begin
  441.   FileCloseMn.Enabled := (MainXz.ZipFileName <> '');
  442.   FileFixMn.Enabled := (MainXz.ZipFileName = '') and (not MainXz.MultidiskMode);
  443.   FileDeleteMn.Enabled := (MainXz.ZipFileName = '');
  444.   FileTestMn.Enabled := (MainXz.ZipFileName = '');
  445. end;
  446.  
  447. { The FileNewMnClick procedure creates a new archive file, but the archive file
  448.   is not really created until files are added to it first. }
  449.  
  450. procedure TMainFormFm.FileNewMnClick(Sender: TObject);
  451. begin
  452.   NewZipDg.FileName := '';
  453.   EnableInterface(False);
  454.   if NewZipDg.Execute then
  455.     begin
  456.       if FileExists(NewZipDg.FileName) then
  457.         DeleteFile(NewZipDg.FileName);
  458.       { Inform the TXceedZip component of the zip file name to use. }
  459.       MainXz.ZipFileName := NewZipDg.FileName;
  460.       Caption := ExtractFileName(MainXz.ZipFileName) + ' - Xceed Zip Delphi 1.0 Sample Application';
  461.       Application.Title := Caption;
  462.       FilesLb.Clear;
  463.       FilesLbBytes := 0;
  464.       TotalSize := 0;
  465.       TotalZipSize := 0;
  466.       StatusLb.Caption := '';
  467.     end;
  468.   EnableInterface(True);
  469. end;
  470.  
  471. { The FileOpenMnClick procedure opens an already existing archive, and calls
  472.   LoadFileList to list the archive's contents into the sample application's
  473.   main listbox. }
  474.  
  475. procedure TMainFormFm.FileOpenMnClick(Sender: TObject);
  476. begin
  477.   OpenZipDg.Title := 'Open Archive';
  478.   OpenZipDg.FileName := '';
  479.   EnableInterface(False);
  480.   if OpenZipDg.Execute then
  481.     begin
  482.       { Inform the TXceedZip component of the zip file name to use. }
  483.  
  484.       MainXz.ZipFileName := OpenZipDg.FileName;
  485.       Caption := ExtractFileName(MainXz.ZipFileName) + ' - Xceed Zip Delphi 1.0 Sample Application';
  486.       Application.Title := Caption;
  487.  
  488.       { Call procedure that will list the contents of the archive into the
  489.         sample application's main listbox. }
  490.  
  491.       LoadFileList;
  492.     end;
  493.   EnableInterface(True);
  494. end;
  495.  
  496. { The FileCloseMnClick procedure closes an archive. It does not really close the
  497.   archive because the archive is already closed when not being used. It only
  498.   clears the main listbox, the ZipFileName property of the TXceedZip component,
  499.   and the application title is reset. }
  500.  
  501. procedure TMainFormFm.FileCloseMnClick(Sender: TObject);
  502. begin
  503.   MainXz.ZipFileName := '';
  504.   Caption := 'Untitled - Xceed Zip Delphi 1.0 Sample Application';
  505.   Application.Title := Caption;
  506.   FilesLb.Clear;
  507.   FilesLbBytes := 0;
  508.   StatusLb.Caption := '';
  509. end;
  510.  
  511. { The FileDeleteMnClick procedure prompts the user for an archive file to
  512.   delete, then deletes it. }
  513.  
  514. procedure TMainFormFm.FileDeleteMnClick(Sender: TObject);
  515. begin
  516.   OpenZipDg.Title := 'Delete Archive';
  517.   OpenZipDg.FileName := '';
  518.   EnableInterface(False);
  519.  
  520.   if OpenZipDg.Execute and (MessageDlg('Are you sure you want to delete file'#13 + '"'
  521.      + OpenZipDg.FileName + '"?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
  522.     DeleteFile(OpenZipDg.FileName);
  523.  
  524.   EnableInterface(True);
  525. end;
  526.  
  527. { The FileTestMnClick procedure tells the TXceedZip component to test the
  528.   contents of an archive file selected by the user. A dialog box is opened for
  529.   the user to select the archive file. Note: The Test method is used, but is not
  530.   passed a list of files to process. Without a list of files to process, the
  531.   TXceedZip component will test all the files in the archive. You can pass a
  532.   list of files to test in the same way that files are passed to the Extract
  533.   method in the EditExtractMnClick procedure in this sample application. This
  534.   way, you can test specific files. }
  535.  
  536. procedure TMainFormFm.FileTestMnClick(Sender: TObject);
  537. var
  538.   Err: Integer;
  539. begin
  540.   OpenZipDg.Title := 'Test Archive';
  541.   OpenZipDg.FileName := '';
  542.   EnableInterface(False);
  543.  
  544.   { Open a dialog box to ask for the archive filename. }
  545.  
  546.   if OpenZipDg.Execute then
  547.     begin
  548.       { Inform the TXceedZip component of the filename. }
  549.       MainXz.ZipFileName := OpenZipDg.FileName;
  550.  
  551.       { Since it may take long before getting an OnTesting event so we can
  552.         display 'Testing file...' we will display 'Testing archive...' until then. }
  553.       StatusLb.Caption := 'Testing archive ' + MainXz.ZipFileName;
  554.       Testing := True; { used so that skipping messages are different }
  555.  
  556.       { Execute the Test method. Put return value in Err. }
  557.       Err := MainXz.Test;
  558.       Testing := False;
  559.  
  560.       { Since we are testing an archive file, XcdSuccess means that all the
  561.         files in the archive have passed the test. }
  562.       if (Err = XcdSuccess) then
  563.         MessageDlg('All files in the archive are OK.',
  564.           mtInformation, [mbOK], 0)
  565.       else if (Err = XcdWarningFilesSkipped) then
  566.         { We can permit ourselves to say 'Some files were skipped', without
  567.           specifying which ones, because the OnSkippingFile event will have
  568.           already informed us about each file being skipped. }
  569.         MessageDlg('All files tested in the archive are OK.'#13 +
  570.           '(Some files were skipped)', mtInformation, [mbOK], 0)
  571.       else
  572.         { Regular error handler. }
  573.         HandleError(Err, 'testing');
  574.  
  575.       MainXz.ZipFileName := '';
  576.  
  577.     end;
  578.     EnableInterface(True);
  579.  end;
  580.  
  581. procedure TMainFormFm.FileExitMnClick(Sender: TObject);
  582. begin
  583.   Close;
  584. end;
  585.  
  586. { The EditMnClick procedure makes sure that the proper menu items in the Edit
  587.   menu are enabled. For example, when we are in Multidisk mode, the Update,
  588.   Delete and UpdateZIPDate commands cannot be used. }
  589.  
  590. procedure TMainFormFm.EditMnClick(Sender: TObject);
  591. begin
  592.   EditAddMn.Enabled := (MainXz.ZipFileName <> '')
  593.     and ((MainXz.MultidiskMode = False) or (FilesLb.Items.Count = 0));
  594.   EditDeleteMn.Enabled := (FilesLb.SelCount > 0) and (not MainXz.MultidiskMode);
  595.   EditExtractMn.Enabled := (FilesLb.SelCount > 0);
  596.   EditUpdateMn.Enabled := (MainXz.ZipFileName <> '') and (not MainXz.MultidiskMode);
  597.   EditUpdateZIPDateMn.Enabled := (FilesLb.Items.Count > 0) and (not MainXz.MultidiskMode);
  598.   EditSelectAllMn.Enabled := (FilesLb.Items.Count > 0);
  599. end;
  600.  
  601. { The EditAddMnClick procedure adds files to the currently opened archive file.
  602.   A dialog box is opened to allow the user to select the files to be added to
  603.   the archive. Files selected in the sample application's main listbox
  604.   are not considered. }
  605.  
  606. procedure TMainFormFm.EditAddMnClick(Sender: TObject);
  607. var
  608.   Dir: String;
  609.   FilesToAdd: TStrings;
  610. begin
  611.   AddFilesDg.FileName := '';
  612.   EnableInterface(False);
  613.   { Allow user to select files to add with a dialog box. }
  614.   if AddFilesDg.Execute then
  615.     begin
  616.       FilesToAdd := AddFilesDg.Files;
  617.  
  618.       { Workaround for a Delphi dialog box problem }
  619.       DoubleBackslashFix(FilesToAdd);
  620.  
  621.       { Add all the files selected from the dialog box to the TXceedZip
  622.         component's list of files to process. }
  623.       MainXz.FilesToProcess.Assign(FilesToAdd);
  624.       StatusLb.Caption := 'Adding selected files.';
  625.  
  626.       { Add the files, handle return code. }
  627.       if HandleError(MainXz.Add(xecAll), 'adding') <> 2 then
  628.       begin
  629.         { If in Multidisk mode, tell user the add was completed (so that
  630.           the user may understand that any further disk swapping is only
  631.           to read the contents of the archive. }
  632.         if (MainXz.MultidiskMode) then
  633.           MessageDlg('Add operation completed.  To test the archive, you must' +
  634.           ' close it first, then select the test option from the file menu.',
  635.           mtInformation, [mbOK], 0);
  636.         { Update the sample application's main listbox to reflect the new additions. }
  637.         LoadFileList;
  638.       end;
  639.     end;
  640.     EnableInterface(True);
  641. end;
  642.  
  643. { The EditDeleteMnClick procedure takes the selected files in the sample
  644.   application's listbox and instructs the TXceedZip component to delete
  645.   these files from the currently opened archive. }
  646.  
  647. procedure TMainFormFm.EditDeleteMnClick(Sender: TObject);
  648. begin
  649.   EnableInterface(False);
  650.  
  651.   { Add all the files that are selected in the sample application's main
  652.     listbox to the TXceedZip component's list of files to process. Since the
  653.     main listbox contains a list of files already in the currently opened
  654.     archive, only files in the archive can be selected to delete. }
  655.   AssignFromLb(FilesLb, MainXz.FilesToProcess);
  656.   StatusLb.Caption := 'Deleting selected files.';
  657.  
  658.   { Delete the files, handle return code }
  659.   HandleError(MainXz.Delete, 'deleting');
  660.  
  661.   { Update the sample application's main listbox to reflect the current
  662.     contents of the currently opened archive file. }
  663.   LoadFileList;
  664.   EnableInterface(True);
  665. end;
  666.  
  667. { The EditExtractMnClick procedure takes the selected files in the sample
  668.   application's listbox and instructs the TXceedZip component to extract
  669.   these files into the user selected destination. A dialog box is opened
  670.   to let the user select the destination directory. }
  671.  
  672. procedure TMainFormFm.EditExtractMnClick(Sender: TObject);
  673. var
  674.   Dir: String;
  675. begin
  676.   GetDir(0, Dir);
  677.  
  678.   if (FilesLb.SelCount > 0) then
  679.     { Ask the user where to extract the files. }
  680.     if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
  681.       begin
  682.         EnableInterface(False);
  683.         { Add all the files that are selected in the sample application's main
  684.           listbox to the TXceedZip component's list of files to process. Since
  685.           the main listbox contains a list of files already in the currently
  686.           opened archive, only files in the archive can be selected to extract. }
  687.         AssignFromLb(FilesLb, MainXz.FilesToProcess);
  688.         { Tell TXceedZip component where the user wants to extract the files. }
  689.         MainXz.ExtractDirectory := Dir;
  690.         StatusLb.Caption := 'Extracting selected files.';
  691.         { Extract the files, handle return code. }
  692.         HandleError(MainXz.Extract(xecAll),'extracting');
  693.         { No need to update the main listbox here - contents have not changed. }
  694.         EnableInterface(True);
  695.       end;
  696. end;
  697.  
  698. { The EditUpdateMnClick procedure updates files in the currently opened archive
  699.   file. A dialog box is opened to allow the user to select files to be updated
  700.   in the archive. Update means that only files newer than those already in the
  701.   archive file will be added or replaced into the archive.}
  702.  
  703. procedure TMainFormFm.EditUpdateMnClick(Sender: TObject);
  704. var
  705.   Dir: String;
  706. begin
  707.   AddFilesDg.FileName := '';
  708.   EnableInterface(False);
  709.   { Allow user to select files to update with a dialog box. }
  710.   if AddFilesDg.Execute then
  711.     begin
  712.       { Workaround for a Delphi dialog box problem }
  713.       {DoubleBackslashFix(AddFilesDg.Files);}
  714.       { Add all the files selected from the dialog box to the TXceedZip
  715.         component's list of files to process. }
  716.       MainXz.FilesToProcess.Assign(AddFilesDg.Files);
  717.       StatusLb.Caption := 'Updating files.';
  718.  
  719.       { Update the files, handle error }
  720.       if HandleError(MainXz.Add(xecUpdate),'updating') <> 2 then
  721.         { Update the sample application's main listbox to reflect the new additions. }
  722.         LoadFileList;
  723.     end;
  724.   EnableInterface(True);
  725. end;
  726.  
  727. { The EditUpdateZipDateMnClick procedure tells the TXceedZip component to update
  728.   the date of an archive file to the date of the most recent file it contains.
  729.   A dialog box opens up to prompt the user for the name of the archive file. }
  730.  
  731. procedure TMainFormFm.EditUpdateZIPDateMnClick(Sender: TObject);
  732. begin
  733.   EnableInterface(False);
  734.   StatusLb.Caption := 'Updating ZIP date.';
  735.  
  736.   { Update the zip date, handle error }
  737.   HandleError(MainXz.UpdateZIPDate, 'updating zip date');
  738.   EnableInterface(True);
  739. end;
  740.  
  741. { The EditSelectAllMnClick procedure selects all the items in the sample
  742.   application's main listbox. }
  743.  
  744. procedure TMainFormFm.EditSelectAllMnClick(Sender: TObject);
  745. begin
  746.   SendMessage(FilesLb.Handle, LB_SELITEMRANGE, 1, MakeLong(0, FilesLb.Items.Count - 1));
  747. end;
  748.  
  749. procedure TMainFormFm.OptionsMnClick(Sender: TObject);
  750. begin
  751.   OptionsUseTempFileMn.Checked := MainXz.UseTempFile and (not MainXz.MultidiskMode);
  752.   OptionsUseTempFileMn.Enabled := not MainXz.MultidiskMode;
  753.   ClearDisksMn.Checked := MainXz.ClearDisks and (MainXz.MultidiskMode);
  754.   ClearDisksMn.Enabled := MainXz.MultidiskMode;
  755.   MultidiskModeMn.Checked := MainXz.MultidiskMode;
  756.   NoCompression.Checked := (MainXz.Compression = 0);
  757.   FastestCompression.Checked := (MainXz.Compression = 1);
  758.   NormalCompression.Checked := (MainXz.Compression = 6);
  759.   BestCompression.Checked := (MainXz.Compression = 9);
  760. end;
  761.  
  762. { The OptionsUseTempFileMnClick procedure informs the TXceedZip component
  763.   whether or not to use a temporary file when adding files. }
  764.  
  765. procedure TMainFormFm.OptionsUseTempFileMnClick(Sender: TObject);
  766. begin
  767.   MainXz.UseTempFile := Not MainXz.UseTempFile;
  768.   OptionsUseTempFileMn.Checked := MainXz.UseTempFile;
  769. end;
  770.  
  771. procedure TMainFormFm.MultidiskmodeMnClick(Sender: TObject);
  772. begin
  773.   MainXz.MultidiskMode := Not MainXz.MultidiskMode;
  774.   MultidiskModeMn.Checked := MainXz.MultidiskMode;
  775. end;
  776.  
  777. { The HelpAboutMnClick option opens an about box for this sample application. }
  778.  
  779. procedure TMainFormFm.HelpAboutMnClick(Sender: TObject);
  780. begin
  781.   MessageDlg('Xceed Zip Compression Library Sample Application - v3.5/D1'#13 +
  782.     'Copyright ⌐1995-1998 Xceed Software, all rights reserved.'#13 +
  783.     'This sample application is made in Borland Delphi 1.0.',
  784.     mtInformation, [mbOK], 0);
  785. end;
  786.  
  787. { The AbortSbClick procedure prompts the user (with a message box), if they want
  788.   to stop the current operation. This procedure is called when the user clicks
  789.   on the little stop sign in the bottom right corner of the sample application's
  790.   main form. }
  791.  
  792. procedure TMainFormFm.AbortSbClick(Sender: TObject);
  793. begin
  794.   if (MessageDlg('Are you sure you want to abort the current process?',
  795.     mtWarning, mbOKCancel, 0) = mrOK) then
  796.   MainXz.Abort := True;
  797. end;
  798.  
  799. { The FilesLbDrawItem procedure draws the items contained in the sample
  800.   application's main listbox using the proper format. For example, the
  801.   filename and path are separated into the 1st and 7th column when
  802.   being displayed. }
  803.  
  804. procedure TMainFormFm.FilesLbDrawItem(Control: TWinControl; Index: Integer;
  805.   Rect: TRect; State: TOwnerDrawState);
  806. var
  807.   I: Integer;
  808.   R: TRect;
  809.   FileName,
  810.   ItemStr, Str: String;
  811. begin
  812.   with (Control as TListBox) do
  813.     begin
  814.       if (odGrayed in State) or (odDisabled in State) then
  815.         Canvas.Font.Color := clGrayText;
  816.  
  817.       ItemStr := Items[Index];
  818.       I := 1;
  819.  
  820.       R := Rect;
  821.       R.Right := R.Left + FilesHd.SectionWidth[0];
  822.       FileName := ParseTab(ItemStr, I);
  823.       Canvas.TextRect(R, R.Left + 2, R.Top, ExtractFileName(FileName));
  824.  
  825.       R.Left := R.Right;
  826.       R.Right := R.Left + FilesHd.SectionWidth[1];
  827.       Str := ParseTab(ItemStr, I);
  828.       Canvas.TextRect(R, R.Left + (R.Right - R.Left) - Canvas.TextWidth(Str)
  829.         - 2, R.Top, Str);
  830.  
  831.       R.Left := R.Right;
  832.       R.Right := R.Left + FilesHd.SectionWidth[2];
  833.       Str := ParseTab(ItemStr, I);
  834.       Canvas.TextRect(R, R.Left + (R.Right - R.Left) - Canvas.TextWidth(Str)
  835.        - 2, R.Top, Str);
  836.  
  837.       R.Left := R.Right;
  838.       R.Right := R.Left + FilesHd.SectionWidth[3];
  839.       Str := ParseTab(ItemStr, I);
  840.       Canvas.TextRect(R, R.Left + (R.Right - R.Left) - Canvas.TextWidth(Str)
  841.         - 2, R.Top, Str);
  842.  
  843.       R.Left := R.Right;
  844.       R.Right := R.Left + FilesHd.SectionWidth[4];
  845.       Str := ParseTab(ItemStr, I);
  846.       Canvas.TextRect(R, R.Left + (R.Right - R.Left) - Canvas.TextWidth(Str)
  847.         - 2, R.Top, Str);
  848.  
  849.       R.Left := R.Right;
  850.       R.Right := R.Left + FilesHd.SectionWidth[5];
  851.       Str := ParseTab(ItemStr, I);
  852.       Canvas.TextRect(R, R.Left + (((R.Right - R.Left) - Canvas.TextWidth(Str))
  853.         div 2), R.Top, Str);
  854.  
  855.       R.Left := R.Right;
  856.       R.Right := Rect.Right;
  857.       Canvas.TextRect(R, R.Left + 2, R.Top,
  858.         RemoveBackSlash(ExtractFilePath(FileName)));
  859.     end;
  860. end;
  861.  
  862. procedure TMainFormFm.FilesLbMeasureItem(Control: TWinControl;
  863.   Index: Integer; var Height: Integer);
  864. begin
  865.   Height := (Control as TListBox).Canvas.TextHeight('W');
  866. end;
  867.  
  868. { MainXz events }
  869.  
  870. { The MainXzAdding procedure is a handler for the OnAdding event generated by
  871.   the TXceedZip component whenever a new file is going to be added to an
  872.   archive. This particular handler simply displays which file is being added
  873.   into the sample application 's status label, and resets the progress gauge to 0%. }
  874.  
  875. procedure TMainFormFm.MainXzAdding(XceedZip: TXceedZip;
  876.   const FileStats: TXcdFileStats);
  877. begin
  878.   StatusLb.Caption := 'Adding "' + FileStats.Name + '".'+ '('+
  879.                    FloatToStrF(Filestats.size div 1024, ffFixed, 10, 0)+'K,   0%)';
  880.  
  881. end;
  882.  
  883. { The MainXzDeleting procedure is a handler for the OnDeleting event generated
  884.   by the TXceedZip component whenever a file is being deleted from an archive.
  885.   This particular handler simply displays which file is being deleted into the
  886.   sample application's status label, and resets the progress gauge to 0%.
  887.   Note: The progress gauge will not be updated beyond 0% during the delete
  888.   operation because the delete operation does not generate OnStatus events. }
  889.  
  890. procedure TMainFormFm.MainXzDeleting(XceedZip: TXceedZip;
  891.   const FileName: String);
  892. begin
  893.   StatusLb.Caption := 'Deleting "' + FileName + '".';
  894. end;
  895.  
  896. { See the note for the MainXzDeleting procedure/handler, because this handler is
  897.   identical except for replacing Deleting with Fixing. }
  898.  
  899. procedure TMainFormFm.MainXzFixing(XceedZip: TXceedZip;
  900.   const FileName: String);
  901. begin
  902.   StatusLb.Caption := 'Fixing "' + FileName + '".';
  903. end;
  904.  
  905. { The MainXzListing procedure is an event handler for the OnListing event
  906.   generated by the TXceedZip component because the List method was called to
  907.   list files in an archive. This particular handler here takes information of
  908.   each file and adds it to the sample application's main listbox. No more
  909.   than 64000 bytes of files and file information will be added to the listbox. }
  910.  
  911. procedure TMainFormFm.MainXzListing(XceedZip: TXceedZip;
  912.   const FileStats: TXcdFileStats);
  913. var
  914.   NewListboxData: String;
  915. begin
  916.   { The FileStats parameter contains all of the file's information. }
  917.   with FileStats do
  918.     begin
  919.       NewListBoxData := Name + #9 + DateToStr(Time) + #9 + TimeToStr(Time) + #9
  920.         + FloatToStrF(Size, ffNumber, 10, 0) + #9 +
  921.         FloatToStrF(PackedSize, ffNumber, 10, 0) + #9 + IntToStr(Ratio) + '%';
  922.  
  923.       if FilesLbBytes < 64000 then
  924.       begin
  925.         FilesLb.Items.Add(NewListBoxData);
  926.         FilesLbBytes := FilesLbBytes + Length(NewListBoxData);
  927.       end;
  928.  
  929.       TotalSize := TotalSize + Size;
  930.       TotalZipSize := TotalZipSize + PackedSize;
  931.     end;
  932. end;
  933.  
  934. { The MainXzStatus procedure is an event handler for the OnStatus event
  935.   generated by the TXceedZip component to provide a progress report on the
  936.   current file being processed. This particular handler here simply updates a
  937.   gauge to reflect the current percentage of completion for a file. It does not
  938.   use any of the other information that can be obtained from the FileStats
  939.   parameter because the filename of the file currently being processed was
  940.   already displayed in the sample applications's status label by the handler
  941.   for the OnAdding, OnTesting, OnFixing, and OnExtracting events. In this sample
  942.   application we do not display the amount of bytes processed for the file in text. }
  943.  
  944. procedure TMainFormFm.MainXzStatus(XceedZip: TXceedZip;
  945.   const FileStats: TXcdFileStats);
  946. begin
  947.    StatusLb.Caption := copy(StatusLb.Caption,0,Pos(',',StatusLb.Caption));
  948.    StatusLb.Caption := StatusLb.Caption + ' '+IntToStr(FileStats.Completion)+'%)'
  949. end;
  950.  
  951. { See the note for the MainXzDeleting procedure/handler, because this handler is
  952.   identical except for replacing 'Deleting' with 'Testing'. }
  953.  
  954. procedure TMainFormFm.MainXzTesting(XceedZip: TXceedZip;
  955.   const FileStats: TXcdFileStats);
  956. begin
  957.   StatusLb.Caption := 'Testing "' + FileStats.Name + '".' + '('+
  958.                    FloatToStrF(Filestats.size div 1024, ffFixed, 10, 0)+'K,   0%)'
  959. end;
  960.  
  961. { The MainXzSkipping procedure is an event handler for the TXceedZip component's
  962.   OnSkippingFile event. A message box is displayed to inform the user that a
  963.   file is being skipped. The reason why is also indicated. }
  964.  
  965. procedure TMainFormFm.MainXzSkippingFile(XceedZip: TXceedZip;
  966.   const Skipping: TXcdSkipping);
  967. var
  968.   SkipMsg: String;
  969. begin
  970.   if not Testing then
  971.     SkipMsg := 'Skipping "' + Skipping.Name + '", '
  972.   else
  973.     SkipMsg := 'File "' + Skipping.Name +'" failed test: ';
  974.  
  975.   case TxcdSkippingReason(Skipping.Reason) of
  976.     xsrFileNotFound:
  977.       SkipMsg := SkipMsg + 'file not found.';
  978.     xsrBadCrc:
  979.       SkipMsg := SkipMsg + 'CRC does not check out.';
  980.     xsrBadVersion:
  981.       SkipMsg := SkipMsg + 'unknown compression.';
  982.     xsrUnableToOpen:
  983.       SkipMsg := SkipMsg + 'unable to open file.';
  984.     xsrUpToDate:
  985.       SkipMsg := SkipMsg + 'file is already up to date.';
  986.     xsrBadPassword:
  987.       SkipMsg := SkipMsg + 'invalid or no password to decrypt file.';
  988.     xsrBadData:
  989.       SkipMsg := SkipMsg + 'file'#39's compressed data is corrupted.';
  990.     xsrOverwrite:
  991.       SkipMsg := SkipMsg + 'instructed not to overwrite this file.';
  992.   end;
  993.  
  994.   MessageDlg(SkipMsg, mtWarning, [mbOK], 0);
  995.  
  996. end;
  997.  
  998. { See the note for the MainXzDeleting procedure/handler, because this handler
  999.   is identical except for replacing Deleting with Updating. }
  1000.  
  1001. procedure TMainFormFm.MainXzUpdating(XceedZip: TXceedZip;
  1002.   const FileStats: TXcdFileStats);
  1003. begin
  1004.   StatusLb.Caption := 'Updating "' + FileStats.Name + '".'+ '('+
  1005.                    FloatToStrF(Filestats.size div 1024, ffFixed, 10, 0)+'K,   0%)';
  1006. end;
  1007.  
  1008. { See the note for the MainXzDeleting procedure/handler, because this handler is
  1009.   identical except for replacing Deleting with Extracting. }
  1010.  
  1011. procedure TMainFormFm.MainXzExtracting(XceedZip: TXceedZip;
  1012.   const FileStats: TXcdFileStats);
  1013. begin
  1014.   StatusLb.Caption := 'Extracting "' + FileStats.Name + '".'+ '('+
  1015.                    FloatToStrF(Filestats.size div 1024, ffFixed, 10, 0)+'K,   0%)';
  1016. end;
  1017.  
  1018. { The MainXzReplace procedure is an event handler for the OnReplace event
  1019.   generated by the TXceedZip component whenever a file that is being extracted
  1020.   may overwrite an already existing file. This procedure displays a message box
  1021.   to allow the user to decide to skip the file or not. Notes: The Overwrite
  1022.   property must be set to xowAsk for the OnReplace event to occur. Also, the
  1023.   choice to rename the file could also be given, as well as the choice of always
  1024.   overwriting or never overwriting. See 'OnReplace' in the online help. }
  1025.  
  1026. procedure TMainFormFm.MainXzReplace(XceedZip: TXceedZip;
  1027.   var Replace: TXcdReplace);
  1028. var
  1029.   UserAnswer: Word;
  1030. begin
  1031.   UserAnswer := MessageDlg('The file "' + Replace.OrigName +
  1032.     '" already exists. Do you want to replace this file?',
  1033.     mtConfirmation, [mbYes,mbNo,mbAbort], 0);
  1034.   if UserAnswer = mrYes then
  1035.     { Tell the TXceedZip component to replace this file. }
  1036.     Replace.Command := xrcReplace
  1037.   else if UserAnswer = mrNo then
  1038.     { Tell the TXceedZip component to skip this file. }
  1039.     Replace.Command := xrcSkip
  1040.   else
  1041.     { Tell the XceedZip component to stop the entire operation. }
  1042.     MainXz.Abort := True;
  1043. end;
  1044.  
  1045. procedure TMainFormFm.FastestcompressionClick(Sender: TObject);
  1046. begin
  1047.   MainXz.Compression := 1;
  1048. end;
  1049.  
  1050. procedure TMainFormFm.NormalcompressionClick(Sender: TObject);
  1051. begin
  1052.   MainXz.Compression := 6;
  1053. end;
  1054.  
  1055. procedure TMainFormFm.BestcompressionClick(Sender: TObject);
  1056. begin
  1057.   MainXz.Compression := 9;
  1058. end;
  1059.  
  1060. procedure TMainFormFm.NoCompressionClick(Sender: TObject);
  1061. begin
  1062.   MainXz.Compression := 0;
  1063. end;
  1064.  
  1065. procedure TMainFormFm.ClearDisksMnClick(Sender: TObject);
  1066. begin
  1067.   MainXz.ClearDisks := not ClearDisksMn.Checked;
  1068. end;
  1069.  
  1070.  
  1071. { The FixNormal1Click procedure tells the TXceedZip component to fix a zipfile.
  1072.   This procedure is activated when the File|Fix|Normal menu item is selected.
  1073.   The actual code is found in the FileFix procedure.}
  1074.  
  1075. procedure TMainFormFm.FixNormal1Click(Sender: TObject);
  1076. begin
  1077.   FileFix(False);
  1078. end;
  1079.  
  1080. { This procedure is like the previous one but it calls FileFix with the
  1081.   agressive-fix feature. See online help for more details about the
  1082.   FIX modes. }
  1083.  
  1084. procedure TMainFormFm.FixAgressive1Click(Sender: TObject);
  1085. begin
  1086.   FileFix(True);
  1087. end;
  1088.  
  1089. { The FileFix procedure tells the TXceedZip component to fix a zipfile,
  1090.   with the 'agressive' feature on/off depending on the 'agressive' parameter.
  1091.   A dialog box is used to prompt the user for the archive filename to fix. }
  1092.  
  1093. procedure FileFix(Agressive: Boolean);
  1094. var
  1095.   Err: Integer;
  1096. begin
  1097.   with MainFormFm do
  1098.   begin
  1099.     OpenZipDg.Title := 'Fix Archive';
  1100.     OpenZipDg.FileName := '';
  1101.     EnableInterface(False);
  1102.     if OpenZipDg.Execute then
  1103.       begin
  1104.         { Tell the TXceedZip component which archive file to work with. }
  1105.         MainXz.ZipFileName := OpenZipDg.FileName;
  1106.  
  1107.         { Call the Fix method (aggressive = True, set Err to the return value. }
  1108.         Err := MainXz.Fix(Agressive);
  1109.         { Since we are fixing, Err=XcdSuccess means the archive has been fixed. }
  1110.         if (Err = XcdSuccess) then
  1111.           MessageDlg('The specified Zip file has been fixed.',
  1112.             mtInformation, [mbOK], 0)
  1113.         else if (Err = XcdErrorZipStruct) then
  1114.           MessageDlg('The specified Zip file is too corrupted to be fixed.',
  1115.             mtInformation, [mbOK], 0)
  1116.         else
  1117.           { Some other error, pass it to the error handling routine. }
  1118.           HandleError(Err,'fixing');
  1119.  
  1120.         MainXz.ZipFileName := '';
  1121.       end;
  1122.       EnableInterface(True);
  1123.   end;
  1124. end;
  1125.  
  1126. { The following procedure handles the OnNewdisk event, which occurs when
  1127.   multidisk mode is activated and the component requires another disk to
  1128.   be inserted. This procedure simply informs the user to insert the right
  1129.   disk (depending on the Disknumber parameter, and waits for the user to
  1130.   press OK... }
  1131.  
  1132. procedure TMainFormFm.MainXzNewdisk(XceedZip: TXceedZip;
  1133.   const Disknumber: Integer);
  1134. var
  1135.   response: Word;
  1136. begin
  1137.   if (DiskNumber = 0) then
  1138.     response := MessageDlg('Please insert the last disk of the set.',
  1139.       mtConfirmation, [mbOK,mbCancel], 0)
  1140.   else
  1141.     response := MessageDlg('Please insert disk #' + IntToSTr(Disknumber)
  1142.       + ' of the set.',mtConfirmation, [mbOK,mbCancel], 0);
  1143.  
  1144.   if (response = mrCancel) then MainXz.Abort := True;
  1145.  
  1146. end;
  1147.  
  1148. procedure TMainFormFm.MainXzGlobalStatus(XceedZip: TXceedZip;
  1149.   const GlobalStats: TXcdGlobalStats);
  1150. begin
  1151.   ProgressGa.Progress := GlobalStats.CompletionBytes;
  1152. end;
  1153.  
  1154.  
  1155. procedure TMainFormFm.SelfExtractingMnuClick(Sender: TObject);
  1156. begin
  1157.  
  1158.      SelfExtractingMnu.Checked := Not SelfExtractingMnu.Checked;
  1159.      SelfextractorOptionsmnu.Enabled := SelfExtractingMnu.Checked;
  1160.      MainXz.SelfExtracting := SelfExtractingMnu.Checked;
  1161. end;
  1162.  
  1163. procedure TMainFormFm.SelfextractorOptionsmnuClick(Sender: TObject);
  1164. begin
  1165.    frmConfigSFX.ShowModal
  1166. end;
  1167.  
  1168. procedure TMainFormFM.SetSfxConfiguration;
  1169. var
  1170.   Intro: String;
  1171. begin
  1172.  
  1173.   With MainFormFM.MainXZ Do
  1174.   begin
  1175.  
  1176.     { The SfxDefaultExtractDir property should contain the path where files will be
  1177.       extracted to by default.
  1178.  
  1179.       You can use macros when specifying a value for the SfxDefaultExtractDir
  1180.       property. Here are some of the available macros. For a complete list,
  1181.       consult the Xceed Zip Online Help.
  1182.  
  1183.       %w = The location of the Windows Directory
  1184.       %s = The location of the Windows System directory
  1185.       %e = The directory where the self-extractor is being run from. }
  1186.  
  1187.     SfxExtractDirectory := '%e';
  1188.  
  1189.     { The SfxReadmePath should contain the path and filename of a text file
  1190.       to display after extracting files.}
  1191.  
  1192.     SfxReadmePath := '';
  1193.  
  1194.     { The SfxRunExePath property should contain the path and filename of an
  1195.       executable to run after succesfully extracting all the files. This
  1196.       property also should contain the parameters the executable.
  1197.  
  1198.       You can use macros when specifying a value for the SfxRunExePath
  1199.       property. Here are some of the available macros. For a complete list,
  1200.       consult the Xceed Zip Online Help.
  1201.  
  1202.       %d = The DefaultExtractDir, or the user-selected
  1203.            directory where files were extracted.
  1204.       %w = The location of the Windoes Directory
  1205.       %s = The location of the Windows System directory
  1206.       %e = The directory where the self-extractor is
  1207.            being run from. }
  1208.  
  1209.     SfxRunExePath := '';
  1210.  
  1211.     { Display the Confirm Extract Directory dialog box}
  1212.     SfxPromptForDirectory := True;
  1213.  
  1214.     { Confirm the creation of a new directory }
  1215.     SfxPromptCreateDirectory := True;
  1216.  
  1217.     { Display a Progress dialog box while extracting}
  1218.     SfxShowProgress := True;
  1219.  
  1220.     { Display a Password Prompt dialog box when required}
  1221.     SfxPromptForPassword := True;
  1222.  
  1223.     { Default password to be used by self-extractor to extract files}
  1224.     SfxDefaultPassword := '';
  1225.  
  1226.     { Default overwrite behavior (Ask, Never, Always)}
  1227.     SfxOverwrite := xowAsk;
  1228.  
  1229.     { Caption for the OK button.}
  1230.     SfxButtons[xsbOk] := 'My &OK';
  1231.  
  1232.     { Caption for the Cancel button.}
  1233.     SfxButtons[xsbCancel] := 'My &Cancel';
  1234.  
  1235.     { Caption for the Abort button.}
  1236.     SfxButtons[xsbAbort] := 'My &Abort';
  1237.  
  1238.     { Caption for the Exit button (Intro Message and Confirm Extract Directory dialog)}
  1239.     SfxButtons[xsbExit] := '&My_Exit'; {Default is 'Exit'}
  1240.  
  1241.     { You can customize all the buttons in the Self-Extractor. Consult the
  1242.       SfxButtons property in the Xceed Zip Online Help for a complete button list}
  1243.  
  1244.     { Prompt for extract directory (Confirm Extract Directory dialog)}
  1245.     SfxPrompts[xspDirectory] := 'Select the path where you want to extract the files to.';
  1246.  
  1247.     { Prompt requiring user to enter a password (Password Prompt dialog)}
  1248.     SfxPrompts[xspPassword] := 'A password is required for file:';
  1249.  
  1250.     { Prompt to insert the last disk}
  1251.     SfxPrompts[xspInsertLastDisk] := 'Please insert the last disk of the set.';
  1252.  
  1253.     { You can customize all the prompts in the Self-Extractor. Consult the
  1254.       SfxPrompts property in the Xceed Zip Online Help for a complete list}
  1255.  
  1256.     { String indicating file currently being extracted}
  1257.     SfxStrings[xssExtractingFile] := 'Extracting file:';
  1258.  
  1259.     { String indicating what the progress bar is}
  1260.     SfxStrings[xssProgress] := 'Overall progress:';
  1261.  
  1262.     { String displayed in title bar of all dialog boxes}
  1263.     {Default value is "The Xceed Zip Self-Extractor"}
  1264.     SfxStrings[xssTitle] := 'Self-Extractor created with Delphi 1.0';
  1265.  
  1266.     { String indicating which directory is selected (browser)}
  1267.     SfxStrings[xssCurrentExtractDir] := 'Current extract directory:';
  1268.  
  1269.     { You can customize all the strings in the Self-Extractor. Consult the
  1270.       SfxStrings property in the Xceed Zip Online Help for a complete list}
  1271.  
  1272.     { Message displayed when self-extracting has been succesfully completed}
  1273.     SfxMessages[xsmSuccess] := 'All files were succesfully extracted.';
  1274.  
  1275.     { Message displayed if there are any errors when extracting}
  1276.     SfxMessages[xsmFail] := 'Error during extraction. One or more files were not succesfully extracted.';
  1277.  
  1278.     { Message displayed if failed in creating directory}
  1279.     SfxMessages[xsmErrorCreatingDir] := 'Unable to create directory ''%d''';
  1280.  
  1281.     { Message displayed when self-extractor is run}
  1282.  
  1283.     Intro := 'Welcome to the Xceed Zip Self-Extractor. This program will extract ' +
  1284.              'some files onto your system. This program was made with the ' +
  1285.              'Xceed Zip Delphi 1.0 Sample Application, and can be fully customized! '+
  1286.              'Look at the SetSfxConfiguration function in the sample app!';
  1287.  
  1288.     SfxMessages[xsmIntro] := Intro;
  1289.  
  1290.     { For a complete list of Messages you can customize, consult the
  1291.       SfxMessages property in the Xceed Zip Online Help for a complete list}
  1292.  
  1293.   End;
  1294.  
  1295. End;
  1296.  
  1297. end.
  1298.  
  1299.  
  1300.