home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / vbasic / Data / Utils / XZipComp.exe / XceedZip.Cab / F112478_Main.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-11-12  |  34.6 KB  |  787 lines
  1. unit Main;
  2. {==================================================================}
  3. { Description: Getting Started Sample Application                  }
  4. { Languages:   For Delphi 3, 4 and 5                               }
  5. { Copyright:   Copyright ⌐ 1995-1999 Xceed Software Inc.           }
  6. {              All Rights Reserved.                                }
  7. {==================================================================}
  8.  
  9. interface
  10.  
  11. uses
  12.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  13.   OleCtrls, XceedZipLib_TLB, ComCtrls, StdCtrls, checklst;
  14.  
  15. const
  16.   { Property hints }
  17.   cBasePathHint = 'BasePath property:' + #13#10 +
  18.     '    This path determines where entries in the FilesToProcess and FilesToExclude' + #13#10 +
  19.     '    properties are relative to. The base path never appears in the zip file, even if' + #13#10 +
  20.     '    PreservePaths = True. Only the portion of the path and filename specified in' + #13#10 +
  21.     '    the FilesToProcess property is actually stored in the zip file. Therefore,' + #13#10 +
  22.     '    BasePath helps you control what portions of paths are stored in the zip file.' + #13#10 +
  23.     '    (The BasePath property is irrelevant when you are using absolute paths)';
  24.  
  25.   cFilesToProcessHint = 'FilesToProcess property:' + #13#10 +
  26.     '    Multiline string that contains all the filenames and/or file masks to be' + #13#10 +
  27.     '    processed (zipped, unzipped, etc). If you entered a path in the' + #13#10 +
  28.     '    BasePath property, all entries with relative paths will be relative to' + #13#10 +
  29.     '    the specified base path. The pipe character can be used instead of' + #13#10 +
  30.     '    the linefeed to separate entries for the FilesToProcess property.';
  31.  
  32.   cFilesToExcludeHint = 'FilesToExclude property:' + #13#10 +
  33.     '    Multiline string that contains all filenames and/or file masks to exclude' + #13#10 +
  34.     '    from the files to be processed by the FilesToProcess property. These' + #13#10 +
  35.     '    entries are also relative to the path specified in the BasePath property' + #13#10 +
  36.     '    if its not empty.';
  37.  
  38.   cProcessSubfoldersHint = 'ProcessSubfolders property:' + #13#10 +
  39.     '    If set to True, the contents of all encoutered subfolders will be processed.';
  40.  
  41.   cZipFilenameHint = 'ZipFilename property:' + #13#10 +
  42.     '    The filename of the zip file to work with. When unzipping, this file must' + #13#10 +
  43.     '    exist. When zipping, if the file exists, it''s updated. Otherwise, it is' + #13#10 +
  44.     '    created. You must enter an absolute path for this property. The' + #13#10 +
  45.     '    BasePath property does not interfere with the ZipFilename property.';
  46.  
  47.   cPreservePathsHint = 'PreservePaths property:' + #13#10 +
  48.     '    If set to True, the zip file will store both the path and the filename of' + #13#10 +
  49.     '    each file that is being zipped. As usual, the portion of a file''s path' + #13#10 +
  50.     '    that is specified in the BasePath property will not be stored in the' + #13#10 +
  51.     '    zip file. When PreservePaths is set to False, only filenames (no' + #13#10 +
  52.     '    paths) are stored.';
  53.  
  54.   cUseTempFileHint = 'UseTempFile property:' + #13#10 +
  55.     '    If set to true, all zipping operations will be performed on a temp file' + #13#10 +
  56.     '    located in the folder specified in the TempFolder property.' + #13#10 +
  57.     '    Otherwise, the operation is performed directly on the zip file' + #13#10 +
  58.     '    without using a temp file. You cannot remove files from an existing' + #13#10 +
  59.     '    zip file, or update files already in an existing zip files without setting' + #13#10 +
  60.     '    this property to True.';
  61.  
  62.   cTempFolderHint = 'TempFolder property:' + #13#10 +
  63.     '    Location of the temp file when the UseTempFile property is set to True.' + #13#10 +
  64.     '    When you leave this property empty, the Windows default temp' + #13#10 +
  65.     '    directory is used.';
  66.  
  67.   cRequiredFileAttributesHint = 'RequiredFileAttributes property:' + #13#10 +
  68.     '    Bit-field value that specifies all attributes that a file must have in' + #13#10 +
  69.     '    order to be included in the process.';
  70.  
  71.   cExcludedFileAttributesHint = 'ExcludedFileAttributes property:' + #13#10 +
  72.     '    Bit-field value that specifies all attributes that a file must NOT have' + #13#10 +
  73.     '    in order to be included in the process.';
  74.  
  75.   cMinDateToProcessHint = 'MinDateToProcess property:' + #13#10 +
  76.     '    Minimum value of a file''s ''Last modifed date'' required in order to be' + #13#10 +
  77.     '    included in the process.';
  78.  
  79.   cMaxDateToProcessHint = 'MaxDateToProcess property:' + #13#10 +
  80.     '    Maximum value of a file''s ''Last modifed date'' required in order to be' + #13#10 +
  81.     '    included in the process.';
  82.  
  83.   cMinSizeToProcessHint = 'MinSizeToProcess property:' + #13#10 +
  84.     '    Minimum file size that a file must have in order to be included in the process.';
  85.  
  86.   cMaxSizeToProcessHint = 'MaxSizeToProcess property:' + #13#10 +
  87.     '    Maximum file size that a file must have in order to be included in the process.';
  88.  
  89.   cUnzipToFolderHint = 'UnzipToFolder property:' + #13#10 +
  90.     '    Destination folder for files being unzipped. In this sample, the PreservePaths' + #13#10 +
  91.     '    property is set to True, so if files are stored in the zip file with paths, those' + #13#10 +
  92.     '    stored paths will be recreated inside the destination folder specified by the' + #13#10 +
  93.     '    UnzipToFolder property.';
  94.  
  95.   cSkipIfExistingHint = 'SkipIfExisting property:' + #13#10 +
  96.     '    If the destination file (located in a zip file that is being updated, or' + #13#10 +
  97.     '    on disk when a zip file is being unzipped) already exists, and this' + #13#10 +
  98.     '    property is set to True, then the file won''t be overwritten. This has' + #13#10 +
  99.     '    the effect of only processing files that don''t exist in the destination' + #13#10 +
  100.     '    zip file or unzipping folder.';
  101.  
  102.   cSkipIfNotExistingHint = 'SkipIfNotExisting property:' + #13#10 +
  103.     '    Setting this property to True will cause only files that don''t already' + #13#10 +
  104.     '    exist in the destination unzipping location (when unzipping) or the' + #13#10 +
  105.     '    zip file (when zipping) to be skipped.';
  106.  
  107.   cSkipIfOlderDateHint = 'SkipIfOlderDate property:' + #13#10 +
  108.     '    When updating a file (in a zip while zipping, or on disk while unzipping),' + #13#10 +
  109.     '    the file is skipped if the existing file''s ''Last modified date'' is greater than' + #13#10 +
  110.     '    the file being zipped or unzipped.';
  111.  
  112.   cSkipIfOlderVersionHint = 'SkipIfOlderVersion property:' + #13#10 +
  113.     '    When updating a file (in a zip while zipping, or on disk while unzipping),' + #13#10 +
  114.     '    the file is skipped if the existing file''s version resource value is greater' + #13#10 +
  115.     '    than the file being zipped or unzipped.';
  116.  
  117.   cZipFilenameSfxHint = 'ZipFilename property with Sfx:' + #13#10 +
  118.     '    The filename of the zip file to work on. When creating or updating' + #13#10 +
  119.     '    self-extracting zip files, you should enter an executable filename' + #13#10 +
  120.     '    (use a .EXE extension).';
  121.  
  122.   cSfxBinaryModuleHint  = 'SfxBinaryModule property:' + #13#10 +
  123.     '    This binary file will be prepended to the zip file, with configuration' + #13#10 +
  124.     '    data if the binary is one of the Xceed Self-Extractor Module' + #13#10 +
  125.     '    binaries. If you leave this field empty, a regular (non-sfx) zip file' + #13#10 +
  126.     '    will be created.';
  127.  
  128.   cSfxStringsHint = 'SfxStrings property array:' + #13#10 +
  129.     '    This array contains all the strings displayed by the Xceed Self-Extractor' + #13#10 +
  130.     '    Module binaries. For example, the ''xssTitle'' index contains the title' + #13#10 +
  131.     '    displayed by all dialog boxes.';
  132.  
  133.   cSfxMessagesHint  = 'SfxMessages property array:' + #13#10 +
  134.     '    This array contains all messages displayed by the Xceed Self-Extractor Module' + #13#10 +
  135.     '    binaries. These messages often appear in their own dialog boxes. If a particular' + #13#10 +
  136.     '    message is left empty, the dialog box won''t be displayed. As an example,' + #13#10 +
  137.     '    leaving this field empty will avoid displaying an introduction message dialog.';
  138.  
  139.   { Method hints }
  140.   cPreviewFilesHint = 'PreviewFiles method:' + #13#10 +
  141.     '    Lets you scan the disk for files that would be zipped with the current property' + #13#10 +
  142.     '    settings. A PreviewingFile event is triggered for each file that matches an' + #13#10 +
  143.     '    entry in the FilesToProcess property. Set this method''s parameter to True to' + #13#10 +
  144.     '    have the library calculate the compressed size of the previewed files.';
  145.  
  146.   cListZipContentsHint = 'ListZipContents method:' + #13#10 +
  147.     '    Lets you view the zip file''s contents. Due to the fact that the FilesToProcess' + #13#10 +
  148.     '    property and the other filtering properties affect the ListZipContents method,' + #13#10 +
  149.     '    you can use it to preview which files would be unzipped by the Unzip method' + #13#10 +
  150.     '    if it were called with the current property settings. A ListingFile event is' + #13#10 +
  151.     '    triggered for each file in the zip file that is listed.';
  152.  
  153.   cZipHint = 'Zip method:' + #13#10 +
  154.     '    Lets you zip files. Only files that match all the entries in the FilesToProcess' + #13#10 +
  155.     '    and filtering properties will be processed. For each file that matches the' + #13#10 +
  156.     '    FilesToProcess property, the ZipPreprocessingFile event is triggered. That' + #13#10 +
  157.     '    event provides you with the chance to change the inclusion state of a file,' + #13#10 +
  158.     '    or to change its information before it is stored in the zip file.';
  159.  
  160.   cUnzipHint = 'Unzip method:' + #13#10 +
  161.     '    Lets you unzip files. Only files that match all the entries in the FilesToProcess' + #13#10 +
  162.     '    and filtering properties will be processed. For each file that matches the' + #13#10 +
  163.     '    FilesToProcess property, the UnzipPreprocessingFile event is triggered. That' + #13#10 +
  164.     '    event provides you with the chance to change the inclusion state of a file, or' + #13#10 +
  165.     '    to change its information before it is written to the destination unzipping folder.';
  166.  
  167.   cZipSfxHint = 'Zip method with Sfx:' + #13#10 +
  168.     '    It''s just like creating a regular (non-sfx) zip file, but if you enter a value' + #13#10 +
  169.     '    for the SfxBinaryModule property, the binary (or any file for that matter)' + #13#10 +
  170.     '    is prepended to the zip file. The zip file is now self-extracting because' + #13#10 +
  171.     '    the binary knows how to unzip the rest of the data after itself.' + #13#10 +
  172.     '    Furthermore, if the library recognises an Xceed binary, it will add' + #13#10 +
  173.     '    config data to the binary so that the self-extracting zip file can display' + #13#10 +
  174.     '    intro messages and have custom behavior.';
  175.     
  176. type
  177.   TfrmMain = class(TForm)
  178.     Label1: TLabel;
  179.     shtPreview: TTabSheet;
  180.     shtZip: TTabSheet;
  181.     shtList: TTabSheet;
  182.     shtUnzip: TTabSheet;
  183.     shtSFX: TTabSheet;
  184.     tabExamples: TPageControl;
  185.     Label3: TLabel;
  186.     edtPFilesToProcess: TMemo;
  187.     Label4: TLabel;
  188.     edtPFilesToExclude: TMemo;
  189.     Label5: TLabel;
  190.     lstPRequiredFileAttributes: TCheckListBox;
  191.     lstPExcludedFileAttributes: TCheckListBox;
  192.     Label6: TLabel;
  193.     chkPProcessSubfolders: TCheckBox;
  194.     btPreviewFiles: TButton;
  195.     StatusBar1: TStatusBar;
  196.     Label7: TLabel;
  197.     edtResults: TMemo;
  198.     Label8: TLabel;
  199.     Label9: TLabel;
  200.     edtZZipFilename: TEdit;
  201.     Label10: TLabel;
  202.     edtZBasePath: TEdit;
  203.     Label11: TLabel;
  204.     edtZFilesToProcess: TMemo;
  205.     Label12: TLabel;
  206.     edtZFilesToExclude: TMemo;
  207.     chkZPreservePaths: TCheckBox;
  208.     chkZProcessSubfolders: TCheckBox;
  209.     chkZUseTempFile: TCheckBox;
  210.     Label13: TLabel;
  211.     edtZTempFolder: TEdit;
  212.     btZip: TButton;
  213.     Label14: TLabel;
  214.     Label15: TLabel;
  215.     Label16: TLabel;
  216.     Label17: TLabel;
  217.     edtLZipFilename: TEdit;
  218.     Label18: TLabel;
  219.     Label19: TLabel;
  220.     Label20: TLabel;
  221.     edtLMinSizeToProcess: TEdit;
  222.     Label21: TLabel;
  223.     edtLMaxSizeToProcess: TEdit;
  224.     btList: TButton;
  225.     dtLMinDateToProcess: TDateTimePicker;
  226.     dtLMaxDateToProcess: TDateTimePicker;
  227.     Label23: TLabel;
  228.     edtUZipFilename: TEdit;
  229.     Label24: TLabel;
  230.     edtUUnzipToFolder: TEdit;
  231.     Label25: TLabel;
  232.     edtUFilesToProcess: TMemo;
  233.     Label26: TLabel;
  234.     edtUFilesToExclude: TMemo;
  235.     chkUSkipIfExisting: TCheckBox;
  236.     chkUSkipIfNotExisting: TCheckBox;
  237.     chkUSkipIfOlderDate: TCheckBox;
  238.     chkUSkipIfOlderVersion: TCheckBox;
  239.     btUnzip: TButton;
  240.     Label29: TLabel;
  241.     edtSZipFilename: TEdit;
  242.     Label30: TLabel;
  243.     edtSFilesToProcess: TMemo;
  244.     Label31: TLabel;
  245.     edtSSfxBinaryModule: TEdit;
  246.     Label32: TLabel;
  247.     edtSTitle: TEdit;
  248.     btZipSfx: TButton;
  249.     Label33: TLabel;
  250.     edtSIntro: TMemo;
  251.     barFile: TProgressBar;
  252.     barGlobal: TProgressBar;
  253.     xZip: TXceedZip;
  254.     Memo1: TMemo;
  255.     Memo2: TMemo;
  256.     Memo3: TMemo;
  257.     procedure FormCreate(Sender: TObject);
  258.     procedure btPreviewFilesClick(Sender: TObject);
  259.     procedure btZipClick(Sender: TObject);
  260.     procedure btListClick(Sender: TObject);
  261.     procedure btUnzipClick(Sender: TObject);
  262.     procedure btZipSfxClick(Sender: TObject);
  263.     procedure xZipInsertDisk(Sender: TObject; nDiskNumber: Integer;
  264.       var bDiskInserted: WordBool);
  265.     procedure xZipWarning(Sender: TObject; const sFilename: WideString;
  266.       xWarning: TOleEnum);
  267.     procedure xZipListingFile(Sender: TObject; const sFilename,
  268.       sComment: WideString; lSize, lCompressedSize: Integer;
  269.       nCompressionRatio: Smallint; xAttributes: TOleEnum; lCRC: Integer;
  270.       dtLastModified, dtLastAccessed, dtCreated: TDateTime;
  271.       xMethod: TOleEnum; bEncrypted: WordBool; lDiskNumber: Integer;
  272.       bExcluded: WordBool; xReason: TOleEnum);
  273.     procedure xZipPreviewingFile(Sender: TObject; const sFilename,
  274.       sSourceFilename: WideString; lSize: Integer; xAttributes: TOleEnum;
  275.       dtLastModified, dtLastAccessed, dtCreated: TDateTime;
  276.       bExcluded: WordBool; xReason: TOleEnum);
  277.     procedure xZipSkippingFile(Sender: TObject; const sFilename, sComment,
  278.       sFilenameOnDisk: WideString; lSize, lCompressedSize: Integer;
  279.       xAttributes: TOleEnum; lCRC: Integer; dtLastModified, dtLastAccessed,
  280.       dtCreated: TDateTime; xMethod: TOleEnum; bEncrypted: WordBool;
  281.       xReason: TOleEnum);
  282.     procedure xZipFileStatus(Sender: TObject; const sFilename: WideString;
  283.       lSize, lCompressedSize, lBytesProcessed: Integer; nBytesPercent,
  284.       nCompressionRatio: Smallint; bFileCompleted: WordBool);
  285.     procedure xZipGlobalStatus(Sender: TObject; lFilesTotal,
  286.       lFilesProcessed, lFilesSkipped: Integer; nFilesPercent: Smallint;
  287.       lBytesTotal, lBytesProcessed, lBytesSkipped: Integer;
  288.       nBytesPercent: Smallint; lBytesOutput: Integer;
  289.       nCompressionRatio: Smallint);
  290.     procedure xZipProcessCompleted(Sender: TObject; lFilesTotal,
  291.       lFilesProcessed, lFilesSkipped, lBytesTotal, lBytesProcessed,
  292.       lBytesSkipped, lBytesOutput: Integer; nCompressionRatio: Smallint;
  293.       xResult: TOleEnum);
  294.     procedure xZipReplacingFile(Sender: TObject; const sFilename,
  295.       sComment: WideString; lSize: Integer; xAttributes: TOleEnum;
  296.       dtLastModified, dtLastAccessed, dtCreated: TDateTime;
  297.       const sOrigFilename: WideString; lOrigSize: Integer;
  298.       xOrigAttributes: TOleEnum; dtOrigLastModified, dtOrigLastAccessed,
  299.       dtOrigCreated: TDateTime; var bReplaceFile: WordBool);
  300.     procedure xZipZipContentsStatus(Sender: TObject; lFilesRead,
  301.       lFilesTotal: Integer; nFilesPercent: Smallint);
  302.   private
  303.     { Private declarations }
  304.     procedure UpdateFieldHints;
  305.   public
  306.     { Public declarations }
  307.   end;
  308.  
  309.   { Some useful global functions and procedures }
  310.   procedure XceedResetDefaultProperties( var xZip : TXceedZip );
  311.   procedure XceedFillAttributeList( var lstAttributes : TCheckListBox );
  312.   function  XceedGetSelectedAttributes( var lstAttributes : TCheckListBox ) : integer;
  313.   procedure XceedSetSelectedAttributes( var lstAttributes : TCheckListBox; xAttrib : xcdFileAttributes );
  314.  
  315. var
  316.   frmMain: TfrmMain;
  317.  
  318. implementation
  319.  
  320. {$R *.DFM}
  321.  
  322. {-----------------------------------------------------------------------------}
  323. { Some useful global functions and procedures                                 }
  324. {-----------------------------------------------------------------------------}
  325.  
  326. { Reset XceedZip properties }
  327. procedure XceedResetDefaultProperties( var xZip : TXceedZip );
  328. begin
  329.   xZip.BasePath := '';
  330.   xZip.CompressionLevel := xclHigh;
  331.   xZip.EncryptionPassword := '';
  332.   xZip.RequiredFileAttributes := xfaNone;
  333.   xZip.ExcludedFileAttributes := xfaNone;
  334.   xZip.FilesToProcess := '';
  335.   xZip.FilesToExclude := '';
  336.   xZip.MinDateToProcess := EncodeDate( 1900, 01, 01 );
  337.   xZip.MaxDateToProcess := EncodeDate( 9999, 12, 31 );
  338.   xZip.MinSizeToProcess := 0;
  339.   xZip.MaxSizeToProcess := 0;   { Zero means no upper limit }
  340.   xZip.SplitSize := 0;          { Zero means no split }
  341.   xZip.PreservePaths := false;
  342.   xZip.ProcessSubfolders := false;
  343.   xZip.SkipIfExisting := false;
  344.   xZip.SkipIfNotExisting := false;
  345.   xZip.SkipIfOlderDate := false;
  346.   xZip.SkipIfOlderVersion := false;
  347.   xZip.TempFolder := '';        { Empty means default Windows temp folder }
  348.   xZip.UseTempFile := true;
  349.   xZip.UnzipToFolder := '';
  350.   xZip.ZipFilename := '';
  351.   xZip.SpanMultipleDisks := xdsRemovableDrivesOnly;
  352.   xZip.ExtraHeaders := 0;
  353.  
  354.   { General SFX stuff }
  355.   xZip.SfxBinaryModule := '';
  356.   xZip.SfxResetButtons;
  357.   xZip.SfxResetMessages;
  358.   xZip.SfxResetStrings;
  359. end;
  360.  
  361. { Fill a list with Xceed attributes. Uses the Object field as a holder for
  362.   Xceed xcdFileAttributes enumeration values }
  363. procedure XceedFillAttributeList( var lstAttributes : TCheckListBox );
  364. begin
  365.   lstAttributes.Items.Clear;
  366.   lstAttributes.Items.AddObject( 'Archive', TObject( xfaArchive ) );
  367.   lstAttributes.Items.AddObject( 'Read-only', TObject( xfaReadOnly ) );
  368.   lstAttributes.Items.AddObject( 'Hidden', TObject( xfaHidden ) );
  369.   lstAttributes.Items.AddObject( 'System', TObject( xfaSystem ) );
  370.   lstAttributes.Items.AddObject( 'Volume label', TObject( xfaVolume ) );
  371.   lstAttributes.Items.AddObject( 'Folder', TObject( xfaFolder ) );
  372.   lstAttributes.Items.AddObject( 'Compressed', TObject( xfaCompressed ) );
  373. end;
  374.  
  375. { Return Xceed attributes value for selected items. Use with XceedFillAttributeList }
  376. function XceedGetSelectedAttributes( var lstAttributes : TCheckListBox ) : integer;
  377. var
  378.   i : integer;
  379.   nAttributes : integer;
  380. begin
  381.   nAttributes := xfaNone;
  382.  
  383.   for i := 0 to lstAttributes.Items.Count-1 do
  384.   begin
  385.     if lstAttributes.Checked[i] then
  386.       nAttributes := nAttributes + integer( lstAttributes.Items.Objects[i] );
  387.   end;
  388.  
  389.   result := nAttributes;
  390. end;
  391.  
  392. { Set the attributes found in the given attribute mask }
  393. procedure XceedSetSelectedAttributes( var lstAttributes : TCheckListBox;
  394.                                       xAttrib : xcdFileAttributes );
  395. var
  396.   i : integer;
  397.   xOne : xcdFileAttributes;
  398. begin
  399.   for i := 0 to lstAttributes.Items.Count-1 do
  400.   begin
  401.     xOne  := xcdFileAttributes( lstAttributes.Items.Objects[i] );
  402.     lstAttributes.Checked[i] := ( ( xOne and xAttrib ) = xOne );
  403.   end;
  404. end;
  405.  
  406. {-----------------------------------------------------------------------------}
  407. { Form's methods                                                              }
  408. {-----------------------------------------------------------------------------}
  409.  
  410. { Update hints with linefeeds for better output }
  411. procedure TfrmMain.UpdateFieldHints;
  412. begin
  413.   { Previewing }
  414.   edtPFilesToProcess.Hint := cFilesToProcessHint;
  415.   edtPFilesToExclude.Hint := cFilesToExcludeHint;
  416.   chkPProcessSubfolders.Hint := cProcessSubfoldersHint;
  417.   lstPRequiredFileAttributes.Hint := cRequiredFileAttributesHint;
  418.   lstPExcludedFileAttributes.Hint := cExcludedFileAttributesHint;
  419.   btPreviewFiles.Hint := cPreviewFilesHint;
  420.  
  421.   { Zipping }
  422.   edtZZipFilename.Hint := cZipFilenameHint;
  423.   edtZBasePath.Hint := cBasePathHint;
  424.   edtZFilesToProcess.Hint := cFilesToProcessHint;
  425.   edtZFilesToExclude.Hint := cFilesToExcludeHint;
  426.   chkZProcessSubfolders.Hint := cProcessSubfoldersHint;
  427.   chkZPreservePaths.Hint := cPreservePathsHint;
  428.   chkZUseTempFile.Hint := cUseTempFileHint;
  429.   edtZTempFolder.Hint := cTempFolderHint;
  430.   btZip.Hint := cZipHint;
  431.  
  432.   { Listing }
  433.   edtLZipFilename.Hint := cZipFilenameHint;
  434.   dtLMinDateToProcess.Hint := cMinDateToProcessHint;
  435.   dtLMaxDateToProcess.Hint := cMaxDateToProcessHint;
  436.   edtLMinSizeToProcess.Hint := cMinSizeToProcessHint;
  437.   edtLMaxSizeToProcess.Hint := cMaxSizeToProcessHint;
  438.   btList.Hint := cListZipContentsHint;
  439.  
  440.   { Unzipping }
  441.   edtUZipFilename.Hint := cZipFilenameHint;
  442.   edtUUnzipToFolder.Hint := cUnzipToFolderHint;
  443.   edtUFilesToProcess.Hint := cFilesToProcessHint;
  444.   edtUFilesToExclude.Hint := cFilesToExcludeHint;
  445.   chkUSkipIfExisting.Hint := cSkipIfExistingHint;
  446.   chkUSkipIfNotExisting.Hint := cSkipIfNotExistingHint;
  447.   chkUSkipIfOlderDate.Hint := cSkipIfOlderDateHint;
  448.   chkUSkipIfOlderVersion.Hint := cSkipIfOlderVersionHint;
  449.   btUnzip.Hint := cUnzipHint;
  450.  
  451.   { Zipping Sfx }
  452.   edtSZipFilename.Hint := cZipFilenameSfxHint;
  453.   edtSFilesToProcess.Hint := cFilesToProcessHint;
  454.   edtSSfxBinaryModule.Hint := cSfxBinaryModuleHint;
  455.   edtSTitle.Hint := cSfxStringsHint;
  456.   edtSIntro.Hint := cSfxMessagesHint;
  457.   btZipSfx.Hint := cZipSfxHint;
  458. end;
  459.  
  460. procedure TfrmMain.FormCreate(Sender: TObject);
  461. begin
  462.   { We update hints for better look. We cannot put linefeeds in property editor! }
  463.   UpdateFieldHints;
  464.  
  465.   { We fill attribute lists }
  466.   XceedFillAttributeList( lstPRequiredFileAttributes );
  467.   XceedFillAttributeList( lstPExcludedFileAttributes );
  468.  
  469.   { We set their initial state }
  470.   XceedSetSelectedAttributes( lstPRequiredFileAttributes,
  471.                               xZip.RequiredFileAttributes );
  472.   XceedSetSelectedAttributes( lstPExcludedFileAttributes,
  473.                               xZip.ExcludedFileAttributes );
  474. end;
  475.  
  476. {-----------------------------------------------------------------------------}
  477. { Examples of how to use XceedZip                                             }
  478. {-----------------------------------------------------------------------------}
  479.  
  480. { PreviewFiles example:
  481.   This method let's you list all files (through the "OnPreviewingFile" event)
  482.   that would be processed by the Zip method with the same property values. }
  483. procedure TfrmMain.btPreviewFilesClick(Sender: TObject);
  484. var
  485.   xErr : xcdError;
  486. begin
  487.   { To be sure other tabs settings do not interfere with this example, we
  488.     start by resetting XceedZip properties to default values }
  489.   XceedResetDefaultProperties( xZip );
  490.  
  491.   { Clear the result list before starting }
  492.   edtResults.Clear;
  493.   edtResults.Lines.Add( 'PreviewFiles example:' );
  494.  
  495.   { Set properties displayed on this tab }
  496.   xZip.FilesToProcess := edtPFilesToProcess.Text;   { required }
  497.   xZip.FilesToExclude := edtPFilesToExclude.Text;
  498.   xZip.ProcessSubfolders := chkPProcessSubfolders.Checked;
  499.   xZip.RequiredFileAttributes := XceedGetSelectedAttributes( lstPRequiredFileAttributes );
  500.   xZip.ExcludedFileAttributes := XceedGetSelectedAttributes( lstPExcludedFileAttributes );
  501.  
  502.   { Launch the previewing }
  503.   xErr := xZip.PreviewFiles( false );
  504. end;
  505.  
  506. { Zip method:
  507.   The files that are matched by the filtering properties will be added to the
  508.   zip file specified by the ZipFilename property. }
  509. procedure TfrmMain.btZipClick(Sender: TObject);
  510. var
  511.   xErr : xcdError;
  512. begin
  513.   { To be sure other tabs settings do not interfere with this example, we
  514.     start by resetting XceedZip properties to default values }
  515.   XceedResetDefaultProperties( xZip );
  516.  
  517.   { Clear the result list before starting }
  518.   edtResults.Lines.Clear;
  519.   edtResults.Lines.Add( 'Zip example:' );
  520.  
  521.   { Set properties displayed on this tab }
  522.   xZip.ZipFilename := edtZZipFilename.Text;       { required }
  523.   xZip.BasePath := edtZBasePath.Text;
  524.   xZip.FilesToProcess := edtZFilesToProcess.Text; { required }
  525.   xZip.FilesToExclude := edtZFilesToExclude.Text;
  526.   xZip.ProcessSubfolders := chkZProcessSubfolders.Checked;
  527.   xZip.PreservePaths := chkZPreservePaths.Checked;
  528.   xZip.UseTempFile := chkZUseTempFile.Checked;
  529.   xZip.TempFolder := edtZTempFolder.Text;
  530.  
  531.   { Launch the zipping }
  532.   xErr := xZip.Zip;
  533. end;
  534.  
  535. { ListZipContents method:
  536.   Lists (through the OnListingFile event) the files contained in the zip file
  537.   specified by the ZipFilename property. You can set the filtering propeties
  538.   to list only particular files, or leave the FilesToProcess empty to list
  539.   everything. }
  540. procedure TfrmMain.btListClick(Sender: TObject);
  541. var
  542.   xErr : xcdError;
  543. begin
  544.   { To be sure other tabs settings do not interfere with this example, we
  545.     start by resetting XceedZip properties to default values }
  546.   XceedResetDefaultProperties( xZip );
  547.  
  548.   { Clear the result list before starting }
  549.   edtResults.Lines.Clear;
  550.   edtResults.Lines.Add( 'ListZipContents example:' );
  551.  
  552.   { Set properties displayed on this tab }
  553.   xZip.ZipFilename := edtLZipFilename.Text;           { required }
  554.   xZip.MinDateToProcess := dtLMinDateToProcess.Date;
  555.   xZip.MaxDateToProcess := dtLMaxDateToProcess.Date;
  556.   xZip.MinSizeToProcess := StrToIntDef( edtLMinSizeToProcess.Text, 0 );
  557.   xZip.MaxSizeToProcess := StrToIntDef( edtLMaxSizeToProcess.Text, 0 );
  558.  
  559.   { Launch the listing }
  560.   xErr := xZip.ListZipContents;
  561. end;
  562.  
  563. { Unzip method:
  564.   Unzips from the specified zip file (ZipFilename property) files that match
  565.   the filtering properties. }
  566. procedure TfrmMain.btUnzipClick(Sender: TObject);
  567. var
  568.   xErr : xcdError;
  569. begin
  570.   { To be sure other tabs settings do not interfere with this example, we
  571.     start by resetting XceedZip properties to default values }
  572.   XceedResetDefaultProperties( xZip );
  573.  
  574.   { Clear the result list before starting }
  575.   edtResults.Lines.Clear;
  576.   edtResults.Lines.Add( 'Unzip example:' );
  577.  
  578.   { Set properties displayed on this tab }
  579.   xZip.ZipFilename := edtUZipFilename.Text;       { required }
  580.   xZip.UnzipToFolder := edtUUnzipToFolder.Text;   { required }
  581.   xZip.FilesToProcess := edtUFilesToProcess.Text; { required }
  582.   xZip.FilesToExclude := edtUFilesToExclude.Text;
  583.   xZip.SkipIfExisting := chkUSkipIfExisting.Checked;
  584.   xZip.SkipIfNotExisting := chkUSkipIfNotExisting.Checked;
  585.   xZip.SkipIfOlderDate := chkUSkipIfOlderDate.Checked;
  586.   xZip.SkipIfOlderVersion := chkUSkipIfOlderVersion.Checked;
  587.  
  588.   { Launch the unzipping }
  589.   xErr := xZip.Unzip;
  590. end;
  591.  
  592. { Zip method:
  593.   When SfxBinaryModule contains a filename, then the resulting zip file is a
  594.   self-extracting zip file that uses this binary module as a binary header.
  595.   But appart from that (and changing the Sfx options with the Sfx properties),
  596.   creating a self-extracting zip file is just like creating a normal zip file. }
  597. procedure TfrmMain.btZipSfxClick(Sender: TObject);
  598. var
  599.   xErr : xcdError;
  600. begin
  601.   { To be sure other tabs settings do not interfere with this example, we
  602.     start by resetting XceedZip properties to default values }
  603.   XceedResetDefaultProperties( xZip );
  604.  
  605.   { Clear the result list before starting }
  606.   edtResults.Lines.Clear;
  607.   edtResults.Lines.Add( 'Zip Sfx example:' );
  608.  
  609.   { Set properties displayed on this tab }
  610.   xZip.ZipFilename := edtSZipFilename.Text;         { required }
  611.   xZip.FilesToProcess := edtSFilesToProcess.Text;   { required }
  612.   xZip.SfxBinaryModule := edtSSfxBinaryModule.Text; { required to make an EXE }
  613.   xZip.SfxStrings[ xssTitle ] := edtSTitle.Text;
  614.   xZip.SfxMessages[ xsmIntro ] := edtSIntro.Text;
  615.  
  616.   { Launch the zipping }
  617.   xErr := xZip.Zip;
  618. end;
  619.  
  620. {-----------------------------------------------------------------------------}
  621. { XceedZip events handling examples                                           }
  622. {-----------------------------------------------------------------------------}
  623.  
  624. { OnFileStatus event:
  625.   Triggered during processing of a file, at every 32k. Gives a status on each
  626.   file, one at a time, while it is being processed. Perfect for a file by file
  627.   progress bar. You can use the CurrentOperation property to recall what this
  628.   XceedZip instance is doing and display a proper status message. }
  629. procedure TfrmMain.xZipFileStatus(Sender: TObject;
  630.   const sFilename: WideString; lSize, lCompressedSize,
  631.   lBytesProcessed: Integer; nBytesPercent, nCompressionRatio: Smallint;
  632.   bFileCompleted: WordBool);
  633. begin
  634.   if lBytesProcessed = 0 then
  635.   begin
  636.     case TXceedZip( Sender ).CurrentOperation of
  637.     xcoZipping:
  638.       edtResults.Lines.Add( 'Zipping ' + sFilename );
  639.     xcoUnzipping:
  640.       edtResults.Lines.Add( 'Unzipping ' + sFilename );
  641.     end;
  642.   end;
  643. end;
  644.  
  645. { OnGlobalStatus event:
  646.   Triggered during processing of files, at every 32k. Gives general status of
  647.   the complete process. Perfect for a general progress bar. }
  648. procedure TfrmMain.xZipGlobalStatus(Sender: TObject; lFilesTotal,
  649.   lFilesProcessed, lFilesSkipped: Integer; nFilesPercent: Smallint;
  650.   lBytesTotal, lBytesProcessed, lBytesSkipped: Integer;
  651.   nBytesPercent: Smallint; lBytesOutput: Integer;
  652.   nCompressionRatio: Smallint);
  653. begin
  654.   barGlobal.Position := nBytesPercent;
  655. end;
  656.  
  657. { OnInsertDisk event:
  658.   Triggered when processing a spanned zip file, or when creating a spanned zip
  659.   file and the current disk is filled. When nDiskNumber is zero, it means the
  660.   last disk of the set is required, in order to read the zip file's list of
  661.   files. }
  662. procedure TfrmMain.xZipInsertDisk(Sender: TObject; nDiskNumber: Integer;
  663.   var bDiskInserted: WordBool);
  664. var
  665.   nAnswer : Word;
  666. begin
  667.   { When nDiskNumber is 0, this means the last disk of the set is required }
  668.   if nDiskNumber = 0 then
  669.     nAnswer := MessageDlg( 'This file is part of a multidisk zip file. Please ' +
  670.                            'insert the last disk of the set.', mtInformation,
  671.                            [mbOK,mbCancel], 0 )
  672.   else
  673.     nAnswer := MessageDlg( 'Please insert disk #' + IntToStr( nDiskNumber ) + '.',
  674.                            mtInformation, [mbOK,mbCancel], 0 );
  675.  
  676.   if nAnswer = mrOK then
  677.     bDiskInserted := true;
  678. end;
  679.  
  680. { OnListingFile event:
  681.   Triggered while listing the contents of a zip file with the ListZipContents
  682.   method. }
  683. procedure TfrmMain.xZipListingFile(Sender: TObject; const sFilename,
  684.   sComment: WideString; lSize, lCompressedSize: Integer;
  685.   nCompressionRatio: Smallint; xAttributes: TOleEnum; lCRC: Integer;
  686.   dtLastModified, dtLastAccessed, dtCreated: TDateTime; xMethod: TOleEnum;
  687.   bEncrypted: WordBool; lDiskNumber: Integer; bExcluded: WordBool;
  688.   xReason: TOleEnum);
  689. begin
  690.   if bExcluded then
  691.     edtResults.Lines.Add( 'Excluding ' + sFilename + ' (reason: ' + IntToStr( xReason ) + ')' )
  692.   else
  693.     edtResults.Lines.Add( 'Including ' + sFilename );
  694. end;
  695.  
  696. { OnPreviewingFile event:
  697.   Triggered when previewing files on disk with the PreviewFiles method. }
  698. procedure TfrmMain.xZipPreviewingFile(Sender: TObject; const sFilename,
  699.   sSourceFilename: WideString; lSize: Integer; xAttributes: TOleEnum;
  700.   dtLastModified, dtLastAccessed, dtCreated: TDateTime;
  701.   bExcluded: WordBool; xReason: TOleEnum);
  702. begin
  703.   if bExcluded then
  704.     edtResults.Lines.Add( 'Excluding ' + sFilename + ' (reason: ' + IntToStr( xReason ) + ')' )
  705.   else
  706.     edtResults.Lines.Add( 'Including ' + sFilename );
  707. end;
  708.  
  709. { OnProcessCompleted event:
  710.   Triggered when any process submitted terminates. It is highly useful when
  711.   processing files with BackgroundProcessing set to true. This is how you
  712.   know the process completed! }
  713. procedure TfrmMain.xZipProcessCompleted(Sender: TObject; lFilesTotal,
  714.   lFilesProcessed, lFilesSkipped, lBytesTotal, lBytesProcessed,
  715.   lBytesSkipped, lBytesOutput: Integer; nCompressionRatio: Smallint;
  716.   xResult: TOleEnum);
  717. begin
  718.   { Display the error number and default message }
  719.   edtResults.Lines.Add( 'Process completed with error code ' + IntToStr( xResult ) );
  720.   edtResults.Lines.Add( '-=> ' + TXceedZip( Sender ).GetErrorDescription( xvtError, xResult ) );
  721.  
  722.   { Display statistics }
  723.   case TXceedZip( Sender ).CurrentOperation of
  724.   xcoZipping, xcoUnzipping, xcoRemoving:
  725.   begin
  726.     edtResults.Lines.Add( IntToStr( lFilesProcessed ) + ' file(s) processed for ' +
  727.                           IntToStr( lBytesProcessed ) + ' bytes' );
  728.     edtResults.Lines.Add( IntToStr( lFilesSkipped ) + ' file(s) skipped for ' +
  729.                           IntToStr( lBytesSkipped ) + ' bytes' );
  730.   end;
  731.   xcoListing:
  732.     edtResults.Lines.Add( IntToStr( lFilesTotal ) + ' file(s) listed' );
  733.   xcoPreviewing:
  734.     edtResults.Lines.Add( IntToStr( lFilesTotal ) + ' file(s) previewed' );
  735.   end;
  736. end;
  737.  
  738. { OnReplacingFile event:
  739.   Triggered while zipping or unzipping, when a file is about to be replaced.
  740.   The default value of the bReplaceFile parameter is true, so you do not need
  741.   to implement anything if you always want to replace files. }
  742. procedure TfrmMain.xZipReplacingFile(Sender: TObject; const sFilename,
  743.   sComment: WideString; lSize: Integer; xAttributes: TOleEnum;
  744.   dtLastModified, dtLastAccessed, dtCreated: TDateTime;
  745.   const sOrigFilename: WideString; lOrigSize: Integer;
  746.   xOrigAttributes: TOleEnum; dtOrigLastModified, dtOrigLastAccessed,
  747.   dtOrigCreated: TDateTime; var bReplaceFile: WordBool);
  748. begin
  749.   { We'll stick to the default behavior of replacing everything ! }
  750. end;
  751.  
  752. { OnSkippingFile event:
  753.   Triggered during any processing, when a file is excluded because of the
  754.   filtering properties (0 < xReason < 100), or because an error prevented this
  755.   file from being processed (xReason >= 100). }
  756. procedure TfrmMain.xZipSkippingFile(Sender: TObject; const sFilename,
  757.   sComment, sFilenameOnDisk: WideString; lSize, lCompressedSize: Integer;
  758.   xAttributes: TOleEnum; lCRC: Integer; dtLastModified, dtLastAccessed,
  759.   dtCreated: TDateTime; xMethod: TOleEnum; bEncrypted: WordBool;
  760.   xReason: TOleEnum);
  761. begin
  762.   edtResults.Lines.Add( 'Skipping ' + sFilename + ' (reason: ' + IntToStr( xReason ) + ')' );
  763. end;
  764.  
  765. { OnWarning event:
  766.   Triggered during processing when a recoverable error is encountered. }
  767. procedure TfrmMain.xZipWarning(Sender: TObject;
  768.   const sFilename: WideString; xWarning: TOleEnum);
  769. begin
  770.   edtResults.Lines.Add( 'Warning ' + IntToStr( xWarning ) );
  771. end;
  772.  
  773. { OnZipContentsStatus event:
  774.   Triggered while reading the contents of an existing zip file. This happens
  775.   when unzipping, adding files to an existing zip file, removing files,
  776.   testing a zip file, converting a zip file, or getting the zip file's info.
  777.   This event is useful when dealing with very large zip files, and you want
  778.   to display a progress status while the zip file is read. }
  779. procedure TfrmMain.xZipZipContentsStatus(Sender: TObject; lFilesRead,
  780.   lFilesTotal: Integer; nFilesPercent: Smallint);
  781. begin
  782.   { We're not doing anything special here! }
  783. end;
  784.  
  785. end.
  786.  
  787.