home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 May / Chip_2002-05_cd1.bin / zkuste / delphi / kompon / d5 / CAKDIR.ZIP / CakDir.pas < prev    next >
Pascal/Delphi Source File  |  2002-02-20  |  260KB  |  7,115 lines
  1. unit CakDir;
  2. // Common Archiver Kit Experiment(CAKE)
  3. // Common Interface for Compression/Decompression components.
  4.  
  5. //Copyright (C) Joseph Leung 2001 (lycj@yahoo.com)
  6. //
  7. //This library is free software; you can redistribute it and/or
  8. //modify it under the terms of the GNU Lesser General Public
  9. //License as published by the Free Software Foundation; either
  10. //version 2.1 of the License, or (at your option) any later version.
  11. //
  12. //This library is distributed in the hope that it will be useful,
  13. //but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. //MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. //Lesser General Public License for more details.
  16. //
  17. //You should have received a copy of the GNU Lesser General Public
  18. //License along with this library; if not, write to the Free Software
  19. //Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20.  
  21. // ___________________________________________|
  22. // CAKE ver 1.0.32                            |
  23. // lastupdate 20.02.2002                      |
  24. // hIsToRy                                    |
  25. // ___________________________________________|
  26. // |1.0.3 extract/list/test.                  |
  27. // |1.0.4 added zip stop function.            |
  28. // |-.-.- added zip add function.             |
  29. // |-.-.- added zip delete function.          |
  30. // |-.-.- added filelist (html/txt).          |
  31. // |1.0.5 added rs list function.             |
  32. // |-.-.- added rs extr functions.            |
  33. // |1.0.6 added zip sfx functions.            |
  34. // |1.0.7 some code to fix directory.         |
  35. // |1.0.8 added zip overwrite code.           |
  36. // |1.0.9 New_Archive command.                |
  37. // |1.0.10 Pk3 = Zip now.                     |
  38. // |1.0.11 Hotedit function.                  |
  39. // |-.-.-- added zip rename function.         |
  40. // |-.-.-- Filters need USE_ARC now.          |
  41. // |1.0.12 added arc add function.            |
  42. // |1.0.13 Clear add list after add.          |
  43. // |-.-.-- added arc delete function.         |
  44. // |-.-.-- added arc overwrite code.          |
  45. // |-.-.-- added zip sfx extractpath.         |
  46. // |-.-.-- added get_total_size.              |
  47. // |-.-.-- added get_selected_size.           |
  48. // |1.0.14 Hotedit update check if file exist.|
  49. // |1.0.15 arc add now work without all dll.  |
  50. // |-.-.-- (it will set the file type first.) |
  51. // |-.-.-- fixed onprogress.                  |
  52. // |1.0.16 fixed crash if not assign event.   |
  53. // |1.0.17 new code on registry/inifiles.     |
  54. // |-.-.-- simple showagain? and yesno dialog.|
  55. // |-.-.-- association code.                  |
  56. // |-.-.-- small fix on cab adding,           |
  57. // |-.-.-- (require modify CAB32.pas to fix.) |
  58. // |-.-.-- line 60, 255, replace cmdline to   |
  59. // |-.-.-- Fcmdline.                          |
  60. // |-.-.-- <No longer use that to load CAB    |
  61. // |-.-.-- , So nevermind...>                 |
  62. // |-.-.-- it will nolonger add only 1 file.  |
  63. // |-.-.-- updated DelZip1.6N(replace 1.6L).  |
  64. // |1.0.18 Getassociatedprogram               |
  65. // |-.-.-- Size in K, GetArcString, Cando.    |
  66. // |1.0.19 Fix a bug in mask_add_selectedlist.|
  67. // |-.-.-- Runandwait, install, checkout.     |
  68. // |-.-.-- added SHChangeNotify component.    |
  69. // |-.-.-- minitor file system change.        |
  70. // |1.0.20 Moved some item to CAKStrings.pas. |
  71. // |-.-.-- event for password/overwrite.      |
  72. // |-.-.-- will work even unassigned.         |
  73. // |-.-.-- modified FuncCheck const.          |
  74. // |-.-.-- monitor registry change.           |
  75. // |-.-.--    (check MonitorShowChanges)      |
  76. // |-.-.-- Warning :required > 10mb of memory.|
  77. // |-.-.-- More if you modify it to check     |
  78. // |-.-.-- Whats changed(hint: Check //ed var)|
  79. // |-.-.-- added function CreateShortCut.     |
  80. // |1.0.21 Load & Decode UUE files.           |
  81. // |-.-.-- (Thanks Marcus Wirth for tips)     |
  82. // |-.-.-- (UUE add contain bug, dont use it!)|
  83. // |-.-.-- A working Find function.           |
  84. // |-.-.-- Extract : archive in archives.     |
  85. // |1.0.22 Loading Cab without cab32.dll.     |
  86. // |-.-.-- Fix GrabDesktopPath.               |
  87. // |-.-.-- CAKScript - Load_Script.           |
  88. // |-.-.--  ^^^ Suggested extensions (*.AKS)  |
  89. // |-.-.-- Converter - Archive_Convert        |
  90. // |-.--.- Warning : Directory not supported. |
  91. // |-.-.-- Filename truncater.                |
  92. // |-.-.-- Warning : Directory not supported. |
  93. // |-.-.-- added : GrabProgramPath.           |
  94. // |-.-.-- Fix ArcOpenSupport, ArcAddSupport. |
  95. // |-.-.-- Copied UUE code to XXE/B64 code.   |
  96. // |-.-.-- Fix MruList.                       |
  97. // |1.0.23 Pak, Wad Loading, Extracting       |
  98. // |-.-.-- Disk spanner(Create .bat to unspan)|
  99. // |-.-.-- Disk imager, SFX to Zip            |
  100. // |-.-.-- Backup registry  to .reg file      |
  101. // |-.-.-- new Add_Selected_List, faster      |
  102. // |-.-.-- RsDir Add function completed.      |
  103. // |-.-.-- added Crypto Zip Encrypt function. |
  104. // |-.-.-- added DeleteAllFiles function.     |
  105. // |1.0.24 Updated reSource version 2.6.      |
  106. // |-.-.-- support multiple %1% parameter.    |
  107. // |-.-.-- SYNC command, removedrive.         |
  108. // |-.-.-- isLocked command.                  |
  109. // |-.-.-- Customizable archive type(treatas).|
  110. // |-.-.-- new Properties.                    |
  111. // |-.-.-- Updated Capack version 1.36.       |
  112. // |1.0.25 REN, RENDIR, MSG command.          |
  113. // |-.-.-- zipdirRename                       |
  114. // |-.-.-- a fix for pak/wad loading.         |
  115. // |1.0.26 CanAdd, CanExtract.                |
  116. // |-.-.-- missed file: strconst.inc included.|
  117. // |1.0.27 Archive file size now working.     |
  118. // |-.-.-- List_Mask_Archive speed improve =) |
  119. // |-.-.-- List_Cache_Archive                 |
  120. // |-.-.-- Fixed multi "%1%" in loading aks.  |
  121. // |-.-.-- Fixed DelKeyInReg.                 |
  122. // |-.-.-- VersionControl(see qzip2).         |
  123. // |-.-.-- Fixed adding masked folder to cab. |
  124. // |-.-.-- Fixed Ace wont crash when closing. |
  125. // |1.0.28 Cake Extension - let you customize |
  126. // |-.-.-- Cake to use dos-prompt archiver.   |
  127. // |-.-.-- Fixed Batch Zip.                   |
  128. // |-.-.-- Fixed Pollfilelist                 |
  129. // |-.-.-- GenerateIndex - create index..     |
  130. // |-.-.-- Fixed Create dir in wrong loc(zip) |
  131. // |1.0.29 Fix Zip not adding subdirs.        |
  132. // |-.-.-- Removed analysis because of bugs.  |
  133. // |-.-.-- Included Floopy.pas and vwin32.pas.|
  134. // |-.-.-- Cab adding support dir now.        |
  135. // |-.-.-- Fix Cab adding confirmation dialog.|
  136. // |1.0.30 Ace2 Extract support added.        |
  137. // |-.-.-- Fixed Zip extract to root path.    |
  138. // |-.-.-- New features : Create Thumbnail.   |
  139. // |1.0.31 Fixed Cab Directory issue.         |
  140. // |1.0.32 %F% macro for filename withot ext. |
  141. // |-.-.-- Customizable Version control.      |
  142. // |-.-.-- Added RtdunRar.                    |
  143. // |-.-.-- %DATE% macro and DATESTR command.  |
  144. // |------------------------------------------|
  145.  
  146.  
  147. {$INCLUDE CAKDIR.INC}      //Config, Read it before compile!
  148. {$IFDEF USE_ZIP}{$R ZipMsgUS.res}{$ENDIF} //ZipDir Res file
  149. interface
  150. uses
  151.   CakStrings,
  152.   Graphics,
  153.   CakExt,                 {CakExtension}
  154.   Cabinet,fci,fdi,fcntl,  {Used for load cabinet}
  155.   {TResource is used by Graphics & RsDir}
  156.   {$IFDEF USE_ZIPR}   ZipRepair,         {$ENDIF}
  157.   {$IFDEF USE_ZIP}    ZipMstr,           {$ENDIF}
  158.   {$IFDEF USE_RAR}    RTdunRar,          {$ENDIF}
  159.   {$IFDEF USE_ACE}    RTdunAce,          {$ENDIF}
  160.   {$IFDEF USE_ACE2}   UNACEV2,           {$ENDIF}
  161.   {$IFDEF USE_ARC}    Archives,          {$ENDIF}
  162.   {$IFDEF USE_ARC}    Filters,           {$ENDIF}
  163.   {$IFDEF USE_ARC}    CAB32,             {$ENDIF}
  164.   {$IFDEF USE_WINEXT} WinEx32,           {$ENDIF}
  165.   {$IFDEF USE_CZIP}   EncryptIt,         {$ENDIF}
  166.   {$IFDEF USE_RS}     ResourceCompUnit,  {$ENDIF}
  167.   {$IFDEF USE_RS}     RsSupp,            {$ENDIF}
  168.   {$IFDEF USE_RS}     ArchiveHeadersUnit,{$ENDIF}
  169.   {$IFDEF USE_RS}     FClasses,          {$ENDIF}
  170.   {$IFDEF USE_INDY}   IdBaseComponent,   {$ENDIF}
  171.   {$IFDEF USE_INDY}   IdCoder,IDGlobal,  {$ENDIF}
  172.   {$IFDEF USE_INDY}   IdCoder3To4,       {$ENDIF}
  173.   {$IFDEF USE_SHCN}   SHChangeNotify,    {$ENDIF}
  174.   {$IFDEF USE_PDF}    PDFMaker, PMFonts, {$ENDIF}
  175.   Windows, Messages, ShlObj, SysUtils, Classes,  Controls, Forms, Dialogs,
  176.   StdCtrls, Registry, Inifiles, Shellapi, Extctrls, FileCtrl, Masks, MAPI,
  177.   Floppy,vwin32,Links;
  178.  
  179.   const
  180.         MAJORVER = '1';
  181.         MINORVER = '0';
  182.         BUILD    = '32';
  183.  
  184.         CAKVER = MAJORVER + '.'+ MINORVER + '.' + BUILD;
  185.         DefaultTreatAsZip = '.ZIP .PK3 .EXE .JAR .WSZ .SIT';
  186.         DefaultTreatAsRar = '.RAR';
  187.         DefaultTreatAsCab = '.CAB';
  188.         DefaultTreatAsLha = '.LHA .LZH';
  189.         DefaultTreatAsArj = '.ARJ';
  190.         DefaultTreatAsAce = '.ACE';
  191.         DefaultTreatAsTar = '.TAZ .TAR';
  192.         DefaultTreatAsTgz = '.TGZ .GZ .Z';
  193.         DefaultTreatAsBz2 = '.BZ2 .TB2';
  194.         DefaultTreatAsBza = '.BZA .GZA';
  195.         DefaultTreatAsCzip = '.CZIP';
  196.         DefaultTreatAsRs = '.RS';
  197.         DefaultTreatAsYz1 = '.YZ1';
  198.         DefaultTreatAsUue = '.UUE .UU .ENC';
  199.         DefaultTreatAsXxe = '.XXE';
  200.         DefaultTreatAsB64 = '.B64';
  201.         DefaultTreatAsPak = '.PAK .WAD';
  202.         DefaultTreatAsBel = '.BEL';
  203.         DefaultTreatAsGcA = '.GCA';
  204.         DefaultTreatAsAks = '.AKS';
  205.  
  206. type
  207.   supportType = (_Zip,_Rar,_Cab,_Arj,_Lha,_Tar,_Tgz,_Ace,_Bz2,_Bel,_Gca,_Bza,_Rs,_Czip,_Yz1,_Uue,_Xxe,_B64,_Pak,_Ext,_Aks,_WIT);
  208.   filelisttype = (_Txt, _Htm,_Pdf,_Pdf2);
  209.   sortbyType = (_FName, _FType, _FSize, _FPSize,_FCRC,_FRatio, _FDefPath, _FTime, _FArchive);
  210.   cabmodetype = (_CFList,_CFExtract);
  211.   addmodetype = set of (_refresh, _update, _move);
  212.  
  213.   TCOverEvent = procedure ( Sender : TObject; Filename : string;var overwrite : boolean ;var applytoall : boolean) of object;
  214.   TCPwdEvent = procedure ( Sender : TObject; archive, filename : string; var newpassword : string) of object;
  215.   TCMsgEvent = procedure( Sender: TObject; ErrCode: Integer; Message: String ) of object;
  216.   TCProgEvent = procedure( Sender: TObject; Filename: String; FileSize: Longint; Completed : Longint ) of object;
  217.   TCFoundEvent = procedure ( Sender: TObject; Filename: String; Filesize : integer) of object;
  218.   TCCrytoEvent = procedure ( Sender : TObject; var key1, key2, key3 : integer) of object;
  219.   Arctype = record
  220.             _ARCname : string;
  221.             _ARCtype : supporttype;
  222.             _ARCsize : integer;
  223.             _ARChaveinst,
  224.             _ARChavecomm,
  225.             _ARCneedpassword : boolean;
  226.             _ARCTime : TDatetime;
  227.             end;
  228.   Regnodetype = record
  229.                 iskey : boolean;
  230.                 fullpath : string;
  231.                 keyname : string;
  232.           {//   valuetype : TRegDataType;
  233.                 dataS : String;
  234.                 dataES : ANSIString;
  235.                 dataI : integer;
  236.                 dataB : integer; //}
  237.                 subkey : TList;
  238.                 end;
  239.   PRegnodetype = ^Regnodetype;
  240.   Contenttype = record
  241.               _FileIcon,_FileRatio, _Tag : integer;
  242.               _FileSize,_FilePackedSize : Longint;
  243.               _FileTime : TDatetime;
  244.               _Filename,_Filetype,
  245.               _FileCRC,_FileDefPath,_FileArchive : String;
  246.               _Encrypted, _Selected : boolean;
  247.               end;
  248.   SfxOptionstype = record
  249.                    sfx_to : integer;
  250.                    sfx_message : string;
  251.                    sfx_commandline : string;
  252.                    sfx_caption : string;
  253.                    sfx_extractto : string;
  254.                    sfx_autorun : boolean;
  255.                    sfx_overwrite : boolean;
  256.                    end;
  257.   ExtractOptionstype = record
  258.                    extr_to : string;
  259.                    extr_DirNames : boolean;
  260.                    extr_OverWrite : boolean;
  261.                    extr_ArcINArc : boolean;
  262.                    extr_Extractall : boolean;
  263.                    end;
  264.   AddOptionstype = record
  265.                    add_to : integer;
  266.                    add_encrypt : string;
  267.                    add_SubDir : boolean;
  268.                    add_useencrypt : boolean;
  269.                    add_usepath : boolean;
  270.                    add_mode : addmodetype;
  271.                    add_hidden : boolean;
  272.                    add_filelist : boolean;
  273.                    add_files : TStrings;
  274.                    add_basedir : string;
  275.                    add_exclude : TStrings;
  276.                    add_dosformat : boolean;
  277.                    add_relative : boolean; //zip only!!
  278.                    end;
  279.   FinderOptionstype = record
  280.                       af_targetname : TStrings;
  281.                       af_sourcedir : string;
  282.                       af_subdir : boolean;
  283.                       af_arcfilter : string;
  284.                       af_arctype : set of supporttype;
  285.                       af_containtext : string;
  286.                       end;
  287.   Worktype = (_None,              //Donothing
  288.               _LoadContents,      //List Archive
  289.               _Extract,           //Extract Archive
  290.               _Test,              //Test Archive
  291.               _Add,               //Add file to archive
  292.               _Delete,            //Delete file from archive
  293.               _SFX,               //Create Self extractables
  294.               _CryptoZip
  295.               );
  296.  
  297.   AVILTYPE = array[Worktype] of boolean;
  298.  
  299.   TCakDir = class(TComponent)
  300.   private
  301.      FOnOver : TCOverEvent;
  302.      FOnPwd: TCPwdEvent;
  303.      FOnMsg: TCMsgEvent;
  304.      FOnProg: TCProgEvent;
  305.      FOnFound: TCFoundEvent;
  306.      FOnCryto: TCCrytoEvent;
  307.      stopping : boolean;
  308.      loadlines : boolean;
  309.      Cabmode : cabmodetype;
  310.      Cab_Extr_to : string;
  311.  
  312.      procedure doStop(Stopp : boolean);
  313.      procedure Fillabout;
  314.      procedure SetArchivetype(value : supportType);
  315.      function GetArchivetype : supportType;
  316.      function Process(processwhat : worktype) : boolean;
  317.      function Compare(Item1, Item2: Contenttype; FSortforward : boolean; atype: Sortbytype): integer;
  318.      procedure QuickSort(var Sortarray: array of Contenttype; size: integer;
  319.                FSortforward : boolean; atype: Sortbytype);
  320.      function GetARCtype1(archivename : string) : supporttype;
  321.      {$IFDEF USE_WINEXT} function GetARCtype2(archivename : string) : supporttype; {$ENDIF}
  322.  
  323.      {$IFDEF USE_ZIP} function ProcessZIP(processwhat : worktype) : boolean; {$ENDIF}
  324.      {$IFDEF USE_ZIP} procedure Load_ZIP_DLL; {$ENDIF}
  325.      {$IFDEF USE_ZIP} procedure UNLoad_ZIP_DLL; {$ENDIF}
  326.      {$IFDEF USE_ZIP} procedure ZipDirMessage(Sender: TObject; ErrCode: integer; Message: string); {$ENDIF}
  327.      {$IFDEF USE_ZIP} procedure ZipDirProgress(Sender: TObject; ProgrType: ProgressType; Filename: string; FileSize: integer); {$ENDIF}
  328.      {$IFDEF USE_ZIP} procedure ZipDirPwdErr(Sender: TObject; IsZipAction: Boolean; var NewPassword: String; ForFile: String; var RepeatCount: Cardinal; var Action: TPasswordButton); {$ENDIF}
  329.      {$IFDEF USE_ZIP} procedure ZipDirExtrOver(Sender: TObject;  ForFile: String; Older: Boolean; var DoOverwrite: Boolean;  DirIndex: Integer); {$ENDIF}
  330.  
  331.      {$IFDEF USE_ACE} function ProcessACE(processwhat : worktype) : boolean; {$ENDIF}
  332.      {$IFDEF USE_ACE} procedure Load_ACE_DLL; {$ENDIF}
  333.      {$IFDEF USE_ACE} procedure UNLoad_ACE_DLL; {$ENDIF}
  334.      {$IFDEF USE_ACE} procedure AceDirList(Sender: TObject; eFile: TACEHeaderData; Result: Boolean); {$ENDIF}
  335.      {$IFDEF USE_ACE} procedure AceDirError(Sender: TObject; Error: Integer); {$ENDIF}
  336.      {$IFDEF USE_ACE} procedure AceDirExtracting(Sender: TObject; eFile: TACEHeaderData); {$ENDIF}
  337.      {$IFDEF USE_ACE2} function CallAceInitDll : integer; {$ENDIF}
  338.      {$IFDEF USE_ACE2} procedure Ace2HandleError(ErrNo : integer); {$ENDIF}
  339.  
  340.      {$IFDEF USE_Rar} function ProcessRar(processwhat : worktype) : boolean; {$ENDIF}
  341.      {$IFDEF USE_Rar} procedure Load_Rar_DLL; {$ENDIF}
  342.      {$IFDEF USE_Rar} procedure UNLoad_Rar_DLL; {$ENDIF}
  343.      {$IFDEF USE_Rar} procedure RarDirList(Sender: TObject; eFile: TRarHeaderData; Result: Boolean); {$ENDIF}
  344.      {$IFDEF USE_Rar} procedure RarDirError(Sender: TObject; Error: Integer); {$ENDIF}
  345.      {$IFDEF USE_Rar} procedure RarDirExtracting(Sender: TObject; eFile: TRarHeaderData); {$ENDIF}
  346.      {$IFDEF USE_Rar} function  RarDirVolumeChange(Sender: TObject; ArcName: PChar;  Mode: Integer): Integer; {$ENDIF}
  347.  
  348.      {$IFDEF USE_ARC} function ProcessARC(processwhat : worktype) : boolean; {$ENDIF}
  349.      {$IFDEF USE_ARC} procedure Load_ARC_DLL; {$ENDIF}
  350.      {$IFDEF USE_ARC} procedure UNLoad_ARC_DLL; {$ENDIF}
  351.      {$IFDEF USE_ARC} procedure ArcDirProgress( Sender:TObject;State:Integer;lpEis:LPEXTRACTINGINFOEX;var Abort: Boolean ); {$ENDIF}
  352.      {$IFDEF USE_ARC} procedure ARCHandleError(code : integer); {$ENDIF}
  353.  
  354.      function ProcessEXT(processwhat : worktype) : boolean;
  355.      procedure Load_EXT_DLL;
  356.      procedure UnLoad_EXT_DLL;
  357.      procedure SetScriptPath(path : string);
  358.      function translatetype(aworktype : worktype) : worktypeex;
  359.  
  360.      {$IFDEF USE_CZIP} function ProcessCZIP(processwhat : worktype) : boolean; {$ENDIF}
  361.      procedure ProcessAKS(processwhat : worktype);
  362.      function ProcessPAK(processwhat : worktype) : boolean;
  363.      function ProcessCAB(processwhat : worktype) : boolean;
  364.      procedure Load_CAB_DLL;
  365.      procedure UNLoad_CAB_DLL;
  366.      procedure CabRCopyFile(Sender: TObject; const FileName: String; UncompressedSize: Integer; Date, Time,
  367.                             Attribs: Smallint; var Action: TFileCopyAction;
  368.                             var DestFileHandle: Integer);
  369.      procedure CabRDirCloseCopied(Sender: TObject;
  370.                             const FileName: String; FileHandle: Integer; Date, Time,
  371.                             Attribs: Smallint; FolderIndex: Integer; Execute: Boolean;
  372.                             var Abort: Boolean);
  373.      procedure CabWFilePlaced(Sender: TObject; var CabParameters: TCCAB; const FileName: String; FileLength: Integer;
  374.                               Continuation: Boolean; var AbortProcessing: Boolean);
  375.      procedure CabRNextCab(Sender: TObject;
  376.                         const NextCabinetName, NextCabinetDisk: String; var CabinetPath: String;
  377.                         ErrorIndication: TFDIERROR; var Abort: Boolean);
  378.  
  379.      {$IFDEF USE_RS} function ProcessRS(processwhat : worktype) : boolean; {$ENDIF}
  380.      {$IFDEF USE_RS} procedure Load_RS_DLL; {$ENDIF}
  381.      {$IFDEF USE_RS} procedure UNLoad_RS_DLL; {$ENDIF}
  382.      {$IFDEF USE_RS} Procedure RsDirAddLog(Sender: TObject; s: String); {$ENDIF}
  383.      {$IFDEF USE_RS} Procedure RsDirCDChange(Sender: TObject); {$ENDIF}
  384.  
  385.      {$IFDEF USE_INDY} function ProcessUUE(processwhat : worktype) : boolean; {$ENDIF}
  386.      {$IFDEF USE_INDY} function ProcessB64(processwhat : worktype) : boolean; {$ENDIF}
  387.      {$IFDEF USE_INDY} function ProcessXXE(processwhat : worktype) : boolean; {$ENDIF}
  388.  
  389.      {$IFDEF USE_SHCN}procedure CNOnAttrib(Sender: TObject; Flags: Cardinal;Path1: String);{$ENDIF}
  390.      {$IFDEF USE_SHCN}procedure CNOnCreate(Sender: TObject; Flags: Cardinal;Path1: String);{$ENDIF}
  391.      {$IFDEF USE_SHCN}procedure CNOnDelete(Sender: TObject; Flags: Cardinal;Path1: String);{$ENDIF}
  392.      {$IFDEF USE_SHCN}procedure CNOnNewDir(Sender: TObject; Flags: Cardinal;Path1: String);{$ENDIF}
  393.      {$IFDEF USE_SHCN}procedure CNOnRename(Sender: TObject; Flags: Cardinal;Path1, path2: String);{$ENDIF}
  394.      {$IFDEF USE_SHCN}procedure CNOnRmDir(Sender: TObject; Flags: Cardinal;Path1: String);{$ENDIF}
  395.      {$IFDEF USE_SHCN}procedure CNOnUpdateDir(Sender: TObject; Flags: Cardinal;Path1: String);{$ENDIF}
  396.      {$IFDEF USE_SHCN}procedure CNOnUpdateItem(Sender: TObject; Flags: Cardinal;Path1: String);{$ENDIF}
  397.  
  398.      procedure T1Ontimer(Sender : TObject);
  399.      procedure PlainDialog;
  400.      procedure FreePlainDialog;
  401.      Function ExecInf( Var Path, Param: String ): Cardinal;
  402.      procedure ExecReg(Var Path : String);
  403.      function ArcOpenSupport : string;
  404.      function ArcAddSupport : string;
  405.      function MakeRegnode(rootkey : HKEY; path : ANSIstring) : Tlist;
  406.      procedure CleanRegnode(alist : TList);
  407.      procedure AddRegnode(Rootkey : Hkey; alist : TList;var  astring : TStrings;key, subkey : string);
  408.      procedure CompareRegnode(rootkey :HKEY; list1,list2 : TList; var astring : TStrings; key,subkey : string);
  409.      function InitContentType : Contenttype;
  410.  
  411.   protected
  412.   public
  413.      {$IFDEF USE_ZIP} Zipdir : TZipMaster;      {$ENDIF}
  414.      {$IFDEF USE_ACE} Acedir : TdACE;           {$ENDIF}
  415.      {$IFDEF USE_Rar} Rardir : TdRar;           {$ENDIF}
  416.      {$IFDEF USE_ARC} Arcdir : TArchiveFile;    {$ENDIF}
  417.      {$IFDEF USE_RS } Rsdir  : TResource;       {$ENDIF}
  418.      {$IFDEF USE_SHCN}SHCN   : TSHChangeNotify; {$ENDIF}
  419.                       CabWDir: TCabinetWriter;
  420.                       CabRDir: TCabinetReader;
  421.                       CabFH  : TStreamCabinetFileHandler;
  422.      {$IFDEF USE_SHCN}HISTORY: TStringList;     {$ENDIF}
  423.  
  424.      CakExt : TCakExt;
  425.      CakExtLogFile : string;
  426.      TreatasExt : string;
  427.  
  428.      Timer1 : TTimer;
  429.  
  430.      AsZip, AsRar, AsCab, AsArj, AsLha, AsTar, AsTgz,
  431.      AsAce, AsBz2, AsBel, AsGca, AsBza, AsRs, AsCZip,
  432.      AsYz1, AsUue, AsXxe, AsB64, AsPak, AsAks : string;
  433.  
  434.      ImageS: TImageList;
  435.      ImageL: TImageList;
  436.      FileType, FileExt, DirectoryList, Abouttext, MRUList, NewDirList, ScriptParam : TStringlist;
  437.      MaxMRU : integer;
  438.      Total_Archive : integer;
  439.      Total_Contents, Fullcontentcount : integer;
  440.      key1,key2,key3 : integer;
  441.      leadchar, Temppath : String;
  442.      scriptvar1 : string;
  443.      password : string;
  444.      Timestrformat : string;
  445.      exploremode : boolean;
  446.  
  447.      SubDir_List : TStringlist;
  448.      SubDir_RootPath : string;
  449.      Archive_List : array of Arctype;
  450.      Archive_Contents, temp_Contents, Full_Contents : array of Contenttype;
  451.  
  452.      processfrom, processto, processing : integer;
  453.      Extractoptions : ExtractOptionsType;
  454.      AddOptions : AddOptionsType;
  455.      sfxOptions : SfxOptionsType;
  456.      FinderOptions : FinderOptionsType;
  457.  
  458.      cancelwait,terminaterun : boolean;
  459.  
  460.      versioncontrol : boolean;
  461.  
  462.      constructor Create( AOwner: TComponent ); override;
  463.      destructor Destroy; override;
  464.  
  465.      //Archive List functions
  466.      procedure  Set_Archive_List(filename : string);
  467.      function Get_Archive_Name : string;
  468.      procedure Clear_Archive_List;
  469.      function  Add_Archive_List(filename : string) : integer;
  470.      procedure Append_Archive_List(filename : string; appendto : integer);
  471.      procedure Sort_Archive_List(accending : boolean; atype: Sortbytype);
  472.      function Get_Total_Size : Longint;
  473.      {$IFDEF USE_WINEXT} procedure GetFileType(filename : string; var info1,info2, info3 : string); {$ENDIF}
  474.  
  475.      //Command
  476.      procedure List_Archive(arcfrom,arcto : integer);
  477.      procedure List_Cache_Archive;
  478.      procedure List_Mask_Archive(mask : string; arcfrom,arcto : integer; showonlythatdir : boolean);
  479.      procedure Extract_Archive(arcfrom, arcto : integer);
  480.      procedure Test_Archive(arcfrom,arcto : integer);
  481.      procedure Delete_Archive(arcfrom,arcto : integer);
  482.      procedure New_Archive(filename : string);
  483.      procedure Load_Script(script : Tstrings);
  484.      procedure Archive_Convert(filename : string; totype : supporttype);
  485.      procedure Filename_Truncate(arcname : string);
  486.      procedure Extract;
  487.      procedure Test;
  488.      procedure Delete;
  489.      procedure Add;
  490.      procedure SFX;
  491.      function AskOverwrite(forfile : string) : boolean;
  492.      {$IFDEF USE_ZIP} procedure SFX2ZIP(SFXname : string); {$ENDIF}
  493.      {$IFDEF USE_CZIP} procedure CrytoZip; {$ENDIF}
  494.  
  495.      procedure Find;
  496.      procedure FindStop;
  497.      procedure BatchAdd(afilelist : TStrings; archivetype : supporttype);
  498.      function Checkout(arc : integer;openit : boolean) : string;
  499.      procedure Install(filename : string; arc : integer);
  500.      procedure HotEdit(filename : string; arc : integer);
  501.      function Cando(atype : supporttype;awork : worktype) : boolean;
  502.      function CanAdd : boolean;
  503.      function CanExtract : boolean;
  504.      procedure Filelist(fltype : filelisttype;filename : string; arcfrom, arcto : integer);
  505.      {$IFDEF USE_ZIP} procedure Zipdirrenamedir(SourceName, DestName: string); {$ENDIF}
  506.      {$IFDEF USE_ZIP} procedure Zipdirrename(SourceName, DestName: string); {$ENDIF}
  507.      {$IFDEF USE_ZIPR} procedure repairZip(SourceName, DestName : string); {$ENDIF}
  508.  
  509.      //Selected List function
  510.      procedure Clear_Selected_List;
  511.      procedure Add_Selected_List(filename, archivename : string); overload;
  512.      procedure Add_Selected_List(filename : tstrings; archivename : string); overload;
  513.      procedure Add_All_Selected_List;
  514.      procedure Mask_Add_Selected_List(FileMasks, Filearchive: string);
  515.      function Get_Selected_Count(ForArchive : string) : integer; overload;
  516.      function Get_Selected_Count : integer; overload;
  517.      function Get_Selected_Size : Longint;
  518.      function Get_Selected_CompSize : Longint;
  519.      function Get_Top_Selected : string; 
  520.      function Get_Top_index : integer;
  521.  
  522.      //Archive Content function
  523.      function Get_Archive_Code(filearchive, filename : string) : integer;
  524.  
  525.      //Add List function
  526.      procedure Clear_Add_List;
  527.  
  528.      //Path Grabbing
  529.      function GrabDesktopPath : string;
  530.      function GrabProgramPath : string;
  531.      function GrabCurrentPath : string;
  532.      function GrabTempPath : string;
  533.      function GrabSystemPath : string;
  534.      function GrabWindowPath : string;
  535.      function GrabMydocuPath : string;
  536.  
  537.      //Archive related function
  538.      procedure Thumbnail(Filename : string; cellHeight, cellWidth : Integer);
  539.      //Others
  540.      function CalcFolderSize(const aRootPath: string): Int64;
  541.      procedure MakeDirectory(dirname: string);
  542.      function appendSlash(input : string) : string;
  543.      function removeSlash(input : string) : string;
  544.      function modifyslash(input : string) : string; overload;
  545.      function modifyslash(input : string;fromm,tto : char) : string; overload;
  546.      function removefileext(input : string) : string;
  547.      function removedrive(input : string) : string;
  548.      function Returnicontype(filename : string) : integer;
  549.      procedure reiniticons;
  550.      function GetarcString(atype : supporttype) : string;
  551.      function GetarcStringFull(atype : supporttype) : string;
  552.      function GetarcStringFilter(atype : supporttype) : string;
  553.      function sizeinK(size: int64): string;
  554.      procedure run(programpath,Programparam : string);
  555.      procedure runwww(wwwpath : string);
  556.      procedure runandwait(programpath,Programparam : string);
  557.      function isharddrive(drive : char) : boolean;
  558.      function iscdrom(drive : char) : boolean;
  559.      function isfloppy(drive : char) : boolean;
  560.      procedure Explorefolder(folder : string);
  561.      function newtemppath : string;
  562.      {$IFDEF USE_SHCN}procedure MonitorStart;{$ENDIF}
  563.      {$IFDEF USE_SHCN}function MonitorShowChanges : TStrings;{$ENDIF}
  564.      {$IFDEF USE_SHCN}procedure MonitorStop; {$ENDIF}
  565.      procedure SendMail(Subject, Mailtext, FromName, FromAdress, ToName, ToAdress,  AttachedFileName,  DisplayFileName: string;  ShowDialog: boolean);
  566.      function CreateShortcut(linkfilename,filepath : string) : boolean;
  567.      procedure DeleteDir(aDir: string);
  568.      function found(filename : string) : boolean;
  569.      function SubDirList(dir : string) : TStrings;
  570.      function GetARCtype(archivename : string) : supporttype;
  571.      function DiskSpan(source, target : string; disksize : longint; MakeBatch : boolean) : integer;
  572.      procedure DiskUnSpan(filename : string);
  573.      function DiskMakeImage(drive : integer; filename : string) : boolean;
  574.      function DiskWriteImage(drive : integer; filename : string) : boolean;
  575.      function RegListsubkey(RKey : HKey; KeyPath : string) : TStrings;
  576.      function RegListVal(RKey : HKey; KeyPath : string) : TStrings;
  577.      procedure RegBackup(RKey : HKey; KeyPath, Value : string;filename : string);
  578.      function rkeyname(rootkey :HKEY) : string;
  579.      function name2rkey(key : string) : HKey;
  580.      function DeleteAllFiles(FilesOrDir: string): boolean;
  581.      procedure SetDefaultTreasAs;
  582.      function isLocked(filename : string) : boolean;
  583.      function GetFileSize(const FileName: String): Int64;
  584.      function decodetimestr(input : string) : string;
  585.  
  586.      //Registry support features
  587.      function GetvalInReg(RKey : HKey; KeyPath : string; Valname : string) : string;
  588.      procedure SetValInReg(RKey: HKey; KeyPath: string; ValName: string; NewVal: string);
  589.      procedure DelValInReg(RKey: HKey; KeyPath: string; Key : string);
  590.      procedure DelKeyInReg(RKey: HKey; KeyPath: string);
  591.      function pollfilelist(maskedname : string; subdir : boolean) : tstrings;
  592.      procedure GenerateIndex(path : string; masks : tstrings;  Indexfilename, Contentfilename : string); 
  593.  
  594.      //Associating
  595.      procedure AssociateProgram(ext,path,icon : string);
  596.      procedure UNAssociateProgram(ext : string);
  597.      function GetAssociatedProgram(ext : string) : string;
  598.      procedure refreshicon;
  599.  
  600.      //INI support features
  601.      function GetvalInIni(filename : string; section : string; key : string; default : string) : string;
  602.      procedure SetValInIni(filename : string; section : string; key, value : string);
  603.  
  604.      //Simple dialogs
  605.      procedure RegAskShowAgainDialog(dcaption, Msg : string; Path, key : string);
  606.      procedure IniAskShowAgainDialog(dcaption, Msg : string; Filename, section, key : string);
  607.      function ShowAgainDialog(dcaption, msg : string) : boolean;
  608.  
  609.      procedure RegYesNoAskShowAgainDialog(dcaption, Msg : string; Path, section, key : string;var yesno : boolean);
  610.      procedure IniYesNoAskShowAgainDialog(dcaption, Msg : string; Filename, Product, section, key : string;var yesno : boolean);
  611.      function YesNoShowAgainDialog(dcaption,msg : string; var yesno : boolean) : boolean;
  612.  
  613.   published
  614.      property OnCMessage :TCMsgEvent read  FOnMsg write FOnMsg;
  615.      property OnCProgress:TCProgEvent read FOnProg write FOnProg;
  616.      property OnCArchiveFound:TCFoundEvent read FOnFound write FOnFound;
  617.      property OnCOverwrite : TCOverEvent read FOnOver write FOnOver;
  618.      property OnCPassword : TCPwdEvent read FOnPwd write FOnPwd;
  619.      property OnCCrytoEvent : TCCrytoEvent read FOnCryto write FOnCryto;
  620.  
  621.      property ScriptShowLoadingLines : boolean read loadlines write loadlines default true;
  622.  
  623.      property TreatAsZip : string read AsZip write AsZip;
  624.      property TreatAsRar : string read AsRar write AsRar;
  625.      property TreatAsCab : string read AsCab write AsCab;
  626.      property TreatAsArj : string read AsArj write AsArj;
  627.      property TreatAsLha : string read AsLha write AsLha;
  628.      property TreatAsTar : string read AsTar write AsTar;
  629.      property TreatAsTgz : string read AsTgz write AsTgz;
  630.      property TreatAsAce : string read AsAce write AsAce;
  631.      property TreatAsBz2 : string read AsBz2 write AsBz2;
  632.      property TreatAsBel : string read AsBel write AsBel;
  633.      property TreatAsGca : string read AsGca write AsGca;
  634.      property TreatAsBza : string read AsBza write AsBza;
  635.      property TreatAsRs : string read AsRs write AsRs;
  636.      property TreatAsCzip : string read AscZip write AscZip;
  637.      property TreatAsYz1 : string read AsYz1 write AsYz1;
  638.      property TreatAsUue : string read AsUue write AsUue;
  639.      property TreatAsXxe : string read AsXxe write AsXxe;
  640.      property TreatAsB64 : string read AsB64 write AsB64;
  641.      property TreatAsPak : string read AsPak write AsPak;
  642.      property TreatAsAks : string read AsAks write AsAks;
  643.  
  644.      property ArchiveName : string read Get_Archive_Name write Set_Archive_List;
  645.      property ArchiveType : supportType read GetArchiveType write SetArchiveType default _WIT;
  646.      property ExtractTo : string read ExtractOptions.extr_to write ExtractOptions.extr_to;
  647.      property ExtractUsepath : boolean read ExtractOptions.extr_Dirnames write ExtractOptions.extr_Dirnames default True;
  648.      property ExtractOverwrite : boolean read ExtractOptions.Extr_Overwrite write ExtractOptions.extr_Overwrite default False;
  649.  
  650.      property Addmode : addmodetype read AddOptions.add_mode write AddOptions.add_mode;
  651.      property Addpassword : string read AddOptions.add_encrypt write AddOptions.add_encrypt;
  652.      property Adduseencrypt : boolean read AddOptions.add_useencrypt write AddOptions.add_useencrypt default False;
  653.      property Addusepath : boolean read AddOptions.add_usepath write AddOptions.add_usepath default True;
  654.      property Addsubdir : boolean read AddOptions.add_subdir write AddOptions.add_subdir default True;
  655.      property Addfiles : tstrings read AddOptions.add_files write AddOptions.add_files;
  656.      property AddBaseDir : string read AddOptions.add_basedir write AddOptions.add_basedir;
  657.      property AddExclude : tstrings read AddOptions.add_exclude write AddOptions.add_exclude;
  658.  
  659.      property CakExtScriptPath : string write SetScriptPath;
  660.      property Stop : boolean read stopping write doStop;
  661.      property About : TStringlist read Abouttext;
  662.   end;
  663.  
  664.   TFinder = class(TThread)
  665.   private
  666.   FOnFound : TCFoundEvent;
  667.   FOption : FinderOptionstype;
  668.   CakDir1 : TCakDir;
  669.   procedure Search(dir : string);
  670.   protected
  671.  
  672.   public
  673.     constructor Create(Createsuspended: boolean);
  674.     procedure Execute; override;
  675.     destructor Destroy; override;
  676.   published
  677.   property FinderOption : FinderOptionstype read FOption write FOption;
  678.   property OnCArchiveFound:TCFoundEvent read FOnFound write FOnFound;
  679.   end;
  680.  
  681.  
  682. procedure Register;
  683. const T = True; F = False;
  684.       FuncCheck :
  685.       array[supporttype,worktype] of boolean =
  686. ((T,T,T,T,T,T,T,T), (T,T,T,T,F,F,F,F), {_Zip,_Rar}
  687.  (T,T,T,T,T,F,F,F), (T,T,T,T,F,F,F,F), (T,T,T,T,T,T,T,F), {_Cab,_Arj,_Lha}
  688.  (T,T,T,T,T,T,F,F), (T,T,T,T,T,T,F,F), (T,T,T,T,F,F,F,F), {_Tar,_Tgz,_Ace}
  689.  (T,T,T,T,T,T,F,F), (T,T,T,T,F,F,F,F), (T,T,T,T,F,F,F,F), {_Bz2,_Bel,_Gca}
  690.  (T,T,T,T,T,T,F,F), (T,T,T,F,T,T,F,F), (T,T,T,F,F,F,F,F), {_Bza,_Rs,_Czip}
  691.  (T,T,T,F,T,F,F,F), (T,T,T,F,F,F,F,F), (T,T,T,F,F,F,F,F), {_Yz1,_Uue,_Xxe}
  692.  (T,T,T,F,F,F,F,F), (T,T,T,F,F,F,F,F), (T,F,F,F,F,F,F,F),  {_B64,_Pak,_Ext}
  693.  (T,T,T,F,F,F,F,F), (F,F,F,F,F,F,F,F));{_Aks,_WIT}
  694. {None,LoadContents,Extract,Test,Add,Delete,Sfx,CrytoZip}
  695.  
  696. var processed_files : integer;
  697.     TotalProgress : Longint;
  698.     Total_Unpacked, Totalsize : longint;
  699.     overwriteall : integer;
  700.     lastname : string;
  701.     aform : TForm;
  702.     aCheckbox : TCheckbox;
  703.     aLabel : TStaticText;
  704.     A_HKCU,A_HKLM : TList;
  705.     aFinder : TFinder;
  706.     stopprocess : boolean;
  707.     Ace2Msg : string;
  708.     Ace2Code : integer;
  709. implementation
  710.  
  711. constructor TFinder.Create(Createsuspended: boolean);
  712. begin
  713.   inherited Create(CreateSuspended);
  714.   CakDir1 := TCakDir.Create(nil);
  715.   FreeOnTerminate := True;
  716. end;
  717. destructor TFinder.Destroy;
  718. begin
  719.   CakDir1.free;
  720.   inherited Destroy;
  721. end;
  722.  
  723. function TCakdir.decodetimestr(input : string) : string;
  724. var i: integer;
  725.     hh,mm,ss,ms,yy,nn,dd : word;
  726.     Date: TDateTime;
  727. begin
  728.         Date := now;
  729.         Decodetime(date,hh,mm,ss,ms);
  730.         Decodedate(date,yy,nn,dd);
  731.         Result := '';
  732.         for i := 1 to length(input) do
  733.         Case input[i] of
  734.         'h','H' : Result := Result + inttostr(hh);
  735.         'm','M' : Result := Result + inttostr(mm);
  736.         's','S' : Result := Result + inttostr(ss);
  737.         'i','I' : Result := Result + inttostr(ms);
  738.         'y','Y' : Result := Result + inttostr(yy);
  739.         'n','N' : Result := Result + inttostr(nn);
  740.         'd','D' : Result := Result + inttostr(dd);
  741.         'p','P' : if hh > 12 then Result := Result + 'PM' else
  742.                         Result := Result + 'AM';
  743.         else Result := Result + input[i];
  744.         end;
  745. end;
  746.  
  747.  
  748. function TCakdir.GetFileSize(const FileName: String): Int64;
  749. var
  750.   myFile: THandle;
  751.   myFindData: TWin32FindData;
  752. begin
  753.   Result := 0;
  754.   myFile := FindFirstFile(PChar(FileName), myFindData);
  755.   if myFile <> INVALID_HANDLE_VALUE then
  756.   begin
  757.     Windows.FindClose(myFile);
  758.     Result := Int64(myFindData.nFileSizeHigh) shl Int64(32) +
  759. Int64(myFindData.nFileSizeLow);
  760.   end;
  761. end;
  762.  
  763. procedure TFinder.Search(dir : string);
  764. var
  765.         sr: TSearchRec;
  766.         k: string;
  767.         FileAttrs,i,j : integer;
  768.         aStrings : TStrings;
  769.         alist : tstrings;
  770. begin
  771.         alist := tstringlist.create;
  772.         alist.commatext := FOption.af_arcfilter;
  773.         for j := 0 to alist.count -1 do
  774.         begin
  775.         k := CakDir1.appendslash(dir) + alist.strings[j];
  776.         FileAttrs := 0;
  777.         FileAttrs := FileAttrs and faAnyFile;
  778.  
  779.         if FindFirst(k , FileAttrs, sr) = 0 then
  780.         begin
  781.                 if fileexists(CakDir1.appendslash(dir) + sr.Name) then
  782.                         begin
  783.                         CakDir1.Set_Archive_List(CakDir1.appendslash(dir) + sr.name);
  784.                         CakDir1.Total_Contents := 0;
  785.                         if CakDir1.Cando(CakDir1.GetARCtype(CakDir1.appendslash(dir) + sr.Name),_LoadContents) then
  786.                                 CakDir1.List_Archive(0,0);
  787.                         if CakDir1.Total_Contents > 0 then
  788.                         For i := 0 to FOption.af_targetname.Count - 1 do
  789.                         if CakDir1.Found(FOption.af_targetname.strings[i]) then
  790.                                 FOnFound(nil,dir + sr.name, sr.Size);
  791.                         end;
  792.                 while (FindNext(sr) = 0) and not terminated do
  793.                         if fileexists(CakDir1.appendslash(dir) + sr.Name) then
  794.                         begin
  795.                         CakDir1.Set_Archive_List(CakDir1.appendslash(dir) + sr.name);
  796.                         CakDir1.Total_Contents := 0;
  797.                         if CakDir1.Cando(CakDir1.GetARCtype(CakDir1.appendslash(dir) + sr.Name),_LoadContents) then
  798.                                 CakDir1.List_Archive(0,0);
  799.                         For i := 0 to FOption.af_targetname.Count - 1 do
  800.                         if CakDir1.Found(FOption.af_targetname.strings[i]) then
  801.                                 FOnFound(nil,dir + sr.name, sr.size);
  802.                         end;
  803.                 FindClose(sr);
  804.         end;
  805.         end;
  806.         alist.free;
  807.         
  808.         Application.ProcessMessages;
  809.         if FOption.af_subdir then
  810.                 begin
  811.                 aStrings := CakDir1.SubDirList(dir);
  812.                 if aStrings.count > 0 then
  813.                 For i := 0 to astrings.count -1 do
  814.                 if not terminated then
  815.                 begin
  816.                 Search(aStrings.strings[i]);
  817.                 Application.ProcessMessages;
  818.                 FOnFound(nil,CakDir1.Appendslash(aStrings.strings[i]),0);
  819.                 end;
  820.                 aStrings.free;
  821.                 end;
  822. end;
  823.  
  824. procedure TFinder.Execute;
  825. begin
  826.         if assigned(FOnFound) then
  827.         begin
  828.         Search(FOption.af_sourcedir);
  829.         FOnFound(nil,'*COMPLETED*',-1);
  830.         end else
  831.         Showmessage('Error : Unassigned found event');
  832. end;
  833.  
  834. constructor TCakDir.Create( AOwner: TComponent );
  835. begin
  836.      inherited Create( AOwner );
  837.      exploremode := false;
  838.      ImageS := TImageList.Create(self);
  839.      ImageS.Width := 16;
  840.      ImageS.Height:= 16;
  841.      ImageL := TImageList.Create(self);
  842.      ImageL.Width := 32;
  843.      ImageL.Height:= 32;
  844.      temppath := grabtemppath;
  845.      Timer1 := TTimer.create(self);
  846.      FileType := TStringList.Create( );
  847.      FileExt  := TStringList.Create( );
  848.      NewDirList  := TStringList.Create( );
  849.      DirectoryList := TStringList.Create();
  850.      DirectoryList.Sorted := true;
  851.      MRUList := TStringList.Create();
  852.      ExtractOptions.extr_ArcINArc := FALSE;
  853.      AddOptions.add_exclude := TStringList.Create();
  854.      AddOptions.add_files := TStringList.Create();
  855.      ScriptParam := TStringList.Create();
  856.      SubDir_List := TStringList.Create();
  857.      SubDir_List.Sorted := true;
  858.      FinderOptions.af_targetname := TStringList.Create();
  859.      Abouttext := TStringList.Create();
  860.      Fillabout;
  861.      Timer1.OnTimer := T1OnTimer;
  862.      Timer1.Interval := 1000;
  863.      Timer1.Enabled := False;
  864.      processfrom := -1;
  865.      processto := -1;
  866.      MAXMRU := 9;
  867.      AddOptions.add_files.Clear;
  868.      leadchar := 'CAK.';
  869.      scriptvar1 := '';
  870.      Tag := strtointdef(MINORVER,0);
  871.      SetDefaultTreasAs;
  872.      versioncontrol := false;
  873.      Extractoptions.extr_Extractall := false;
  874. end;
  875. destructor TCakDir.Destroy;
  876. begin
  877.         ImageS.Free;
  878.         ImageL.Free;
  879.         FileType.Free;
  880.         FileExt.Free;
  881.         Timer1.Free;
  882.         Abouttext.free;
  883.         MRUList.free;
  884.         Scriptparam.free;
  885.         AddOptions.add_files.Free;
  886.         AddOptions.add_exclude.Free;
  887.         NewDirList.free;
  888.         FinderOptions.af_targetname.Free;
  889.         DirectoryList.Free;
  890.         SubDir_List.Free;
  891.         UNLoad_CAB_DLL;
  892.         {$IFDEF USE_ZIP} UNLoad_ZIP_DLL; {$ENDIF}
  893.         {$IFDEF USE_ACE} UNLoad_ACE_DLL; {$ENDIF}
  894.         {$IFDEF USE_ARC} UNLoad_ARC_DLL; {$ENDIF}
  895.         {$IFDEF USE_RS}  UNLoad_RS_DLL;  {$ENDIF}
  896.         UNLoad_EXT_DLL;
  897.         inherited Destroy;
  898. end;
  899. function TCakDir.InitContenttype : contenttype;
  900. var content : contenttype;
  901. begin
  902.         with content do
  903.         begin
  904.         _FileIcon := 0;
  905.         _FileRatio := 0;
  906.         _Tag := 0;
  907.         _FileSize := 0;
  908.         _FilePackedSize := 0;
  909.         _FileTime := 0;
  910.         _Filename := '';
  911.         _Filetype := '';
  912.         _FileCRC := '';
  913.         _FileDefPath := '';
  914.         _FileArchive := '';
  915.         _Encrypted := false;
  916.         _Selected := false;
  917.         end;
  918.         Result := content;
  919. end;
  920.  
  921. procedure TCakdir.Fillabout;
  922. begin
  923.         Abouttext.add(ABOUTSTR);
  924.  
  925. end;
  926. function TCakdir.modifyslash(input : string) : string;
  927. var i : integer;
  928.     k : string;
  929. begin
  930.         k := input;
  931.         for i := 0 to length(k) do
  932.                 if k[i] = '/' then k[i] := '\';
  933.         result := k;
  934. end;
  935.  
  936. function TCakdir.modifyslash(input : string;fromm,tto : char) : string;
  937. var i : integer;
  938.     k : string;
  939. begin
  940.         k := input;
  941.         for i := 0 to length(k) do
  942.                 if k[i] = fromm then k[i] := tto;
  943.         result := k;
  944. end;
  945.  
  946. function TCakDir.appendSlash(input : string) : string;
  947. begin
  948.         if length(input) > 0 then
  949.         if input[Length(input)] = '\' then
  950.                 result := input else
  951.                 result := input + '\' else
  952.         result := input;
  953. end;
  954.  
  955. function TCakDir.removeSlash(input : string) : string;
  956. begin
  957.         if input <> '' then
  958.         if input[Length(input)] = '\' then
  959.                 result := Copy(input,0,length(input) -1) else
  960.                 result := input;
  961. end;
  962.  
  963. function TCakdir.removefileext(input : string) : string;
  964. var
  965.   I: Integer;
  966. begin
  967.   I := LastDelimiter('.\:', input);
  968.   if (I > 0) and (input[I] = '.') then
  969.     Result := Copy(input, 0, i-1) else
  970.     Result := input;
  971. end;
  972.  
  973. function TCakdir.removedrive(input : string) : string;
  974. var
  975.   I: Integer;
  976. begin
  977.   I := pos(':\', input);
  978.   if (I > 0) and (input[I] = ':') then
  979.     Result := Copy(input, I+2, length(input) -3) else
  980.     Result := input;
  981. end;
  982.  
  983. procedure TCakDir.T1Ontimer(Sender : TObject);
  984. begin
  985.         Application.ProcessMessages;
  986. end;
  987.  
  988. procedure TCakDir.doStop(Stopp : boolean);
  989. begin
  990.          stopping := stopp;
  991.          stopprocess := stopp;
  992.          if Total_Archive > 0 then
  993.          Case Archive_List[processfrom]._ARCtype of
  994.          _ZIP : Zipdir.Cancel := true;
  995.          end;
  996. end;
  997.  
  998. procedure TCakDir.Add_All_Selected_List;
  999. var i : integer;
  1000. begin
  1001.         for i := 0 to Total_Contents -1 do
  1002.                 Archive_Contents[i]._Selected := true;
  1003. end;
  1004.  
  1005. procedure TCakDir.Clear_Selected_List;
  1006. var i : integer;
  1007. begin
  1008.         for i := 0 to Total_Contents -1 do
  1009.                 Archive_Contents[i]._Selected := false;
  1010. end;
  1011.  
  1012. procedure TCakDir.Clear_Add_List;
  1013. begin
  1014.         addoptions.add_files.clear;
  1015. end;
  1016. procedure TCakDir.Add_Selected_List(filename, archivename : string);
  1017. var i : integer;
  1018. begin
  1019.         for i := 0 to Total_Contents -1 do
  1020.                 if Archive_Contents[i]._FileName = Extractfilename(filename) then
  1021.                 if Archive_Contents[i]._FileArchive = archivename then
  1022.                 if Archive_Contents[i]._FileDefpath = Extractfilepath(filename) then
  1023.                 begin
  1024.                         Archive_Contents[i]._Selected := True;
  1025.                 end;
  1026. end;
  1027.  
  1028. procedure TCakDir.Add_Selected_List(filename : tstrings; archivename : string);
  1029. var i : integer;
  1030. begin
  1031.         for i := 0 to Total_Contents -1 do
  1032.                 with Archive_Contents[i] do
  1033.                 if not _Selected then
  1034.                 if _FileArchive = archivename then
  1035.                         if filename.IndexOf(_FileDefpath + _Filename) <> -1 then
  1036.                                 _Selected := True;
  1037. end;
  1038.  
  1039. procedure TCakDir.Mask_Add_Selected_List(FileMasks, Filearchive: string);
  1040. var
  1041.   i:     integer;
  1042.   AMask: TMask;
  1043. begin
  1044.   AMask := TMask.Create(FileMasks);
  1045.   if Total_Archive <= 0 then exit;
  1046.   for i := 0 to Total_Contents - 1 do
  1047.     with Archive_Contents[i] do
  1048.       if AMask.Matches(_Filedefpath + _Filename) then
  1049.         if (Archive_Contents[i]._Filearchive = Filearchive) or (Filearchive = '') then
  1050.         begin
  1051.           Archive_Contents[i]._Selected := True;
  1052.         end;
  1053.   AMask.Free;
  1054. end;
  1055. function TCakdir.Get_Selected_Count(ForArchive : string) : integer;
  1056. var i : integer;
  1057. begin
  1058.         Result := 0;
  1059.         for i := 0 to Total_Contents -1  do
  1060.                 if Archive_Contents[i]._Selected then
  1061.                         if Archive_Contents[i]._FileArchive = ForArchive then
  1062.                         Inc(Result);
  1063.  
  1064. end;
  1065.  
  1066. function TCakDir.Get_Selected_Count : integer;
  1067. var i : integer;
  1068. begin
  1069.         Result := 0;
  1070.         for i := 0 to Total_Contents -1  do
  1071.                 if Archive_Contents[i]._Selected then
  1072.                         Inc(Result);
  1073. end;
  1074.  
  1075. function TCakDir.Get_Selected_Size : Longint;
  1076. var i : integer;
  1077. begin
  1078.         Result := 0;
  1079.         for i := 0 to Total_Contents -1  do
  1080.                 if Archive_Contents[i]._Selected then
  1081.                         Inc(Result, Archive_Contents[i]._FileSize);
  1082.         if Result = 0 then
  1083.                 Result := -1;
  1084. end;
  1085.  
  1086. function TCakDir.Get_Selected_CompSize : Longint;
  1087. var i : integer;
  1088. begin
  1089.         Result := 0;
  1090.         for i := 0 to Total_Contents -1  do
  1091.                 if Archive_Contents[i]._Selected then
  1092.                         Inc(Result, Archive_Contents[i]._Filepackedsize);
  1093.         if Result = 0 then
  1094.                 Result := -1;
  1095. end;
  1096.  
  1097. function TCakDir.Get_Total_Size : Longint;
  1098. var i : integer;
  1099. begin
  1100.         Result := 0;
  1101.         for i := 0 to Total_Contents -1  do
  1102.                         Inc(Result, Archive_Contents[i]._FileSize);
  1103.         if Total_Contents = 0 then Result := -1; //Prevent crash...
  1104. end;
  1105.  
  1106. procedure TCakDir.List_Mask_Archive(mask : string; arcfrom,arcto : integer; showonlythatdir : boolean);
  1107. var i,j : integer;
  1108.     amask : TMask;
  1109.     count : integer;
  1110.     k : string;
  1111. begin
  1112.         aMask := TMask.Create(mask);
  1113.         //List_Archive(arcfrom,arcto);
  1114.         Archive_Contents := Full_Contents;
  1115.         total_contents := Fullcontentcount;
  1116.         setlength(temp_contents,total_contents + 5);
  1117.         count := -1;
  1118.         SubDir_list.Clear;
  1119.         if mask <> '*.*' then
  1120.                 SubDir_List.Add('...');
  1121.         For i := Total_Contents -1 downto 0 do
  1122.                 With Archive_Contents[i] do
  1123.                         if amask.Matches(_Filedefpath + _Filename) then
  1124.                         begin
  1125.                         if ((showonlythatdir) or (uppercase(_Filedefpath) = uppercase(extractfilepath(Mask) ))) then
  1126.                                 begin
  1127.                                 inc(count);
  1128.                                 temp_contents[count] := Archive_Contents[i];
  1129.                                 end;
  1130.                         if (uppercase(_Filedefpath) <> uppercase(extractfilepath(Mask) )) then
  1131.                                 begin
  1132.                                 k := copy(_Filedefpath,length(extractfilepath(Mask))+1,length(_Filedefpath) - length(extractfilepath(Mask)));
  1133.                                 j := pos('\',k);
  1134.                                 if j <> 0 then
  1135.                                         k := copy(k,0,j);
  1136.                                 if SubDir_List.IndexOf(k) = -1 then
  1137.                                         SubDir_List.Add(k);
  1138.                                 end;
  1139.                         SubDir_RootPath := extractfilepath(Mask);
  1140.                         end;
  1141.  
  1142.         Total_contents := count + 1;
  1143.         SetLength(Archive_Contents,Total_contents + 5);
  1144.         Archive_contents := temp_contents;
  1145. end;
  1146.  
  1147. procedure TCakDir.List_Cache_Archive;
  1148. var i,j : integer;
  1149.     k : string;
  1150. begin
  1151.         Total_contents := Fullcontentcount;
  1152.         Archive_Contents := Full_Contents;
  1153.         SubDir_List.clear;
  1154.         SubDir_RootPath := '';
  1155.         SubDir_List.clear;
  1156.         SubDir_RootPath := '';
  1157.         for i := 0 to total_contents -1 do
  1158.         with archive_contents[i] do
  1159.         if _FileDefPath <> '' then
  1160.                 begin
  1161.                 k := _Filedefpath;
  1162.                 j := pos('\',k);
  1163.                 if j <> 0 then
  1164.                 k := copy(k,0,j);
  1165.                 if SubDir_List.IndexOf(k) = -1 then
  1166.                         SubDir_List.Add(k);
  1167.                 end;
  1168. end;
  1169.  
  1170. procedure TCakDir.List_Archive(arcfrom,arcto : integer);
  1171. begin
  1172.         if Total_Archive = 0 then exit;
  1173.         processfrom := arcfrom;
  1174.         processto := arcto;
  1175.         Process(_LoadContents);
  1176.         SubDir_List.clear;
  1177.         SubDir_RootPath := '';
  1178.         Sort_Archive_List(False,_FName);
  1179.         {
  1180.         for i := 0 to total_contents -1 do
  1181.         with archive_contents[i] do
  1182.         if _FileDefPath <> '' then
  1183.                 begin
  1184.                 k := _Filedefpath;
  1185.                 j := pos('\',k);
  1186.                 if j <> 0 then
  1187.                 k := copy(k,0,j);
  1188.                 if SubDir_List.IndexOf(k) = -1 then
  1189.                         SubDir_List.Add(k);
  1190.                 end;}
  1191.         if exploremode then
  1192.                 List_Mask_Archive('*.*',arcfrom,arcto,false);
  1193.  
  1194. end;
  1195.  
  1196. procedure TCakDir.Extract_Archive(arcfrom, arcto : integer);
  1197. begin
  1198.         if Total_Archive = 0 then exit;
  1199.         if not directoryexists(ExtractOptions.extr_to) then
  1200.         MakeDirectory(ExtractOptions.extr_to);
  1201.         
  1202.         ExtractOptions.extr_to := AppendSlash(ExtractOptions.extr_to);
  1203.         processfrom := arcfrom;
  1204.         processto := arcto;
  1205.         Process(_Extract);
  1206. end;
  1207.  
  1208. procedure TCakDir.Extract;
  1209. begin
  1210.         if Total_Archive = 0 then exit;
  1211.         if not directoryexists(ExtractOptions.extr_to) then
  1212.                 MakeDirectory(ExtractOptions.extr_to);
  1213.         ExtractOptions.extr_to := AppendSlash(ExtractOptions.extr_to);
  1214.         processfrom := 0;
  1215.         processto := Total_Archive-1;
  1216.         process(_Extract);
  1217. end;
  1218.  
  1219. procedure TCakDir.New_Archive(filename : string);
  1220. begin
  1221.         Set_Archive_List(filename);
  1222.         Total_Contents := 0;
  1223.         processfrom := 0;
  1224.         processto := 0;
  1225. end;
  1226.  
  1227. procedure TCakDir.Add;
  1228. begin
  1229.         if Total_Archive = 0 then exit;
  1230.         if (processfrom = -1) and (processto = -1) then
  1231.                 begin
  1232.                 processfrom := 0;
  1233.                 processto := total_archive -1;
  1234.                 end;
  1235.         process(_Add);
  1236. end;
  1237.  
  1238. procedure TCakDir.SFX;
  1239. begin
  1240.         if Total_Archive = 0 then exit;
  1241.         processfrom := sfxoptions.sfx_to;
  1242.         processto := processfrom;
  1243.         if Archive_List[processfrom]._ARCtype <> _ZIP then
  1244.                 begin
  1245.                 Archive_Convert(Archive_List[processfrom]._Arcname,_ZIP);
  1246.                 Archive_List[processfrom]._Arcname := Removefileext(Archive_List[processfrom]._Arcname) + '.zip';
  1247.                 Archive_List[processfrom]._Arctype := _ZIP;
  1248.                 end else
  1249.         Copyfile(PCHAR(Archive_List[processfrom]._Arcname),PCHAR(Archive_List[processfrom]._Arcname + '^'),TRUE);
  1250.         process(_SFX);
  1251.         if fileexists(Archive_List[processfrom]._Arcname + '^') and not fileexists(Archive_List[processfrom]._Arcname) then
  1252.                 Renamefile(Archive_List[processfrom]._Arcname + '^', Archive_List[processfrom]._Arcname);
  1253. end;
  1254.  
  1255. procedure TCakDir.Delete_Archive(arcfrom, arcto : integer);
  1256. begin
  1257.         if Total_Archive = 0 then exit;
  1258.         processfrom := arcfrom;
  1259.         processto := arcto;
  1260.         Process(_Delete);
  1261. end;
  1262.  
  1263. procedure TCakDir.Delete;
  1264. var i,all : integer;
  1265. begin
  1266.         if Total_Archive = 0 then exit;
  1267.         all := 0;
  1268.         for i := 0 to Total_Contents -1 do
  1269.         if Archive_Contents[i]._Selected then
  1270.         if all = 0 then
  1271.         Case MessageDlg(Format('Are you sure want to delete %s?',[Archive_Contents[i]._Filename]), mtWarning, [mbYes, mbNo, mbCancel, mbYesToAll], 0) of
  1272.         MrNo : Archive_Contents[i]._Selected := false;
  1273.         MrYestoAll : all := 1;
  1274.         MrCancel : Clear_Selected_List;
  1275.         end;
  1276.         if Get_Selected_Count = 0 then exit;
  1277.         processfrom := 0;
  1278.         processto := Total_Archive-1;
  1279.         process(_Delete);
  1280. end;
  1281.  
  1282. procedure TCakDir.Test_Archive(arcfrom, arcto : integer);
  1283. begin
  1284.         if Total_Archive = 0 then exit;
  1285.         processfrom := arcfrom;
  1286.         processto := arcto;
  1287.         Process(_Test);
  1288. end;
  1289.  
  1290. procedure TCakDir.Test;
  1291. begin
  1292.         if Total_Archive = 0 then exit;
  1293.         processfrom := 0;
  1294.         processto := Total_Archive-1;
  1295.         process(_Test);
  1296. end;
  1297. function TCakDir.Checkout(arc : integer;openit : boolean) : string;
  1298. var i : integer;
  1299.     k : string;
  1300. begin
  1301.         i := Gettickcount;
  1302.         While Directoryexists(Grabtemppath + inttostr(i)) do
  1303.                 inc(i);
  1304.         k := Grabtemppath + inttostr(i) + '\';
  1305.         Extractoptions.extr_to := k;
  1306.         Extractoptions.extr_DirNames := true;
  1307.         Extractoptions.extr_OverWrite := true;
  1308.         Add_All_Selected_List;
  1309.         if arc = -1 then
  1310.         Extract_Archive(0, Total_Archive-1) else
  1311.         Extract_Archive(arc,arc);
  1312.         if openit then
  1313.         Explorefolder(k);
  1314.         result := k;
  1315. end;
  1316. procedure TCakDir.Install(filename : string; arc : integer);
  1317. var k : string;
  1318.     astring : Tstrings;
  1319. begin
  1320.         k := Checkout(arc,false);
  1321.         {$IFDEF USE_SHCN}
  1322.         Run(k + filename,'');
  1323.         MonitorStart;
  1324.         Showmessage('Press <OK> when completed install');
  1325.         {$ELSE}
  1326.         Runandwait(k + filename,'');
  1327.         {$ENDIF}
  1328.         {$IFDEF USE_SHCN}
  1329.         History.Add('End Logging');
  1330.         astring := TStringlist.create;
  1331.         astring.AddStrings(MonitorShowChanges);
  1332.         astring.SaveToFile(k + 'log.txt');
  1333.         astring.free;
  1334.         Run(k + 'log.txt','');
  1335.         MonitorStop;
  1336.        {$ENDIF}
  1337.  
  1338. end;
  1339. procedure TCakDir.HotEdit(filename : string; arc : integer);
  1340. var i : integer;
  1341.     k,fn : string;
  1342.     encrypted : boolean;
  1343. begin
  1344.         encrypted := Archive_list[Get_Archive_Code('',filename)]._ARCneedpassword;
  1345.         if Extractfilepath(filename) <> '' then
  1346.                 begin
  1347.                 if Assigned( FOnMsg ) then
  1348.                         FOnMsg( nil, 0, 'File with path, cannot HotEdit' );
  1349.                 exit;
  1350.                 end;
  1351.         fn := filename;
  1352.         k := GrabTemppath + 'Checkout\';
  1353.         With ExtractOptions do
  1354.         begin
  1355.                 extr_OverWrite := true;
  1356.                 extr_DirNames := False;
  1357.                 extr_to := k;
  1358.         end;
  1359.  
  1360.         Clear_Selected_List;
  1361.         Add_Selected_List(filename, Archive_list[arc]._ARCname);
  1362.         overwriteall := 1;
  1363.         if Get_Selected_Count = 0 then
  1364.                 begin
  1365.                 if Assigned( FOnMsg ) then
  1366.                          FOnMsg( nil, 0, 'Internal error - File not exists!');
  1367.                 exit;
  1368.                 end;
  1369.         Extract;
  1370.  
  1371.         explorefolder(k);
  1372.  
  1373.         i :=  MessageDlg('Hot Edit'
  1374.         +#13+#10+'--------------------------------------'
  1375.         +#13+#10+'File is now located at :'
  1376.         +#13+#10+ k 
  1377.         +#13+#10+'--------------------------------------'
  1378.         +#13+#10+'When you finished editing, press <OK>.'
  1379.         +#13+#10+'Archive will then be updated.'
  1380.         +#13+#10+'If you don`t want to save changes, press <Cancel>.',
  1381.         mtWarning, [mbOK, mbCancel], 0);
  1382.  
  1383.         if i = Mrok then
  1384.                 begin
  1385.                 if fileexists(k + fn) then
  1386.                 begin
  1387.                 //Clear_Selected_List;
  1388.                 //Add_Selected_List(filename, Archive_list[arc]._ARCname);
  1389.                 //Delete;
  1390.  
  1391.                 With AddOptions do
  1392.                         begin
  1393.                         add_to := arc;
  1394.                         {$IFDEF USE_ZIP}
  1395.                         if Assigned(Zipdir) and (archive_list[arc]._ARCtype = _ZIP) then
  1396.                         if encrypted then
  1397.                         begin
  1398.                         add_useencrypt := encrypted;
  1399.                         if assigned(FOnPwd) then
  1400.                                 FOnPwd(nil,zipdir.ZipFileName,fn,add_encrypt);
  1401.                         end;
  1402.                         {$ENDIF}
  1403.  
  1404.                         add_usepath := false;
  1405.                         addmode := [];
  1406.                         add_files.Clear;
  1407.                         add_files.Add(k + fn);
  1408.                         end;
  1409.                 Add;
  1410.                 end;
  1411.                 end else
  1412.                 Showmessage(k + fn + ' is deleted, update ABORT'); 
  1413.         Deletefile(k +  fn);
  1414.         RemoveDir(k);
  1415. end;
  1416.  
  1417. function TCakDir.Cando(atype : supporttype; awork : worktype) : boolean;
  1418. var b : boolean;
  1419. begin
  1420.         b := true;
  1421.         LOAD_EXT_DLL;
  1422.         Case awork of
  1423.         _LoadContents,_Extract :
  1424.         begin
  1425.         b := (pos(GetArcString(AType),ArcOpenSupport) <> 0);
  1426.         end;
  1427.         _ADD :
  1428.         b := (pos(GetArcString(AType),ArcAddSupport) <> 0);
  1429.         end;
  1430.  
  1431.         result := FunCCheck[Atype, awork] and b;
  1432.  
  1433.         if not result then
  1434.         Case awork of
  1435.         _LoadContents : result := Cakext.Supportactions(GetArcString(AType),Ex_LoadContents);
  1436.         _Extract : result := Cakext.Supportactions(GetArcString(AType),Ex_Extract);
  1437.         _Add : result := Cakext.Supportactions(GetArcString(AType),Ex_Add);
  1438.         _SFX : result := Cakext.Supportactions(GetArcString(AType),Ex_SFX);
  1439.         _Test : result := Cakext.Supportactions(GetArcString(AType),Ex_TEST);
  1440.         _Delete : result := Cakext.Supportactions(GetArcString(AType),Ex_DELETE);
  1441.         end;
  1442. end;
  1443.  
  1444. procedure TCakDir.Filelist(fltype : filelisttype;filename : string; arcfrom, arcto : integer);
  1445. const totalcolumns = 8;
  1446.       columns : array[1..totalcolumns] of string =
  1447.       ('Name', 'Type', 'Size','Date','Pack',
  1448.       '%','Crc','Path');
  1449.       startat : array[1..totalcolumns] of integer =
  1450.       (70,140,240,270,360,390,410,460);
  1451. var
  1452.       df : Textfile;
  1453.       l,i,j,y : integer;
  1454.       k : string;
  1455.       {$IFDEF USE_PDF}
  1456.       aPDFMaker : TPDFMaker;
  1457.       {$ENDIF}
  1458. {$IFDEF USE_PDF}
  1459. procedure DrawColumns(aPDFMaker : TPDFMaker);
  1460. var j : integer;
  1461. begin
  1462.        With aPDFMaker do
  1463.        begin
  1464.        for j := 1 to totalcolumns do
  1465.                 begin
  1466.                 Canvas.TextOut(startat[j]+5,730,columns[j]);
  1467.                 Canvas.LineTo(startat[j],50,startat[j],740);
  1468.                 end;
  1469.        canvas.LineTo(startat[1],725,530,725);
  1470.        Canvas.DrawRect(startat[1],740,530,50,true);
  1471.        Canvas.FontSize := 7;
  1472.        y := 710;
  1473.        end;
  1474. end;
  1475. procedure DrawColumns2(aPDFMaker : TPDFMaker);
  1476. begin
  1477.        With aPDFMaker do
  1478.        begin
  1479.        Canvas.TextOut(startat[1]+5,730,'File name');
  1480.        Canvas.TextOut(startat[4]+5,730,'File date');
  1481.        Canvas.TextOut(startat[6],730,'File size (%)');
  1482.        Canvas.TextOut(startat[8]+5,730,'File size(k)');
  1483.        y := 710;
  1484.        end;
  1485. end;
  1486. procedure WriteHeader(aPDFMaker : TPDFMaker);
  1487. begin
  1488.        With aPDFMaker do
  1489.        begin
  1490.        Canvas.FontSize := 15;
  1491.        Canvas.font := fiarialBold;
  1492.        Canvas.TextOut(50,790,PRODUCT + ' Archive File List');
  1493.        Canvas.LineTo(50,810,450,810);
  1494.        Canvas.LineTo(50,780,450,780);
  1495.        Canvas.Font := fiCentury;
  1496.        Canvas.FontSize := 8;
  1497.        Canvas.TextOut(150,770,'Archive : '+ Extractfilename(Archive_List[0]._Arcname));
  1498.        Canvas.Textout(150,750,'Size : '+ inttostr(Get_Total_Size) + ' (' + SizeinK(Get_Total_Size) + ')');
  1499.        Canvas.TextOut(350,770,'Total Files : ' + InttoStr(Total_Contents));
  1500.        Canvas.TextOut(350,750,'Page : ' + InttoStr(l));
  1501.        end;
  1502. end;
  1503. {$ENDIF}
  1504. begin
  1505. Case fltype of
  1506. _TXT : begin
  1507.        assignfile(df,filename);
  1508.        rewrite(df);
  1509.        for j := arcfrom to arcto do
  1510.                 begin
  1511.                 List_Archive(j,j);
  1512.                 for i := 0 to Total_Contents -1 do
  1513.                 with Archive_Contents[i] do
  1514.                  begin
  1515.                  k := _Filename +  ' ';
  1516.                  k := k + _Filetype + ' ';
  1517.                  k := k + Inttostr(_Filesize) + ' ';
  1518.                  k := k + Datetimetostr(_Filetime) + ' ';
  1519.                  k := k + Inttostr(_FilePackedSize) + ' ';
  1520.                  k := k + Inttostr(_Fileratio) + ' ';
  1521.                  k := k + _FileCRC + ' ';
  1522.                  k := k + _Filedefpath + ' ';
  1523.                  writeln(df, k);
  1524.                  end;
  1525.                 end;
  1526.        closefile(df);
  1527.        end;
  1528. {$IFDEF USE_PDF}
  1529. _PDF2: begin
  1530.        aPDFMaker := TPDFMaker.Create;
  1531.        with aPDFMaker do
  1532.        begin
  1533.        l := 1;
  1534.        y := 710;
  1535.        BeginDoc(TFileStream.Create(filename, fmCreate));
  1536.        WriteHeader(aPDFMaker);
  1537.        DrawColumns2(aPDFMaker);
  1538.        for i := 0 to Total_Contents -1 do
  1539.                 with Archive_Contents[i] do
  1540.                  begin
  1541.                  Canvas.TextOut(startat[1]+5,y,_filedefpath + _filename);
  1542.                  Canvas.TextOut(startat[4]+5,y,Datetimetostr(_Filetime));
  1543.  
  1544.                  Canvas.FillColor := clBlack;
  1545.                  j := trunc(_Filesize / Get_total_size * (startat[8] - startat[6]));
  1546.  
  1547.                  Canvas.DrawandfillRect(startat[6],y,startat[8],y+12,False);
  1548.  
  1549.                  canvas.pStroke;
  1550.                  Canvas.FillColor := clLime;
  1551.                  Canvas.FillRect(startat[6]+j,y,startat[8],y+12,False);
  1552.                  Canvas.DrawRect(startat[6],y,startat[8],y+12,False);
  1553.                  
  1554.                  Canvas.FillColor := clBlack;
  1555.                  j := trunc(_Filesize / Get_total_size * (100));
  1556.                  Canvas.textout(startat[6] + ((startat[8] - startat[6]) div 2),y + 2, inttostr(j) + '%');
  1557.  
  1558.                  Canvas.TextOut(startat[8]+5,y,SizeinK(_Filesize));
  1559.                  y := y - 15;
  1560.                  if y <= 60 then
  1561.                  if i <> Total_Contents -1 then
  1562.                         begin
  1563.                         NewPage;
  1564.                         y := 710;
  1565.                         inc(l);
  1566.                         WriteHeader(aPDFMaker);
  1567.                         DrawColumns2(aPDFMaker);
  1568.                         end;
  1569.                  end;
  1570.        EndDoc(true);
  1571.        Free;
  1572.        end;
  1573.        end;
  1574. _PDF : begin
  1575.        aPDFMaker := TPDFMaker.Create;
  1576.        with aPDFMaker do
  1577.        begin
  1578.        l := 1;
  1579.        BeginDoc(TFileStream.Create(filename, fmCreate));
  1580.        WriteHeader(aPDFMaker);
  1581.        DrawColumns(aPDFMaker);
  1582.        for i := 0 to Total_Contents -1 do
  1583.                 with Archive_Contents[i] do
  1584.                  begin
  1585.                  Canvas.TextOut(startat[1]+5,y,_filename);
  1586.                  Canvas.TextOut(startat[2]+5,y,_filetype);
  1587.                  Canvas.TextOut(startat[3]+5,y,Inttostr(_Filesize));
  1588.                  Canvas.TextOut(startat[4]+5,y,Datetimetostr(_Filetime));
  1589.                  Canvas.TextOut(startat[5]+5,y,Inttostr(_FilePackedsize));
  1590.                  Canvas.TextOut(startat[6]+5,y,Inttostr(_Fileratio));
  1591.                  Canvas.TextOut(startat[7]+5,y,_filecrc);
  1592.                  Canvas.TextOut(startat[8]+5,y,_filedefpath);
  1593.                  y := y - 15;
  1594.                  if y <= 60 then
  1595.                  if i <> Total_Contents -1 then
  1596.                         begin
  1597.                         NewPage;
  1598.                         y := 710;
  1599.                         inc(l);
  1600.                         WriteHeader(aPDFMaker);
  1601.                         DrawColumns(aPDFMaker);
  1602.                         end;
  1603.                  end;
  1604.        EndDoc(true);
  1605.        Free;
  1606.        end;
  1607.        end;
  1608. {$ENDIF}
  1609. _HTM : begin
  1610.         assignfile(df,filename);
  1611.         rewrite(df);
  1612.         writeln(df,'<html>' +  #10 + '<head> ');
  1613.         writeln(df,'<meta name=GENERATOR content=Common Archiver Kit ' + CAKVER + '>');
  1614.         writeln(df,'<title> Archive Contents </title>');
  1615.         writeln(df,'<body bgcolor=#CFE9C7>');
  1616.         for j := arcfrom to arcto do
  1617.                 begin
  1618.                 List_Archive(j,j);
  1619.                 write(df,'<H5>Content of archive: <a href=');
  1620.                 write(df, Archive_List[j]._Arcname+ '>');
  1621.                 write(df, Archive_List[j]._Arcname+ '</a> ');
  1622.                 writeln(df, 'total ' + inttostr(Total_Contents) + ' files.');
  1623.                 writeln(df,'<HR SIZE=3>');
  1624.  
  1625.                 writeln(df,'<TABLE BORDER=0 cellpadding=1 cellspacing=1>');
  1626.                 write(df,'<TD>' + columns[1] + '</TD>');
  1627.                 for l := 2 to totalcolumns do
  1628.                 write(df,'<TD>' + columns[l] + '<TD>');
  1629.  
  1630.                 for i := 0 to Total_Contents -1 do
  1631.                         with Archive_Contents[i] do
  1632.                         begin
  1633.                         write(df,'<TR><TD>' + _Filename + '</TD>');
  1634.                         write(df,'<TD>' + _Filetype + '<TD>');
  1635.                         write(df,'<TD>' + SizeinK(_Filesize) + '<TD>');
  1636.                         write(df,'<TD>' + Datetimetostr(_Filetime) + '<TD>');
  1637.                         write(df,'<TD>' + SizeinK(_FilePackedSize) + '<TD>');
  1638.                         write(df,'<TD>' + Inttostr(_Fileratio) + '%<TD>');
  1639.                         write(df,'<TD>' + _FileCRC + '<TD>');
  1640.                         write(df,'<TD>' + _Filedefpath + '<TD>');
  1641.                         //write(df,'<TD>' + _FileArchive + '<TD>');
  1642.                         writeln(df);
  1643.                         end;
  1644.                 writeln(df,'</TABLE>');
  1645.                 writeln(df,'<HR SIZE=3>');
  1646.                 end;
  1647.         writeln(df,'</HTML>');
  1648.         closefile(df);
  1649.         end;
  1650.  
  1651.  
  1652. end;
  1653.         if assigned(FOnMsg) then
  1654.                 FOnMsg(nil,0,'Created ' + filename);
  1655. end;
  1656.  
  1657. function TCakDir.translatetype(aworktype : worktype) : worktypeex;
  1658. begin
  1659.         Case aworktype of
  1660.         _LoadContents : Result := Ex_LoadContents;
  1661.         _Extract : Result := Ex_Extract;
  1662.         _Add : Result := Ex_Add;
  1663.         _SFX : Result := Ex_SFX;
  1664.         _TEST : Result := Ex_Test;
  1665.         _Delete : Result := Ex_Delete;
  1666.         else Result := EX_None;
  1667.         end;
  1668. end;
  1669.  
  1670. function TCakDir.Process(processwhat : worktype) : boolean;
  1671. var k : string;
  1672.     tickcount : Word;
  1673.     i : integer;
  1674.     CakDir1 : TCakDir;
  1675.     arctype : supporttype;
  1676. begin
  1677.  if MRUList.IndexOf(Archive_List[0]._Arcname) <> -1 then
  1678.         MRUList.Delete(MRUList.IndexOf(Archive_List[0]._Arcname));
  1679.  
  1680.         MRUList.Insert(0,Archive_List[0]._Arcname);
  1681.  
  1682.  if MAXMRU > 0 then
  1683.  while MRUList.Count > MAXMRU do
  1684.         MRUList.Delete(MRUList.count -1);
  1685.  
  1686.  stopping := false;
  1687.  result := false;
  1688.  if (processfrom = -1) or (processto = -1) then exit;
  1689.  Case processwhat of
  1690.  _Extract : k := 'Extracting archive';
  1691.  _Test : k := 'Testing archive';
  1692.  _Add : k := 'Adding files to archive';
  1693.  _Delete : k := 'Deleting files from archive';
  1694.  _SFX : k := 'Creating SFX';
  1695.  else k := '';
  1696.  end;
  1697.  if (processwhat <> _ADD) then
  1698.         if (processfrom = 0) and (processto = 0) then
  1699.         if not fileexists(Archive_List[0]._Arcname) then
  1700.                 if assigned(FOnMsg) then
  1701.                         FOnMsg(nil,0,Format('Warning, %s not found',[Extractfilename(Archive_List[0]._Arcname)]));
  1702.  
  1703.  if paramcount > 0 then
  1704.  if paramstr(0) = '/CAKVER' then
  1705.         Showmessage('CAK' + CAKVER);
  1706.  
  1707.  if k <> '' then
  1708.  if Assigned( FOnMsg ) then
  1709.                   FOnMsg( nil, 0, k );
  1710.  
  1711.  tickcount := gettickcount;
  1712.  
  1713.  LOAD_EXT_DLL;
  1714.  if Cakext.Supportactions(Extractfileext(Archive_List[processfrom]._Arcname),translatetype(processwhat)) then
  1715.  begin
  1716.         ProcessExt(processwhat);
  1717.  end else
  1718.  Case Archive_List[processfrom]._ARCtype of
  1719.         {$IFDEF USE_ZIP} _ZIP : result := ProcessZIP(processwhat);
  1720.         {$ELSE}
  1721.            {$IFDEF USE_ARC}
  1722.                          _ZIP : result := ProcessARC(processwhat);
  1723.            {$ENDIF}
  1724.         {$ENDIF}
  1725.         {$IFDEF USE_ARC} _LHA : result := ProcessARC(processwhat); {$ENDIF}
  1726.         
  1727.         {$IFDEF USE_RAR} _RAR : result := ProcessRAR(processwhat);
  1728.         {$ELSE}
  1729.            {$IFDEF USE_ARC}
  1730.                          _RAR : result := ProcessARC(processwhat);
  1731.            {$ENDIF}
  1732.         {$ENDIF}
  1733.                          _CAB : result := ProcessCAB(processwhat);
  1734.                          _PAK : result := ProcessPAK(processwhat);
  1735.         {$IFDEF USE_ARC} _ARJ : result := ProcessARC(processwhat); {$ENDIF}
  1736.         {$IFDEF USE_ARC} _TAR : result := ProcessARC(processwhat); {$ENDIF}
  1737.         {$IFDEF USE_ARC} _TGZ : result := ProcessARC(processwhat); {$ENDIF}
  1738.         {$IFDEF USE_ACE} _ACE : result := ProcessACE(processwhat); {$ENDIF}
  1739.         {$IFDEF USE_ARC} _BZ2 : result := ProcessARC(processwhat); {$ENDIF}
  1740.         {$IFDEF USE_ARC} _BEL : result := ProcessARC(processwhat); {$ENDIF}
  1741.         {$IFDEF USE_ARC} _GCA : result := ProcessARC(processwhat); {$ENDIF}
  1742.         {$IFDEF USE_ARC} _YZ1 : result := ProcessARC(processwhat); {$ENDIF}
  1743.         {$IFDEF USE_ARC} _BZA : result := ProcessARC(processwhat); {$ENDIF}
  1744.         {$IFDEF USE_RS}  _RS  : result := ProcessRS(processwhat);  {$ENDIF}
  1745.         {$IFDEF USE_CZIP}_CZIP: result := ProcessCZIP(processwhat);{$ENDIF}
  1746.         {$IFDEF USE_INDY}_B64 : result := ProcessB64(processwhat); {$ENDIF}
  1747.         {$IFDEF USE_INDY}_UUE : result := ProcessUUE(processwhat); {$ENDIF}
  1748.         {$IFDEF USE_INDY}_XXE : result := ProcessXXE(processwhat); {$ENDIF}
  1749.         _AKS : ProcessAKS(processwhat);
  1750.         _WIT : result := false;
  1751.         else result := false;
  1752.         end;
  1753.         if processwhat = _LoadContents then
  1754.                 begin
  1755.                 for i := 0 to total_Archive -1 do
  1756.                 Archive_List[i]._ARCsize := CalcFolderSize(Archive_List[i]._Arcname);
  1757.                 Full_Contents := Archive_Contents;
  1758.                 FullContentcount := Total_Contents;
  1759.                 end;
  1760.  
  1761.         if processwhat = _Extract then
  1762.            if extractOptions.extr_ArcINArc then
  1763.                 begin
  1764.                 CakDir1 := TCakDir.Create(nil);
  1765.                 for i := 0 to Total_Contents -1 do
  1766.                         begin
  1767.                         k := Appendslash(Extractoptions.extr_to) + Archive_Contents[i]._Filename;
  1768.                         arctype := getarctype(k);
  1769.                         if arctype <> _WIT then
  1770.                         if cando(arctype,_Extract) then
  1771.                                 begin
  1772.                                 CakDir1.Set_Archive_List(k);
  1773.                                 CakDir1.List_Archive(0,0);
  1774.                                 CakDir1.Add_All_Selected_List;
  1775.                                 CakDir1.Extractoptions := Extractoptions;
  1776.                                 CakDir1.OnCMessage := OnCMessage;
  1777.                                 CakDir1.OnCProgress := OnCProgress;
  1778.                                 CakDir1.OnCOverwrite := OnCOverwrite;
  1779.                                 CakDir1.Extract;
  1780.                                 end;
  1781.                         end;
  1782.                 CakDir1.Free;
  1783.                 end;
  1784.         Clear_Selected_List;
  1785.         Clear_Add_List;
  1786.         overwriteall := 0;
  1787.  
  1788.         if k <> '' then
  1789.         begin
  1790.         //k := 'Time used : ' + inttostr((gettickcount - tickcount)div 10000) + 'ms';
  1791.         //if Assigned( FOnMsg ) then
  1792.         //          FOnMsg( nil, 0, k );
  1793.         end;
  1794.  
  1795.         Extractoptions.extr_Extractall := false;
  1796.         if Assigned( FOnProg ) then
  1797.         FOnProg(nil,'', TotalProgress,TotalProgress);
  1798. end;
  1799. procedure TCakDir.reiniticons;
  1800. var shinfo : TSHFileInfo;
  1801.     Icon : TIcon;
  1802.     i : integer;
  1803. begin
  1804.         ImageS.Clear;
  1805.         ImageL.Clear;
  1806.         Filetype.Clear;
  1807.         Icon := TIcon.create();
  1808.         for i := 0 to fileext.count -1 do
  1809.             begin
  1810.              SHGetFileInfo(PChar(fileext.strings[i]), 0, shInfo, SizeOf(shInfo),
  1811.             (SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES)
  1812.             or (SHGFI_ICON or SHGFI_TYPENAME));
  1813.             icon.Handle := shinfo.hIcon;
  1814.             imageS.AddIcon(icon);
  1815.             imageL.addicon(icon);
  1816.             Filetype.Add(Shinfo.szTypeName);
  1817.             end;
  1818.         Icon.free;
  1819. end;
  1820. function TCakDir.isLocked(filename : string) : boolean;
  1821. var fs : Tfilestream;
  1822. begin
  1823.   result := false;
  1824.   try
  1825.     fs:= Tfilestream.Create( filename, fmOpenRead or fmShareExclusive );
  1826.     fs.Free;
  1827.   except
  1828.     result := true;
  1829.   end;
  1830. end;
  1831. function TCakDir.returnicontype(filename : string) : integer;
  1832. var loc : integer;
  1833.     ext : string;
  1834.     shinfo : TSHFileInfo;
  1835.     Icon : TIcon;
  1836. begin
  1837.         Icon := TIcon.create();
  1838.         ext := Extractfileext(filename);
  1839.         if filename = '*DIR*' then
  1840.                 ext := filename;
  1841.         loc := FileExt.IndexOf(ext);
  1842.         if (loc = -1) then {Use Cache}
  1843.             begin
  1844.             SHGetFileInfo(PChar(ext), 0, shInfo, SizeOf(shInfo),
  1845.             (SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES)
  1846.             or (SHGFI_ICON or SHGFI_TYPENAME));
  1847.             icon.Handle := shinfo.hIcon;
  1848.             loc := imageS.AddIcon(icon);
  1849.             imageL.addicon(icon);
  1850.             FileExt.Add(ext);
  1851.             Filetype.Add(Shinfo.szTypeName);
  1852.             end;
  1853.         result := loc;
  1854.         Icon.free;
  1855. end;
  1856.  
  1857.  
  1858.  
  1859. {$IFDEF USE_RS}
  1860. function TCakDir.ProcessRS(processwhat : worktype) : boolean;
  1861. var
  1862.   List:     TList;
  1863.   i:        integer;
  1864.   k:        string;
  1865.   ColMan:   TObjList;
  1866.   dummystrings : tstrings;
  1867.  
  1868. begin
  1869. LOAD_RS_DLL;
  1870. result := false;
  1871.         if Rsdir.ArchiveMan.archive_file_full_path <> Archive_List[processfrom]._ArcName then
  1872.         begin
  1873.         RsDir.ArchiveMan.TempDir := temppath;
  1874.         RsDir.ArchiveMan.OpenArchive(Archive_List[processfrom]._ArcName, True);
  1875.  
  1876.         end;
  1877.  
  1878.         case Processwhat of
  1879.         _LoadContents : begin {DoNothing} end;
  1880.         _Add : begin
  1881.                dummystrings := TStringlist.create;
  1882.                RsDir.ArchiveMan.use_folder_names := AddOptions.add_usepath;
  1883.                for i := 0 to Addoptions.add_files.count -1 do
  1884.                 begin
  1885.                 dummystrings.clear;
  1886.                 dummystrings.add(Extractfilename(Addoptions.add_files.strings[i]));
  1887.                 RsDir.ArchiveMan.Addfiles(dummystrings,extractfilepath(Addoptions.add_files.strings[i]));
  1888.                 end;
  1889.                dummystrings.free;
  1890.  
  1891.  
  1892.                end;
  1893.         _Extract : begin
  1894.                    RsDir.ArchiveMan.dest_dir := ExtractOptions.extr_to;
  1895.                    RsDir.ArchiveMan.use_folder_names := False; //Extract_sc.Usefolder;
  1896.                    List   := TList.Create;
  1897.                    ColMan := TObjList.Create;
  1898.                    ColMan.Add(TNameColDataExtr.Create);
  1899.                    try
  1900.                    for i := 0 to Total_Contents - 1 do
  1901.                    begin
  1902.                    with RsDir.ArchiveMan.ArchiveFile do
  1903.                      k := TColDataExtr(ColMan[0]).Extract
  1904.                            (TCentralFileHeader(CentralDir[i]));
  1905.  
  1906.                    if ExtractOptions.extr_Extractall or Archive_contents[Get_Archive_Code(Rsdir.ArchiveMan.archive_file_full_path,k)]._Selected then
  1907.                    List.Add(RsDir.ArchiveMan.ArchiveFile.CentralDir[i]);
  1908.                    end;
  1909.                    RsDir.ArchiveMan.ExtractList(List, Total_Unpacked, totalprogress);
  1910.                    finally
  1911.                    List.Free;
  1912.                    ColMan.Free;
  1913.                    if Assigned( FOnProg ) then
  1914.                         FOnProg( nil, '', Total_Unpacked, Trunc((Total_Contents/totalprogress)*100));
  1915.  
  1916.                    end;
  1917.                    end
  1918.         else if Assigned( FOnMsg ) then
  1919.                   FOnMsg( nil, 0, FUNCNOTAVIL );
  1920.         end;
  1921.  
  1922. end;
  1923. {$ENDIF}
  1924.  
  1925. {$IFDEF USE_CZIP}
  1926. function TCakDir.ProcessCZIP(processwhat : worktype) : boolean;
  1927. var i : integer;
  1928.     k : string;
  1929.     continue : boolean;
  1930. begin
  1931. result := false;
  1932. if assigned(FOnCryto) then
  1933.         FOnCryto(nil,key1,key2,key3);
  1934. Case Processwhat of
  1935. _LoadContents : begin
  1936.                 For i := processfrom to processto do
  1937.                 begin
  1938.                  k := Copy(Archive_List[i]._ARCname, 0, Pos('.', Archive_List[i]._ARCname) - 1);
  1939.                  Encryptit.DecryptFile(Archive_List[i]._ARCname, k + '.zip', key1, key2, key3);
  1940.                  continue := true;
  1941.                  {$IFDEF USE_WINEXT}
  1942.                  if GetARCtype2(k + '.zip') <> _ZIP then
  1943.                         begin
  1944.                         continue := false;
  1945.                         if Assigned( FOnMsg ) then
  1946.                         FOnMSG(nil,0,'Wrong key or damaged archives');
  1947.                         end;
  1948.                  {$ENDIF}
  1949.                  if continue then
  1950.                  Archive_List[i]._ARCname := k + '.zip';
  1951.                 end;
  1952.                if GetARCtype(Archive_List[processfrom]._ARCname) = _ZIP then
  1953.                ProcessZip(_LoadContents);
  1954.                end;
  1955. else ProcessZIP(processwhat);
  1956. end;
  1957. end;
  1958. {$ENDIF}
  1959.  
  1960. {$IFDEF USE_ZIP}
  1961. function TCakDir.ProcessZIP(processwhat : worktype) : boolean;
  1962. var i,j,loc,l : integer;
  1963.     ext,k : string;
  1964.     Icon : TICON;
  1965.     timestr,k2,k3 : string;
  1966.     afilelist : tstrings;
  1967. function changeslash(input : string) : string;
  1968. var i : integer;
  1969.     k : string;
  1970. begin
  1971.         k := input;
  1972.         for i := 0 to length(k) do
  1973.                 if (k[i] = '/') or (k[i] = '\') then k[i] := '-';
  1974.         result := k;
  1975. end;
  1976. begin
  1977. result := false;
  1978. Load_ZIP_DLL;
  1979. Case Processwhat of
  1980. _SFX          : begin
  1981.                 Zipdir.zipfilename := Archive_List[sfxoptions.sfx_to]._arcname;
  1982.                 Zipdir.sfxMessage := sfxoptions.sfx_message;
  1983.                 Zipdir.sfxCaption := sfxoptions.sfx_caption;
  1984.                 Zipdir.sfxcommandline := sfxoptions.sfx_commandline;
  1985.                 Zipdir.SFXOptions := [];
  1986.                 if SFXOptions.sfx_autorun then
  1987.                 Zipdir.SFXOptions := Zipdir.SFXOptions + [SFXAutoRun];
  1988.  
  1989.                 Zipdir.SFXOverWriteMode := OvrConfirm;
  1990.                 if SFXOptions.sfx_overwrite then
  1991.                 Zipdir.SFXOverWriteMode := OvrAlways;
  1992.  
  1993.                 Zipdir.SFXPath := sfxoptions.sfx_extractto;
  1994.                 zipdir.ConvertSFX;
  1995.                 end;
  1996. _Test         : begin
  1997.                 //Zipdir.TempDir := ExtractOptions.extr_to;
  1998.                 Zipdir.ExtrOptions := [ExtrTest];
  1999.                 For j := processfrom to processto do
  2000.                 begin
  2001.                 Zipdir.ZipFileName := Archive_List[j]._ARCname;
  2002.                 Zipdir.Extract;
  2003.                 end;
  2004.                 end;
  2005. _Extract      : begin
  2006.                 if length(ExtractOptions.extr_to) > 3 then
  2007.                 Zipdir.ExtrBaseDir := removeslash(ExtractOptions.extr_to) + '\' else
  2008.                 Zipdir.ExtrBaseDir := Removeslash(ExtractOptions.extr_to);
  2009.                 SetcurrentDir(removeslash(ExtractOptions.extr_to));
  2010.                 For j := processfrom to processto do
  2011.                 if ExtractOptions.extr_Extractall or (Get_Selected_Count(Archive_List[j]._ARCname) > 0) then
  2012.                 begin
  2013.                 Zipdir.ZipFileName := Archive_List[j]._ARCname;
  2014.                 Zipdir.FSpecArgs.Clear;
  2015.                 if ExtractOptions.extr_Extractall then
  2016.                         Zipdir.FSpecArgs.Add('*.*')
  2017.                 else
  2018.                 for i := 0 to Total_Contents -1 do
  2019.                       if Archive_Contents[i]._Selected then
  2020.                         if Archive_Contents[i]._FileArchive = Archive_List[j]._ARCname then
  2021.                         begin
  2022.                             k := appendslash(ExtractOptions.extr_to) + Archive_Contents[i]._Filedefpath;
  2023.                             if not directoryexists(k) then
  2024.                                 MakeDirectory(k);
  2025.                             Zipdir.FSpecArgs.Add(Archive_Contents[i]._Filedefpath + Archive_Contents[i]._Filename);
  2026.                         end;
  2027.  
  2028.                 Zipdir.ExtrOptions := [];
  2029.                 if ExtractOptions.extr_Dirnames then
  2030.                       Zipdir.ExtrOptions := Zipdir.ExtrOptions + [ExtrDirNames];
  2031.                 if ExtractOptions.extr_overwrite then
  2032.                       Zipdir.ExtrOptions := Zipdir.ExtrOptions + [ExtrOverwrite];
  2033.                 overwriteall := 0;
  2034.                 Zipdir.Extract;
  2035.                 end;
  2036.                 end;
  2037. _Add : begin
  2038.        Zipdir.ZipFileName := Archive_List[AddOptions.add_to]._ARCname;
  2039.  
  2040.        afilelist := Tstringlist.create();
  2041.        Zipdir.AddOptions := [];
  2042.        if Addoptions.add_dosformat then
  2043.         Zipdir.Addoptions := Zipdir.Addoptions + [AddForceDos];
  2044.        if Addoptions.add_hidden then
  2045.         Zipdir.Addoptions := Zipdir.Addoptions + [AddHiddenFiles];
  2046.        if _refresh in Addoptions.add_mode then
  2047.         Zipdir.AddOptions := Zipdir.Addoptions + [AddFreshen] else
  2048.        if _update in Addoptions.add_mode then
  2049.         Zipdir.AddOptions := Zipdir.Addoptions + [AddUpdate] else
  2050.        if _move in Addoptions.add_mode then
  2051.         Zipdir.AddOptions := Zipdir.Addoptions + [AddMove];
  2052.        if Addoptions.add_usepath then
  2053.         Zipdir.AddOptions := Zipdir.Addoptions + [AddDirnames];
  2054.        if Addoptions.add_useencrypt then
  2055.         if Addoptions.add_encrypt <> '' then
  2056.                 begin
  2057.                         Zipdir.AddOptions := Zipdir.Addoptions + [AddEncrypt];
  2058.                         Zipdir.Password := Addoptions.add_encrypt;
  2059.                 end;
  2060.         afilelist.Clear;
  2061.  
  2062.         for i := 0 to AddOptions.Add_files.Count -1 do
  2063.                 afilelist.AddStrings(pollfilelist(Addoptions.add_files.strings[i],Addoptions.add_SubDir));
  2064.  
  2065.         Zipdir.RootDir := '\';
  2066.         
  2067.         if not versioncontrol then
  2068.         if AddOptions.add_relative then
  2069.         Zipdir.RootDir := Removeslash(Extractfilepath(Archive_List[AddOptions.add_to]._ARCname));
  2070.  
  2071.  
  2072.         if not versioncontrol then
  2073.         if AddOptions.add_relative then
  2074.         for i := 0 to Afilelist.count -1 do
  2075.                 if Copy(uppercase(Afilelist.strings[i]),0,length(zipdir.rootdir)) = uppercase(zipdir.rootdir) then
  2076.                         afilelist.strings[i] := '\' + Copy(afilelist.strings[i],length(zipdir.rootdir) + 1, length(afilelist.strings[i]) - length(zipdir.rootdir));
  2077.  
  2078.        if not versioncontrol then
  2079.        begin
  2080.        For i := 0 to AddOptions.add_exclude.Count -1 do
  2081.                     begin
  2082.                     j := AddOptions.Add_files.Indexof(AddOptions.add_exclude.Strings[i]);
  2083.                     if j <> -1 then AddOptions.Add_files.Delete(j);
  2084.                     end;
  2085.        //Zipdir.RootDir := AddOptions.add_basedir;
  2086.        Zipdir.FSpecArgs.Clear;
  2087.        Zipdir.FSpecArgs.AddStrings(afilelist);
  2088.        try
  2089.        Zipdir.Add;
  2090.        finally
  2091.        AddOptions.add_files.Clear;
  2092.        end;
  2093.        end else
  2094.        begin {VERSIONCONTROL}
  2095.  
  2096.        if timestrformat = '' then
  2097.        timestr := changeslash(Datetimetostr(now)) else
  2098.        timestr := decodetimestr(timestrformat);
  2099.        
  2100.        timestr := Changeslash(timestr);
  2101.  
  2102.        //for i := 0 to AddOptions.Add_files.Count -1 do
  2103.        //         afilelist.AddStrings(pollfilelist(Addoptions.add_files.strings[i],Addoptions.add_SubDir));
  2104.  
  2105.        afilelist.clear;
  2106.        afilelist.AddStrings(addoptions.add_files);
  2107.  
  2108.        for i := 0 to afilelist.count -1 do
  2109.        begin
  2110.        Load_ZIP_Dll;
  2111.        Zipdir.ZipFileName := Archive_List[AddOptions.add_to]._ARCname;
  2112.         k := afilelist.strings[i];
  2113.         k2 := Appendslash(extractfilepath(k)) + '+' + Extractfilename(k);
  2114.         k3 := k2;
  2115.  
  2116.        copyfile(pchar(k),pchar(k2),true);
  2117.        if AddOptions.add_usepath then
  2118.        Zipdir.AddOptions := Zipdir.Addoptions + [AddDirnames] else
  2119.        Zipdir.AddOptions := Zipdir.Addoptions - [AddDirnames];
  2120.        Zipdir.FSpecArgs.Add(k2);
  2121.        Zipdir.Add;
  2122.        if AddOptions.add_usepath then
  2123.                 begin
  2124.                 k2 := removedrive(k2);
  2125.                 k := removedrive(k);
  2126.                 end else
  2127.                 begin
  2128.                 k2 := extractfilename(removedrive(k2));
  2129.                 k := extractfilename(removedrive(k));
  2130.                 end;
  2131.        Zipdirrename(k2,timestr + '\' + k);
  2132.        sysutils.DeleteFile(k3);
  2133.        end;
  2134.  
  2135.        end;
  2136.  
  2137.        AddOptions.add_files.Clear;
  2138.        afilelist.free;
  2139.        end;
  2140. _Delete : begin
  2141.           For j := processfrom to processto do
  2142.                 begin
  2143.                 Zipdir.ZipFileName := Archive_List[j]._ARCname;
  2144.                 Zipdir.FSpecArgs.Clear;
  2145.                 for i := 0 to Total_Contents -1 do
  2146.                       if Archive_Contents[i]._Selected then
  2147.                         if Archive_Contents[i]._FileArchive = Archive_List[j]._ARCname then
  2148.                             Zipdir.FSpecArgs.Add(Archive_Contents[i]._Filedefpath + Archive_Contents[i]._Filename);
  2149.                 Zipdir.Delete;
  2150.                 end;
  2151.  
  2152.           end;
  2153. _CryptoZip : begin
  2154.                if assigned(FOnCryto) then
  2155.                         FOnCryto(nil,key1,key2,key3);
  2156.                k := Removefileext(Archive_List[processfrom]._ARCname);
  2157.                {$IFDEF USE_CZIP}Encryptit.EncryptFile(Archive_List[processfrom]._ARCname,k  + '.czip', key1, key2, key3); {$ENDIF}
  2158.                end;
  2159.  
  2160. _LoadContents : begin
  2161.                 icon := TICON.Create;
  2162.                 DirectoryList.clear;
  2163.                 l := -1;
  2164.                 try
  2165.                 Total_Contents := 0;
  2166.                 for j := processfrom to processto do
  2167.                         begin
  2168.                         zipdir.ZipFileName := Archive_List[j]._ARCname;
  2169.                         if zipdir.ZipFileName = '' then Archive_List[j]._ARCtype := _WIT;
  2170.                         Archive_List[j]._ARCneedpassword := false;
  2171.                         SetLength(Archive_Contents, Total_Contents + zipdir.Count + 5);
  2172.                         for i := 0 to zipdir.Count -1 do
  2173.                                  with ZipDirEntry( ZipDir.ZipContents[i]^ ) do
  2174.                                  begin
  2175.                                  l := l + 1;
  2176.                 {Filename}       Archive_Contents[l]._Filename := Extractfilename(Filename);
  2177.                                  ext := Extractfileext(filename);
  2178.                                  loc := returnicontype(filename);
  2179.                                  Archive_Contents[l]._Fileicon := loc;
  2180.                                  Archive_Contents[l]._FileType := Filetype.strings[loc];
  2181.                {FileRatio}       if UnCompressedSize <> 0 then
  2182.                                  Archive_Contents[l]._FileRatio := trunc((1-(CompressedSize / UnCompressedSize) ) * 100) else
  2183.                                  Archive_Contents[l]._FileRatio := 0;
  2184.                {Encrypted?}      Archive_Contents[l]._encrypted := Encrypted;
  2185.                                  if encrypted then
  2186.                                  Archive_List[j]._ARCneedpassword := true;
  2187.                                  Archive_Contents[l]._FileSize := UnCompressedSize;
  2188.                                  Archive_Contents[l]._FilePackedSize := CompressedSize;
  2189.                                  Archive_Contents[l]._FileTime := FileDateToDateTime( DateTime );
  2190.                                  Archive_Contents[l]._FileCRC :=  InttoHex(CRC32,8);
  2191.                                  Archive_Contents[l]._FileDefPath := Extractfilepath(Filename);
  2192.                                  if DirectoryList.IndexOf(Archive_Contents[l]._FileDefPath) = -1 then
  2193.                                         if (Archive_Contents[i]._FileDefPath) <> '' then
  2194.                                         DirectoryList.Add(Archive_Contents[l]._FileDefPath);
  2195.                                  Archive_Contents[l]._FileArchive := Archive_List[j]._ARCname;
  2196.                                  end;
  2197.                         Total_Contents := Total_Contents + zipdir.Count
  2198.                         end;
  2199.                 finally
  2200.                 Icon.Free;
  2201.                 if Total_Contents > 0 then
  2202.                 Total_Contents := l + 1;
  2203.                 SetLength(Archive_Contents, Total_Contents + 5);
  2204.                 end;
  2205.                 end;
  2206.  
  2207. else if Assigned( FOnMsg ) then
  2208.                   FOnMsg( nil, 0, FUNCNOTAVIL );
  2209. end;
  2210. end;
  2211. {$ENDIF}
  2212.  
  2213. {$IFDEF USE_ACE}
  2214. procedure TCakdir.AceDirExtracting(Sender: TObject; eFile: TACEHeaderData);
  2215. begin
  2216. inc(processed_files);
  2217. if Assigned( FOnProg ) then
  2218.              FOnProg( nil, efile.FileName, efile.UnpSize, Trunc((Total_Contents/processed_files)*100));
  2219. end;
  2220. {$ENDIF}
  2221.  
  2222. {$IFDEF USE_ACE}
  2223. procedure TCakdir.AceDirError(Sender: TObject; Error: Integer);
  2224. begin
  2225.         if Assigned( FOnMsg ) then
  2226.         Case Error of
  2227.         11  : FOnMsg( nil, Error, ACEINTERR );
  2228.         128 : FOnMsg( nil, Error, NOERR );
  2229.         132 : FOnMsg( nil, Error, METHODNOTSUPPORT );
  2230.         else
  2231.         FOnMsg( nil, Error, '' );
  2232.         end;
  2233. end;
  2234. {$ENDIF}
  2235. {$IFDEF USE_ACE}
  2236. procedure TCakDir.AceDirList(Sender: TObject; eFile: TACEHeaderData;
  2237.   Result: Boolean);
  2238. var loc : integer;
  2239.     ext : string;
  2240.     Icon : TICON;
  2241. begin
  2242.                 DirectoryList.clear;
  2243.                 icon := TICON.Create;
  2244.                 Inc(Total_Contents);
  2245.                 try
  2246.                 SetLength(Archive_Contents, Total_Contents + 1 + 5);
  2247.                 with efile do
  2248.                 begin
  2249.                     Archive_Contents[Total_Contents]._Filename := Extractfilename(Filename);
  2250.                     ext := Extractfileext(filename);
  2251.                     loc := returnicontype(filename);
  2252.                     Archive_Contents[Total_Contents]._Fileicon := loc;
  2253.                     Archive_Contents[Total_Contents]._FileType := Filetype.strings[loc];
  2254.                     if UnpSize  <> 0 then
  2255.                     Archive_Contents[Total_Contents]._FileRatio := trunc((1-(PackSize / UnpSize) ) * 100) else
  2256.                     Archive_Contents[Total_Contents]._FileRatio := 0;
  2257.                     Archive_Contents[Total_Contents]._encrypted := FALSE;
  2258.                     Archive_Contents[Total_Contents]._FileSize := UnpSize;
  2259.                     Archive_Contents[Total_Contents]._FilePackedSize := PackSize;
  2260.                     Archive_Contents[Total_Contents]._FileTime := FileDateToDateTime( FileTime );
  2261.                     Archive_Contents[Total_Contents]._FileCRC :=  InttoHex(FileCRC,8);
  2262.                     Archive_Contents[Total_Contents]._FileDefPath := Extractfilepath(Filename);
  2263.                     if DirectoryList.IndexOf(Archive_Contents[Total_Contents]._FileDefPath) = -1 then
  2264.                         if (Archive_Contents[Total_Contents]._FileDefPath) <> '' then
  2265.                                         DirectoryList.Add(Archive_Contents[Total_Contents]._FileDefPath);
  2266.                     Archive_Contents[Total_Contents]._FileArchive := Archive_List[processing]._ARCname;
  2267.                     end;
  2268.                 finally
  2269.                 Icon.Free;
  2270.                 end;
  2271.  
  2272. end;
  2273. {$ENDIF}
  2274.  
  2275. {$IFDEF USE_RAR}
  2276. procedure TCakdir.RARDirExtracting(Sender: TObject; eFile: TRARHeaderData);
  2277. begin
  2278. inc(processed_files);
  2279. if Assigned( FOnProg ) then
  2280.              FOnProg( nil, efile.FileName, efile.UnpSize, Trunc((Total_Contents/processed_files)*100));
  2281. end;
  2282. {$ENDIF}
  2283.  
  2284. {$IFDEF USE_RAR}
  2285. procedure TCakdir.RARDirError(Sender: TObject; Error: Integer);
  2286. begin
  2287.         if Assigned( FOnMsg ) then
  2288.         Case Error of
  2289.         11  : FOnMsg( nil, Error, ACEINTERR );
  2290.         128 : FOnMsg( nil, Error, NOERR );
  2291.         132 : FOnMsg( nil, Error, METHODNOTSUPPORT );
  2292.         else
  2293.         FOnMsg( nil, Error, '' );
  2294.         end;
  2295. end;
  2296. {$ENDIF}
  2297.  
  2298. {$IFDEF USE_Rar}
  2299. function  TCakDir.RarDirVolumeChange(Sender: TObject; ArcName: PChar;  Mode: Integer): Integer;
  2300. begin
  2301. end;
  2302. {$ENDIF}
  2303. {$IFDEF USE_RAR}
  2304. procedure TCakDir.RARDirList(Sender: TObject; eFile: TRARHeaderData;
  2305.   Result: Boolean);
  2306. var loc : integer;
  2307.     ext : string;
  2308.     Icon : TICON;
  2309.     Buffer : Pchar;
  2310. begin
  2311.                 DirectoryList.clear;
  2312.                 icon := TICON.Create;
  2313.                 Inc(Total_Contents);
  2314.                 try
  2315.                 SetLength(Archive_Contents, Total_Contents + 1 + 5);
  2316.                 with efile do
  2317.                 begin
  2318.                     StrCopy(Buffer,Pchar(Extractfilename(Filename)));
  2319.                     Archive_Contents[Total_Contents]._Filename := buffer;
  2320.                     ext := Extractfileext(filename);
  2321.                     loc := returnicontype(filename);
  2322.                     Archive_Contents[Total_Contents]._Fileicon := loc;
  2323.                     Archive_Contents[Total_Contents]._FileType := Filetype.strings[loc];
  2324.                     if UnpSize  <> 0 then
  2325.                     Archive_Contents[Total_Contents]._FileRatio := trunc((1-(PackSize / UnpSize) ) * 100) else
  2326.                     Archive_Contents[Total_Contents]._FileRatio := 0;
  2327.                     Archive_Contents[Total_Contents]._encrypted := FALSE;
  2328.                     Archive_Contents[Total_Contents]._FileSize := UnpSize;
  2329.                     Archive_Contents[Total_Contents]._FilePackedSize := PackSize;
  2330.                     Archive_Contents[Total_Contents]._FileTime := FileDateToDateTime( FileTime );
  2331.                     Archive_Contents[Total_Contents]._FileCRC :=  InttoHex(FileCRC,8);
  2332.                     Archive_Contents[Total_Contents]._FileDefPath := Extractfilepath(Filename);
  2333.                     if DirectoryList.IndexOf(Archive_Contents[Total_Contents]._FileDefPath) = -1 then
  2334.                         if (Archive_Contents[Total_Contents]._FileDefPath) <> '' then
  2335.                                         DirectoryList.Add(Archive_Contents[Total_Contents]._FileDefPath);
  2336.                     Archive_Contents[Total_Contents]._FileArchive := Archive_List[processing]._ARCname;
  2337.                     end;
  2338.                 finally
  2339.                 Icon.Free;
  2340.                 end;
  2341.  
  2342. end;
  2343. {$ENDIF}
  2344.  
  2345.  
  2346. {$IFDEF USE_ARC}
  2347. procedure TCakDir.ArcDirProgress( Sender:TObject;State:Integer;lpEis:LPEXTRACTINGINFOEX;var Abort: Boolean );
  2348. begin
  2349.     Application.ProcessMessages;
  2350.     Abort := Stopping;
  2351.     if lpEis = nil then exit;
  2352.         with lpEis^,lpEis^.exinfo do
  2353.         if Lastname <> szSourceFileName then
  2354.         //if Archive_Contents[Get_Archive_Code(szSourceFileName,ArcDir.filename)]._Selected then
  2355.         begin
  2356.         Lastname := szSourceFilename;
  2357.         Inc(TotalSize,dwFileSize);
  2358.         if Assigned( FOnProg ) then
  2359.              FOnProg( nil, ExtractFileName( szSourceFileName ), dwWriteSize, TotalSize);
  2360.         end;
  2361. end;
  2362. {$ENDIF}
  2363.  
  2364. {$IFDEF USE_ARC}
  2365. procedure TCakDir.ARCHandleError(code : integer);
  2366. begin
  2367.         if Assigned( FOnMsg ) then
  2368.         Case code of
  2369.         0,1 : FOnMsg(nil,0,NOERR);
  2370.         ERROR_DISK_SPACE : FOnMsg(nil,ERROR_DISK_SPACE,ERR_NODISKSPACE);
  2371.         ERROR_READ_ONLY : FOnMsg(nil,ERROR_READ_ONLY,ERR_READONLY);
  2372.         ERROR_USER_SKIP, ERROR_USER_CANCEL : FOnMsg(nil,ERROR_USER_SKIP,ERR_USERSKIP);
  2373.         ERROR_FILE_CRC : FOnMsg(nil, ERROR_FILE_CRC,ERR_CRC);
  2374.         ERROR_UNKNOWN_TYPE : FOnMsg(nil,ERROR_UNKNOWN_TYPE,ERR_UNKTYPE);
  2375.         ERROR_METHOD : FOnMsg(nil,ERROR_METHOD ,ERR_NOSUPPORT);
  2376.         ERROR_PASSWORD_FILE : FOnMsg(nil,ERROR_PASSWORD_FILE ,ERR_PASSWORD);
  2377.         ERROR_LONG_FILE_NAME : FOnMsg(nil,ERROR_LONG_FILE_NAME ,ERR_LONGFN);
  2378.         ERROR_VERSION : FOnMsg(nil,ERROR_VERSION , ERR_WRONGVER);
  2379.         ERROR_FILE_OPEN : FOnMsg(nil,ERROR_FILE_OPEN,ERR_OPENED);
  2380.         ERROR_MORE_FRESH : FOnMsg(nil,ERROR_MORE_FRESH,ERR_NEWER);
  2381.         ERROR_NOT_EXIST : FOnMsg(nil,ERROR_NOT_EXIST,ERR_NOTEXIST);
  2382.         ERROR_ALREADY_EXIST : FOnMsg(nil,ERROR_ALREADY_EXIST,ERR_EXIST);
  2383.         ERROR_TOO_MANY_FILES : FOnMsg(nil,ERROR_TOO_MANY_FILES, ERR_TOOMANYFILE);
  2384.         ERROR_MAKEDIRECTORY : FOnMsg(nil,ERROR_MAKEDIRECTORY,ERR_MAKEDIR);
  2385.         ERROR_CANNOT_WRITE : FOnMsg(nil,ERROR_CANNOT_WRITE, ERR_WRITE);
  2386.         ERROR_HUFFMAN_CODE : FOnMsg(nil,ERROR_HUFFMAN_CODE, ERR_HUFFAN);
  2387.         ERROR_COMMENT_HEADER : FOnMsg(nil,ERROR_COMMENT_HEADER,ERR_HEADER);
  2388.         ERROR_HEADER_CRC : FOnMsg(nil,ERROR_HEADER_CRC,ERR_CRCHEADER);
  2389.         ERROR_HEADER_BROKEN : FOnMsg(nil,ERROR_HEADER_BROKEN,ERR_HEADERBROKE);
  2390.         ERROR_ARC_FILE_OPEN : FOnMsg(nil,ERROR_ARC_FILE_OPEN,ERR_OPENED);
  2391.         ERROR_NOT_ARC_FILE : FOnMsg(nil,ERROR_NOT_ARC_FILE,ERR_NOTARC);
  2392.         ERROR_CANNOT_READ : FOnMsg(nil,ERROR_CANNOT_READ,ERR_CANTREAD);
  2393.         ERROR_FILE_STYLE : FOnMsg(nil,ERROR_FILE_STYLE,ERR_WRONGTYPE);
  2394.         ERROR_COMMAND_NAME : FOnMsg(nil,ERROR_COMMAND_NAME,ERR_WRONGCMD);
  2395.         ERROR_MORE_HEAP_MEMORY : FOnMsg(nil,ERROR_MORE_HEAP_MEMORY,ERR_MOREHEAP);
  2396.         ERROR_ENOUGH_MEMORY : FOnMsg(nil,ERROR_ENOUGH_MEMORY,ERR_NOMEMORY);
  2397.         ERROR_ALREADY_RUNNING : FOnMsg(nil,ERROR_ALREADY_RUNNING,ERR_RUNNING);
  2398.         ERROR_HARC_ISNOT_OPENED : FOnMsg(nil,ERROR_HARC_ISNOT_OPENED,ERR_HARC);
  2399.         ERROR_NOT_SEARCH_MODE : FOnMsg(nil,ERROR_NOT_SEARCH_MODE,ERR_SEARCH);
  2400.         ERROR_NOT_SUPPORT : FOnMsg(nil,ERROR_NOT_SUPPORT,ERR_NOSUPPORT);
  2401.         ERROR_TIME_STAMP : FOnMsg(nil,ERROR_TIME_STAMP,'Wrong timestamp');
  2402.         ERROR_ARC_READ_ONLY : FOnMsg(nil,ERROR_ARC_READ_ONLY,ERR_ARCREADONLY);
  2403.         ERROR_TMP_OPEN : FOnMsg(nil,ERROR_TMP_OPEN,ERR_TMPOPEN);
  2404.         ERROR_SAME_NAME_FILE : FOnMsg(nil,ERROR_SAME_NAME_FILE,ERR_SAMENAME);
  2405.         ERROR_NOT_FIND_ARC_FILE : FOnMsg(nil,ERROR_NOT_FIND_ARC_FILE,ERR_NOTFOUNDARC);
  2406.         ERROR_RESPONSE_READ : FOnMsg(nil,ERROR_RESPONSE_READ,ERR_NORESPONSE);
  2407.         ERROR_NOT_FILENAME : FOnMsg(nil,ERROR_NOT_FILENAME,ERR_NOTVALID);
  2408.         ERROR_TMP_COPY : FOnMsg(nil,ERROR_TMP_COPY,ERR_COPYTEMP);
  2409.         ERROR_EOF : FOnMsg(nil,ERROR_EOF,ERR_EOF);
  2410.         end;
  2411. end;
  2412. {$ENDIF}
  2413.  
  2414. procedure TCakDir.CabRCopyFile(Sender: TObject; const FileName: String; UncompressedSize: Integer; Date, Time,
  2415. Attribs: Smallint; var Action: TFileCopyAction;
  2416. var DestFileHandle: Integer);
  2417. var i : integer;
  2418. begin
  2419. Case Cabmode of
  2420. _CFList : begin
  2421.           Inc(Total_Contents);
  2422.           SetLength(Archive_Contents,Total_Contents + 5);
  2423.           with Archive_Contents[Total_Contents-1] do
  2424.           begin
  2425.           _Filename := Extractfilename(modifyslash(Filename));
  2426.           _FileSize := UncompressedSize;
  2427.           _FilePackedSize := UncompressedSize;
  2428.           _FileICON := returnicontype(_Filename);
  2429.           _Filetype := Filetype.strings[_Fileicon];
  2430.           _FileRatio := 100;
  2431.           _encrypted := False;
  2432.           {$IFDEF USE_USE_ARC}
  2433.           _FileTime := DosDatetimetoDatetime(Word(Date),Word(Time));
  2434.           {$ELSE}
  2435.           _FileTime := Now;
  2436.           {$ENDIF}
  2437.           _FileCRC := 'FFFFFF';
  2438.           _FileDefPath := Extractfilepath(modifyslash(Filename));
  2439.           if DirectoryList.IndexOf(_FileDefPath) = -1 then
  2440.                      if (_FileDefPath) <> '' then
  2441.                      DirectoryList.Add(_FileDefPath);
  2442.           _FileArchive := Archive_List[processing]._ARCname;
  2443.           Action := fcaSkip;
  2444.           end;
  2445.           end;
  2446. _CFExtract : if stopping then Action := fcaSkip else
  2447.              begin
  2448.              i := Get_archive_code(Archive_List[processing]._ARCname,modifyslash(filename));
  2449.  
  2450.              if (i = -1)
  2451.                 then Action := fcaSkip else
  2452.                         if  (Archive_Contents[i]._Selected or Extractoptions.extr_Extractall) then
  2453.              begin
  2454.              TotalProgress := TotalProgress + UnCompressedSize;
  2455.              if assigned(FOnProg) then
  2456.                 FOnProg(nil,Filename,UncompressedSize,TotalProgress);
  2457.              Action := fcaDefaultCopy;
  2458.              end else
  2459.              Action := fcaSkip;
  2460.              end;
  2461. end;
  2462.  
  2463. end;
  2464.  
  2465. procedure TcakDir.CabRDirCloseCopied(Sender: TObject;
  2466. const FileName: String; FileHandle: Integer; Date, Time,
  2467. Attribs: Smallint; FolderIndex: Integer; Execute: Boolean;
  2468. var Abort: Boolean);
  2469. begin
  2470.         if Assigned(FOnProg) then
  2471.         FOnProg(Sender,Filename,0,0);
  2472.         if Assigned(FOnMsg) then
  2473.         FOnMsg(Sender,0,Filename + ' is Extracted');
  2474.         Abort := Stopping;
  2475. end;
  2476. {
  2477. procedure TCakDir.CabWGetOpenInfo(Sender: TObject; const FileName: String; var Date, Time, Attributes: Smallint;
  2478. var FileHandle, ResultCode: Integer);
  2479. begin
  2480.         if assigned(FOnProg) then
  2481.                 FOnProg(nil,Filename,0,0);
  2482.         if assigned(FOnMsg) then
  2483.         Case ResultCode of
  2484.         0 : FOnMsg(Sender,ResultCode,NOERR);
  2485.         1 : FOnMsg(Sender,ResultCode,ERR_CANTREAD);
  2486.         // Failure opening file to be stored in cabinet
  2487.         //  erf.erfTyp has C run-time *errno* value
  2488.         2 : FOnMsg(Sender,ResultCode,ERR_CANTREAD);
  2489.         // Failure reading file to be stored in cabinet
  2490.         //  erf.erfTyp has C run-time *errno* value
  2491.         3 : FOnMsg(Sender,ResultCode,ERR_NOMEMORY);
  2492.         // Out of memory in FCI
  2493.         4 : FOnMsg(Sender,ResultCode,ERR_COPYTEMP);
  2494.         // Could not create a temporary file
  2495.         //  erf.erfTyp has C run-time *errno* value
  2496.         5 : FOnMsg(Sender,ResultCode,ERR_NOSUPPORT );
  2497.         // Unknown compression type
  2498.         6 : FOnMsg(Sender,ResultCode,ERR_WRITE  );
  2499.         // Could not create cabinet file
  2500.         //  erf.erfTyp has C run-time *errno* value
  2501.         7 : FOnMsg(Sender,ResultCode,ERR_USERSKIP  );
  2502.         // Client requested abort
  2503.         8 : FOnMsg(Sender,ResultCode,ERR_WRITE  );
  2504.         // Failure compressing data
  2505.         end;
  2506. end;        }
  2507. procedure TCakDir.CabWFilePlaced(Sender: TObject; var CabParameters: TCCAB; const FileName: String; FileLength: Integer;
  2508. Continuation: Boolean; var AbortProcessing: Boolean);
  2509. begin
  2510.         Inc(TotalProgress,FileLength);
  2511.         if assigned(FOnMsg) then
  2512.         FOnMsg(Sender,0,Filename);
  2513.         if assigned(FOnProg) then
  2514.                 FOnProg(nil,Filename,FileLength,TotalProgress);
  2515.         abortProcessing := Stopping;
  2516. end;
  2517. procedure TCakDir.CabRNextCab(Sender: TObject;
  2518.   const NextCabinetName, NextCabinetDisk: String; var CabinetPath: String;
  2519.   ErrorIndication: TFDIERROR; var Abort: Boolean);
  2520. var Opendialog : TOpendialog;
  2521. begin
  2522.         Opendialog := TOpendialog.Create(nil);
  2523.         Opendialog.Title := 'Please locate ' + NextCabinetDisk + ' (' + NextCabinetName + ')';
  2524.         Opendialog.Filter := 'Cabinet|*.cab';
  2525.         Abort := false;
  2526.         if opendialog.execute then
  2527.                 cabinetpath := Opendialog.filename else
  2528.                         Abort := true;
  2529. end;
  2530. function TCakDir.ProcessPAK(processwhat : worktype) : boolean;
  2531. var
  2532. //   Buf1 : array[1..4] of Char;
  2533.    Buf2 : array[1..4] of Byte;
  2534.    Buf3 : array[1..56] of Char;
  2535.    Buf4 : array[1..120] of Char;
  2536.    Buf5 : array[1..16] of Char;
  2537.    Buf6 : array[1..120] of Byte;
  2538.    sign : longint;
  2539.    f,ff : file;
  2540.    fsize : longint;
  2541.    NumRead, offset, contents : longint;
  2542.    i,j,k,loc : integer;
  2543. function HexToInt(HexStr: String): LongInt;
  2544. var
  2545.   s : string;
  2546. begin
  2547.   s := '$' + HexStr;
  2548.   result := StrToInt(s);
  2549. end;
  2550.  
  2551. function IntToHex(DecValue: Integer): String;
  2552. begin
  2553.   result:= Format('%0x', [DecValue]);
  2554. end;
  2555. function buf5tostr : string;
  2556. var i : integer;
  2557.     output : string;
  2558. begin
  2559.         output := '';
  2560.         i := 1;
  2561.         While (Buf5[i] <> #0) and (i < 16) do
  2562.         begin
  2563.                 output := output + Char(Buf5[i]);
  2564.                 inc(i);
  2565.         end;
  2566.         result := output;
  2567. end;
  2568.  
  2569. function buf4tostr : string;
  2570. var i : integer;
  2571.     output : string;
  2572. begin
  2573.         output := '';
  2574.         i := 1;
  2575.         While (Buf4[i] <> #0) and (i < 120) do
  2576.         begin
  2577.                 output := output + Char(Buf4[i]);
  2578.                 inc(i);
  2579.         end;
  2580.         result := output;
  2581. end;
  2582. function buf3tostr : string;
  2583. var i : integer;
  2584.     output : string;
  2585. begin
  2586.         output := '';
  2587.         i := 1;
  2588.         While (Buf3[i] <> #0) and (i < 53) do
  2589.         begin
  2590.                 output := output + Char(Buf3[i]);
  2591.                 inc(i);
  2592.         end;
  2593.         result := output;
  2594. end;
  2595. function buf2toint : integer;
  2596. var x : byte;
  2597.     s : string;
  2598.     i : integer;
  2599.     hexstr : string;
  2600. begin
  2601.         hexstr:= '';
  2602.         for i := 4 downto 1 do
  2603.         begin
  2604.         x:= Buf2[i];
  2605.         s:= IntToHex(x);
  2606.         HexStr:= HexStr + s;
  2607.         end;
  2608.         result := HexToInt(hexstr);
  2609. end;
  2610.  
  2611. procedure LoadPAK;
  2612. var i : integer;
  2613. begin
  2614.       Blockread(F, Buf2, SizeOf(Buf2),NumRead);
  2615.       offset:= Buf2ToInt;
  2616.       Blockread(F, Buf2, SizeOf(Buf2),NumRead);
  2617.       contents:= Buf2ToInt div 64;
  2618.       if fsize >= offset + contents then
  2619.       begin
  2620.       Seek(F,offset);
  2621.       Inc(Total_Contents,Contents);
  2622.       //Set_ArchiveContentList(Total_contents,Total_Contents - Contents - 1,Total_Contents - 1);
  2623.       SetLength(Archive_Contents,Total_Contents + 5);
  2624.       for i := 0 to contents -1 do
  2625.       begin
  2626.       Archive_Contents[i] := InitContenttype;
  2627.       with Archive_Contents[i] do
  2628.       begin
  2629.       if (sign = $4b415053) then
  2630.       begin
  2631.       BlockRead(F, Buf4, SizeOf(Buf4), NumRead);
  2632.       _Filename := Extractfilename(ModifySlash(Buf4tostr));
  2633.       _FileDefpath := Extractfilepath(ModifySlash(Buf4tostr));
  2634.       end
  2635.       else
  2636.       begin
  2637.       BlockRead(F, Buf3, SizeOf(Buf3), NumRead);
  2638.       _Filename := Extractfilename(ModifySlash(Buf3tostr));
  2639.       _FileDefpath := Extractfilepath(ModifySlash(Buf3tostr));
  2640.       end;
  2641.       loc := returnicontype(_filename);
  2642.       _Fileicon := loc;
  2643.       _FileType := Filetype.strings[loc];
  2644.       if DirectoryList.IndexOf(_FileDefPath) = -1 then
  2645.       if (_FileDefPath) <> '' then
  2646.       DirectoryList.Add(_FileDefPath);
  2647.  
  2648.       BlockRead(F, Buf2, SizeOf(Buf2), NumRead);
  2649.       _Tag := Buf2toint;
  2650.       BlockRead(F, Buf2, SizeOf(Buf2), NumRead);
  2651.       _FileSize := Buf2toInt;
  2652.       _FileArchive := Archive_List[k]._ARCname;
  2653.       end;
  2654.       end;
  2655.       end;
  2656. end;
  2657. Procedure LoadWAD;
  2658. var i : integer;
  2659.     dummy : string[8];
  2660. begin
  2661.         Blockread(F, Buf2, SizeOf(Buf2),NumRead);
  2662.         contents:= Buf2ToInt;
  2663.         Blockread(F, Buf2, SizeOf(Buf2),NumRead);
  2664.         offset:= Buf2ToInt;
  2665.  
  2666.         if fsize >= offset + contents*$20 then
  2667.         begin
  2668.         Seek(F,offset);
  2669.         Inc(Total_Contents,Contents);
  2670.         //Set_ArchiveContentList(Total_contents,Total_Contents - Contents - 1,Total_Contents - 1);;
  2671.         SetLength(Archive_Contents,Total_Contents + 5);
  2672.         for i := 0 to contents -1 do
  2673.         begin
  2674.         Archive_Contents[i] := InitContenttype;
  2675.         with Archive_Contents[i] do
  2676.         begin
  2677.         BlockRead(F, Buf2, SizeOf(Buf2), NumRead);
  2678.         _Tag := Buf2toint;
  2679.  
  2680.         BlockRead(F, Buf2, SizeOf(Buf2), NumRead);
  2681.         _FileSize := Buf2toInt;
  2682.  
  2683.         BlockRead(F, dummy, 8, NumRead);
  2684.  
  2685.         BlockRead(F, Buf5, SizeOf(Buf5), NumRead);
  2686.         _Filename := Extractfilename(ModifySlash(Buf5tostr));
  2687.         _FileDefpath := Extractfilepath(ModifySlash(Buf5tostr));
  2688.         _FileArchive := Archive_List[k]._ARCname;
  2689.         loc := returnicontype(_filename);
  2690.         _Fileicon := loc;
  2691.         _FileType := Filetype.strings[loc];
  2692.  
  2693.         if DirectoryList.IndexOf(_FileDefPath) = -1 then
  2694.         if (_FileDefPath) <> '' then
  2695.         DirectoryList.Add(_FileDefPath);
  2696.         end;
  2697.         end;
  2698.         end;
  2699. end;
  2700. Procedure LoadIWAD;
  2701. var i : integer;
  2702. begin
  2703.         Blockread(F, Buf2, SizeOf(Buf2),NumRead);
  2704.         contents:= Buf2ToInt;
  2705.         Blockread(F, Buf2, SizeOf(Buf2),NumRead);
  2706.         offset:= Buf2ToInt;
  2707.  
  2708.         if fsize >= offset + contents*$10 then
  2709.         begin
  2710.         Seek(F,offset);
  2711.         Inc(Total_Contents,Contents);
  2712.         //Set_ArchiveContentList(Total_contents,Total_Contents - Contents - 1,Total_Contents - 1);
  2713.         SetLength(Archive_Contents,Total_Contents + 5);
  2714.         for i := 0 to contents -1 do
  2715.         begin
  2716.         Archive_Contents[i] := InitContenttype;
  2717.         with Archive_Contents[i] do
  2718.         begin
  2719.         BlockRead(F, Buf2, SizeOf(Buf2), NumRead);
  2720.         _Tag := Buf2toint;
  2721.  
  2722.         BlockRead(F, Buf2, SizeOf(Buf2), NumRead);
  2723.         _FileSize := Buf2toInt;
  2724.  
  2725.         BlockRead(F, Buf5, 8, NumRead);
  2726.         _Filename := Extractfilename(ModifySlash(Buf5tostr));
  2727.  
  2728.         _FileDefpath := Extractfilepath(ModifySlash(Buf5tostr));
  2729.         _FileArchive := Archive_List[k]._ARCname;
  2730.  
  2731.         loc := returnicontype(_filename);
  2732.         _Fileicon := loc;
  2733.         _FileType := Filetype.strings[loc];
  2734.  
  2735.         if DirectoryList.IndexOf(_FileDefPath) = -1 then
  2736.         if (_FileDefPath) <> '' then
  2737.         DirectoryList.Add(_FileDefPath);
  2738.         end;
  2739.         end;
  2740.         end;
  2741. end;
  2742. Procedure LoadUNKNOWN;
  2743. var i : integer;
  2744.     test : longint;
  2745.     recsize : longint;
  2746.     dummy : string[4];
  2747. begin
  2748.         BlockRead(F, test, 4, NumRead);
  2749.         if (test and $ffffff) <> $464650 then exit;
  2750.  
  2751.         Blockread(F, Buf2, SizeOf(Buf2),NumRead);
  2752.         contents:= Buf2ToInt div 64;;
  2753.  
  2754.         Blockread(F, Buf2, SizeOf(Buf2),NumRead);
  2755.         recsize:= Buf2ToInt;// div 64;;
  2756.  
  2757.         Blockread(F, Buf2, SizeOf(Buf2),NumRead);
  2758.         offset:= Buf2ToInt;
  2759.  
  2760.         if fsize >= offset + contents*recsize then
  2761.         begin
  2762.         Seek(F,offset);
  2763.         Inc(Total_Contents,Contents);
  2764.         //Set_ArchiveContentList(Total_contents,Total_Contents - Contents - 1,Total_Contents - 1);
  2765.         SetLength(Archive_Contents,Total_Contents + 5);
  2766.         for i := 0 to contents -1 do
  2767.         begin
  2768.         Archive_Contents[i] := InitContenttype;
  2769.         with Archive_Contents[i] do
  2770.         begin
  2771.  
  2772.         BlockRead(F, dummy, 4, NumRead);
  2773.  
  2774.         BlockRead(F, Buf2, SizeOf(Buf2), NumRead);
  2775.         _Tag := Buf2toint;
  2776.  
  2777.         BlockRead(F, Buf2, SizeOf(Buf2), NumRead);
  2778.         _FileSize := Buf2toInt;
  2779.         BlockRead(F, dummy, 4, NumRead);
  2780.  
  2781.         BlockRead(F, Buf5, Sizeof(Buf5), NumRead);
  2782.         _Filename := Extractfilename(ModifySlash(Buf5tostr));
  2783.         _FileDefpath := Extractfilepath(ModifySlash(Buf5tostr));
  2784.         _FileArchive := Archive_List[k]._ARCname;
  2785.         loc := returnicontype(_filename);
  2786.         _Fileicon := loc;
  2787.         _FileType := Filetype.strings[loc];
  2788.  
  2789.  
  2790.         if DirectoryList.IndexOf(_FileDefPath) = -1 then
  2791.         if (_FileDefPath) <> '' then
  2792.         DirectoryList.Add(_FileDefPath);
  2793.         end;
  2794.         end;
  2795.         end;
  2796. end;
  2797.  
  2798. begin
  2799. Result := true;
  2800. Case Processwhat of
  2801. _LoadContents : begin
  2802.                 DirectoryList.Clear;
  2803.  
  2804.                 for k := processfrom to processto do
  2805.                 begin
  2806.                 Total_Contents := 0;
  2807.                 Assignfile(f,Archive_List[k]._ARCname);
  2808.                 reset(f,1);
  2809.                 fsize := Filesize(f);
  2810.  
  2811.                 BlockRead(F, sign, 4, NumRead);
  2812.  
  2813.                 Case Sign of
  2814.                 $4b434150, $4b415053 : LOADPAK;
  2815.                 $32444157, $33444157 : LOADWAD;
  2816.                 $44415749, $44415750 : LOADIWAD;
  2817.                 else LOADUNKNOWN;
  2818.                 end; //Case
  2819.                 Closefile(f);
  2820.                 end;
  2821.                 end;
  2822. _Extract :      begin
  2823.                 for i := processfrom to processto do
  2824.                         begin
  2825.                         Assignfile(f,Archive_List[i]._ARCname);
  2826.                         reset(f,1);
  2827.                         fsize := Filesize(f);
  2828.                         for j := 0 to total_Contents -1 do
  2829.                         if Archive_Contents[j]._FileArchive = Archive_List[i]._ARCname then
  2830.                         if ExtractOptions.extr_Extractall or Archive_Contents[j]._Selected then
  2831.                         begin
  2832.                         with Archive_Contents[j] do
  2833.                         if ExtractOptions.extr_DirNames then
  2834.                         begin
  2835.                         MakeDirectory(ExtractOptions.extr_to + _Filedefpath);
  2836.                         Assignfile(ff,ExtractOptions.extr_to + _Filedefpath + _Filename)
  2837.                         end
  2838.                         else
  2839.                         Assignfile(ff,ExtractOptions.extr_to + Archive_Contents[j]._Filename);
  2840.  
  2841.                         Rewrite(ff,1);
  2842.                         Seek(F,Archive_Contents[j]._Tag);
  2843.                         fsize := Archive_Contents[j]._FileSize;
  2844.                         While fsize >= sizeof(buf6) do
  2845.                         begin
  2846.                         BlockRead(F, Buf6, Sizeof(buf6),NumRead);
  2847.                         fsize := fsize - NumRead;
  2848.                         BlockWrite(FF,Buf6,Numread);
  2849.                         end;
  2850.                         if fsize > 0 then
  2851.                         begin
  2852.                         BlockRead(F, Buf6, fsize,NumRead);
  2853.                         BlockWrite(FF,Buf6,Numread);
  2854.                         end;
  2855.                         Closefile(ff);
  2856.  
  2857.                         end;
  2858.                         Closefile(f);
  2859.                         end;
  2860.                 end;
  2861.  
  2862.  
  2863. end;
  2864. end;
  2865. function TCakDir.ProcessCAB(processwhat : worktype) : boolean;
  2866. var i,j : integer;
  2867.     afilelist,  apathlist : TStrings;
  2868. begin
  2869. Result := true;
  2870. Load_CAB_DLL;
  2871. case ProcessWhat of
  2872. _LoadContents : begin
  2873.                 Cabmode := _CFList;
  2874.                 Total_Contents := 0;
  2875.                 DirectoryList.Clear;
  2876.                 for i := processfrom to processto do
  2877.                 begin
  2878.                 processing := i;
  2879.                 CabRDir.ExtractFiles(Archive_List[i]._ARCname,GrabTempPath,_O_RDWR);
  2880.                 end;
  2881.                 end;
  2882. _Extract : begin
  2883.            Cabmode := _CFExtract;
  2884.            for i := processfrom to processto do
  2885.                 if ExtractOptions.extr_Extractall or (Get_Selected_Count(Archive_List[i]._ARCname) > 0) then
  2886.                 begin
  2887.                 processing := i;
  2888.                 Cab_Extr_to := NewTempPath;
  2889.                 TotalProgress := 0;
  2890.                 For j := 0 to Total_Contents -1 do
  2891.                     if ExtractOptions.extr_Extractall or Archive_Contents[j]._Selected then
  2892.                     if not directoryexists(Cab_Extr_to + Archive_Contents[j]._FileDefPath) then
  2893.                         MakeDirectory(Cab_Extr_to + Archive_Contents[j]._FileDefPath);
  2894.  
  2895.                 CabRDir.ExtractFiles(Archive_List[i]._ARCname,Cab_Extr_to,0);
  2896.                 UNLoad_Cab_DLL;
  2897.                 For j := 0 to Total_Contents -1 do
  2898.                     if ExtractOptions.extr_Extractall or Archive_Contents[j]._Selected then
  2899.                         with Archive_Contents[j] do
  2900.                         if fileexists(Cab_Extr_to + _FileDefpath + _FileName) then
  2901.                                 if Extractoptions.extr_DirNames = true then
  2902.                                         begin
  2903.                                         if not DirectoryExists(Extractoptions.extr_to + _FileDefpath) then
  2904.                                                 MakeDirectory(Extractoptions.extr_to + _FileDefpath);
  2905.                                         MoveFile(PChar(Cab_Extr_to + _FileDefpath + _FileName),Pchar(Extractoptions.extr_to + _FileDefpath + _FileName));
  2906.                                         end else
  2907.                                         MoveFile(PChar(Cab_Extr_to + _FileDefpath + _FileName),Pchar(Extractoptions.extr_to + _FileName));
  2908.  
  2909.                 For j := 0 to Total_Contents -1 do
  2910.                     if ExtractOptions.extr_Extractall or Archive_Contents[j]._Selected then
  2911.                         with Archive_Contents[j] do
  2912.                         if directoryexists(Cab_Extr_to + _FileDefpath) then
  2913.                              RemoveDirectory(PChaR(Cab_Extr_to + _FileDefPath));
  2914.                              
  2915.                 RemoveDirectory(PChar(Cab_Extr_to));
  2916.                 end;
  2917.            end;
  2918. _Test : begin
  2919.         Add_All_Selected_List;
  2920.         Cabmode := _CFExtract;
  2921.            for i := processfrom to processto do
  2922.                 begin
  2923.                 processing := i;
  2924.                 Cab_Extr_to := NewTempPath;
  2925.                 MakeDirectory(Cab_Extr_to);
  2926.                 TotalProgress := 0;
  2927.                 For j := 0 to Total_Contents -1 do
  2928.                     if Archive_Contents[j]._Selected then
  2929.                     if not directoryexists(Cab_Extr_to + Archive_Contents[j]._FileDefPath) then
  2930.                         MakeDirectory(Cab_Extr_to + Archive_Contents[j]._FileDefPath);
  2931.  
  2932.                 CabRDir.ExtractFiles(Archive_List[i]._ARCname,Cab_Extr_to,0);
  2933.                 UNLoad_Cab_DLL;
  2934.  
  2935.                 For j := 0 to Total_Contents -1 do
  2936.                     if Archive_Contents[j]._Selected then
  2937.                         with Archive_Contents[j] do
  2938.                         begin
  2939.  
  2940.                         if fileexists(Cab_Extr_to + _FileDefpath + _FileName) then
  2941.                         begin
  2942.                             if assigned(FOnMsg) then
  2943.                                    FOnMsg(nil,0, _FileDefpath + _Filename + ' OK');
  2944.                         end else
  2945.                         if assigned(FOnMsg) then
  2946.                                    FOnMsg(nil,0, _FileDefpath + _Filename + ' FAIL');
  2947.                         end;
  2948.  
  2949.                  For j := 0 to Total_Contents -1 do
  2950.                     if Archive_Contents[j]._Selected then
  2951.                         with Archive_Contents[j] do
  2952.                         if fileexists(Cab_Extr_to + _FileDefpath + _FileName) then
  2953.                         Deletefile(PChar(Cab_Extr_to + _FileDefpath + _FileName));
  2954.  
  2955.  
  2956.                 For j := 0 to Total_Contents -1 do
  2957.                     if Archive_Contents[j]._Selected then
  2958.                         with Archive_Contents[j] do
  2959.                         if directoryexists(Cab_Extr_to + _FileDefpath) then
  2960.                              RemoveDirectory(PChaR(Cab_Extr_to + _FileDefPath));
  2961.  
  2962.                 RemoveDirectory(PChar(Cab_Extr_to));
  2963.                 end;
  2964.  
  2965.         end;
  2966.  
  2967. _Add : begin
  2968.        if total_contents > 0 then
  2969.         if MessageDlg('Are you sure? Origional Cab content will be removed!', mtWarning, [mbYes, mbNo], 0) = MrNo then
  2970.                 exit;
  2971.  
  2972.        afilelist := TStringList.create;
  2973.        afilelist.clear;
  2974.        apathlist := TStringList.create;
  2975.        apathlist.clear;
  2976.        TotalProgress := 0;
  2977.        try
  2978.        //if  then
  2979.        for i := 0 to AddOptions.Add_files.Count -1 do
  2980.                 afilelist.AddStrings(pollfilelist(Addoptions.add_files.strings[i],Addoptions.add_SubDir));
  2981.        AddOptions.Add_files.clear;
  2982.        AddOptions.Add_files.addstrings(afilelist);
  2983.        afilelist.clear;
  2984.  
  2985.        For i := 0 to AddOptions.add_exclude.Count -1 do
  2986.                     begin
  2987.                     j := AddOptions.Add_files.Indexof(AddOptions.add_exclude.Strings[i]);
  2988.                     if j <> -1 then AddOptions.Add_files.Delete(j);
  2989.                     end;
  2990.  
  2991.        For i := 0 to Addoptions.add_files.count -1 do
  2992.        begin
  2993.         afilelist.Add(Addoptions.add_files.strings[i]);
  2994.         apathlist.Add(Extractfilename(Addoptions.add_files.strings[i]));
  2995.        end;
  2996.  
  2997.        CabWDir.Open(Archive_List[Addoptions.add_to]._ARCName,'Disk',0 ,900000,60);
  2998.  
  2999.        For i := 0 to afilelist.count -1 do
  3000.        if Addoptions.add_usepath then
  3001.        CabWDir.AddFile(afilelist.strings[i],modifyslash(removedrive(afilelist.strings[i]),'\','/'),[],MakeLzxcompression(21)) else
  3002.        CabWDir.AddFile(afilelist.strings[i],apathlist.strings[i],[],MakeLzxcompression(21));
  3003.  
  3004.        CabWDir.FlushCabinet(True);
  3005.        CabWDir.Close;
  3006.  
  3007.        finally
  3008.        afilelist.free;
  3009.        apathlist.free;
  3010.        end;
  3011.        end;
  3012.  
  3013. Else Result := false;
  3014. end;
  3015. end;
  3016.  
  3017. function TCakDir.ProcessEXT(processwhat : worktype) : boolean;
  3018. var i,loc : integer;
  3019. begin
  3020. Load_EXT_DLL;
  3021. result := true;
  3022. Case Processwhat of
  3023. _LoadContents : begin
  3024.         CakExt.Process(Archive_list[0]._Arcname,Ex_LoadContents);
  3025.         Total_Contents := Cakext.Total_Contents;
  3026.         Setlength(Archive_Contents,Total_Contents + 5);
  3027.         for i := 0 to cakext.Total_Contents - 1 do
  3028.                 begin
  3029.                 Archive_Contents[i]._Filename := extractfilename(cakext.Archive_Contents[i]._Filename);
  3030.                 Archive_Contents[i]._Filedefpath := extractfilepath(cakext.Archive_Contents[i]._Filename);
  3031.                 loc := returnicontype(Archive_Contents[i]._Filename);
  3032.                 Archive_Contents[i]._Fileicon := loc;
  3033.                 Archive_Contents[i]._FileType := Filetype.strings[loc];
  3034.                 Archive_Contents[i]._FileSize := cakext.Archive_Contents[i]._FileSize;
  3035.                 Archive_Contents[i]._FilePackedSize := cakext.Archive_Contents[i]._FilePackedSize;
  3036.                 Archive_Contents[i]._FileRatio := cakext.Archive_Contents[i]._FileRatio;
  3037.                 Archive_Contents[i]._Filetime := now;
  3038.                 Archive_Contents[i]._FileCRC := '000000';
  3039.                 end;
  3040.         end;
  3041. _Add : begin
  3042.        for i := 0 to AddOptions.add_files.count -1 do
  3043.                 begin
  3044.                 CakExt.AddOptionsEx.add_files := AddOptions.add_files.strings[i];
  3045.                 CakExt.Process(Archive_list[0]._Arcname,Ex_Add);
  3046.                 end;
  3047.  
  3048.        end;
  3049. _Extract : begin
  3050.            CakExt.ExtractOptionsEx.extr_to := ExtractOptions.extr_to;
  3051.            if ExtractOptions.extr_Extractall or (Get_Selected_Count = Total_Contents) then
  3052.                 begin
  3053.                 CakExt.ExtractOptionsEx.extract_files := '*.*';
  3054.                 CakExt.Process(Archive_list[0]._Arcname,Ex_Extract);
  3055.                 end else
  3056.                 begin
  3057.                 for i := 0 to Total_Contents -1 do
  3058.                         if ExtractOptions.extr_Extractall or Archive_Contents[i]._Selected then
  3059.                                 begin
  3060.                                 CakExt.ExtractOptionsEx.extract_files := Archive_Contents[i]._FileDefPath + Archive_Contents[i]._FileName; 
  3061.                                 CakExt.Process(Archive_list[0]._Arcname,Ex_Extract);
  3062.                                 end;
  3063.  
  3064.                 end;
  3065.  
  3066.            end;
  3067. _SFX : begin
  3068.        CakExt.Process(Archive_list[0]._Arcname,Ex_SFX);
  3069.        end;
  3070.  
  3071. _TEST : begin
  3072.         CakExt.Process(Archive_list[0]._Arcname,Ex_TEST);
  3073.         end;
  3074.  
  3075. _DELETE : begin
  3076.         CakExt.Process(Archive_list[0]._Arcname,Ex_DELETE);
  3077.         end;
  3078. end;
  3079. if assigned(FOnMsg) then
  3080. for i := 0 to cakext.DosOutput.count -1 do
  3081.         FOnMsg(nil,0,cakext.dosoutput.strings[i]);
  3082.  
  3083. end;
  3084.  
  3085. {$IFDEF USE_ARC}
  3086. function TCakDir.ProcessARC(processwhat : worktype) : boolean;
  3087. var i,j, done : integer;
  3088.     IndivisualInfo:TIndivisualInfo;
  3089.     sfiles : TStrings;
  3090.     k,dummy : string;
  3091.     CABDIR : TCAB32;
  3092.     afilelist : tstrings;
  3093. function ReturnarchiveType(filename : string) : TArchiverType;
  3094. begin
  3095.                 k := Uppercase(extractfileext(filename));
  3096.                 if k = '.ZIP' then
  3097.                         Result := atZip else
  3098.                 if (k = '.LZH') or (k = '.LHA') then
  3099.                         Result := atLha else
  3100.                 if k = '.CAB' then
  3101.                         Result := atCab else
  3102.                 if k = '.TAR' then
  3103.                         Result := atTar else
  3104.                 if (k = '.TAZ') or (k = '.TGZ') or
  3105.                    (k = '.GZ')  or (k = '.Z')  then
  3106.                         Result := atTgz else
  3107.                 if k = '.BZ2' then
  3108.                         Result := atBz2 else
  3109.                 if k = '.RAR' then
  3110.                         Result := atRar else
  3111.                 if (k = '.BGA') or (k = 'BZA') or (k = '.GZA') then
  3112.                         Result := atBga else
  3113.                 if k = '.YZ1' then
  3114.                         Result := atYz1 else
  3115.                 if k = '.BEL' then
  3116.                         Result := atBel else
  3117.                 if k = '.GCA' then
  3118.                         Result := atGca else
  3119.                 Result := atAutoDetect;
  3120. end;
  3121. begin
  3122. result := false;
  3123. Load_ARC_DLL;
  3124. Timer1.Enabled := true;
  3125. ArcDir.Options.n := 0;  {Showing Extracting Dialog}
  3126. ArcDir.OutputSize := 8192;
  3127. Case ProcessWhat of
  3128. _SFX          : begin
  3129.                 ArcDir.Options.gw := 3;
  3130.                 Arcdir.FileName := Archive_List[sfxoptions.sfx_to]._arcname;
  3131.                 k := extractfilepath(Archive_List[sfxoptions.sfx_to]._arcname);
  3132.                 ArcHandleError(Arcdir.MakeSfx(Application.handle,nil,k));
  3133.                 end;
  3134. _LoadContents : begin
  3135.                 DirectoryList.clear;
  3136.                 Total_Contents := -1;
  3137.                 for i := processfrom to processto do
  3138.                 begin
  3139.                 processing := i;
  3140.                 ArcDir.FileName:= Archive_List[i]._ARCname;
  3141.                 ArcDir.FindOpen(Application.handle,0 );
  3142.                 ArcDir.ArchiverType := ReturnarchiveType(Archive_List[i]._ARCname);
  3143.                 done := ArcDir.FindFirst( '*.*',IndivisualInfo );
  3144.                 while done = 0 do
  3145.                 begin
  3146.                 Inc(Total_Contents);
  3147.                 SetLength(Archive_Contents,Total_Contents + 1 + 5);
  3148.                         with Archive_Contents[Total_Contents] do
  3149.                                 begin
  3150.                                 _Filename := Extractfilename(modifyslash(IndivisualInfo.szFileName));
  3151.                                 _FileICON := returnicontype(_Filename);
  3152.                                 _Filetype := Filetype.strings[_Fileicon];
  3153.                                 _FileRatio := IndivisualInfo.wRatio;
  3154.                                 _encrypted := False;
  3155.                                 _FileSize := IndivisualInfo.dwOriginalSize;
  3156.                                 _FilePackedSize :=IndivisualInfo.dwCompressedSize;
  3157.                                 _FileTime :=  DosDateTimeToDateTime(IndivisualInfo.wDate,IndivisualInfo.wtime);
  3158.                                 _FileCRC := InttoHex(IndivisualInfo.dwCRC,8);
  3159.                                 _FileDefPath := Extractfilepath(modifyslash(IndivisualInfo.szFileName));
  3160.                                 if DirectoryList.IndexOf(_FileDefPath) = -1 then
  3161.                                         if (_FileDefPath) <> '' then
  3162.                                         DirectoryList.Add(_FileDefPath);
  3163.                                 _FileArchive := Archive_List[i]._ARCname;
  3164.                                 end;
  3165.                 done := ArcDir.FindNext(IndivisualInfo);
  3166.                 end;
  3167.                 Inc(Total_Contents);
  3168.                 end;
  3169.                 ArcDir.FindClose;
  3170.                 end;
  3171. _Add     :      begin
  3172.                 TotalSize := 0;
  3173.                 ArcDir.Options.a := 1;
  3174.                 ArcDir.FileName := Archive_List[addoptions.add_to]._ARCname;
  3175.                 ArcDir.ArchiverType := ReturnarchiveType(Archive_List[addoptions.add_to]._ARCname);
  3176.                 afilelist := TStringlist.create;
  3177.                 sfiles := TStringlist.create;
  3178.                 try
  3179.                 if Addoptions.add_usepath then
  3180.                     ArcDir.Options.x := 1
  3181.                     else
  3182.                     ArcDir.Options.x := 0;
  3183.  
  3184.                 for i := 0 to AddOptions.Add_files.Count -1 do
  3185.                         afilelist.addstrings(pollfilelist(Addoptions.add_files.strings[i],Addoptions.add_SubDir));
  3186.  
  3187.                 Addoptions.add_files.clear;
  3188.                 Addoptions.add_files.AddStrings(afilelist);
  3189.  
  3190.                 For i := 0 to AddOptions.add_exclude.Count -1 do
  3191.                     begin
  3192.                     j := AddOptions.Add_files.Indexof(AddOptions.add_exclude.Strings[i]);
  3193.                     if j <> -1 then AddOptions.Add_files.Delete(j);
  3194.                     end;
  3195.  
  3196.                 if ArcDir.ArchiverType = atCAB then {this code let you add more than 1 file @ a time}
  3197.                         begin
  3198.                         k := '-a -mx';
  3199.                         k := space + '"' + ArcDir.Filename + '"';
  3200.                         for i := 0 to Addoptions.add_files.Count - 1 do
  3201.                         k := k + space + '"' + Addoptions.add_files.strings[i] + '"';
  3202.                         CabDir := TCab32.Create;
  3203.                         try
  3204.                         CabDir.Cab(application.handle,k,dummy);
  3205.                         finally
  3206.                         CabDir.Free;
  3207.                         end;
  3208.                         end
  3209.                 else
  3210.                 if (ArcDir.ArchiverType = atTgz) or (ArcDir.ArchiverType = atTar) then
  3211.                 begin
  3212.                 sfiles.clear;
  3213.                 for i := 0 to Addoptions.add_files.Count - 1 do
  3214.                 sfiles.Add(Addoptions.add_files.strings[i]);
  3215.  
  3216.                 ArcHandleError(ArcDir.PackFiles(Application.Handle, nil,
  3217.                 '', [sfiles]));
  3218.                 end else
  3219.                 for i := 0 to Addoptions.add_files.Count - 1 do
  3220.                 begin
  3221.                 sfiles.Clear;
  3222.                 sfiles.Add(Extractfilename(Addoptions.add_files.strings[i]));
  3223.  
  3224.                 ArcHandleError(ArcDir.PackFiles(Application.Handle, nil,
  3225.                 Extractfilepath(Addoptions.add_files.Strings[i]), [sfiles]));
  3226.                 end;
  3227.                 finally
  3228.                 sfiles.free;
  3229.                 end;
  3230.  
  3231.                 end;
  3232. _Extract :      For j := processfrom to processto do
  3233.                 if ExtractOptions.extr_Extractall or (Get_Selected_Count(Archive_List[j]._ARCname) > 0) then
  3234.                 begin
  3235.                 TotalSize := 0;
  3236.                 sfiles := TStringlist.create;
  3237.                 try
  3238.                 ArcDir.Filename := Archive_List[j]._ARCname;
  3239.                 if ExtractOptions.extr_Dirnames then
  3240.                 ArcDir.Options.x := 1 else
  3241.                 ArcDir.Options.x := 0;
  3242.                 sfiles.Clear;
  3243.                 for i := 0 to Total_Contents -1 do
  3244.                       if ExtractOptions.extr_Extractall or Archive_Contents[i]._Selected then
  3245.                         if Archive_Contents[i]._FileArchive = Archive_List[j]._ARCname then
  3246.                                 sfiles.Add(Archive_Contents[i]._Filedefpath + Archive_Contents[i]._Filename);
  3247.  
  3248.                 for i := sfiles.count -1 downto 0 do
  3249.                         if fileexists(Appendslash(ExtractOptions.extr_to) + sfiles.strings[i]) then
  3250.                                 if AskOverwrite(sfiles.strings[i]) then
  3251.                                         Deletefile(ExtractOptions.extr_to + sfiles.strings[i]) else
  3252.                                                 sfiles.Delete(i);
  3253.  
  3254.                 ArcHandleError(ArcDir.UnpackFiles(Application.handle,nil,ExtractOptions.extr_to,[sfiles]));
  3255.                 finally
  3256.                 sfiles.free;
  3257.                 end;
  3258.                 end;
  3259. _Delete :  For j := processfrom to processto do
  3260.                 begin
  3261.                 TotalSize := 0;
  3262.                 sfiles := TStringlist.create;
  3263.                 try
  3264.                 ArcDir.Filename := Archive_List[j]._ARCname;
  3265.                 if ExtractOptions.extr_Dirnames then
  3266.                 ArcDir.Options.x := 1 else
  3267.                 ArcDir.Options.x := 0;
  3268.                 sfiles.Clear;
  3269.                 for i := 0 to Total_Contents -1 do
  3270.                       if Archive_Contents[i]._Selected then
  3271.                         if Archive_Contents[i]._FileArchive = Archive_List[j]._ARCname then
  3272.                                 begin
  3273.                                 sfiles.clear;
  3274.                                 sfiles.Add(Archive_Contents[i]._Filedefpath + Archive_Contents[i]._Filename);
  3275.                                 ArcHandleError(ArcDir.Removeitems(Application.handle,nil,Archive_Contents[i]._FileDefPath ,[sfiles]));
  3276.                                 end;
  3277.                 finally
  3278.                 sfiles.free;
  3279.                 end;
  3280.                 end;
  3281. _Test   :       For j := processfrom to processto do
  3282.                 begin
  3283.                 ArcDir.Filename := Archive_List[j]._ARCname;
  3284.                 ARCHandleError(ArcDir.CheckArchive( CHECKARCHIVE_FULLCRC,0 ));
  3285.                 //ARCHandleError(ArcDir.UnpackFiles( Application.Handle,nil,'TEST\',[nil] ));
  3286.                 end;
  3287.  
  3288. end;
  3289. Timer1.Enabled := false;
  3290. end;
  3291. {$ENDIF}
  3292.  
  3293. {$IFDEF USE_ACE2}
  3294. procedure TCakdir.Ace2HandleError(ErrNo : integer);
  3295. begin
  3296. if Ace2Msg <> '' then
  3297.                 if assigned(FOnMsg) then
  3298.                         FOnMsg(nil,Ace2Code,Ace2Msg);
  3299. if assigned(FOnMsg) then
  3300. Case ErrNo of
  3301.   ACE_ERROR_NOERROR : FOnMsg(nil,ErrNo,'OK');
  3302.   ACE_ERROR_MEM : FOnMsg(nil,ErrNo,'our of memory');
  3303.   ACE_ERROR_FILES : FOnMsg(nil,ErrNo,'no files specified');
  3304.   ACE_ERROR_FOUND : FOnMsg(nil,ErrNo,'specified archive not found');
  3305.   ACE_ERROR_FULL : FOnMsg(nil,ErrNo,'disk full');
  3306.   ACE_ERROR_OPEN : FOnMsg(nil,ErrNo,'could not open file');
  3307.   ACE_ERROR_READ : FOnMsg(nil,ErrNo,'read error');
  3308.   ACE_ERROR_WRITE : FOnMsg(nil,ErrNo,'write error');
  3309.   ACE_ERROR_CLINE : FOnMsg(nil,ErrNo,'invalid command line');
  3310.   ACE_ERROR_CRC : FOnMsg(nil,ErrNo,'CRC error');
  3311.   ACE_ERROR_OTHER : FOnMsg(nil,ErrNo,'other error');
  3312.   ACE_ERROR_EXISTS : FOnMsg(nil,ErrNo,'file already exists');
  3313.   ACE_ERROR_USER : FOnMsg(nil,ErrNo,'user terminate');
  3314. end;
  3315. end;
  3316. {$ENDIF}
  3317.  
  3318. {$IFDEF USE_ACE}
  3319. function TCakDir.ProcessACE(processwhat : worktype) : boolean;
  3320. var i,j: integer;
  3321. begin
  3322. result := false;
  3323. Load_ACE_DLL;
  3324. Case Processwhat of
  3325. _LoadContents : begin
  3326.                 Total_Contents := -1;
  3327.                 for i := processfrom to processto do
  3328.                 begin
  3329.                 processing := i;
  3330.                 Acedir.Archivefilename := Archive_List[i]._ARCname;
  3331.                 j := Acedir.ListArchive;
  3332.                 if j = 0 then result := true else
  3333.                         result := false;
  3334.                 Inc(Total_Contents)
  3335.                 end;
  3336.                 end;
  3337. _Extract : begin
  3338.            {$IFDEF USE_ACE2}
  3339.            For j := processfrom to processto do
  3340.            for i := 0 to Total_Contents -1 do
  3341.            if (ExtractOptions.extr_Extractall or Archive_Contents[i]._Selected) and (Archive_Contents[i]._FileArchive = Archive_List[j]._ARCname) then
  3342.            begin
  3343.            Strcopy(UnaceV2.FileList,Pchar(Archive_Contents[i]._Filedefpath +
  3344.                 Archive_Contents[i]._Filename));
  3345.            Ace2Msg := '';
  3346.            Ace2HandleError(CallACEExtract(Archive_List[j]._ARCname,
  3347.                         ExtractOptions.extr_to,
  3348.                         Password,
  3349.                         not ExtractOptions.extr_DirNames));
  3350.            end;
  3351.            {$ELSE}
  3352.            Acedir.TargetDirectory := ExtractOptions.extr_to;
  3353.  
  3354.            For j := processfrom to processto do
  3355.                 if Get_Selected_Count(Archive_List[j]._ARCname) > 0 then
  3356.                 begin
  3357.                 Acedir.Archivefilename := Archive_List[j]._ARCname;
  3358.                 Acedir.FilesToProcess.Clear;
  3359.                 for i := 0 to Total_Contents -1 do
  3360.                       if (Archive_Contents[i]._Selected or ExtractOptions.extr_Extractall) then
  3361.                         if Archive_Contents[i]._FileArchive = Archive_List[j]._ARCname then
  3362.                             Acedir.FilesToProcess.Add(Archive_Contents[i]._Filedefpath + Archive_Contents[i]._Filename);
  3363.  
  3364.                 i :=  Acedir.ExtractArchive;
  3365.                 if i= 0 then result := true else
  3366.                         if Assigned( FOnMsg ) then
  3367.                         FOnMsg(nil,i,Acedir.GetAceErrorString(i));
  3368.                 end;
  3369.            {$ENDIF}
  3370.            end;
  3371. _Test : {$IFDEF USE_ACE2}
  3372.            For j := processfrom to processto do
  3373.            begin
  3374.            Ace2Msg := '';
  3375.            Ace2HandleError(CallACETest(Archive_List[j]._ARCname));
  3376.            end;
  3377.            {$ELSE}
  3378.            for i := processfrom to processto do
  3379.                 begin
  3380.                 processing := i;
  3381.                 Acedir.Archivefilename := Archive_List[i]._ARCname;
  3382.                 j := Acedir.TestArchive;
  3383.                 if j = 0 then result := true else
  3384.                         if Assigned( FOnMsg ) then
  3385.                         FOnMsg(nil,i,Acedir.GetAceErrorString(j));
  3386.            end;
  3387.            {$ENDIF}
  3388. else if Assigned( FOnMsg ) then
  3389.                   FOnMsg( nil, 0, FUNCNOTAVIL );
  3390. end;
  3391.  
  3392.  
  3393. end;
  3394. {$ENDIF}
  3395.  
  3396. {$IFDEF USE_Rar}
  3397. function TCakDir.ProcessRAR(processwhat : worktype) : boolean;
  3398. var i,j: integer;
  3399. begin
  3400. result := false;
  3401. Load_Rar_DLL;
  3402. Case Processwhat of
  3403. _LoadContents : begin
  3404.                 Total_Contents := -1;
  3405.                 for i := processfrom to processto do
  3406.                 begin
  3407.                 processing := i;
  3408.                 Rardir.Archivefilename := Archive_List[i]._ARCname;
  3409.                 j := Rardir.ListArchive;
  3410.                 if j = 0 then result := true else
  3411.                         result := false;
  3412.                 Inc(Total_Contents)
  3413.                 end;
  3414.                 end;
  3415. _Extract : begin
  3416.            Rardir.TargetDirectory := ExtractOptions.extr_to;
  3417.  
  3418.            For j := processfrom to processto do
  3419.                 if ExtractOptions.extr_Extractall or (Get_Selected_Count(Archive_List[j]._ARCname) > 0) then
  3420.                 begin
  3421.                 Rardir.Archivefilename := Archive_List[j]._ARCname;
  3422.                 Rardir.FilesToProcess.Clear;
  3423.                 for i := 0 to Total_Contents -1 do
  3424.                       if ExtractOptions.extr_Extractall or Archive_Contents[i]._Selected then
  3425.                         if Archive_Contents[i]._FileArchive = Archive_List[j]._ARCname then
  3426.                             Rardir.FilesToProcess.Add(Archive_Contents[i]._Filedefpath + Archive_Contents[i]._Filename);
  3427.  
  3428.                 i :=  Rardir.ExtractArchive;
  3429.                 if i= 0 then result := true else
  3430.                         if Assigned( FOnMsg ) then
  3431.                         FOnMsg(nil,i,Rardir.GetRarErrorString(i));
  3432.                 end;
  3433.            end;
  3434. _Test : for i := processfrom to processto do
  3435.                 begin
  3436.                 processing := i;
  3437.                 Rardir.Archivefilename := Archive_List[i]._ARCname;
  3438.                 j := Rardir.TestArchive;
  3439.                 if j = 0 then result := true else
  3440.                         if Assigned( FOnMsg ) then
  3441.                         FOnMsg(nil,i,Rardir.GetRarErrorString(j));
  3442.            end;
  3443. else if Assigned( FOnMsg ) then
  3444.                   FOnMsg( nil, 0, FUNCNOTAVIL );
  3445. end;
  3446.  
  3447.  
  3448. end;
  3449. {$ENDIF}
  3450.  
  3451. {$IFDEF USE_ARC}
  3452. procedure TCakDir.Load_ARC_DLL;
  3453. begin
  3454. if not assigned(ArcDir) then
  3455. Arcdir  := TArchiveFile.Create(Application);
  3456. ArcDir.OnProgress := ArcDirProgress;
  3457. end;
  3458. {$ENDIF}
  3459. {$IFDEF USE_ARC}
  3460. procedure TCakDir.UnLoad_ARC_DLL;
  3461. begin
  3462. //if assigned(Arcdir) then   //Crash here...
  3463. //        Arcdir.Free;
  3464. //Arcdir := nil;
  3465. end;
  3466. {$ENDIF}
  3467.  
  3468. {$IFDEF USE_ZIP}
  3469. procedure TCakDir.ZipDirMessage(Sender: TObject; ErrCode: integer;
  3470.   Message: string);
  3471. begin
  3472.         if Assigned( FOnMsg ) then
  3473.         FOnMsg(Sender, Errcode, Message);
  3474. end;
  3475. {$ENDIF}
  3476.  
  3477.  
  3478. {$IFDEF USE_ZIP}
  3479. procedure TCakDir.ZipDirExtrOver(Sender: TObject;
  3480. ForFile: String; Older: Boolean; var DoOverwrite: Boolean;  DirIndex: Integer);
  3481. begin
  3482.         DoOverwrite := AskOverwrite(Forfile);
  3483. end;
  3484. {$ENDIF}
  3485.  
  3486. {$IFDEF USE_ZIP}
  3487. procedure TCakDir.ZipDirProgress(Sender: TObject; ProgrType: ProgressType;
  3488.   Filename: string; FileSize: integer);
  3489. begin
  3490.     case ProgrType of
  3491.     TotalSize2Process:
  3492.          TotalProgress := 0;
  3493.     ProgressUpdate:
  3494.          TotalProgress := TotalProgress + FileSize;
  3495.     end;
  3496.     if Assigned( FOnProg ) then
  3497.         FOnProg(Sender,filename, Filesize,TotalProgress);
  3498. end;
  3499. {$ENDIF}
  3500.  
  3501. {$IFDEF USE_ZIP}
  3502. procedure TCakDir.ZipDirPwdErr(Sender: TObject;
  3503.   IsZipAction: Boolean; var NewPassword: String; ForFile: String;
  3504.   var RepeatCount: Cardinal; var Action: TPasswordButton);
  3505. var pwd : string;
  3506. begin
  3507.         if (password <> pwd) and (password <> '') then
  3508.                 begin
  3509.                 newpassword := password;
  3510.                 RepeatCount := 1;
  3511.                 end
  3512.         else
  3513.         begin
  3514.         if assigned(FOnPwd) then
  3515.                 FOnPwd(nil,zipdir.ZipFileName,forfile,pwd) else
  3516.         pwd := Inputbox(MSG_PWD, MSG_PLZENTERPWD4 + forfile, pwd);
  3517.         zipdir.Password := pwd;
  3518.         Newpassword := pwd;
  3519.         password := pwd;
  3520.         RepeatCount := 0;
  3521.         end;
  3522. end;
  3523. {$ENDIF}
  3524.  
  3525. {$IFDEF USE_RS}
  3526. Procedure TCakDir.RsDirAddLog(Sender: TObject; s: String);
  3527. begin
  3528.         if Assigned( FOnMsg ) then
  3529.         FOnMsg(Sender,0,s);
  3530. end;
  3531. {$ENDIF}
  3532. {$IFDEF USE_RS}
  3533. Procedure TCakDir.RsDirCDChange(Sender: TObject);
  3534. var 
  3535.   i, loc: integer;
  3536.   CentralFileHeader: TCentralFileHeader;
  3537.   ColMan: TObjList;
  3538.   k:      string;
  3539. begin
  3540.   ColMan := TObjList.Create;
  3541.   ColMan.Add(TNameColDataExtr.Create);
  3542.   ColMan.Add(TSizeColDataExtr.Create);
  3543.   ColMan.Add(TTypeNameColDataExtr.Create);
  3544.   ColMan.Add(TRatioColDataExtr.Create);
  3545.   ColMan.Add(TPackedColDataExtr.Create);
  3546.   ColMan.Add(TTimeColDataExtr.Create);
  3547.   ColMan.Add(TNumBlocksColDataExtr.Create);
  3548.   with RsDir.ArchiveMan.ArchiveFile do
  3549.   begin
  3550.     Total_Contents := CentralDir.Count;
  3551.     SetLength(Archive_Contents, Total_Contents + 5);
  3552.     for i := 0 to CentralDir.Count - 1 do
  3553.       with Archive_Contents[i] do
  3554.       begin
  3555.         CentralFileHeader := TCentralFileHeader(CentralDir[i]);
  3556.         _Filename := Extractfilename(TColDataExtr(ColMan[0]).Extract(CentralFileHeader));
  3557.         _Filedefpath := Extractfilepath(TColDataExtr(ColMan[0]).Extract(CentralFileHeader));
  3558.         loc := returnicontype(_filename);
  3559.         _Filetype := Filetype.strings[loc];
  3560.         _FileIcon := loc;
  3561.         _FileSize := strtointdef(TColDataExtr(ColMan[1]).Extract(CentralFileHeader), 1);
  3562.         _FilePackedSize := strtointdef(TColDataExtr(ColMan[4]).Extract(CentralFileHeader),
  3563.           1);
  3564.         _FileRatio := trunc((_FilePackedSize / _FileSize) * 100);
  3565.         _FileArchive := Archive_List[0]._ARCname;
  3566.         k := TColDataExtr(ColMan[5]).Extract(CentralFileHeader);
  3567.         if k <> '' then
  3568.           _fileTime := StrtoDatetime(k);
  3569.  
  3570.       end;
  3571.   end;
  3572.   ColMan.Free;
  3573. end;
  3574.  
  3575. {$ENDIF}
  3576.  
  3577. {$IFDEF USE_INDY}
  3578. function TCakDir.ProcessUUE(processwhat : worktype) : boolean;
  3579. var IDUUDecoder1 : TIDUUDecoder;
  3580.     IDUUEncoder1 : TIDUUEncoder;
  3581.     s,k,x : string;
  3582.     t : array[0..44] of Char;
  3583.     tf : textfile;
  3584.     fn : string;
  3585.     loc,i,fz,count : integer;
  3586.     bf : file;
  3587.     Fs : TFileStream;
  3588. begin
  3589. result := true;
  3590. Case processwhat of
  3591. _LoadContents : begin
  3592.                 Total_Contents := 0;
  3593.                 For i := processfrom to processto do
  3594.                 begin
  3595.                 Assignfile(tf,Archive_List[i]._arcname);
  3596.                 Reset(tf);
  3597.                 fz := Filesize(tf);
  3598.                 fn := '';
  3599.                 IDUUDecoder1 := TIDUUDecoder.Create(nil);
  3600.  
  3601.                 with IDUUDecoder1 do
  3602.                         begin
  3603.                         AutocompleteInput := False;
  3604.                         Reset;
  3605.                         while not eof(tf) and (fn = '') do
  3606.                         begin
  3607.                         readln(tf,k);
  3608.                         s := CodeString(k+#13);
  3609.                         s := CompletedInput;
  3610.                         s := CompletedInput;
  3611.                         if filename <> '' then fn := filename;
  3612.                         end;
  3613.                         end;
  3614.                 Closefile(tf);
  3615.                 IDUUDecoder1.free;
  3616.  
  3617.                 Inc(Total_Contents);
  3618.                 SetLength(Archive_Contents,Total_Contents + 5);
  3619.                 Archive_Contents[Total_Contents-1]._Filename := fn;
  3620.                 loc := returnicontype(fn);
  3621.                 Archive_Contents[Total_Contents-1]._Fileicon := loc;
  3622.                 Archive_Contents[Total_Contents-1]._FileType := Filetype.strings[loc];
  3623.  
  3624.                 Archive_Contents[Total_Contents-1]._FileRatio := 100;
  3625.                 Archive_Contents[Total_Contents-1]._encrypted := FALSE;
  3626.                 Archive_Contents[Total_Contents-1]._FileSize := fz;
  3627.                 Archive_Contents[Total_Contents-1]._FilePackedSize := fz;
  3628.                 Archive_Contents[Total_Contents-1]._FileCRC :=  '';
  3629.                 Archive_Contents[Total_Contents-1]._FileDefPath := '';
  3630.                 Archive_Contents[Total_Contents-1]._FileArchive := Archive_List[i]._ARCname;
  3631.                 end;
  3632.                 end;
  3633. _Extract : begin
  3634.  
  3635.            For i := processfrom to processto do
  3636.                 if ExtractOptions.extr_Extractall or Archive_Contents[i]._Selected then
  3637.                 begin
  3638.                 Assignfile(tf,Archive_List[i]._arcname);
  3639.                 Reset(tf);
  3640.                 fn := '';
  3641.                 IDUUDecoder1 := TIDUUDecoder.Create(nil);
  3642.                 with IDUUDecoder1 do
  3643.                         begin
  3644.                         while not eof(tf) and (fn = '') do
  3645.                         begin
  3646.                         AutocompleteInput := False;
  3647.                         Reset;
  3648.                         readln(tf,k);
  3649.  
  3650.                         if Uppercase(k) = 'TABLE' then
  3651.                         begin
  3652.                         x := '';
  3653.                         s := '';
  3654.                         While not eof(tf) and not (Uppercase(Copy(s,0,9)) = 'BEGIN 644') do
  3655.                                 begin
  3656.                                 x := x + s;
  3657.                                 readln(tf,s);
  3658.                                 end;
  3659.                         SetCodingtable(x);
  3660.                         k := s;
  3661.                         end;
  3662.  
  3663.                         if Uppercase(Copy(k,0,9)) = 'BEGIN 644' then
  3664.                         begin
  3665.                         s := CodeString(k+#13);
  3666.                         s := CompletedInput;
  3667.                         s := CompletedInput;
  3668.                         if filename <> '' then fn := filename;
  3669.                         end;
  3670.                         end;
  3671.  
  3672.                         s := Appendslash(extractoptions.extr_to) + fn;
  3673.                         AssignFile(bf, s);
  3674.                         Rewrite(bf,1);
  3675.  
  3676.                         While not eof(tf) do
  3677.                         begin
  3678.                          Readln(tf,k);
  3679.                          k := CodeString(k  +#13#10);
  3680.                          Fetch(k, ';');
  3681.                          BlockWrite(bf, k[1], Length(k));
  3682.                          end;
  3683.  
  3684.                          repeat
  3685.                          k := CompletedInput;
  3686.                          Fetch(k, ';');
  3687.                          BlockWrite(bf, k[1], Length(k));
  3688.                          until k = '';
  3689.                        end;
  3690.  
  3691.                          Closefile(tf);
  3692.                          Closefile(bf);
  3693.                         IDUUDecoder1.free;
  3694.                 end;
  3695.            end;
  3696. _Add : begin
  3697.        IDUUEncoder1 := TIDUUEncoder.Create(nil);
  3698.        Fs := TFileStream.Create(Addoptions.add_files.Strings[0], fmOPENREAD);
  3699.        with IDUUEncoder1 do
  3700.         begin
  3701.         AutocompleteInput := False;
  3702.         Reset;
  3703.         Filename := Extractfilename(Addoptions.add_files.strings[0]);
  3704.         AssignFile(tf, Archive_List[0]._arcname);
  3705.         Rewrite(tf);
  3706.         writeln(tf,'table');
  3707.         i := length(IDUUEncoder1.CodingTable) div 2;
  3708.         Writeln(tf,Copy(IDUUEncoder1.CodingTable,0,i));
  3709.         Writeln(tf,Copy(IDUUEncoder1.CodingTable,i+1,length(IDUUEncoder1.CodingTable)-i));
  3710.                 Repeat
  3711.                 count := fs.Read(t,45);
  3712.                 SetBufferSize(count);
  3713.                 s := CodeString(t);
  3714.                 Fetch(s, ';');
  3715.                 write(tf, s);
  3716.                 Until count < 45;
  3717.         s := CompletedInput;
  3718.         Fetch(s, ';');
  3719.         if s <> '' then write(tf, s);
  3720.         Free;
  3721.  
  3722.         Closefile(tf);
  3723.         Fs.Free;
  3724.         end;
  3725.         end;
  3726. {
  3727. _Add : begin
  3728.        IDUUEncoder1 := TIDUUEncoder.Create(nil);
  3729.        with IDUUEncoder1 do
  3730.        begin
  3731.         AutocompleteInput := False;
  3732.         filter := DEFAULTFILTER;
  3733.         Reset;
  3734.         SetCodingtable(filter);
  3735.         AssignFile(bf, Addoptions.add_files.Strings[0]);
  3736.         System.Reset(bf, 1);
  3737.         Filename := Extractfilename(Addoptions.add_files.strings[0]);
  3738.         AssignFile(tf, Archive_List[0]._arcname);
  3739.         Rewrite(tf);
  3740.         SetLength(t, 45);
  3741.         BlockRead(bf, t[1], 45, count);
  3742.         SetLength(t, count);
  3743.         while count > 0 do
  3744.         begin
  3745.         // set coding buffer size to the number of bytes read (up to 45)
  3746.         SetBufferSize(Length(t));
  3747.         s := CodeString(t);
  3748.         Fetch(s, ';');
  3749.         if s <> '' then
  3750.               write(tf, s);
  3751.         BlockRead(bf, t[1], 45, count);
  3752.         SetLength(t, count);
  3753.         end;
  3754.  
  3755.         // to end coding and get an "end" line
  3756.         s := CompletedInput;
  3757.         Fetch(s, ';');
  3758.         if s <> ''
  3759.           then write(tf, s);
  3760.         Free;
  3761.         end;
  3762.         CloseFile(bf);
  3763.         CloseFile(tf);
  3764.        end;
  3765. }
  3766. end;
  3767. end;
  3768. {$ENDIF}
  3769.  
  3770. {$IFDEF USE_INDY}
  3771. function TCakDir.ProcessXXE(processwhat : worktype) : boolean;
  3772. var IDXXDecoder1 : TIDXXDecoder;
  3773. //    IDXXEncoder1 : TIDXXEncoder;
  3774.     s,k,x : string;
  3775. //    t : array[0..44] of Char;
  3776.     tf : textfile;
  3777.     fn : string;
  3778.     loc,i,fz{,count} : integer;
  3779.     bf : file;
  3780.     //Fs : TFileStream;
  3781. begin
  3782. result := true;
  3783. Case processwhat of
  3784. _LoadContents : begin
  3785.                 Total_Contents := 0;
  3786.                 For i := processfrom to processto do
  3787.                 begin
  3788.                 Assignfile(tf,Archive_List[i]._arcname);
  3789.                 Reset(tf);
  3790.                 fz := Filesize(tf);
  3791.                 fn := '';
  3792.                 IDXXDecoder1 := TIDXXDecoder.Create(nil);
  3793.  
  3794.                 with IDXXDecoder1 do
  3795.                         begin
  3796.                         AutocompleteInput := False;
  3797.                         Reset;
  3798.                         while not eof(tf) and (fn = '') do
  3799.                         begin
  3800.                         readln(tf,k);
  3801.                         s := CodeString(k+#13);
  3802.                         s := CompletedInput;
  3803.                         s := CompletedInput;
  3804.                         if filename <> '' then fn := filename;
  3805.                         end;
  3806.                         end;
  3807.                 Closefile(tf);
  3808.                 IDXXDecoder1.free;
  3809.  
  3810.                 Inc(Total_Contents);
  3811.                 SetLength(Archive_Contents, Total_Contents + 5);
  3812.                 Archive_Contents[Total_Contents-1]._Filename := fn;
  3813.                 loc := returnicontype(fn);
  3814.                 Archive_Contents[Total_Contents-1]._Fileicon := loc;
  3815.                 Archive_Contents[Total_Contents-1]._FileType := Filetype.strings[loc];
  3816.  
  3817.                 Archive_Contents[Total_Contents-1]._FileRatio := 100;
  3818.                 Archive_Contents[Total_Contents-1]._encrypted := FALSE;
  3819.                 Archive_Contents[Total_Contents-1]._FileSize := fz;
  3820.                 Archive_Contents[Total_Contents-1]._FilePackedSize := fz;
  3821.                 Archive_Contents[Total_Contents-1]._FileCRC :=  '';
  3822.                 Archive_Contents[Total_Contents-1]._FileDefPath := '';
  3823.                 Archive_Contents[Total_Contents-1]._FileArchive := Archive_List[i]._ARCname;
  3824.                 end;
  3825.                 end;
  3826. _Extract : begin
  3827.  
  3828.            For i := processfrom to processto do
  3829.                 if ExtractOptions.extr_Extractall or Archive_Contents[i]._Selected then
  3830.                 begin
  3831.                 Assignfile(tf,Archive_List[i]._arcname);
  3832.                 Reset(tf);
  3833.                 fn := '';
  3834.                 IDXXDecoder1 := TIDXXDecoder.Create(nil);
  3835.                 with IDXXDecoder1 do
  3836.                         begin
  3837.                         while not eof(tf) and (fn = '') do
  3838.                         begin
  3839.                         AutocompleteInput := False;
  3840.                         Reset;
  3841.                         readln(tf,k);
  3842.  
  3843.                         if Uppercase(k) = 'TABLE' then
  3844.                         begin
  3845.                         x := '';
  3846.                         s := '';
  3847.                         While not eof(tf) and not (Uppercase(Copy(s,0,9)) = 'BEGIN 644') do
  3848.                                 begin
  3849.                                 x := x + s;
  3850.                                 readln(tf,s);
  3851.                                 end;
  3852.                         SetCodingtable(x);
  3853.                         k := s;
  3854.                         end;
  3855.  
  3856.                         if Uppercase(Copy(k,0,9)) = 'BEGIN 644' then
  3857.                         begin
  3858.                         s := CodeString(k+#13);
  3859.                         s := CompletedInput;
  3860.                         s := CompletedInput;
  3861.                         if filename <> '' then fn := filename;
  3862.                         end;
  3863.                         end;
  3864.  
  3865.                         s := Appendslash(extractoptions.extr_to) + fn;
  3866.                         AssignFile(bf, s);
  3867.                         Rewrite(bf,1);
  3868.  
  3869.                         While not eof(tf) do
  3870.                         begin
  3871.                          Readln(tf,k);
  3872.                          k := CodeString(k  +#13#10);
  3873.                          Fetch(k, ';');
  3874.                          BlockWrite(bf, k[1], Length(k));
  3875.                          end;
  3876.  
  3877.                          repeat
  3878.                          k := CompletedInput;
  3879.                          Fetch(k, ';');
  3880.                          BlockWrite(bf, k[1], Length(k));
  3881.                          until k = '';
  3882.                        end;
  3883.  
  3884.                          Closefile(tf);
  3885.                          Closefile(bf);
  3886.                         IDXXDecoder1.free;
  3887.                 end;
  3888.            end;
  3889. end;
  3890. end;
  3891. {$ENDIF}
  3892.  
  3893. {$IFDEF USE_INDY}
  3894. function TCakDir.ProcessB64(processwhat : worktype) : boolean;
  3895. var IDBase64Decoder1 : TIDBase64Decoder;
  3896. //    IDXXEncoder1 : TIDXXEncoder;
  3897.       s,k : string;
  3898. //    t : array[0..44] of Char;
  3899.       tf : textfile;
  3900.       fn : string;
  3901.       loc,i,fz{,count} : integer;
  3902.       bf : file;
  3903.     //Fs : TFileStream;
  3904. begin
  3905. result := true;
  3906. Case processwhat of
  3907. _LoadContents : begin
  3908.                 Total_Contents := 0;
  3909.                 For i := processfrom to processto do
  3910.                 begin
  3911.                 Assignfile(tf,Archive_List[i]._arcname);
  3912.                 Reset(tf);
  3913.                 fz := Filesize(tf);
  3914.                 fn := '';
  3915.                 IDBase64Decoder1 := TIDBase64Decoder.Create(nil);
  3916.  
  3917.                 with IDBase64Decoder1 do
  3918.                         begin
  3919.                         AutocompleteInput := False;
  3920.                         Reset;
  3921.                         while not eof(tf) and (fn = '') do
  3922.                         begin
  3923.                         readln(tf,k);
  3924.                         s := CodeString(k+#13);
  3925.                         s := CompletedInput;
  3926.                         s := CompletedInput;
  3927.                         if filename <> '' then fn := filename;
  3928.                         end;
  3929.                         end;
  3930.                 Closefile(tf);
  3931.                 IDBase64Decoder1.free;
  3932.  
  3933.                 Inc(Total_Contents);
  3934.                 SetLength(Archive_Contents, Total_Contents + 5);
  3935.                 Archive_Contents[Total_Contents-1]._Filename := fn;
  3936.                 loc := returnicontype(fn);
  3937.                 Archive_Contents[Total_Contents-1]._Fileicon := loc;
  3938.                 Archive_Contents[Total_Contents-1]._FileType := Filetype.strings[loc];
  3939.  
  3940.                 Archive_Contents[Total_Contents-1]._FileRatio := 100;
  3941.                 Archive_Contents[Total_Contents-1]._encrypted := FALSE;
  3942.                 Archive_Contents[Total_Contents-1]._FileSize := fz;
  3943.                 Archive_Contents[Total_Contents-1]._FilePackedSize := fz;
  3944.                 Archive_Contents[Total_Contents-1]._FileCRC :=  '';
  3945.                 Archive_Contents[Total_Contents-1]._FileDefPath := '';
  3946.                 Archive_Contents[Total_Contents-1]._FileArchive := Archive_List[i]._ARCname;
  3947.                 end;
  3948.                 end;
  3949. _Extract : begin
  3950.  
  3951.            For i := processfrom to processto do
  3952.                 if ExtractOptions.extr_Extractall or Archive_Contents[i]._Selected then
  3953.                 begin
  3954.                 Assignfile(tf,Archive_List[i]._arcname);
  3955.                 Reset(tf);
  3956.                 fn := '';
  3957.                 IDBase64Decoder1 := TIDBase64Decoder.Create(nil);
  3958.                 with IDBase64Decoder1 do
  3959.                         begin
  3960.                         readln(tf,k);
  3961.                         s := CodeString(k+#13);
  3962.                         s := CompletedInput;
  3963.                         s := CompletedInput;
  3964.                         if filename <> '' then fn := filename;
  3965.  
  3966.                         s := Appendslash(extractoptions.extr_to) + fn;
  3967.                         AssignFile(bf, s);
  3968.                         Rewrite(bf,1);
  3969.  
  3970.                         While not eof(tf) do
  3971.                         begin
  3972.                          Readln(tf,k);
  3973.                          k := CodeString(k  +#13#10);
  3974.                          Fetch(k, ';');
  3975.                          BlockWrite(bf, k[1], Length(k));
  3976.                          end;
  3977.  
  3978.                          repeat
  3979.                          k := CompletedInput;
  3980.                          Fetch(k, ';');
  3981.                          BlockWrite(bf, k[1], Length(k));
  3982.                          until k = '';
  3983.                        end;
  3984.  
  3985.                          Closefile(tf);
  3986.                          Closefile(bf);
  3987.                         IDBase64Decoder1.free;
  3988.                 end;
  3989.            end;
  3990. end;
  3991. end;
  3992. {$ENDIF}
  3993.  
  3994. {$IFDEF USE_ZIP}
  3995. procedure TCakDir.Load_ZIP_DLL;
  3996. begin
  3997.         if assigned(Zipdir) then exit;
  3998.         Zipdir := TZipMaster.Create(self);
  3999.         Zipdir.OnProgress := ZipDirProgress;
  4000.         Zipdir.OnMessage := ZipDirMessage;
  4001.         Zipdir.OnPasswordError := ZipDirPwdErr;
  4002.         Zipdir.OnExtractOverwrite := ZipDirExtrOver;
  4003.         //Zipdir.Unattended := false;
  4004.         Zipdir.Unattended := true;
  4005.         //Zipdir.Password := 'PASS';
  4006. end;
  4007. {$ENDIF}
  4008. {$IFDEF USE_ZIP}
  4009. procedure TCakDir.UnLoad_ZIP_DLL;
  4010. begin
  4011.         if assigned(Zipdir) then
  4012.         Zipdir.Free;
  4013.         Zipdir := nil;
  4014. end;
  4015. {$ENDIF}
  4016.  
  4017. {$IFDEF USE_ACE2}
  4018. procedure Ace2ErrorMsg(acode : integer ; amessage : string);
  4019. begin
  4020.         if amessage <> '' then
  4021.         begin
  4022.         Ace2Msg := amessage;
  4023.         Ace2Code := acode;
  4024.         end;
  4025. end;
  4026.  
  4027. procedure Ace2Progress(filesize, totalsize : integer);
  4028. begin
  4029.  
  4030. end;
  4031. function Ace2InfoProc(Info : pACEInfoCallbackProcStruc) : integer;
  4032. var
  4033.   InfoStr : string;
  4034. begin
  4035.   case Info^.Global.Code of
  4036.     ACE_CALLBACK_INFO_FILELISTCREATE:
  4037.     begin
  4038.       InfoStr := 'Creating file list';
  4039.     end;
  4040.     ACE_CALLBACK_INFO_FILELISTCREATEEND:
  4041.       InfoStr := 'Finished creating file list';
  4042.     ACE_CALLBACK_INFO_FILELISTADD:
  4043.       InfoStr := 'adding file to file list';
  4044.     else
  4045.       InfoStr := '';
  4046.   end;
  4047.   Result:=ACE_CALLBACK_RETURN_OK;
  4048. end;
  4049.  
  4050. function Ace2HandleErrorGlobal(Error : pACECallbackGlobalStruc) : integer;
  4051. var
  4052.   ErrorStr : string;
  4053. begin
  4054.   Result := ACE_CALLBACK_RETURN_OK;
  4055.  
  4056.   case Error^.Code of
  4057.     ACE_CALLBACK_ERROR_MEMORY:
  4058.       ErrorStr := 'not enough memory';
  4059.     ACE_CALLBACK_ERROR_UNCSPACE:
  4060.       ErrorStr := 'could not detect available space on network drive';
  4061.     else
  4062.     begin
  4063.       ErrorStr := 'unknown';
  4064.       Result := ACE_CALLBACK_RETURN_CANCEL;
  4065.     end;
  4066.   end;
  4067.   MessageDlg('Error: ' + Errorstr, mtError, [mbOK], 0);
  4068. end;
  4069.  
  4070. function Ace2HandleErrorArchive(Error : pACECallbackArchiveStruc) : integer;
  4071. var
  4072.   ErrorStr : string;
  4073. begin
  4074.   Result   := ACE_CALLBACK_RETURN_OK;
  4075.   case Error^.Code of
  4076.     ACE_CALLBACK_ERROR_AV:
  4077.       ErrorStr := 'AV of archive %s invalid';
  4078.     ACE_CALLBACK_ERROR_OPENARCHIVEREAD:
  4079.       ErrorStr := 'could not open archive %s for reading';
  4080.     ACE_CALLBACK_ERROR_READARCHIVE:
  4081.       ErrorStr := 'error reading from archive %s';
  4082.     ACE_CALLBACK_ERROR_ARCHIVEBROKEN:
  4083.       ErrorStr := 'archive %s is broken';
  4084.     ACE_CALLBACK_ERROR_NOFILES:
  4085.       ErrorStr := 'no files specified';
  4086.     ACE_CALLBACK_ERROR_ISNOTANARCHIVE:
  4087.       ErrorStr := 'file is not an ACE archive';
  4088.     ACE_CALLBACK_ERROR_HIGHERVERSION:
  4089.       ErrorStr := 'this Dll version is not able to handle the archive';
  4090.     else
  4091.     begin
  4092.       ErrorStr := 'unknown';
  4093.       Result   := ACE_CALLBACK_RETURN_CANCEL;
  4094.     end;
  4095.   end;
  4096.   MessageDlg(ErrorStr + Error^.ArchiveData^.ArchiveName, mtError, [mbOK], 0);
  4097. end;
  4098.  
  4099. function Ace2HandleErrorArchivedFile(Error : pACECallbackArchivedFileStruc) : integer;
  4100. var
  4101.   ErrorStr : string;
  4102. begin
  4103.   Result   := ACE_CALLBACK_RETURN_OK;
  4104.   case Error^.Code of
  4105.     ACE_CALLBACK_ERROR_CREATIONNAMEINUSE:
  4106.       ErrorStr := 'could not extract %s: name used by directory';
  4107.     ACE_CALLBACK_ERROR_WRITE:
  4108.       ErrorStr := 'error writing %s';
  4109.     ACE_CALLBACK_ERROR_OPENWRITE:
  4110.       ErrorStr := 'error opening %s for writing';
  4111.     ACE_CALLBACK_ERROR_METHOD:
  4112.       ErrorStr := 'compression method not known to this Dll version';
  4113.     ACE_CALLBACK_ERROR_EXTRACTSPACE:
  4114.       ErrorStr := 'not enough space to extract %s';
  4115.     ACE_CALLBACK_ERROR_CREATION:
  4116.       ErrorStr := 'creation of %s failed (write-protection?)';
  4117.     else
  4118.     begin
  4119.       ErrorStr := 'unknown';
  4120.       Result   := ACE_CALLBACK_RETURN_CANCEL;
  4121.     end;
  4122.   end;
  4123.   MessageDlg(ErrorStr + Error^.FileData^.SourceFileName, mtError, [mbOK], 0);
  4124. end;
  4125.  
  4126. function Ace2HandleErrorRealFile(Error : pACECallbackRealFileStruc) : integer;
  4127. var
  4128.   ErrorStr : string;
  4129. begin
  4130.       ErrorStr := 'unknown';
  4131.       Result   := ACE_CALLBACK_RETURN_CANCEL;
  4132.       MessageDlg(ErrorStr + Error^.FileName, mtError, [mbOK], 0);
  4133. end;
  4134.  
  4135. function Ace2HandleErrorSpace(Error : pACECallbackSpaceStruc) : integer;
  4136. var
  4137.   ErrorStr : string;
  4138. begin
  4139.       ErrorStr := 'unknown';
  4140.       Result   := ACE_CALLBACK_RETURN_CANCEL;
  4141.       MessageDlg(ErrorStr + Error^.Directory, mtError, [mbOK], 0);
  4142. end;
  4143.  
  4144. function Ace2HandleErrorSFXFile(Error : pACECallbackSFXFileStruc) : integer;
  4145. var
  4146.   ErrorStr : string;
  4147. begin
  4148.       ErrorStr := 'unknown';
  4149.       Result   := ACE_CALLBACK_RETURN_CANCEL;
  4150.       MessageDlg(ErrorStr + Error^.SFXFileName, mtError, [mbOK], 0);
  4151. end;
  4152.  
  4153. function Ace2ErrorProc(Error : pACEErrorCallbackProcStruc) : integer;
  4154. begin
  4155.   ShowMessage('ErrorProc');
  4156.   case Error^.StructureType of
  4157.     ACE_CALLBACK_TYPE_GLOBAL:
  4158.       Result:= Ace2HandleErrorGlobal(@Error^.Global);
  4159.     ACE_CALLBACK_TYPE_ARCHIVE:
  4160.       Result:= Ace2HandleErrorArchive(@Error^.Archive);
  4161.     ACE_CALLBACK_TYPE_ARCHIVEDFILE:
  4162.       Result:= Ace2HandleErrorArchivedFile(@Error^.ArchivedFile);
  4163.     ACE_CALLBACK_TYPE_REALFILE:
  4164.       Result:= Ace2HandleErrorRealFile(@Error^.RealFile);
  4165.     ACE_CALLBACK_TYPE_SPACE:
  4166.       Result:= Ace2HandleErrorSpace(@Error^.Space);
  4167.     ACE_CALLBACK_TYPE_SFXFILE:
  4168.       Result:= Ace2HandleErrorSFXFile(@Error^.SFXFile);
  4169.     else
  4170.       Result:=ACE_CALLBACK_RETURN_CANCEL;
  4171.   end;
  4172.  
  4173. end;
  4174.  
  4175. function  Ace2HandleRequestGlobal(Request : pACECallbackGlobalStruc) : integer;
  4176. begin
  4177.   MessageDlg('unknown request', mtError, [mbOK], 0);
  4178.   Result:=ACE_CALLBACK_RETURN_CANCEL;
  4179. end;
  4180.  
  4181. function Ace2HandleRequestArchive(Request : pACECallbackArchiveStruc) : integer;
  4182. var
  4183.   RequestStr : string;
  4184. begin
  4185.   case Request^.Code of
  4186.     ACE_CALLBACK_REQUEST_CHANGEVOLUME:
  4187.       RequestStr := 'ready to process next volume'
  4188.     else
  4189.     begin
  4190.       MessageDlg('unknown request', mtError, [mbOK], 0);
  4191.       Result:=ACE_CALLBACK_RETURN_CANCEL;
  4192.       Exit;
  4193.     end;
  4194.   end;
  4195.   if MessageDlg(RequestStr, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  4196.     Result:=1
  4197.   else
  4198.     Result:=0; // False
  4199. end;
  4200.  
  4201. function Ace2HandleRequestArchivedFile(Request : pACECallbackArchivedFileStruc) : integer;
  4202. var
  4203.   RequestStr : string;
  4204. begin
  4205.   case Request^.Code of
  4206.     ACE_CALLBACK_REQUEST_OVERWRITE:
  4207.       RequestStr := 'overwrite existing file ' + Request^.FileData^.SourceFileName;
  4208.  
  4209.     ACE_CALLBACK_REQUEST_PASSWORD:
  4210.     begin
  4211.       RequestStr := Request^.FileData^.SourceFileName +
  4212.                     ' is encrypted, using "testpassword" as password';
  4213.       Request^.GlobalData^.DecryptPassword := 'testpassword';
  4214.     end
  4215.     else
  4216.     begin
  4217.       MessageDlg('unknown request', mtError, [mbOK], 0);
  4218.       Result:=ACE_CALLBACK_RETURN_CANCEL;
  4219.       Exit;
  4220.     end
  4221.   end;
  4222.   if MessageDlg(RequestStr, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  4223.     Result:=ACE_CALLBACK_RETURN_OK
  4224.   else
  4225.     Result:=ACE_CALLBACK_RETURN_NO; // False
  4226. end;
  4227.  
  4228. function Ace2HandleRequestRealFile(Request : pACECallbackRealFileStruc) : integer;
  4229. begin
  4230.   MessageDlg('unknown request', mtError, [mbOK], 0);
  4231.   Result:=ACE_CALLBACK_RETURN_CANCEL;
  4232. end;
  4233.  
  4234. function Ace2RequestProc(Request : pACERequestCallbackProcStruc) : integer;
  4235. begin
  4236.   case Request^.StructureType of
  4237.     ACE_CALLBACK_TYPE_GLOBAL:
  4238.       Result:=Ace2HandleRequestGlobal(@Request^.Global);
  4239.     ACE_CALLBACK_TYPE_ARCHIVE:
  4240.       Result:=Ace2HandleRequestArchive(@Request^.Archive);
  4241.     ACE_CALLBACK_TYPE_ARCHIVEDFILE:
  4242.       Result:=Ace2HandleRequestArchivedFile(@Request^.ArchivedFile);
  4243.     ACE_CALLBACK_TYPE_REALFILE:
  4244.       Result:=Ace2HandleRequestRealFile(@Request^.RealFile);
  4245.     else
  4246.       Result:=ACE_CALLBACK_RETURN_CANCEL;
  4247.   end;
  4248. end;
  4249.  
  4250. function Ace2HandleStateStartArchive(Archive : pACECallbackArchiveStruc) : integer;
  4251. var
  4252.   ActionStr : string;
  4253. begin
  4254.   case Archive^.Operation of
  4255.     ACE_CALLBACK_OPERATION_LIST:
  4256.       ActionStr := 'Listing ' + Archive^.ArchiveData^.ArchiveName;
  4257.     ACE_CALLBACK_OPERATION_TEST:
  4258.       ActionStr := 'Testing ' + Archive^.ArchiveData^.ArchiveName;
  4259.     ACE_CALLBACK_OPERATION_EXTRACT:
  4260.       ActionStr := 'Extracting ' + Archive^.ArchiveData^.ArchiveName;
  4261.     else
  4262.       ActionStr := 'unknown operation on ' + Archive^.ArchiveData^.ArchiveName;
  4263.   end;
  4264.  
  4265.   Result:=ACE_CALLBACK_RETURN_OK;
  4266. end;
  4267.  
  4268. function Ace2HandleStateStartFile(ArchivedFile : pACECallbackArchivedFileStruc) : integer;
  4269. var
  4270.   ActionStr : string;
  4271. begin
  4272.   case ArchivedFile^.Operation of
  4273.     ACE_CALLBACK_OPERATION_LIST:
  4274.     begin
  4275.       ActionStr := 'Found';
  4276.     end;
  4277.     ACE_CALLBACK_OPERATION_TEST:
  4278.       ActionStr := 'Testing';
  4279.     ACE_CALLBACK_OPERATION_ANALYZE:
  4280.       ActionStr := 'Analyzing';
  4281.     ACE_CALLBACK_OPERATION_EXTRACT:
  4282.     begin
  4283.       ActionStr := 'Extracting';
  4284.       Ace2ErrorMsg(0,ActionStr + ' ' +  ArchivedFile^.FileData^.SourceFileName);
  4285.       //Form1.Gauge1.MaxValue:=ArchivedFile^.FileData^.Size;
  4286.     end;
  4287.     else
  4288.       ActionStr := 'unknown operation on';
  4289.   end;
  4290.  
  4291.   Result:=ACE_CALLBACK_RETURN_OK;
  4292. end;
  4293.  
  4294. procedure Ace2DisplayProgress(FileProcessedSize,
  4295.                              FileSize,
  4296.                              TotalProcessedSize,
  4297.                              TotalSize : int64);
  4298.  
  4299.  
  4300. var
  4301.   s          : string;
  4302.   lKBWritten : int64;
  4303. begin
  4304. // Display/calculate progress for ACE extracting
  4305.   Application.ProcessMessages;
  4306.   lKBWritten := TotalProcessedSize;
  4307.  
  4308.   Ace2Progress(lKBwritten,TotalSize);
  4309.  
  4310.   Application.ProcessMessages;
  4311. end; // AceDisplayProgress
  4312.  
  4313. function Ace2StateProc(State : pACEStateCallbackProcStruc) : integer;
  4314. begin
  4315.  
  4316.   if Stopprocess then
  4317.   begin
  4318.     Result:=ACE_CALLBACK_RETURN_CANCEL;
  4319.     Exit;
  4320.   end;
  4321.  
  4322.   case State^.StructureType of
  4323.     ACE_CALLBACK_TYPE_ARCHIVE:
  4324.     begin
  4325.       if (State^.Archive.Code = ACE_CALLBACK_STATE_STARTARCHIVE)
  4326.       and (State^.Archive.Operation = ACE_CALLBACK_OPERATION_EXTRACT)
  4327.           then
  4328.       begin
  4329. //        frmUnpack.lblCurrentFile.Caption:=State^.Archive.ArchiveData^.ArchiveName;
  4330.         // nixe
  4331.       end;
  4332.     end;
  4333.     ACE_CALLBACK_TYPE_ARCHIVEDFILE:
  4334.     begin
  4335.       case State^.ArchivedFile.Code of
  4336.         ACE_CALLBACK_STATE_STARTFILE:
  4337.         begin
  4338.           result:=Ace2HandleStateStartFile(@State^.ArchivedFile);
  4339.           exit;
  4340.         end;
  4341.         ACE_CALLBACK_STATE_ENDNOCRCCHECK:
  4342.         begin
  4343.         end;
  4344.       end;
  4345.     end;
  4346.     ACE_CALLBACK_TYPE_PROGRESS:
  4347.     begin
  4348.       if State^.Progress.Code = ACE_CALLBACK_STATE_PROGRESS then
  4349.       begin
  4350.         Ace2DisplayProgress(State^.Progress.ProgressData^.FileProcessedSize,
  4351.                            State^.Progress.ProgressData^.FileSize,
  4352.                            State^.Progress.ProgressData^.TotalProcessedSize,
  4353.                            State^.Progress.ProgressData^.TotalSize);
  4354.  
  4355.       // nixe
  4356. //      ShowMessage('nixe    processed: ' + IntToStr(State^.Progress.ProgressData^.FileProcessedSize) +
  4357. //                    ' of ' + IntToStr(State^.Progress.ProgressData^.FileSize)  +
  4358. //                    ' bytes (' + IntToStr(State^.Progress.ProgressData^.TotalProcessedSize) +
  4359. //                    ' of ' + IntToStr(State^.Progress.ProgressData^.TotalSize) + ' bytes)');
  4360.       end;
  4361.     end;
  4362.     ACE_CALLBACK_TYPE_CRCCHECK:
  4363.     begin
  4364.       if State^.CRCCheck.Code = ACE_CALLBACK_STATE_ENDCRCCHECK then
  4365.       begin
  4366.         if not State^.CRCCheck.CRCOk then
  4367.           MessageDlg('CRC-check error', mtError, [mbOK], 0);
  4368.       end;
  4369.     end;
  4370.   end;
  4371.  
  4372.   Result:=ACE_CALLBACK_RETURN_OK;
  4373. end;
  4374. {$ENDIF}
  4375.  
  4376. {$IFDEF USE_ACE2}
  4377. function TCakdir.CallAceInitDll : integer;
  4378. var
  4379.   DllData  : tACEInitDllStruc;
  4380.   zTempDir : array[0..255] of char;
  4381. begin
  4382.   FillChar(DllData, SizeOf(DllData), 0);
  4383.   DllData.GlobalData.MaxArchiveTestBytes := $1ffFF;
  4384.   DllData.GlobalData.MaxFileBufSize      := $2ffFF;
  4385.   DllData.GlobalData.Comment.BufSize     := SizeOf(CommentBuf)-1;
  4386.   DllData.GlobalData.Comment.Buf         := @CommentBuf;
  4387.  
  4388.   GetTempPath(255, @zTempDir);
  4389.   DllData.GlobalData.TempDir             := @zTempDir;
  4390.  
  4391.   DllData.GlobalData.InfoCallbackProc    := @Ace2InfoProc;
  4392.   DllData.GlobalData.ErrorCallbackProc   := @Ace2ErrorProc;
  4393.   DllData.GlobalData.RequestCallbackProc := @Ace2RequestProc;
  4394.   DllData.GlobalData.StateCallbackProc   := @Ace2StateProc;
  4395.   
  4396.   Result:=ACEInitDll(@DllData);
  4397. end;
  4398. {$ENDIF}
  4399.  
  4400. {$IFDEF USE_ACE}
  4401. procedure TCakDir.Load_ACE_DLL;
  4402. var i : integer;
  4403. begin
  4404.         if not assigned(Acedir) then
  4405.         Acedir := TdAce.Create(self);
  4406.         Acedir.Path2UnAceDll := Extractfilepath(ParamStr(0));
  4407.         Acedir.OnList := AceDirList;
  4408.         Acedir.OnError := AceDirError;
  4409.         Acedir.OnExtracting := AceDirExtracting;
  4410.         {$IFDEF USE_ACE2}
  4411.         if LoadAceDll('') then
  4412.         begin
  4413.         i:= CallAceInitDll;
  4414.         if i <> 0 then
  4415.         Ace2ErrorMsg(0,'Unable to initialize unace2.dll. Error code: '+IntToStr(i));
  4416.         end else
  4417.         Ace2ErrorMsg(0,'Unable to load unace2.dll!');
  4418.         {$ENDIF}
  4419. end;
  4420. {$ENDIF}
  4421.  
  4422. {$IFDEF USE_ACE}
  4423. procedure TCakDir.UnLoad_ACE_DLL;
  4424. begin
  4425.         if not assigned(Acedir) then exit;
  4426.         Acedir.OnList := nil;
  4427.         Acedir.OnError := nil;
  4428.         Acedir.OnExtracting := nil;
  4429.         {$IFDEF USE_ACE2}
  4430.         UnLoadAceDll
  4431.         {$ENDIF}
  4432.         //Acedir.Free; //Crash here...
  4433.         //Acedir := nil;
  4434. end;
  4435. {$ENDIF}
  4436.  
  4437. {$IFDEF USE_RAR}
  4438. procedure TCakDir.Load_RAR_DLL;
  4439. var i : integer;
  4440. begin
  4441.         if not assigned(Rardir) then
  4442.         Rardir := TdRar.Create(self);
  4443.         Rardir.Path2UnRarDll := Extractfilepath(ParamStr(0));
  4444.         Rardir.OnList := RarDirList;
  4445.         Rardir.OnError := RarDirError;
  4446.         Rardir.OnExtracting := RarDirExtracting;
  4447.         //Rardir.OnVolumeChange := RarDirVolumeChange;
  4448. end;
  4449. {$ENDIF}
  4450.  
  4451. {$IFDEF USE_RAR}
  4452. procedure TCakDir.UnLoad_Rar_DLL;
  4453. begin
  4454.         if not assigned(Rardir) then exit;
  4455.         Rardir.OnList := nil;
  4456.         Rardir.OnError := nil;
  4457.         Rardir.OnExtracting := nil;
  4458. end;
  4459. {$ENDIF}
  4460. {$IFDEF USE_RS}
  4461. procedure TCakDir.Load_RS_DLL;
  4462. begin
  4463.         if not assigned(Rsdir) then
  4464.         RsDir := TResource.Create(Self);
  4465.         RsDir.OnaddLog := RsDirAddLog;
  4466.         RsDir.OnCentralDirChange := RsDirCDChange;
  4467. end;
  4468. {$ENDIF}
  4469.  
  4470. procedure TCakDir.Load_CAB_DLL;
  4471. begin
  4472.         if not assigned(CabFH) then
  4473.         CabFH  := TStreamCabinetFileHandler.Create(Self);
  4474.         if not assigned(CabWDir) then
  4475.         begin
  4476.         CabWDir := TCabinetWriter.Create(Self);
  4477.         CabWDir.FileHandler := CabFH;
  4478.         CabWDir.OnFilePlacedEvent := CabWFilePlaced;
  4479.         end;
  4480.         if not assigned(CabRDir) then
  4481.         begin
  4482.         CabRDir := TCabinetReader.Create(Self);
  4483.         CabRDir.FileHandler := CabFH;
  4484.         CabRDir.OnCloseCopiedFile := CabRDirCloseCopied;
  4485.         CabRDir.OnCopyFile := CabRCopyFile;
  4486.         CabRDir.OnNextCabinet := CabRNextCab;
  4487.         end;
  4488.         CabMode :=  _CFList;
  4489. end;
  4490. procedure TCakDir.UNLoad_CAB_DLL;
  4491. begin
  4492.         if assigned(CabWDir) then
  4493.         begin
  4494.         CabWDir.Free;
  4495.         CabWDir := nil
  4496.         end;
  4497.         if assigned(CabRDir) then
  4498.         begin
  4499.         CabRDir.Free;
  4500.         CabRDir := nil
  4501.         end;
  4502.         if assigned(CabFH) then
  4503.         begin
  4504.         CabFH.Free;
  4505.         CabFH := nil
  4506.         end;
  4507. end;
  4508.  
  4509. procedure TCakDir.Load_EXT_DLL;
  4510. begin
  4511.         if not assigned(CakExt) then
  4512.         CakExt := TCakExt.Create(self);
  4513.         CakExt.Logfile := CakExtLogfile;
  4514. end;
  4515.  
  4516. procedure TCakDir.UNLoad_EXT_DLL;
  4517. begin
  4518.         if assigned(CakExt) then
  4519.         begin
  4520.         CakExt.free;
  4521.         CakExt := nil;
  4522.         end;
  4523. end;
  4524.  
  4525. procedure TCakdir.SetScriptPath(path : string);
  4526. begin
  4527.         LOAD_EXT_DLL;
  4528.         CakExt.ScriptDirectory := path;
  4529.         cakext.RePollScriptDirectory;
  4530.         TreatasExt := Cakext.Supportformats;
  4531. end;
  4532.  
  4533. {$IFDEF USE_RS}
  4534. procedure TCakDir.UnLoad_RS_DLL;
  4535. begin
  4536.         if not assigned(Rsdir) then exit;
  4537.         Rsdir.OnaddLog := nil;
  4538.         Rsdir.Free;
  4539.         Rsdir := nil;
  4540. end;
  4541. {$ENDIF}
  4542.  
  4543. {$IFDEF USE_WINEXT}
  4544. procedure TCakDir.GetFileType(filename : string; var info1,info2, info3 : string);
  4545. var i : integer;
  4546.     aExinfo : ExInfo;
  4547. begin
  4548.         info1 := '';
  4549.         info2 := '';
  4550.         info3 := '';
  4551.         i := -1;
  4552. if Winex32.DLLLoaded then
  4553.         i := WinExGetInfo(PCHAR(filename),
  4554.                          BUFFSIZE_6000,
  4555.                          aExinfo,
  4556.                          0);
  4557.         if i = 0 then
  4558.                 begin
  4559.                 info1 := aExinfo.szFileEx;
  4560.                 info2 := aExinfo.szExInfo1;
  4561.                 info3 := aExinfo.szExInfo2;
  4562.                 end;
  4563. end;
  4564. {$ENDIF}
  4565.  
  4566. {$IFDEF USE_WINEXT}
  4567. function TCakDir.GetARCtype2(archivename : string) : supporttype;
  4568. var i : integer;
  4569.     k : string;
  4570.     aExinfo : ExInfo;
  4571. begin
  4572.         Result := _WIT;
  4573.         if Winex32.DLLLoaded then
  4574.         begin
  4575.         i := WinExGetInfo(PCHAR(Archivename),
  4576.                          BUFFSIZE_6000,
  4577.                          aExinfo,
  4578.                          0);
  4579.         if i = 0 then
  4580.         begin
  4581.         k := aExinfo.szExInfo1;
  4582.         k := trim(k);
  4583.         k := Uppercase(Copy(k,0,3));
  4584.         if k = WinEXT_ZIP then result := _ZIP else
  4585.         if k = WinEXT_CAB then result := _CAB else
  4586.         if k = WinEXT_LHA then result := _LHA else
  4587.         if k = WinEXT_ARJ then result := _ARJ else
  4588.         if k = WinEXT_TAR then result := _TAR else
  4589.         if k = WinEXT_BZ2 then result := _BZ2;
  4590.         end;
  4591.         end;
  4592.         if Result = _WIT then
  4593.                 Result := GetArctype1(Archivename);
  4594. end;
  4595. {$ENDIF}
  4596.  
  4597. function TCakDir.GetARCtype1(archivename : string) : supporttype;
  4598. var ext : string;
  4599. begin
  4600.          ext := Uppercase(Extractfileext(archivename)) + ' ';
  4601.          if (ext = ' ') then Result := _WIT else
  4602.          if pos(ext,Uppercase(AsZip)+ ' ') > 0 then Result := _Zip else
  4603.          if pos(ext,Uppercase(AsAks)+ ' ') > 0 then Result := _Aks else
  4604.          if pos(ext,Uppercase(AsCab)+ ' ') > 0 then Result := _Cab else
  4605.          if pos(ext,Uppercase(AsRar)+ ' ') > 0 then Result := _Rar else
  4606.          if pos(ext,Uppercase(AsLha)+ ' ') > 0 then Result := _Lha else
  4607.          if pos(ext,Uppercase(AsArj)+ ' ') > 0 then Result := _Arj else
  4608.          if pos(ext,Uppercase(AsAce)+ ' ') > 0 then Result := _Ace else
  4609.          if pos(ext,Uppercase(AsTar)+ ' ') > 0 then Result := _Tar else
  4610.          if pos(ext,Uppercase(AsTgz)+ ' ') > 0 then Result := _Tgz else
  4611.          if pos(ext,Uppercase(AsBz2)+ ' ') > 0 then Result := _Bz2 else
  4612.          if pos(ext,Uppercase(AsBel)+ ' ') > 0 then Result := _Bel else
  4613.          if pos(ext,Uppercase(AsGca)+ ' ') > 0 then Result := _Gca else
  4614.          if pos(ext,Uppercase(AsBza)+ ' ') > 0 then Result := _Bza else
  4615.          if pos(ext,Uppercase(AsCzip)+ ' ') > 0 then Result := _Czip else
  4616.          if pos(ext,Uppercase(AsRs)+ ' ') > 0 then Result := _Rs else
  4617.          if pos(ext,Uppercase(AsYz1)+ ' ') > 0 then Result := _Yz1 else
  4618.          if pos(ext,Uppercase(AsUue)+ ' ') > 0 then Result := _Uue else
  4619.          if pos(ext,Uppercase(AsXxe)+ ' ') > 0 then Result := _Xxe else
  4620.          if pos(ext,Uppercase(AsB64)+ ' ') > 0 then Result := _B64 else
  4621.          if pos(ext,Uppercase(AsPak)+ ' ') > 0 then Result := _Pak else
  4622.          Result := _WIT;
  4623.  
  4624.          if Result = _WIT then
  4625.                 if pos(ext,Uppercase(TreatAsExt)) > 0 then Result := _EXT;
  4626. end;
  4627.  
  4628. function TCakDir.GetARCtype(archivename : string) : supporttype;
  4629. begin
  4630.         {$IFDEF USE_WINEXT}
  4631.         Result := GetARCtype2(Archivename);
  4632.         {$ELSE}
  4633.         Result := GetARCtype1(Archivename);
  4634.         {$ENDIF}
  4635. end;
  4636.  
  4637. function TCakDir.AskOverwrite(forfile : string) : boolean;
  4638. var i : integer;
  4639.     DoOverwrite : boolean;
  4640.     overwrite,applytoall : boolean;
  4641. begin
  4642.         DoOverwrite := false;
  4643.         if ExtractOptions.extr_OverWrite then DoOverwrite := true else
  4644.         if overwriteall = 1 then DoOverwrite := true else
  4645.         if overwriteall = 2 then DoOverwrite := false else
  4646.         if assigned(FOnOver) then
  4647.         begin
  4648.         FOnOver(nil,ForFile,overwrite,applytoall);
  4649.                 Dooverwrite := overwrite;
  4650.                 if applytoall then
  4651.                 if overwrite then
  4652.                         overwriteall := 1 else
  4653.                         overwriteall := 2;
  4654.         end else
  4655.         begin
  4656.         i := MessageDlg('Overite ' + Forfile + '?', mtWarning, [mbYes, mbNo, mbYesToAll, mbNoToAll], 0);
  4657.         Case i of
  4658.         MrYes : DoOverwrite := True;
  4659.         MrNo : DoOverwrite := False;
  4660.         MrYestoAll : Begin DoOverwrite := True; overwriteall := 1; end;
  4661.         MrNotoAll : Begin DoOverwrite := False; overwriteall := 2; end;
  4662.         end;
  4663.         end;
  4664.         Result := DoOverwrite;
  4665. end;
  4666.  
  4667. function TCakDir.Compare(Item1, Item2: Contenttype; FSortforward : boolean; atype: Sortbytype): integer;
  4668. var
  4669.   Resu: integer;
  4670. begin
  4671.   try
  4672.     resu := 0;
  4673.     case atype of
  4674.         (* Filename Column     *)
  4675.       _FName:
  4676.         Resu := CompareText(item1._Filename, Item2._Filename);
  4677.       _FType :
  4678.         Resu := CompareText(item1._Filetype  , Item2._Filetype);
  4679.       _FDefPath :
  4680.         Resu := CompareText(item1._FileDefPath, item2._FileDefPath);
  4681.       _FArchive :
  4682.         CompareText(item1._FileArchive, Item2._FileArchive);
  4683.       _FSize :
  4684.         Resu := (Item1._FileSize - Item2._FileSize);
  4685.       _FPSize:
  4686.         Resu := (Item1._FilePackedSize - Item2._FilePackedSize);
  4687.       _FTime :
  4688.         Resu  := Round(item1._FileTime - item2._FileTime);
  4689.        _FCRC :
  4690.         CompareText(item1._FileCRC, Item2._FileCRC);
  4691.        _FRatio:
  4692.          Resu := (Item1._FileRatio - Item2._FileRatio);
  4693.     end;
  4694.   except
  4695.        Resu := 0;
  4696.   end;
  4697.   if resu = 0 then
  4698.     Resu := CompareText(item1._Filename, Item2._Filename);
  4699.   if resu = 0 then
  4700.     Resu := CompareText(item1._FileDefPath, Item2._FileDefPath);
  4701.   if FSortforward then Result := resu
  4702.   else
  4703.     Result := -Resu;
  4704. end;
  4705.  
  4706. procedure TCakDir.QuickSort(var Sortarray: array of Contenttype; size: integer;
  4707.   FSortforward : boolean; atype: Sortbytype);
  4708. var
  4709.   array1, array2, array3: array of Contenttype;
  4710.   middle: Contenttype;
  4711.   pivot, size1, size2, size3, i, j: integer;
  4712. begin
  4713.   if size <= 1 then exit;
  4714.   pivot  := size div 2;
  4715.   middle := Sortarray[pivot];
  4716.   Setlength(array1, size);
  4717.   Setlength(array2, size);
  4718.   Setlength(array3, size);
  4719.  
  4720.   size1 := 0;
  4721.   size2 := 0;
  4722.   size3 := 0;
  4723.   for i := 0 to size - 1 do
  4724.     if pivot <> i then
  4725.     begin
  4726.       j := Compare(Sortarray[i], middle, FSortforward, atype);
  4727.       if j > 0 then
  4728.       begin
  4729.         array1[size1] := sortarray[i];
  4730.         size1         := size1 + 1;
  4731.       end;
  4732.       if j < 0 then
  4733.       begin
  4734.         array2[size2] := sortarray[i];
  4735.         size2         := size2 + 1;
  4736.       end;
  4737.       if j = 0 then
  4738.       begin
  4739.         array3[size3] := sortarray[i];
  4740.         size3         := size3 + 1;
  4741.       end;
  4742.     end;
  4743.  
  4744.  
  4745.   if (size1 > 1) then
  4746.     QuickSort(array1, size1, FSortforward, atype);
  4747.   if (size2 > 1) then
  4748.     QuickSort(array2, size2, FSortforward, atype);
  4749.  
  4750.   Setlength(array1, size1);
  4751.   Setlength(array2, size2);
  4752.   Setlength(array3, size3);
  4753.  
  4754.   sortarray[size1] := middle;
  4755.  
  4756.   if size1 > 0 then
  4757.     for i := 0 to size1 - 1 do
  4758.       sortarray[i] := array1[i];
  4759.  
  4760.   if size3 > 0 then
  4761.     for i := 0 to size3 - 1 do
  4762.       sortarray[size1 + i + 1] := array3[i];
  4763.  
  4764.   if size2 > 0 then
  4765.     for i := 0 to size2 - 1 do
  4766.       Sortarray[size1 + size3 + i + 1] := array2[i];
  4767. end;
  4768.  
  4769.  
  4770.  
  4771. procedure TCakDir.Append_Archive_List(filename : string; appendto : integer);
  4772. var i : integer;
  4773. begin
  4774.         Inc(Total_Archive);
  4775.         SetLength(Archive_List,Total_Archive+1);
  4776.            for i := Total_Archive-1 downto appendto do
  4777.                     Archive_List[i] := Archive_List[i-1];
  4778.            Archive_List[appendto]._ArcName := filename;
  4779.            Archive_List[appendto]._ArcType := GetARCType(filename);
  4780. end;
  4781.  
  4782. procedure TCakDir.Sort_Archive_List(accending : boolean; atype: Sortbytype);
  4783. begin
  4784.         QuickSort(Archive_Contents,Total_Contents,NOT accending,atype);
  4785. end;
  4786.  
  4787. procedure TCakDir.Set_Archive_List(filename : string);
  4788. begin
  4789.         Clear_Archive_List;
  4790.         Inc(Total_Archive);
  4791.         SetLength(Archive_List,Total_Archive);
  4792.            Archive_List[Total_Archive-1]._Arcname := filename;
  4793.         if fileexists(filename) then
  4794.            Archive_List[Total_Archive-1]._ArcType := GetARCType(filename) else
  4795.            Archive_List[Total_Archive-1]._ArcType := GetARCType1(filename);
  4796. end;
  4797.  
  4798. function TCakDir.Add_Archive_List(filename : string) : integer;
  4799. begin
  4800.         Inc(Total_Archive);
  4801.         SetLength(Archive_List,Total_Archive);
  4802.            Archive_List[Total_Archive-1]._Arcname := filename;
  4803.            Archive_List[Total_Archive-1]._ArcType := GetARCType(filename);
  4804.         result := Total_Archive-1;
  4805. end;
  4806.  
  4807. procedure TCakDir.Clear_Archive_List;
  4808. begin
  4809.         Total_Archive := 0;
  4810.         SetLength(Archive_List,Total_Archive+1);
  4811.         Total_Contents := 0;
  4812.         fullcontentcount := 0;
  4813.         SetLength(Full_Contents,Total_Contents+1);
  4814.         SetLength(Archive_Contents,Total_Contents+1);
  4815.         Directorylist.clear;
  4816. end;
  4817.  
  4818. function TCakDir.found(filename : string) : boolean;
  4819. var i : integer;
  4820.     aMask : TMask;
  4821. begin
  4822.         result := false;
  4823.         aMask := TMask.Create(filename);
  4824.         for i := 0 to Total_Contents -1 do
  4825.                 if aMask.Matches(Archive_Contents[i]._Filename) then
  4826.                                 result := true;
  4827.         aMask.free;
  4828. end;
  4829. function TCakDir.Get_Archive_Code(filearchive, filename : string) : integer;
  4830. var i : integer;
  4831. begin
  4832.         result := -1;
  4833.         for i := 0 to Total_Contents -1 do
  4834.                 if uppercase(Archive_Contents[i]._Filedefpath) + uppercase(Archive_Contents[i]._Filename) = uppercase(filename) then
  4835.                         if (uppercase(Archive_Contents[i]._FileArchive) = uppercase(filearchive)) or (filearchive = '') then
  4836.                                 result := i;
  4837. end;
  4838. function TCakdir.Get_Top_Selected : string;
  4839. var i,j : integer;
  4840. begin
  4841.         j := total_contents+1;
  4842.         for i := Total_Contents -1 downto 0 do
  4843.                 if Archive_contents[i]._selected then
  4844.                         j := i;
  4845.         if j >= total_contents +1 then
  4846.         result := '' else
  4847.         result := archive_contents[j]._filedefpath + archive_contents[j]._filename;
  4848. end;
  4849.  
  4850. function TCakdir.Get_Top_Index : integer;
  4851. var i,j : integer;
  4852. begin
  4853.         j := total_contents+1;
  4854.         for i := Total_Contents -1 downto 0 do
  4855.                 if Archive_contents[i]._selected then
  4856.                         j := i;
  4857.         if j >= total_contents + 1 then
  4858.         result := -1 else
  4859.         result := j;
  4860. end;
  4861.  
  4862. function TCakDir.GrabMydocuPath : string;
  4863. var Path: array [0..260] of char;
  4864.     ItemIDList : PItemIDList;
  4865. begin
  4866.         SHGetSpecialFolderLocation(Application.handle,CSIDL_PERSONAL,ItemIDList);
  4867.         SHGetPathFromIDList(ITEMIDLIST,path);
  4868.         result := Appendslash(path);
  4869. end;
  4870.  
  4871. function TCakDir.GrabWindowPath : string;
  4872. var Path: array [0..260] of char;
  4873. begin
  4874.         GetWindowsDirectory(Path, Sizeof(Path));
  4875.         result := Appendslash(path);
  4876. end;
  4877. function TCakDir.GrabSystemPath : string;
  4878. var Path: array [0..260] of char;
  4879. begin
  4880.         GetSystemDirectory(Path, Sizeof(Path));
  4881.         result := Appendslash(path);
  4882. end;
  4883. function TCakDir.GrabTempPath : string;
  4884. var Path: array [0..260] of char;
  4885. begin
  4886.         GetTempPath(Sizeof(Path), Path);;
  4887.         MakeDirectory(Appendslash(path) + 'QZTEMP\');
  4888.         result := Appendslash(path) + 'QZTEMP\';
  4889. end;
  4890. function TCakDir.GrabDesktopPath : string;
  4891. begin
  4892.         Result := SpecialDirectory(CSIDL_Desktopdirectory);
  4893. end;
  4894.  
  4895. function TCakDir.GrabProgramPath : string;
  4896. begin
  4897.         Result := AppendSlash(Extractfilepath(Paramstr(0)));
  4898. end;
  4899.  
  4900.  
  4901. function TCakDir.GrabCurrentPath : string;
  4902. var Path: array [0..260] of char;
  4903. begin
  4904.         GetCurrentDirectory(Sizeof(Path), Path);
  4905.         result := Appendslash(path);
  4906. end;
  4907.  
  4908.  
  4909. procedure TCakDir.MakeDirectory(dirname: string);
  4910. var
  4911.   i:       integer;
  4912.   a, temp: string;
  4913. begin
  4914.   a    := dirname;
  4915.   temp := '';
  4916.   for i := 1 to length(a) + 1 do
  4917.   begin
  4918.     temp := Copy(a, 0, i);
  4919.     if (a[i] = '\') or (i = length(a) + 1) then
  4920.       if not directoryexists(temp) then
  4921.         CreateDirectory(PChar(temp), nil);
  4922.   end;
  4923. end;
  4924.  
  4925. function TCakDir.CalcFolderSize(const aRootPath: string): Int64;
  4926.  
  4927.   procedure Traverse(const aFolder: string);
  4928.   var
  4929.     Data: TWin32FindData;
  4930.     FileHandle: THandle;
  4931.   begin
  4932.     FileHandle := FindFirstFile(PCHAR(aFolder+'*'), Data);
  4933.     if FileHandle <> INVALID_HANDLE_VALUE then
  4934.     try
  4935.       repeat
  4936.         if (Data.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY > 0)
  4937. and (Data.cFileName[0] <> '.') then
  4938.           Traverse(aFolder+Data.cFilename+'\')
  4939.          else Inc(Result, (Data.nFileSizeHigh * MAXDWORD) +
  4940.         Data.nFileSizeLow);
  4941.       until not FindNextFile(FileHandle, Data);
  4942.     finally
  4943.       Windows.FindClose(FileHandle);
  4944.     end;
  4945.   end;
  4946. begin
  4947.   Result := 0;
  4948.   Traverse(aRootPath);
  4949. end;
  4950.  
  4951. {$IFDEF USE_ZIP}
  4952. procedure TCakDir.Zipdirrename(SourceName, DestName: string);
  4953. var
  4954.   ZipRenameList: TList;
  4955.   RenRec:        pZipRenameRec;
  4956. begin
  4957.   ZipRenameList := TList.Create();
  4958.   New(RenRec);
  4959.   RenRec^.Source   := SourceName;
  4960.   RenRec^.Dest     := DestName;
  4961.   RenRec^.DateTime := 0;
  4962.  
  4963.   ZipRenameList.Add(RenRec);
  4964.  
  4965.   Zipdir.Rename(ZipRenameList, 0);
  4966.   Dispose(RenRec);
  4967.   ZipRenameList.Free();
  4968.   
  4969.   UNLoad_ZIP_DLL;
  4970.   Load_ZIP_DLL;
  4971.   List_archive(0,Total_Archive -1 );
  4972. end;
  4973. {$ENDIF}
  4974.  
  4975. {$IFDEF USE_ZIP}
  4976. procedure TCakDir.Zipdirrenamedir(SourceName, DestName: string);
  4977. var
  4978.   j,k : string;
  4979.   i : integer;
  4980. begin
  4981.   for i := 0 to total_contents -1 do
  4982.         if (Uppercase(Archive_contents[i]._Filedefpath) = Uppercase(Appendslash(SourceName))) then
  4983.         begin
  4984.                 j := Archive_contents[i]._filedefpath + Archive_contents[i]._filename;
  4985.                 k := Appendslash(DestName) + Archive_contents[i]._filename;
  4986.                 zipdirrename(j,k);
  4987.         end;
  4988. end;
  4989. {$ENDIF}
  4990. procedure TCakDir.DelValInReg(RKey: HKey; KeyPath: string; Key : string);
  4991. begin
  4992.     with TRegistry.Create do
  4993.     try
  4994.       RootKey := RKey;
  4995.       OpenKey(KeyPath, True);
  4996.       if valueexists(key) then
  4997.       DeleteValue(Key);
  4998.     finally
  4999.       Free;
  5000.     end;
  5001. end;
  5002.  
  5003. procedure TCakDir.DelKeyInReg(RKey: HKey; KeyPath: string);
  5004. var valstrings,subkeystrings : tstrings;
  5005.     i : integer;    
  5006. begin
  5007.     if keypath = '' then exit;
  5008.     valstrings := RegListVal(Rkey,Keypath);
  5009.     subkeystrings := RegListsubKey(RKey,Keypath);
  5010.     for i := 0 to subkeystrings.count -1 do
  5011.         DelKeyInReg(RKey,Keypath + subkeystrings.strings[i]);
  5012.     for i := 0 to valstrings.count -1 do
  5013.         DelValInReg(RKey,Keypath,valstrings.strings[i]);
  5014.     subkeystrings.free;
  5015.     valstrings.free;
  5016.     RegDeleteKey(Rkey, PCHAR(keypath));
  5017. end;
  5018.  
  5019.  
  5020. procedure TCakDir.SetValInReg(RKey: HKey; KeyPath: string;
  5021.   ValName: string; NewVal: string);
  5022. begin
  5023.   with TRegistry.Create do
  5024.     try
  5025.       RootKey := RKey;
  5026.       OpenKey(KeyPath, True);
  5027.       WriteString(ValName, NewVal);
  5028.     finally
  5029.       Free;
  5030.     end;
  5031. end;
  5032.  
  5033. function TCakDir.GetvalInReg(RKey : HKey; KeyPath : string;
  5034.    Valname : string) : string;
  5035. begin
  5036.   with TRegistry.Create do
  5037.     try
  5038.       RootKey := RKey;
  5039.       OpenKey(KeyPath, True);
  5040.       result := Readstring(ValName);
  5041.     finally
  5042.       Free;
  5043.     end;
  5044. end;
  5045.  
  5046. function TCakDir.GetvalInIni(filename : string; section : string; key : string; default : string) : string;
  5047. var Ini : TInifile;
  5048. begin
  5049.   Ini := TIniFile.Create(filename);
  5050.   try
  5051.   with Ini do
  5052.         result := ReadString(section,key,'');
  5053.   finally
  5054.   Ini.Free;
  5055.   end;
  5056.   if result = '' then result := default;
  5057. end;
  5058.  
  5059.  
  5060. procedure TCakDir.SetvalInIni(filename : string; section : string; key, value : string);
  5061. var Ini : TInifile;
  5062. begin
  5063.   Ini := TIniFile.Create(filename);
  5064.   try
  5065.   with Ini do
  5066.         WriteString(section,key,value);
  5067.   finally
  5068.   Ini.Free;
  5069.   end;
  5070. end;
  5071.  
  5072. procedure TCakDir.PlainDialog;
  5073. begin
  5074.         aform := TForm.Create(nil);
  5075.         aCheckbox := TCheckbox.Create(aform);
  5076.         aCheckbox.Parent := aform;
  5077.         aLabel := TStatictext.Create(aform);
  5078.         aLabel.Parent := aform;
  5079.  
  5080.         aLabel.AutoSize := False;
  5081.         aCheckbox.Checked := False;
  5082.  
  5083.         aform.width := 286;
  5084.         aform.height := 240;
  5085.         aform.Position := poDesktopCenter;
  5086.         aform.BorderStyle := bsDialog;
  5087.  
  5088.         ALabel.Left := 10;
  5089.         ALabel.Top := 30;
  5090.         ALabel.width := aform.width - (alabel.Left *2);
  5091.         ALabel.Alignment := taCenter;
  5092.         ALabel.Height := 60;
  5093.  
  5094.         aCheckbox.width := 180;
  5095.  
  5096.         aCheckbox.checked := true;
  5097.         aCheckbox.Caption := MSG_SHOWAGAIN;
  5098.  
  5099.         aCheckbox.Top := 120;
  5100.         aCheckbox.Left := (aform.width -aCheckbox.width) div 2;
  5101. end;
  5102. procedure TCakDir.FreePlainDialog;
  5103. begin
  5104.         aCheckbox.free;
  5105.         aLabel.free;
  5106.         aform.free;
  5107. end;
  5108.  
  5109. function TCakDir.YesNoShowAgainDialog(dcaption,msg : string; var yesno : boolean) : boolean;
  5110. var yButton,nButton : TButton;
  5111. begin
  5112.         result := true;
  5113.         PlainDialog;
  5114.         yButton := TButton.Create(aform);
  5115.         yButton.Parent := aform;
  5116.         yButton.ModalResult := 1;
  5117.         yButton.Default := true;
  5118.         nButton := TButton.Create(aform);
  5119.         nButton.Parent := aform;
  5120.         nButton.ModalResult := 2;
  5121.         nButton.Cancel := true;
  5122.         try
  5123.         aform.Caption := dcaption;
  5124.         aLabel.Caption := Msg;
  5125.         yButton.Top := 160;
  5126.         nButton.Top := 160;
  5127.         yButton.width := 75;
  5128.         yButton.Caption := 'Yes';
  5129.         nButton.width := 75;
  5130.         nButton.Caption := 'No';
  5131.         yButton.Left := (aform.width -yButton.width) div 2 - 75;
  5132.         nButton.Left := (aform.width -nButton.width) div 2 + 75;
  5133.  
  5134.         aform.Showmodal;
  5135.  
  5136.         if aform.ModalResult = 1 then
  5137.                 YesNo := true else
  5138.                 YesNo := false;
  5139.         if not aCheckbox.Checked then
  5140.                 result := false;
  5141.         finally
  5142.         ybutton.free;
  5143.         nbutton.free;
  5144.         freePlaindialog;
  5145.         end;
  5146.  
  5147. end;
  5148. function TCakDir.ShowAgainDialog(dcaption, msg : string) : boolean;
  5149. var aButton : TButton;
  5150. begin
  5151.         result := true;
  5152.         PlainDialog;
  5153.         aButton := TButton.Create(aform);
  5154.         aButton.Parent := aform;
  5155.         aButton.ModalResult := 1;
  5156.         aButton.Default := true;
  5157.  
  5158.         try
  5159.         aform.Caption := dcaption;
  5160.         aLabel.Caption := Msg;
  5161.         aButton.Top := 160;
  5162.         aButton.Left := (aform.width -aButton.width) div 2;
  5163.  
  5164.         aButton.width := 75;
  5165.         aButton.Caption := 'Close';
  5166.         aform.Showmodal;
  5167.  
  5168.         if not aCheckbox.Checked then
  5169.                 result := false;
  5170.         finally
  5171.  
  5172.         abutton.free;
  5173.         freePlaindialog;
  5174.         end;
  5175. end;
  5176.  
  5177. procedure TCakDir.RegAskShowAgainDialog(dcaption, Msg : string; Path, key : string);
  5178. begin
  5179.  
  5180. if GetValInReg(HKEY_CLASSES_ROOT,Path,key) <> 'FALSE' then
  5181.         if ShowAgainDialog(dcaption,msg) then
  5182.                 SetValinReg(HKEY_CLASSES_ROOT,Path,key,'TRUE') else
  5183.                 SetValinReg(HKEY_CLASSES_ROOT,Path,key,'FALSE')
  5184. end;
  5185.  
  5186. procedure TCakDir.IniAskShowAgainDialog(dcaption, Msg : string; Filename, section, key : string);
  5187. begin
  5188. if GetvalInIni(filename,section,key,'TRUE') <> 'FALSE' then
  5189.         if ShowAgainDialog(dcaption,msg) then
  5190.                 SetvalInIni(filename,section,key,'TRUE') else
  5191.                 SetvalInIni(filename,section,key,'FALSE')
  5192. end;
  5193.  
  5194. procedure TCakDir.RegYesNoAskShowAgainDialog(dcaption, Msg : string; Path, section, key : string;var yesno : boolean);
  5195. begin
  5196. if GetValInReg(HKEY_CLASSES_ROOT,Path,key) <> 'FALSE' then
  5197.         if YesNoShowAgainDialog(dcaption,msg,yesno) then
  5198.                 SetValinReg(HKEY_CLASSES_ROOT,Path,key,'TRUE') else
  5199.                 SetValinReg(HKEY_CLASSES_ROOT,Path,key,'FALSE')
  5200. end;
  5201. procedure TCakDir.IniYesNoAskShowAgainDialog(dcaption, Msg : string; Filename, Product, section, key : string;var yesno : boolean);
  5202. begin
  5203. if GetvalInIni(filename,Product,key,'TRUE') <> 'FALSE' then
  5204.         if YesNoShowAgainDialog(dcaption,msg,YesNo) then
  5205.                 SetvalInIni(filename,section,key,'TRUE') else
  5206.                 SetvalInIni(filename,section,key,'FALSE')
  5207.  
  5208. end;
  5209.  
  5210. procedure TCakDir.refreshicon;
  5211. begin
  5212.         Shlobj.SHChangeNotify( SHCNE_ASSOCCHANGED, SHCNF_FLUSH, nil, nil );
  5213.         reiniticons;
  5214. end;
  5215.  
  5216. function TCakDir.GetAssociatedprogram(ext : string) : string;
  5217. begin
  5218.         Ext := LowerCase(Ext);
  5219.         result := Getvalinreg(HKEY_CLASSES_ROOT,'.' + ext,'');
  5220. end;
  5221.  
  5222. procedure TCakDir.UNAssociateProgram(ext : string);
  5223. begin
  5224.  
  5225.   Ext := LowerCase(Ext);
  5226.   delkeyinreg(HKEY_CLASSES_ROOT,
  5227.     '.' + ext);     { extension we want to undefine }
  5228.   delkeyinreg(HKEY_CLASSES_ROOT,
  5229.     leadchar + ext + '\DefaultIcon');
  5230.   delkeyinreg(HKEY_CLASSES_ROOT,
  5231.     leadchar + ext + '\shell\open\command');
  5232.   delkeyinreg(HKEY_CLASSES_ROOT,
  5233.     leadchar + ext);
  5234.   delkeyinreg(HKEY_CLASSES_ROOT,
  5235.     leadchar + ext);
  5236. end;
  5237. procedure TCakDir.AssociateProgram(ext,path,icon : string);
  5238. begin
  5239.    { ALL extensions must be in lowercase to avoid trouble! }
  5240.   Ext := LowerCase(Ext);
  5241.   if FileExists(path) then
  5242.   begin
  5243.     SetValInReg(HKEY_CLASSES_ROOT,
  5244.       '.' + ext, { extension we want to define }
  5245.       '',       { specify the default data item }
  5246.       leadchar + ext); { This is the value of the default data item -
  5247.                                      this referances our new type to be defined  }
  5248.     SetValInReg(HKEY_CLASSES_ROOT,
  5249.       leadchar + ext, { this is the type we want to define }
  5250.       '',             { specify the default data item }
  5251.       ext + ' Archive'); { This is the value of the default data item -
  5252.                               this is the English description of the file type }
  5253.     ext := UPPERCASE(ext);
  5254.     SetValInReg(HKEY_CLASSES_ROOT,
  5255.       leadchar + ext + '\DefaultIcon', { Create a file...DefaultIcon.}
  5256.       '', { Specify the default data item.}
  5257.       icon+ ',0'); { Executable where icon is in and it's Sequence number.}
  5258.  
  5259.     SetValInReg(HKEY_CLASSES_ROOT,
  5260.       leadchar + ext + '\shell\open\command', { create a file...open key }
  5261.       '', { specify the default data item }
  5262.       path + ' "%1"'); { command line to open file with }
  5263.   end;
  5264.  
  5265. end;
  5266.  
  5267. function TCakDir.ArcOpenSupport : string;
  5268. var k,l : string;
  5269. begin
  5270. k := '(^8^)';
  5271. l := GrabProgramPath;
  5272. {$IFDEF USE_ZIP}
  5273. if fileexists(l + UNZIPDLL) then
  5274. k := k + ',' + GetarcStringFull(_ZIP);
  5275. {$ENDIF}
  5276. {$IFDEF USE_ACE}
  5277. if fileexists(l + UNACEDLL) then
  5278. k := k + ',' + GetarcStringFull(_ACE);
  5279. {$ENDIF}
  5280. {$IFDEF USE_ARC}
  5281. if fileexists(l + UNRARDLL) then
  5282. k := k + ',' + GetarcStringFull(_RAR);
  5283. if fileexists(l + LHADLL) then
  5284. k := k + ',' + GetarcStringFull(_LHA);
  5285. if fileexists(l + BZ2DLL) then
  5286. k := k + ',' + GetarcStringFull(_BZ2);
  5287. if fileexists(l + BZADLL) and fileexists(l+BZ2DLL) then
  5288. k := k + ',' + GetarcStringFull(_BZA);
  5289. if fileexists(l + UNARJDLL) then
  5290. k := k + ',' + GetarcStringFull(_ARJ);
  5291. if fileexists(l + TARDLL) then
  5292. k := k + ',' + GetarcStringFull(_TAR) + ',' + GetarcStringFull(_TGZ);
  5293. if fileexists(l + YZ1DLL) then
  5294. k := k + ',' + GetarcStringFull(_YZ1);
  5295. if fileexists(l + BELDLL) then
  5296. k := k + ',' + GetarcStringFull(_BEL);
  5297. if fileexists(l + GCADLL) then
  5298. k := k + ',' + GetarcStringFull(_GCA);
  5299. {$ENDIF}
  5300. {$IFDEF USE_CZIP}
  5301. k := k + ',' + GetarcStringFull(_CZIP);
  5302. {$ENDIF}
  5303. {$IFDEF USE_RS}
  5304. k := k + ',' + GetarcStringFull(_RS);
  5305. {$ENDIF}
  5306. {$IFDEF USE_INDY}
  5307. k := k + ',' + GetarcStringFull(_UUE);
  5308. k := k + ',' + GetarcStringFull(_XXE);
  5309. k := k + ',' + GetarcStringFull(_B64);
  5310. {$ENDIF}
  5311. k := k + ',' + GetarcStringFull(_CAB);
  5312. k := k + ',' + GetarcStringFull(_PAK);
  5313. k := k + ',' + GetarcStringFull(_AKS);
  5314. result := k;
  5315. end;
  5316.  
  5317. function TCakDir.ArcAddSupport : string;
  5318. var k,l : string;
  5319. begin
  5320. k := '(^8^)';
  5321. l := GrabProgramPath;
  5322. {$IFDEF USE_RS}
  5323. k := k + ',' + GetarcStringFull(_RS);
  5324. {$ENDIF}
  5325. {$IFDEF USE_ZIP}
  5326. if fileexists(l + ZIPDLL) then
  5327. k := k + ',' + GetarcStringFull(_ZIP);
  5328. {$ENDIF}
  5329. {$IFDEF USE_ARC}
  5330. if fileexists(l + LHADLL) then
  5331. k := k + ',' + GetarcStringFull(_LHA);
  5332. if fileexists(l + BZ2DLL) then
  5333. k := k + ',' + GetarcStringFull(_BZ2);
  5334. if fileexists(l + BZADLL) and fileexists(l+BZ2DLL) then
  5335. k := k + ',' + GetarcStringFull(_BZA);
  5336. if fileexists(l + TARDLL) then
  5337. k := k + ',' + GetarcStringFull(_TAR) + ',' + GetarcStringFull(_TGZ);
  5338. if fileexists(l + YZ1DLL) then
  5339. k := k + ',' + GetarcStringFull(_YZ1);
  5340. {$ENDIF}
  5341. //{$IFDEF USE_INDY}
  5342. //k := k + ',UU,UUE,XXE,B64';
  5343. //{$ENDIF}
  5344. k := k + ',' + GetarcStringFull(_CAB);
  5345. result := k;
  5346. end;
  5347.  
  5348. function TCakDir.GetarcString(atype : supporttype) : string;
  5349. var astrings : tstrings;
  5350. begin
  5351.         aStrings := TStringList.create;
  5352.         astrings.CommaText := GetArcStringFull(atype);
  5353.         if astrings.count > 0 then
  5354.         result := astrings.strings[0];
  5355.         aStrings.free;
  5356. end;
  5357. function TCakDir.GetarcStringFull(atype : supporttype) : string;
  5358. function LoadTreatAs(TreatAs : string) : string;
  5359. var i : integer;
  5360.     k : string;
  5361. begin
  5362.         k := treatas;
  5363.         i := pos(' ',k);
  5364.         while i <> 0 do
  5365.         begin
  5366.         k := copy(k,0,i-1) + copy(k,i+1,length(k)-1);
  5367.         i := pos(' ',k);
  5368.         end;
  5369.  
  5370.         i := pos('.',k);
  5371.         if i <> 0 then
  5372.                 k := Copy(k,i+1,length(k) - i);
  5373.  
  5374.         i := pos('.',k);
  5375.         While i <> 0 do
  5376.         begin
  5377.         k := copy(k,0,i-1) + ',' + copy(k,i+1,length(k)-1);
  5378.         i := pos('.',k);
  5379.         end;
  5380.  
  5381.         result := k;
  5382. end;
  5383. begin
  5384. case atype of
  5385. _ZIP : result := Loadtreatas(TreatAsZip);
  5386. _Rar : result := Loadtreatas(TreatAsRar);
  5387. _Cab : result := Loadtreatas(TreatAsCab);
  5388. _Arj : result := Loadtreatas(TreatAsArj);
  5389. _Lha : result := Loadtreatas(TreatAsLha);
  5390. _Tar : result := Loadtreatas(TreatAsTar);
  5391. _Tgz : result := Loadtreatas(TreatAsTgz);
  5392. _Ace : result := Loadtreatas(TreatAsAce);
  5393. _BZ2 : result := Loadtreatas(TreatAsBz2);
  5394. _Bel : result := Loadtreatas(TreatAsBel);
  5395. _Gca : result := Loadtreatas(TreatAsGca);
  5396. _Bza : result := Loadtreatas(TreatAsBza);
  5397. _RS  : result := Loadtreatas(TreatAsRs);
  5398. _CZIP: result := Loadtreatas(TreatAsCZip);
  5399. _YZ1 : result := Loadtreatas(TreatAsYz1);
  5400. _UUE : result := Loadtreatas(TreatAsUue);
  5401. _XXE : result := Loadtreatas(TreatAsXxe);
  5402. _B64 : result := Loadtreatas(TreatAsB64);
  5403. _PAK : result := Loadtreatas(TreatAsPak);
  5404. _AKS : result := Loadtreatas(TreatAsAks);
  5405. _EXT : result := Loadtreatas(TreatAsExt);
  5406. _WIT : result := '?HUH?';
  5407. end;
  5408. end;
  5409. function TCakDir.GetarcStringFilter(atype : supporttype) : string;
  5410. var astrings : tstrings;
  5411.     i : integer;
  5412.     k : string;    
  5413. begin
  5414.         aStrings := TStringList.create;
  5415.         astrings.CommaText := GetArcStringFull(atype);
  5416.         k := '';
  5417.         for i := 0 to astrings.count -1 do
  5418.                 if k = '' then
  5419.                 k := '*.' + astrings.strings[i] else
  5420.                 k := k + ';*.'+ astrings.strings[i];
  5421.         aStrings.free;
  5422.         result := k;
  5423. end;
  5424. procedure TCakDir.runwww(wwwpath : string);
  5425. begin
  5426.         shellexecute(application.handle,'open',pchar(
  5427.         wwwpath),'',
  5428.         '',SW_SHOWNORMAL);
  5429. end;
  5430. procedure TCakDir.run(programpath,Programparam : string);
  5431. var k : string;
  5432. begin
  5433.    if uppercase(extractfileext(programpath)) = '.INF' then
  5434.         begin
  5435.         execinf(programpath,k);
  5436.         exit;
  5437.         end;
  5438.    if uppercase(extractfileext(programpath)) = '.REG' then
  5439.         begin
  5440.         execreg(programpath);
  5441.         exit;
  5442.         end;
  5443.  
  5444.         shellexecute(application.handle,'open',pchar(
  5445.         extractfilename(programpath)),pchar(programparam),
  5446.         pchar(extractfilepath(programpath)),SW_SHOWNORMAL);
  5447. end;
  5448.  
  5449. procedure TCakDir.runandwait(programpath,Programparam : string);
  5450. Var
  5451.    sei:SHELLEXECUTEINFO;
  5452.    FileToOpen,Param:array[0..255] of char;
  5453.    k : string;
  5454.    i : integer;
  5455. Begin
  5456.    cancelwait := false;
  5457.    terminaterun := false;
  5458.    if uppercase(extractfileext(programpath)) = '.INF' then
  5459.         begin
  5460.         execinf(programpath,k);
  5461.         exit;
  5462.         end;
  5463.    if uppercase(extractfileext(programpath)) = '.REG' then
  5464.         begin
  5465.         execreg(programpath);
  5466.         exit;
  5467.         end;
  5468.      // Get the file to use
  5469.      StrPCopy(FileToOpen,programpath);
  5470.      StrPCopy(Param,programparam);
  5471.      // Run (exe), open (documents) or install (inf)
  5472.      // the file using ShellExecuteEx
  5473.      sei.cbSize:=sizeof(sei);
  5474.      sei.fMask:=SEE_MASK_FLAG_DDEWAIT or SEE_MASK_NOCLOSEPROCESS;
  5475.      sei.wnd:= Application.MainForm.handle;
  5476.      if(strpos(FileToOpen,'.inf')<>nil) then
  5477.          sei.lpVerb:='Install'
  5478.      else
  5479.          sei.lpVerb:=nil;
  5480.      sei.lpFile:=FileToOpen;
  5481.      if programparam <> '' then
  5482.      sei.lpParameters:=Param else
  5483.      sei.lpParameters:=nil;
  5484.      sei.lpDirectory:=nil;
  5485.      sei.nShow:=SW_SHOWDEFAULT;
  5486.      if(ShellExecuteEx(@sei)=true) then
  5487.      begin
  5488.           // Wait for it to terminate
  5489.           WaitForInputIdle(sei.hProcess,1000);
  5490.           while(WaitForSingleObject(sei.hProcess,10)=WAIT_TIMEOUT) and not cancelwait and not terminaterun do
  5491.           begin
  5492.                // Keep watch for messages so that we
  5493.                // don't appear to "stop responding"
  5494.                Application.ProcessMessages();
  5495.                Sleep(500);
  5496.           end;
  5497.           i := 0;
  5498.           if terminaterun then
  5499.           TerminateProcess(sei.hProcess,i);
  5500.           CloseHandle(sei.hProcess);
  5501.      end
  5502.      else
  5503.          MessageBox(Application.Mainform.Handle,'Unable to run or open this file',pchar(Application.Mainform.caption),mb_ok or mb_iconstop);
  5504. end;
  5505.  
  5506. function TCakDir.sizeinK(size: int64): string;
  5507. var
  5508.   j: real;
  5509.   k : string;
  5510. begin
  5511.   if size = 0 then
  5512.     Result := '0 kb'
  5513.   else
  5514.   begin
  5515.     j := (size / 1000);
  5516.     if j <= 999.99 then
  5517.       k := FormatFloat('##0.00', j)
  5518.     else
  5519.       k := FormatFloat('###,###,###,##0', j);
  5520.     Result := k + ' kb';
  5521.   end;
  5522. end;
  5523.  
  5524. function TCakDir.isharddrive(drive : char) : boolean;
  5525. begin
  5526.         result := (GetDriveType(pchar(drive + ':\')) = DRIVE_FIXED);
  5527. end;
  5528. function TCakDir.iscdrom(drive : char) : boolean;
  5529. begin
  5530.         result := (GetDriveType(pchar(drive + ':\')) = DRIVE_CDROM);
  5531. end;
  5532. function TCakDir.isfloppy(drive : char) : boolean;
  5533. begin
  5534.         result := (GetDriveType(pchar(drive + ':\')) = DRIVE_REMOVABLE);
  5535. end;
  5536.  
  5537. {$IFDEF USE_SHCN}
  5538. procedure TCakDir.MonitorStart;
  5539. begin
  5540.         SHCN := TSHChangeNotify.Create(Application.MainForm);
  5541.         History := TStringList.Create;
  5542.         History.Clear;
  5543.         SHCN.OnAttributes := CNOnAttrib;
  5544.         SHCN.OnCreate := CNOnCreate;
  5545.         SHCN.OnDelete := CNOnDelete;
  5546.         SHCN.OnMkDir := CNOnNewDir;
  5547.         SHCN.OnRenameFolder := CNOnRename;
  5548.         SHCN.OnRenameItem := CNOnRename;
  5549.         SHCN.OnRmDir :=  CNOnRmDir;
  5550.         SHCN.OnUpdateDir := CNOnUpdateDir;
  5551.         SHCN.OnUpdateItem := CNOnUpdateItem;
  5552.         SHCN.Execute;
  5553.         //A_HKCU := MakeRegnode(HKEY_CURRENT_USER,'');
  5554.         //A_HKLM := MakeRegnode(HKEY_LOCAL_MACHINE,'');
  5555.         History.Add(MSG_BEGINLOG);
  5556. end;
  5557. {$ENDIF}
  5558. {$IFDEF USE_SHCN}
  5559. procedure TCakDir.MonitorStop;
  5560. begin
  5561.         SHCN.Stop;
  5562.         SHCN.Free;
  5563.         //CleanRegNode(A_HKCU);
  5564.         //CleanRegNode(A_HKLM);
  5565.         History.Free;
  5566. end;
  5567. {$ENDIF}
  5568. {$IFDEF USE_SHCN}
  5569. procedure TCakDir.CNOnAttrib(Sender: TObject; Flags: Cardinal;Path1: String);
  5570. begin
  5571.         //if pos(Grabtemppath,path1) = 0 then
  5572.         history.Add('Attrib Changed : ' + Path1);
  5573. end;
  5574. {$ENDIF}
  5575. {$IFDEF USE_SHCN}
  5576. procedure TCakDir.CNOnCreate(Sender: TObject; Flags: Cardinal;Path1: String);
  5577. begin
  5578.         //if pos(Grabtemppath,path1) = 0 then
  5579.         history.Add('Created : ' + Path1);
  5580. end;
  5581. {$ENDIF}
  5582. {$IFDEF USE_SHCN}
  5583. procedure TCakDir.CNOnDelete(Sender: TObject; Flags: Cardinal;Path1: String);
  5584. begin
  5585.         //if pos(Grabtemppath,path1) = 0 then
  5586.         history.Add('Deleted : ' + path1);
  5587. end;
  5588. {$ENDIF}
  5589. {$IFDEF USE_SHCN}
  5590. procedure TCakDir.CNOnNewDir(Sender: TObject; Flags: Cardinal;Path1: String);
  5591. begin
  5592.         //if pos(Grabtemppath,path1) = 0 then
  5593.         history.Add('Directory Created : ' + Path1);
  5594. end;
  5595. {$ENDIF}
  5596. {$IFDEF USE_SHCN}
  5597. procedure TCakDir.CNOnRename(Sender: TObject; Flags: Cardinal;Path1, path2: String);
  5598. begin
  5599.         //if pos(Grabtemppath,path1) = 0 then
  5600.         history.Add('Renamed : ' + Path1 + '->' + Path2 );
  5601. end;
  5602. {$ENDIF}
  5603. {$IFDEF USE_SHCN}
  5604. procedure TCakDir.CNOnRmDir(Sender: TObject; Flags: Cardinal;Path1: String);
  5605. begin
  5606.         //if pos(Grabtemppath,path1) = 0 then
  5607.         history.Add('Directory Removed : ' + Path1);
  5608. end;
  5609. {$ENDIF}
  5610. {$IFDEF USE_SHCN}
  5611. procedure TCakDir.CNOnUpdateDir(Sender: TObject; Flags: Cardinal;Path1: String);
  5612. begin
  5613.         //if pos(Grabtemppath,path1) = 0 then
  5614.         history.Add('Directory Updated : ' + Path1);
  5615. end;
  5616. {$ENDIF}
  5617. {$IFDEF USE_SHCN}
  5618. procedure TCakDir.CNOnUpdateItem(Sender: TObject; Flags: Cardinal;Path1: String);
  5619. begin
  5620.         //if pos(Grabtemppath,path1) = 0 then
  5621.         history.Add('Updated : ' + Path1);
  5622. end;
  5623. {$ENDIF}
  5624.  
  5625. procedure TCakDir.Explorefolder(folder : string);
  5626. begin
  5627.      ShellExecute(application.handle,'open',PCHAR(folder),'',
  5628.                    PCHAR(folder),SW_SHOWNORMAL);
  5629. end;
  5630.  
  5631. function TCakDir.newtemppath : string;
  5632. var i : integer;
  5633.     k : string;
  5634. begin
  5635.         i := Gettickcount;
  5636.         While Directoryexists(Grabtemppath + inttostr(i)) do
  5637.                 inc(i);
  5638.         k := Grabtemppath + inttostr(i) + '\';
  5639.         MakeDirectory(k);
  5640.         NewDirList.Add(k);
  5641.         result := k;
  5642. end;
  5643.  
  5644. procedure TCakdir.ExecReg(Var Path : string);
  5645. var k : string;
  5646. begin
  5647.         k := '/s /y ' + path;
  5648.         Shellexecute(application.handle,'open','Regedit.exe',
  5649.         pchar(k), pchar(grabwindowpath), SW_NORMAL);
  5650. end;
  5651.  
  5652. Function TCakDir.ExecInf( Var Path, Param: String ): Cardinal;
  5653. Var
  5654.    osvi: TOSVersionInfo;
  5655. Begin
  5656.    Result:=0;
  5657.  
  5658.    if Param = '.ntx86'
  5659.    then
  5660.        Param := Param + ' '
  5661.    else
  5662.        Param := '';
  5663.  
  5664.    osvi.dwOSVersionInfoSize := SizeOf( OSvi );
  5665.    If GetVersionEx( OSVI ) Then
  5666.    Begin
  5667.       Case osvi.dwPlatformID Of
  5668.         VER_PLATFORM_WIN32_WINDOWS: Path := 'rundll.exe setupx.dll,InstallHinfSection DefaultInstall 132 ' + Path;
  5669.         VER_PLATFORM_WIN32_NT: Path := 'rundll32.exe setupapi.dll,InstallHinfSection DefaultInstall 132 ' + Path;
  5670.        end;
  5671.       Result := WinExec( pChar( Path ), SW_SHOW );
  5672.    End;
  5673. End;
  5674.  
  5675. {$IFDEF USE_ZIPR}
  5676. procedure TCakDir.repairZip(SourceName, DestName : string);
  5677. begin
  5678.         Ziprepair.RepairZip(SourceName,DestName);
  5679. end;
  5680. {$ENDIF}
  5681.  
  5682. procedure TCakDir.SendMail(Subject, Mailtext,
  5683.   FromName, FromAdress,
  5684.   ToName, ToAdress,
  5685.   AttachedFileName,
  5686.   DisplayFileName: string;
  5687.   ShowDialog: boolean);
  5688. var
  5689.   MapiMessage: TMapiMessage;
  5690.   MError:      cardinal;
  5691.   Empfaenger:  array[0..1] of TMapiRecipDesc;
  5692.   Absender:    TMapiRecipDesc;
  5693.   Datei:       array[0..1] of TMapiFileDesc;
  5694. begin
  5695.   with MapiMessage do
  5696.   begin
  5697.     ulReserved := 0;
  5698.     lpszSubject := PChar(Subject);
  5699.     lpszNoteText := PChar(Mailtext);
  5700.     lpszMessageType := nil;
  5701.     lpszDateReceived := nil;
  5702.     lpszConversationID := nil;
  5703.     flFlags := 0;
  5704.     Absender.ulReserved   := 0;
  5705.     Absender.ulRecipClass := MAPI_ORIG;
  5706.     Absender.lpszName     := PChar(FromName);
  5707.     Absender.lpszAddress  := PChar(FromAdress);
  5708.     Absender.ulEIDSize    := 0;
  5709.     Absender.lpEntryID    := nil;
  5710.     lpOriginator          := @Absender;
  5711.     nRecipCount := 1;
  5712.     Empfaenger[0].ulReserved := 0;
  5713.     Empfaenger[0].ulRecipClass := MAPI_TO;
  5714.     Empfaenger[0].lpszName := PChar(ToName);
  5715.     Empfaenger[0].lpszAddress := PChar(ToAdress);
  5716.     Empfaenger[0].ulEIDSize := 0;
  5717.     Empfaenger[0].lpEntryID := nil;
  5718.     lpRecips := @Empfaenger;
  5719.     nFileCount := 1;
  5720.     Datei[0].lpszPathName := PChar(AttachedFilename);
  5721.     Datei[0].lpszFileName := PChar(DisplayFilename);
  5722.     Datei[0].ulReserved := 0;
  5723.     Datei[0].flFlags := 0;
  5724.     Datei[0].nPosition := cardinal(-1);
  5725.     Datei[0].lpFileType := nil;
  5726.     lpFiles := @Datei;
  5727.   end;
  5728.   // Senden
  5729.   if ShowDialog then
  5730.     MError := MapiSendMail(0, application.Handle, MapiMessage,
  5731.       MAPI_DIALOG or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0)
  5732.   else
  5733.     // Wenn kein Dialogfeld angezeigt werden soll:
  5734.     MError := MapiSendMail(0, Application.Handle, MapiMessage, 0, 0);
  5735.   case MError of
  5736.     //MAPI_E_AMBIGUOUS_RECIPIENT:
  5737.      // MessageDlg('EmpfΣnger nicht eindeutig. (Nur m÷glich, wenn Emailadresse nicht angegeben.)',mterror,[mbok],0);
  5738.     MAPI_E_ATTACHMENT_NOT_FOUND:
  5739.       MessageDlg('Cannot find the attachment', mtError, [mbOK], 0);
  5740.     MAPI_E_ATTACHMENT_OPEN_FAILURE:
  5741.       MessageDlg('Cant open the attachment.', mtError, [mbOK], 0);
  5742.     MAPI_E_BAD_RECIPTYPE:
  5743.       MessageDlg('BAD MAPI_TO, MAPI_CC or MAPI_BCC.', mtError, [mbOK], 0);
  5744.     MAPI_E_FAILURE:
  5745.       MessageDlg('Unknown error.', mtError, [mbOK], 0);
  5746.     MAPI_E_INSUFFICIENT_MEMORY:
  5747.       MessageDlg('Not enough memory.', mtError, [mbOK], 0);
  5748.     MAPI_E_LOGIN_FAILURE:
  5749.       MessageDlg('Unable to login.', mtError, [mbOK], 0);
  5750.     MAPI_E_TEXT_TOO_LARGE:
  5751.       MessageDlg('Text too large', mtError, [mbOK], 0);
  5752.     MAPI_E_TOO_MANY_FILES:
  5753.       MessageDlg('Too many files.', mtError, [mbOK], 0);
  5754.     MAPI_E_TOO_MANY_RECIPIENTS:
  5755.       MessageDlg('Too many recipients.', mtError, [mbOK], 0);
  5756.     MAPI_E_UNKNOWN_RECIPIENT: MessageDlg('Unknown receipients', mtError, [mbOK], 0);
  5757.     MAPI_E_USER_ABORT:
  5758.       MessageDlg('User Abort!', mtError, [mbOK], 0);
  5759.     SUCCESS_SUCCESS:
  5760.     begin
  5761.     end;
  5762.   end;
  5763. end;
  5764.  
  5765. procedure TCakDir.BatchAdd(afilelist : TStrings;archivetype : supporttype);
  5766. var i : integer;
  5767. begin
  5768.         for i := 0 to afilelist.count -1 do
  5769.                 begin
  5770.                 Clear_archive_list;
  5771.                 New_archive(removefileext(afilelist.strings[i]) + '.' + getarcstring(archivetype));
  5772.                 addoptions.add_to := 0;
  5773.                 addoptions.add_files.clear;
  5774.                 addoptions.add_files.add(afilelist.strings[i]);
  5775.                 add;
  5776.                 end;
  5777. end;
  5778.  
  5779. function TCakDir.MakeRegnode(rootkey : HKEY; path : ANSIstring) : Tlist;
  5780. var
  5781.   alist : TList;
  5782.   anode,asubnode : PRegnodetype;
  5783.   keylist,subkeylist : tstrings;
  5784.   i : integer;
  5785. begin
  5786.  
  5787.   alist := TList.create;
  5788.   alist.clear;
  5789.  
  5790.   keylist := RegListval(rootkey,path);
  5791.   subkeylist := Reglistsubkey(rootkey,path);
  5792.  
  5793.     for i := 0 to keylist.count-1 do
  5794.     begin
  5795.     New(anode);
  5796.     anode^.iskey := true;
  5797.     anode^.subkey := TList.Create;
  5798.     //anode^.valuetype :=Reg.GetDataType(keylist.strings[i]);
  5799.     anode^.fullpath := path + '\' +  keylist.strings[i];
  5800.     anode^.keyname := keylist.strings[i];
  5801.  
  5802.     alist.add(anode);
  5803.     {anode^.dataS := '';
  5804.     anode^.dataES := '';
  5805.     anode^.dataI := 0;
  5806.     anode^.dataB := 0;
  5807.     Case anode^.valuetype of
  5808.     rdString : anode^.dataS := Reg.ReadString(keylist.strings[i]);
  5809.     rdExpandString : anode^.dataES := Reg.ReadString(keylist.strings[i]);
  5810.     rdInteger : anode^.dataI := Reg.ReadInteger(keylist.strings[i]);
  5811.     rdBinary : anode^.dataB := 0//Reg.ReadBinaryData(keylist.strings[i],j,2147483647);
  5812.  
  5813.     end;}
  5814.     end;
  5815.  
  5816.  
  5817.     for i := 0 to subkeylist.count -1 do
  5818.     begin
  5819.     New(asubnode);
  5820.     asubnode^.iskey := false;
  5821.     asubnode^.fullpath := path + '\' + subkeylist.strings[i];
  5822.     asubnode^.keyname := subkeylist.strings[i];
  5823.     asubnode^.subkey := TList.create;
  5824.     asubnode^.subkey := MakeRegnode(rootkey,asubnode^.fullpath);
  5825.     alist.Add(asubnode);
  5826.     end;
  5827.  
  5828.     keylist.Free;
  5829.     subkeylist.free;
  5830.     result := alist;
  5831. end;
  5832.  
  5833. procedure TCakDir.CleanRegnode(alist : TList);
  5834. var i: integer;
  5835.     anode : PRegnodetype;
  5836. begin
  5837.         for i := alist.Count -1 downto 0 do
  5838.             begin
  5839.                 anode := alist.Items[i];
  5840.                 CleanRegnode(anode^.subkey);
  5841.                 Dispose(anode);
  5842.             end;
  5843. end;
  5844.  
  5845. function TCakDir.name2rkey(key : string) : HKey;
  5846. var k : string;
  5847. begin
  5848.         k := Uppercase(Key);
  5849.         Result := HKEY_CLASSES_ROOT;
  5850.         if k = 'HKCR' then
  5851.                 Result := HKEY_CLASSES_ROOT else
  5852.         if k = 'HKCU' then
  5853.                 Result := HKEY_CURRENT_USER else
  5854.         if k = 'HKLL' then
  5855.                 Result := HKEY_LOCAL_MACHINE else
  5856.         if k = 'HKU' then
  5857.                 Result := HKEY_USERS else
  5858.         if k = 'HKCC' then
  5859.                 Result := HKEY_CURRENT_CONFIG else
  5860.         if k = 'HKDD' then
  5861.                 Result := HKEY_DYN_DATA;
  5862. end;
  5863.  
  5864. function TCakdir.rkeyname(rootkey :HKEY) : string;
  5865. begin
  5866.         Case rootkey of
  5867.         HKEY_CLASSES_ROOT : result := 'HKEY_CLASSES_ROOT';
  5868.         HKEY_CURRENT_USER : result := 'HKEY_CURRENT_USER';
  5869.         HKEY_LOCAL_MACHINE : result := 'HKEY_LOCAL_MACHINE';
  5870.         HKEY_USERS : result := 'HKEY_USERS';
  5871.         HKEY_CURRENT_CONFIG : result := 'HKEY_CURRENT_CONFIG';
  5872.         HKEY_DYN_DATA : result := 'HKEY_DYN_DATA';
  5873.         else result := '??';
  5874.         end;
  5875. end;
  5876.  
  5877.  
  5878. procedure TCakDir.AddRegnode(Rootkey : Hkey; alist : TList;var  astring : TStrings;key, subkey : string);
  5879. var i: integer;
  5880.     anode : PRegnodetype;
  5881. begin
  5882.         astring := Tstringlist.Create;
  5883.         for i := alist.Count -1 downto 0 do
  5884.             begin
  5885.                 anode := alist.Items[i];
  5886.                 if not anode^.iskey then
  5887.                 astring.Add(subkey + rkeyname(rootkey) + anode^.fullpath) else
  5888.                 astring.Add(key + rkeyname(rootkey) + anode^.fullpath);
  5889.                 if not anode^.iskey then
  5890.                    AddRegnode(Rootkey,anode^.subkey,astring,key,subkey);
  5891.             end;
  5892. end;
  5893.  
  5894. procedure TCakDir.CompareRegnode(rootkey :HKEY; list1,list2 : TList; var astring : TStrings; key,subkey : string);
  5895. var i,j: integer;
  5896.     node1, node2 : PRegnodetype;
  5897.     bstring : TStrings;
  5898. begin
  5899.         bstring := TStringList.create;
  5900.         for i := 0 to list2.count -1 do
  5901.                 begin
  5902.                 node2 := list2.items[i];
  5903.                 if node2^.iskey then
  5904.                         begin
  5905.                         j := 0;
  5906.                         if list1.count > 0 then
  5907.                         begin
  5908.                                 node1 := list1.Items[j];
  5909.                                 While ((not node1^.iskey) or (node1^.fullpath <> node2^.fullpath)) and (j < list1.count)  do
  5910.                                         begin
  5911.                                         node1 := list1.Items[j];
  5912.                                         inc(j);
  5913.                                         end;
  5914.                                 if (node1^.fullpath  <> node2^.fullpath) then
  5915.                                         astring.add(key + rkeyname(rootkey) +   node2^.fullpath);
  5916.  
  5917.                         end else if list2.count > 0 then astring.add(key + rkeyname(rootkey) + node2^.fullpath)
  5918.                         end
  5919.                         else
  5920.  
  5921.                         begin
  5922.                         j := 0;
  5923.                         if list1.count > 0 then
  5924.                         begin
  5925.                         node1 := list1.Items[j];
  5926.                         While ((node1^.iskey) or (node1^.fullpath <> node2^.fullpath)) and (j < list1.count) do
  5927.                                 begin
  5928.                                 node1 := list1.Items[j];
  5929.                                 inc(j);
  5930.                                 end;
  5931.                         if (node1^.fullpath  = node2^.fullpath) then
  5932.                                 CompareRegNode(rootkey,node1^.subkey,node2^.subkey, astring,key,subkey)
  5933.                                 else
  5934.                                 begin
  5935.                                 astring.add(subkey + rkeyname(rootkey) + node2^.fullpath);
  5936.                                 AddRegnode(rootkey,node2^.subkey,bstring,key,subkey);
  5937.                                 astring.addstrings(bstring);
  5938.                                 end;
  5939.  
  5940.                         end  else if list2.count > 0 then astring.add(subkey + rkeyname(rootkey) + node2^.fullpath);
  5941.                         end;
  5942.  
  5943.  
  5944.                 end;
  5945.         bstring.free;
  5946. end;
  5947.  
  5948. {$IFDEF USE_SHCN}
  5949. function TCakDir.MonitorShowChanges : TStrings;
  5950. var astring,bstring : TStrings;
  5951.     B_HKCU,B_HKLM : TList;
  5952. begin
  5953.         astring := TStringlist.create;
  5954.         bstring := TStringlist.create;
  5955.         astring.AddStrings(history);
  5956.         {
  5957.         B_HKCU := MakeRegnode(HKEY_CURRENT_USER,'');
  5958.         CompareRegnode(HKEY_CURRENT_USER,A_HKCU,B_HKCU,bstring,'newkey:','newsubkey:');
  5959.         CompareRegnode(HKEY_CURRENT_USER,B_HKCU,A_HKCU,bstring,'delkey:','delsubkey:');
  5960.         CleanRegNode(B_HKCU);
  5961.         astring.AddStrings(bstring);
  5962.         bstring.clear;
  5963.  
  5964.         B_HKLM := MakeRegnode(HKEY_LOCAL_MACHINE,'');
  5965.         CompareRegnode(HKEY_LOCAL_MACHINE,A_HKLM,B_HKLM,bstring,'newkey:','newsubkey:');
  5966.         CompareRegnode(HKEY_LOCAL_MACHINE,B_HKLM,A_HKLM,bstring,'delkey:','delsubkey:');
  5967.         CleanRegNode(B_HKLM);
  5968.         astring.AddStrings(bstring);
  5969.         bstring.clear;
  5970.  
  5971.         bstring.Free;
  5972.         }
  5973.         result := astring;
  5974. end;
  5975. {$ENDIF}
  5976.  
  5977.  
  5978. function TCakDir.SubDirList(dir : string) : TStrings;
  5979. var
  5980.         sr: TSearchRec;
  5981.         FileAttrs : integer;
  5982.         aStrings : TStrings;
  5983.         k : string;
  5984. begin
  5985.         aStrings := TStringList.create;
  5986.         FileAttrs := 0;
  5987.         FileAttrs := FileAttrs + faDirectory;
  5988.         k := Appendslash(dir);
  5989.         if FindFirst(k + '*', FileAttrs, sr) = 0 then
  5990.         begin
  5991.                 if Directoryexists(k + sr.Name) then
  5992.                         if (sr.name <> '.') and (sr.name <> '..') then
  5993.                         aStrings.add(AppendSlash(k+sr.Name));
  5994.                 while (FindNext(sr) = 0) do
  5995.                 if Directoryexists(k + sr.Name) then
  5996.                         if (sr.name <> '.') and (sr.name <> '..') then
  5997.                         aStrings.add(AppendSlash(k+sr.Name));
  5998.                 FindClose(sr);
  5999.         end;
  6000.         result := aStrings;
  6001. end;
  6002.  
  6003. procedure TCakDir.FindStop;
  6004. begin
  6005.         afinder.Terminate;
  6006. end;
  6007.  
  6008. procedure TCakDir.Find;
  6009. begin
  6010.         aFinder := TFinder.Create(true);
  6011.         aFinder.OnCArchiveFound := FOnFound;
  6012.         FinderOptions.af_sourcedir := AppendSlash(FinderOptions.af_sourcedir); 
  6013.         aFinder.FOption := FinderOptions;
  6014.         aFinder.Execute;
  6015.         aFinder.FreeOnTerminate := true;
  6016.         aFinder.Free;
  6017. end;
  6018.  
  6019.  
  6020.  
  6021. procedure TCakDir.Load_Script(script : TStrings);
  6022. var i,j,k,l,m,n,scriptcount : integer;
  6023.     commands : Tstrings;
  6024.     datestr,x,s,s1,var1 : string;
  6025. begin
  6026. commands := TStringList.Create;
  6027. if assigned(script) then
  6028. try
  6029. var1 := scriptvar1;
  6030. scriptcount := script.Count - 1;
  6031. i := -1;
  6032. Datestr := Datetimetostr(now);
  6033. While i < scriptcount do
  6034.         begin
  6035.         inc(i);
  6036.         if loadlines then
  6037.         if assigned(FOnMsg) then
  6038.                 FOnMsg(nil,0,'Loading lines ' + inttostr(i));
  6039.         commands.clear;
  6040.  
  6041.         s := script.strings[i];
  6042.  
  6043.         While s <> '' do
  6044.         begin
  6045.         k := 0;
  6046.         j := pos('"',s);
  6047.                 if j > 0 then
  6048.                 begin
  6049.                 s1 := Copy(s,j+1,length(s)-j);
  6050.                 k := pos('"',s1);
  6051.                 if k <> 0 then
  6052.                 commands.add(Copy(s,j+1,k-1));
  6053.                 end;
  6054.         if k <> 0 then
  6055.         s := Copy(s1,k+1,length(s)-k) else
  6056.         s := '';
  6057.         end;
  6058.  
  6059.         for j := 0 to Commands.count -1 do
  6060.         begin
  6061.         s := Uppercase(Commands.strings[J]);
  6062.         m := pos('%1%',s);
  6063.         n := pos('%F%',s);
  6064.         if (m <> 0) or (n <> 0) then
  6065.                 begin              {e.g. arc.exe c:\test.txt, var1 = ''}
  6066.                 if var1 = '' then  {e.g. arc.exe /macro1 c:\test.txt, var1 = c:\test.txt}
  6067.                 if ScriptParam.Count > 0 then
  6068.                 begin
  6069.                 for l := 0 to scriptParam.count -1 do
  6070.                         begin
  6071.                         s1 := script.strings[i];
  6072.                         m := pos('%1%',s1);
  6073.                         n := pos('%F%',s1);
  6074.                         while (m <> 0) or (n <> 0) do
  6075.                         begin
  6076.                         if m <> 0 then
  6077.                         s1 := Copy(s1,0,m-1) +
  6078.                               scriptparam.strings[l] +
  6079.                               Copy(s1,m + 3, length(s1) - m - 2);
  6080.                               
  6081.                         if n <> 0 then
  6082.                         begin
  6083.                         n := pos('%F%',s1); //Repositioning
  6084.                         s1 := Copy(s1,0,n-1) +
  6085.                               removefileext(scriptparam.strings[l]) +
  6086.                               Copy(s1,n + 3, length(s1) - n - 2);
  6087.                         end;
  6088.  
  6089.                         m := pos('%1%',s1);
  6090.                         n := pos('%F%',s1);
  6091.                         end;
  6092.  
  6093.                         script.insert(i+1, s1);
  6094.  
  6095.                         if assigned(FOnMSg) then
  6096.                                 FOnMsg(nil,0,'added '+ s1);
  6097.                         end;
  6098.                 script.Strings[i] := 'NOCMD';
  6099.                 commands.Strings[0] := 'NOCMD';
  6100.                 var1 := '';
  6101.                 end else
  6102.                 if Paramcount > 1 then if fileexists(Paramstr(2)) then
  6103.                         if Uppercase(Extractfileext(Paramstr(2))) <> '.AKS' then
  6104.                         var1 := Paramstr(2);
  6105.  
  6106.                 if var1 <> '' then
  6107.                         Commands.Strings[j] := var1 + Copy (Commands.strings[j],4,Length(s)-3);
  6108.                 scriptcount := script.Count - 1;
  6109.                 end;
  6110.         s := Uppercase(Commands.strings[J]);
  6111.         k := pos('%DATE%',s);
  6112.         if k <> 0 then
  6113.         Commands.Strings[j] := Copy(Commands.strings[J],0,k-1) + DateStr + Copy(Commands.strings[J],k+6,length(s)-k-5);
  6114.         k := pos('%TEMP%',s);
  6115.         if k = 1 then
  6116.         Commands.Strings[j] := GrabTEMPpath + Copy(Commands.strings[J],8,length(s)-7);
  6117.         k := pos('%WINDOWS%',s);
  6118.         if k = 1 then
  6119.         Commands.Strings[j] := GrabWINDOWpath + Copy(Commands.strings[J],11,length(s)-10);
  6120.         k := pos('%DESKTOP%',s);
  6121.         if k = 1 then
  6122.         Commands.Strings[j] := GrabDESKTOPpath + Copy(Commands.strings[J],11,length(s)-10);
  6123.         k := pos('%ARCHIVE%',s);
  6124.         if k = 1 then
  6125.         if Total_Archive > 0 then
  6126.         Commands.Strings[j] := Appendslash(Extractfilepath(Archive_List[0]._Arcname)) + Copy(Commands.strings[J],11,length(s)-10);
  6127.         end;
  6128.  
  6129.         s := Uppercase(script.strings[i]);
  6130.  
  6131.         if pos('NEW ',s) = 1 then
  6132.                 if commands.count >= 0 then
  6133.                         if not fileexists(commands.strings[0]) then
  6134.                         New_archive(commands.strings[0]) else
  6135.                         begin
  6136.                         l := 0;
  6137.                         x := Format('%s%d%s',[removefileext(commands.strings[0]), l,extractfileext(commands.strings[0])]);
  6138.                         While (l <= 99) and fileexists(x) do
  6139.                                 begin
  6140.                                 inc(l);
  6141.                                 x := Format('%s%d%s',[removefileext(commands.strings[0]), l,extractfileext(commands.strings[0])]);
  6142.                                 end;
  6143.  
  6144.  
  6145.                         if not fileexists(x) then
  6146.                                 New_Archive(x) else
  6147.                                 begin
  6148.                                 Add_Archive_List(commands.strings[0]);
  6149.                                 List_archive(0,0);
  6150.                                 end;
  6151.                         end;
  6152.  
  6153.         if pos('CLOSE ',s) = 1 then
  6154.                         Clear_archive_List;
  6155.         
  6156.         if pos('OPEN ',s) = 1 then
  6157.                 if commands.count >= 0 then
  6158.                         if fileexists(commands.strings[0]) then
  6159.                         begin
  6160.                         Add_Archive_List(commands.strings[0]);
  6161.                         List_archive(0,0);
  6162.                         if (Archive_list[0]._ARCtype = _ZIP) and (Assigned(Zipdir)) and (Fileexists(archivename)) then
  6163.                                 AddOptions.add_mode := AddOptions.add_mode + [_update]; 
  6164.                         end
  6165.                         else
  6166.                         New_archive(commands.strings[0]);
  6167.  
  6168.         if (pos('EXTR ',s) = 1) or (pos('EXTRACT ',s) = 1) then
  6169.                 if Total_Archive > 0 then
  6170.                 if commands.count >= 2 then
  6171.                         begin
  6172.                         Mask_Add_selected_List(commands.strings[0],Archive_List[0]._Arcname);
  6173.                         Extractoptions.extr_to := Commands.strings[1];
  6174.                         Extract;
  6175.                         end;
  6176.  
  6177.         if pos('ADD ',s) = 1 then
  6178.                 if Total_Archive > 0 then
  6179.                 if commands.count > 0 then
  6180.                         begin
  6181.                         AddOptions.add_to := Total_Archive-1;
  6182.                         AddOptions.add_files.Add(commands.strings[0]);
  6183.                         end;
  6184.  
  6185.         if pos('CONVERT ',s) = 1 then
  6186.                 if commands.count > 1 then
  6187.                         begin
  6188.                         Archive_Convert(commands.strings[0],Getarctype('xyz.'+commands.strings[1]));
  6189.                         end;
  6190.  
  6191.         if pos('SYNC ',s) = 1 then
  6192.                 if Total_Archive > 0 then
  6193.                 if commands.count > 0 then
  6194.                         begin
  6195.                         AddOptions.add_to := Total_Archive-1;
  6196.  
  6197.                         if AddOptions.add_Usepath then
  6198.                         j := Get_Archive_Code(Archive_List[0]._arcname,removedrive(commands.strings[0])) else
  6199.                         j := Get_Archive_Code(Archive_List[0]._arcname,extractfilename(commands.strings[0]));
  6200.  
  6201.                         if j <> -1 then
  6202.                                 begin
  6203.                                 if FileDateToDateTime(FileAge(commands.strings[0])) > archive_contents[j]._FileTime then
  6204.                                         AddOptions.add_files.Add(commands.strings[0]);
  6205.                                 end;
  6206.                         end;
  6207.  
  6208.         if pos('DATESTR',s) = 1 then
  6209.                 if commands.count > 0 then
  6210.                         DateStr := Decodetimestr(commands.strings[0]);
  6211.  
  6212.         if pos('DOADD',s) = 1 then
  6213.                 if Total_Archive > 0 then
  6214.                 if AddOptions.add_files.count > 0 then
  6215.                         Add;
  6216.  
  6217.         if pos('DEL ',s) = 1 then
  6218.                 if Total_Archive > 0 then
  6219.                 if commands.count > 0 then
  6220.                         begin
  6221.                         Mask_Add_selected_List(commands.strings[0],Archive_List[0]._Arcname);
  6222.                         Delete
  6223.                         end;
  6224.  
  6225.         if pos('REN ',s) = 1 then
  6226.                 if Total_Archive > 0 then
  6227.                 if Archive_List[0]._Arctype = _ZIP then
  6228.                 if commands.count > 1 then
  6229.                 if Get_Archive_Code(Archive_List[0]._Arcname,commands.strings[0]) <> -1 then
  6230.                 if Get_Archive_Code(Archive_List[0]._Arcname,commands.strings[1]) = -1 then
  6231.                         Zipdirrename(commands.strings[0],commands.strings[1]);
  6232.  
  6233.         if pos('RENDIR ',s) = 1 then
  6234.                 if Total_Archive > 0 then
  6235.                 if Archive_List[0]._Arctype = _ZIP then
  6236.                 if commands.count > 1 then
  6237.                         Zipdirrenamedir(commands.strings[0],commands.strings[1]);
  6238.  
  6239.         if pos('PASSWORD ',s) = 1 then
  6240.                 if commands.count > 0 then
  6241.                         AddOptions.add_encrypt := commands.strings[0] else
  6242.                         AddOptions.add_encrypt := '';
  6243.  
  6244.         AddOptions.add_useencrypt := (AddOptions.add_encrypt <> '');
  6245.  
  6246.         if pos('VERSIONCONTROL ',s) = 1 then
  6247.                 if commands.count > 0 then
  6248.                         if Uppercase(Commands.strings[0]) = 'ON' then
  6249.                                 versioncontrol := true else
  6250.                         if Uppercase(Commands.strings[0]) = 'OFF' then
  6251.                                 versioncontrol := false;
  6252.  
  6253.         if pos('USEEXTRPATH ',s) = 1 then
  6254.                 if commands.count > 0 then
  6255.                         if Uppercase(Commands.strings[0]) = 'ON' then
  6256.                                 Extractoptions.extr_DirNames := true else
  6257.                         if Uppercase(Commands.strings[0]) = 'OFF' then
  6258.                                 Extractoptions.extr_DirNames := false;
  6259.  
  6260.         if pos('USEADDPATH ',s) = 1 then
  6261.                 if commands.count > 0 then
  6262.                         if Uppercase(Commands.strings[0]) = 'ON' then
  6263.                                 Addoptions.add_usepath := true else
  6264.                         if Uppercase(Commands.strings[0]) = 'OFF' then
  6265.                                 Addoptions.add_usepath := false;
  6266.  
  6267.         if pos('USESUBDIR ',s) = 1 then
  6268.                 if commands.count > 0 then
  6269.                         if Uppercase(Commands.strings[0]) = 'ON' then
  6270.                                 Addoptions.add_subdir := true else
  6271.                         if Uppercase(Commands.strings[0]) = 'OFF' then
  6272.                                 Addoptions.add_subdir := false;
  6273.  
  6274.  
  6275.         if pos('RUNFILE ',s) = 1 then
  6276.                 Case commands.count of
  6277.                 1 : Run(commands.strings[0],'');
  6278.                 2 : Run(commands.strings[0],commands.strings[1]);
  6279.                 end;
  6280.  
  6281.         if pos('MOVEFILE ',s) = 1 then
  6282.                 if commands.count > 1 then
  6283.                 Movefile(PCHAR(commands.strings[0]),PCHAR(commands.strings[1]));
  6284.  
  6285.         if pos('RENFILE ',s) = 1 then
  6286.                 if commands.count > 1 then
  6287.                 Renamefile(commands.strings[0],commands.strings[1]);
  6288.  
  6289.         if pos('DELFILE ',s) = 1 then
  6290.                 if commands.count > 0 then
  6291.                         if fileexists(commands.strings[0]) then
  6292.                                 deletefile(commands.strings[0]);
  6293.  
  6294.         if pos('DELDIR ',s) = 1 then
  6295.                 if commands.count > 0 then
  6296.                                 begin
  6297.                                 //DeleteAllfiles(commands.strings[0]);
  6298.                                 Deletedir(commands.strings[0]);
  6299.                                 end;
  6300.  
  6301.         if pos('BACKUPREG ',s) = 1 then
  6302.                 if commands.count > 3 then
  6303.                         RegBackup(name2rkey(commands.strings[0]),commands.strings[1],commands.strings[2],commands.strings[3]);
  6304.  
  6305.         if pos('TXTFLIST ',s) = 1 then
  6306.                 if commands.count > 0 then
  6307.                         FileList(_txt,commands.strings[0],0,total_archive -1);
  6308.  
  6309.         if pos('HTMFLIST ',s) = 1 then
  6310.                 if commands.count > 0 then
  6311.                         FileList(_htm,commands.strings[0],0,total_archive -1);
  6312.  
  6313.         if pos('PDFFLIST ',s) = 1 then
  6314.                 if commands.count > 0 then
  6315.                         FileList(_pdf,commands.strings[0],0,total_archive -1);
  6316.  
  6317.         if pos('PDF2FLIST ',s) = 1 then
  6318.                 if commands.count > 0 then
  6319.                         FileList(_pdf2,commands.strings[0],0,total_archive -1);
  6320.  
  6321.         if pos('SPAN ',s) = 1 then
  6322.                 if commands.count > 2 then
  6323.                         DiskSpan(commands.strings[0],commands.strings[1],strtointdef(commands.strings[2],1000*1024),true);
  6324.  
  6325.         if pos('MSG ',s) = 1 then
  6326.                 if commands.count > 0 then
  6327.                         if assigned(FOnMsg) then
  6328.                                 FOnMsg(nil,0,commands.strings[0]);
  6329.  
  6330.         if pos('EMAIL ',s) = 1 then
  6331.                 if commands.count > 0 then
  6332.                         Sendmail('Subject','','','','',commands.strings[0],Archivename,Extractfilename(Archivename),true);
  6333.  
  6334.         if pos('BATCHADD ',s) = 1 then
  6335.                 if commands.count > 1 then
  6336.                         begin
  6337.  
  6338.                         Archivename := commands.Strings[1];
  6339.                         AddOptions.add_files.Clear;
  6340.                         AddOptions.add_files.Add(commands.Strings[0]);
  6341.                         Add;
  6342.                         Clear_Archive_List;
  6343.                         end;
  6344.  
  6345.         if pos('CLOSEARC',s) = 1 then
  6346.                 Application.Terminate;
  6347.         end;
  6348. except
  6349. if assigned(FOnMsg) then
  6350. FOnMsg(nil,0,'Error Loading Script');
  6351. end;
  6352.  
  6353. commands.Free;
  6354. end;
  6355.  
  6356. procedure TCakDIr.DiskUnSpan(filename : string);
  6357. var tf,sf : file;
  6358.     buf : array[1..500] of byte;
  6359.     textf : tstrings;
  6360.     numread : longint;
  6361.     i : integer;
  6362. begin
  6363.         textf := Tstringlist.create;
  6364.         textf.LoadFromFile(filename);
  6365.         Assignfile(tf,textf.strings[0]);
  6366.         Rewrite(tf,1);
  6367.         For i := 1 to textf.count -1 do
  6368.                 begin
  6369.                 Assignfile(sf,textf.strings[i]);
  6370.                 Reset(sf,1);
  6371.                 While numread > 0 do
  6372.                         begin
  6373.                         Blockread(sf,buf,sizeof(buf),numread);
  6374.                         BlockWrite(tf,buf,numread);
  6375.                         end;
  6376.                 Closefile(sf);
  6377.                 end;
  6378.         Closefile(tf);
  6379.         textf.free;
  6380. end;
  6381. function TCakDir.DiskSpan(source, target : string; disksize : longint; MakeBatch : boolean) : integer;
  6382. const BREAK = #13#10;
  6383.       batadd1 = '@echo off'+BREAK+
  6384.                 'set lbl=a'+BREAK+
  6385.                 'goto logo'+BREAK+
  6386.                 ':a'+BREAK+
  6387.                 'if "%1"=="/auto" goto b'+BREAK+
  6388.                 'choice /C:yn /N /T:Y,3 Reconstruct archive [will default to Yes in 3 secs]?'+BREAK+
  6389.                 'echo.'+BREAK+
  6390.                 'if errorlevel 2 goto end'+BREAK+
  6391.                 ':b'+BREAK+
  6392.                 'set lbl=c'+BREAK+
  6393.                 'goto logo'+BREAK+
  6394.                 ':c'+BREAK+
  6395.                 'echo Reconstructing archive, please wait.....';
  6396.       batadd2 = 'Echo                                         ....done'+BREAK+
  6397.                 'goto end'+BREAK+
  6398.                 ':logo'+BREAK+
  6399.                 'cls'+BREAK+
  6400.                 'Echo ' + PRODUCT + ' UnSpanner'+BREAK+
  6401.                 'Echo.'+BREAK+
  6402.                 'Echo Copyright (c) Joseph Leung, 1999-2001'+BREAK+
  6403.                 'echo.'+BREAK+
  6404.                 'goto %lbl%'+BREAK+
  6405.                 ':end'+BREAK+
  6406.                 'echo.'+BREAK+
  6407.                 'echo Press any key to exit...'+BREAK+
  6408.                 'if not "%1"=="/auto" pause > nul'+BREAK+
  6409.                 'cls';
  6410.  
  6411. var tf,sf : file;
  6412.     textf : textfile;
  6413.     fsize,remainsize : longint;
  6414.     buf : array[1..500] of byte;
  6415.     numread : longint;
  6416.     disk : integer;
  6417.     k,l : string;
  6418.     i : integer;
  6419. begin
  6420.         Assignfile(sf,source);
  6421.         Reset(sf,1);
  6422.         fsize := Filesize(sf);
  6423.         Seek(sF,0);
  6424.         disk := 0;
  6425.         while fsize > 0 do
  6426.         begin
  6427.                 inc(disk);
  6428.                 Assignfile(tf,target + '.' + inttostr(disk));
  6429.                 Rewrite(tf,1);
  6430.                 remainsize := disksize;
  6431.                 numread := -1;
  6432.                 while (remainsize >= 0) and (numread <> 0) do
  6433.                         begin
  6434.                         BlockRead(sf,buf,sizeof(buf),numread);
  6435.                         Dec(Remainsize,numread);
  6436.                         if numread > 0 then
  6437.                         BlockWrite(tf,Buf,numread);
  6438.                         end;
  6439.                 if Isfloppy(source[1]) then
  6440.                         Writeln('Please insert another floppy disk');
  6441.  
  6442.                 Closefile(tf);
  6443.                 Dec(fsize,disksize);
  6444.         end;
  6445.         Closefile(sf);
  6446.         k := extractfilename(target);
  6447.         l := extractfilename(source);
  6448.  
  6449.         Assignfile(textf,target + '.x');
  6450.         Rewrite(textf);
  6451.         writeln(textf,l);
  6452.         for i := 1 to disk  do
  6453.                 Write(textf,k + '.' + inttostr(i));
  6454.         Closefile(textf);
  6455.         
  6456.         if MakeBatch then
  6457.         begin
  6458.         Assignfile(textf,target + '.bat');
  6459.         Rewrite(textf);
  6460.         Writeln(textf,batadd1);
  6461.  
  6462.         write(textf,'Copy /b ');
  6463.         Write(textf, k + '.1');
  6464.         for i := 2 to disk  do
  6465.                 Write(textf,'+' + k + '.' + inttostr(i));
  6466.         Writeln(textf,' ' + l + ' >nul');
  6467.  
  6468.         Writeln(textf,batadd2);
  6469.         Closefile(textf);
  6470.         end;
  6471.         result := disk;
  6472. end;
  6473.  
  6474. procedure TCakDir.ProcessAKS(processwhat : worktype);
  6475. var astrings : TStrings;
  6476.     Cakdir2 : TCakDir;
  6477. begin
  6478.         if processwhat <> _LoadContents then exit;
  6479.         if assigned(FOnMsg) then
  6480.         FOnMsg(nil,0,'Loading ' + Archive_List[0]._Arcname + ' now.');
  6481.         astrings := TstringList.Create;
  6482.         CakDir2 := TCakDir.Create(nil);
  6483.         if assigned(FOnMsg) then
  6484.         CakDir2.OnCMessage := FONMsg;
  6485.         try
  6486.         cakdir2.ScriptParam.AddStrings(scriptparam);
  6487.         CakDir2.scriptvar1 := scriptvar1;
  6488.         astrings.LoadFromFile(Archive_List[0]._Arcname);
  6489.         CakDir2.Load_Script(astrings);
  6490.         finally
  6491.         CakDir2.Free;
  6492.         astrings.free;
  6493.         if assigned(FOnMsg) then
  6494.         FOnMsg(nil,0,'Finish Loading.');
  6495.         end;
  6496. end;
  6497. procedure TCakDir.Filename_Truncate(arcname : string);
  6498. var CakDir2 : TCakDir;
  6499.     i : integer;
  6500.     k : string;
  6501.     newfilename : string; 
  6502. begin
  6503.         CakDir2 := TCakDir.Create(nil);
  6504.         CakDir2.Set_Archive_List(arcname);
  6505.         CakDir2.List_Archive(0,0);
  6506.         k := Newtemppath;
  6507.         if CakDir2.cando(CakDir2.GetArctype(arcname),_Delete) then
  6508.         if CakDir2.cando(CakDir2.GetArctype(arcname),_Add) then
  6509.     With CakDir2 do
  6510.         begin
  6511.         Clear_Selected_List;
  6512.         for i := 0 to total_Contents -1 do
  6513.         if Archive_Contents[i]._FileDefPath = '' then
  6514.         if Length(Removefileext(Archive_Contents[i]._Filename)) > 8 then
  6515.         begin
  6516.         ExtractOptions.extr_to := k;
  6517.         ExtractOptions.extr_DirNames := false;
  6518.         ExtractOptions.extr_OverWrite := true;
  6519.         Archive_Contents[i]._Selected := true;
  6520.         Extract;
  6521.         Archive_Contents[i]._Selected := true;
  6522.  
  6523.         newfilename := Removefileext(Archive_Contents[i]._Filename);
  6524.         newfilename := Copy(newfilename,0,6) + '~1' + Extractfileext(Archive_Contents[i]._Filename);
  6525.         newfilename := k + newfilename;
  6526.         if Renamefile(k + archive_Contents[i]._filename,newfilename) then
  6527.                 begin
  6528.                 Delete;
  6529.                 AddOptions.add_to := 0;
  6530.                 AddOptions.add_files.Add(newfilename);
  6531.                 Add;
  6532.                 end;
  6533.         end;
  6534.         end;
  6535.         showmessage('Finished truncated');
  6536. end;
  6537.  
  6538. procedure TCakDir.Archive_Convert(filename : string; totype : supporttype);
  6539. var i : integer;
  6540.     CakDir2 : TCakDir;
  6541.     k : string;
  6542.     astrings : TStrings;
  6543. begin
  6544.         astrings := TstringList.Create;
  6545.         CakDir2 := TCakDir.Create(nil);
  6546.         try
  6547.         CakDir2.Set_Archive_List(filename);
  6548.         CakDir2.List_Archive(0,0);
  6549.         For i := 0 to CakDir2.Total_Contents -1 do
  6550.                 astrings.Add(CakDir2.Archive_Contents[i]._Filename);
  6551.         CakDir2.Add_All_Selected_List;
  6552.         k := CakDir2.newtemppath;
  6553.         CakDir2.Extractoptions.extr_to := k;
  6554.         CakDir2.Extractoptions.extr_DirNames := false;
  6555.         cakdir2.Extractoptions.extr_ArcINArc := false;
  6556.         CakDir2.Extract;
  6557.  
  6558.         CakDir2.New_Archive(Removefileext(filename) + '.' + GetarcString(totype));
  6559.         CakDir2.AddOptions.add_files.Clear;
  6560.         For i := 0 to astrings.count -1 do
  6561.         CakDir2.AddOptions.add_files.Add(k + astrings.strings[i]);
  6562.         CakDir2.AddOptions.add_usepath := false;
  6563.         CakDir2.Add;
  6564.         finally
  6565.         CakDir2.Free;
  6566.         end;
  6567. end;
  6568.  
  6569. procedure TCakdir.DeleteDir(aDir: string);
  6570.  { delete directory & everything in it }
  6571.  var
  6572.    T: TSHFileOpStruct;  {here is a compiler error, tshfileopstruct not
  6573. found}
  6574.  begin
  6575.    Fillchar(T, SizeOf(T), #0);
  6576.    aDir := aDir + #0;
  6577.    with T do
  6578.    begin
  6579.      Wnd := 0; // no handle -> no animation
  6580.      wFunc := FO_DELETE;
  6581.      pFrom := pchar(aDir);
  6582.      fFlags := FOF_SILENT or FOF_NOCONFIRMATION; // just do it
  6583.    end;
  6584.    if (SHFileOperation(T) <> 0) then
  6585.         if assigned(FonMsg) then
  6586.                 FOnMsg(nil,0,'Error on deleting dir');
  6587.  end; {DeleteDir}
  6588.  
  6589. function TCakDir.CreateShortcut(linkfilename,filepath : string) : boolean;
  6590. var k : string;
  6591. begin
  6592.           k := filepath;
  6593.           if Links.CreateLink(k,
  6594.             linkfilename,
  6595.             Extractfilename(k)) = True then
  6596.             Result := true
  6597.           else
  6598.             Result := false;
  6599. end;
  6600.  
  6601. function TCakDir.DiskMakeImage(drive : integer; filename : string) : boolean;
  6602. var F: TMemoryStream;
  6603.     FBuf: Pointer;
  6604.     nSize: integer;
  6605.     FSBR : PFSBR;
  6606. begin
  6607.         Result := false;
  6608.         F := TMemoryStream.Create;
  6609.         FBuf := AllocMem(512);
  6610.         try
  6611.         if Extractfilename(filename) <> '' then
  6612.         if ReadFloppyFSBR(drive, FSBR) then
  6613.                 if 1474560 = FSBR.BPB.BytesPerSector * FSBR.BPB.SectorsOnDrive then
  6614.                 begin
  6615.                 nsize := FSBR.BPB.BytesPerSector * FSBR.BPB.SectorsOnDrive;
  6616.                 F.SetSize(nsize);
  6617.                 F.Seek(0, 0);
  6618.                 FreeMem(FBuf);
  6619.                 FBuf := AllocMem(nSize);
  6620.                 if not ReadSector(drive, 0 , FSBR.BPB.SectorsOnDrive, FBuf ) then
  6621.                 if Assigned(FOnMsg) then
  6622.                         FOnMsg(nil,0,'Error reading sector');
  6623.  
  6624.                 F.Seek(0, 0);
  6625.                 F.Write(FBuf^, nSize);
  6626.                 F.Seek(0, 0);
  6627.                 F.SaveToFile(filename);
  6628.                 if Assigned(FOnMsg) then
  6629.                         FOnMsg(nil,0,'Created ' + filename);
  6630.                 Result := true;
  6631.                 end;
  6632.         finally
  6633.         F.Free;
  6634.         FreeMem(FBuf);
  6635.         end;
  6636. end;
  6637.  
  6638. function TCakDir.DiskWriteImage(drive : integer; filename : string) : boolean;
  6639. var F: TMemoryStream;
  6640.     FBuf: Pointer;
  6641.     nSize: integer;
  6642.     FSBR : PFSBR;
  6643. begin
  6644.         Result := false;
  6645.         if not ReadFloppyFSBR(drive, FSBR) then
  6646.                 begin
  6647.                 if Assigned(FOnMsg) then
  6648.                         FOnMsg(nil,0,'Floppy not ready');
  6649.                 exit;
  6650.                 end;
  6651.  
  6652.         if not DriveIsRemovable(drive) then
  6653.                 begin
  6654.                 if Assigned(FOnMsg) then
  6655.                         FOnMsg(nil,0,'Not a Floppy');
  6656.                 exit;
  6657.                 end;
  6658.  
  6659.         if not DirectAccessAllowed(drive) then
  6660.                 begin
  6661.                 if Assigned(FOnMsg) then
  6662.                         FOnMsg(nil,0,'Not accessable');
  6663.                 exit;
  6664.                 end;
  6665.                 nsize := FSBR.BPB.BytesPerSector * FSBR.BPB.SectorsOnDrive;
  6666.         if 1474560 = nsize then
  6667.                 begin
  6668.                 F := TMemoryStream.Create;
  6669.                 FBuf := AllocMem(512);
  6670.                 try
  6671.                 F.SetSize(nSize);
  6672.                 F.Seek(0, 0);
  6673.                 FreeMem(FBuf);
  6674.                 FBuf := AllocMem(nSize);
  6675.                 F.LoadfromFile(filename);
  6676.                 F.Seek(0, 0);
  6677.                 F.Read(FBuf^, nSize);
  6678.                 F.Seek(0, 0);
  6679.  
  6680.                 if not WriteSector(drive, 0 , FSBR.BPB.SectorsOnDrive, FBuf, $0000 ) then
  6681.                         if Assigned(FOnMsg) then
  6682.                         FOnMsg(nil,0,'Error writing sectors');
  6683.  
  6684.                 FreeFloppyFSBR(FSBR);
  6685.                 if Assigned(FOnMsg) then
  6686.                         FOnMsg(nil,0,'Restored ' + filename);
  6687.                 Result := true;
  6688.                 finally
  6689.                 F.Free;
  6690.                 FreeMem(FBuf);
  6691.                 end;
  6692.                 end;
  6693.  
  6694. end;
  6695.  
  6696. {$IFDEF USE_ZIP}
  6697. procedure TCakDir.SFX2ZIP(SFXname : string);
  6698. begin
  6699.         Load_ZIP_DLL;
  6700.         Zipdir.ZipFileName := SFXname;
  6701.         Zipdir.ConvertZIP;
  6702. end;
  6703. {$ENDIF}
  6704.  
  6705. procedure TCakDir.RegBackup(RKey : HKey; KeyPath, Value : string;filename : string);
  6706. var vallist : Tstrings;
  6707.     subkeylist : Tstrings;
  6708.     tf : textfile;
  6709.     i : integer;
  6710. begin
  6711.         if Value = '' then
  6712.         begin
  6713.         vallist := RegListval(RKey, Keypath);
  6714.         subkeylist := RegListsubkey(RKey,Keypath);
  6715.         for i := 0 to vallist.Count -1 do
  6716.                 RegBackup(RKey,Keypath,vallist.strings[i],filename);
  6717.         for i := 0 to subkeylist.count -1 do
  6718.                 RegBackup(RKey,Keypath + '\' + subkeylist.strings[i],'',filename);
  6719.         end else
  6720.         if GetvalinReg(RKey,Keypath,Value) <> '' then
  6721.                 begin
  6722.                 assignfile(tf,filename);
  6723.                 if fileexists(filename) then
  6724.                 Append(tf)
  6725.                 else
  6726.                 begin
  6727.                 Rewrite(tf);
  6728.                 Writeln(tf,'REGEDIT4');
  6729.                 Writeln(tf);
  6730.                 end;
  6731.  
  6732.                 Writeln(tf,'[' + rkeyname(rkey) + '\' + keypath + ']');
  6733.                 Write(tf, '"' + Value + '"=');
  6734.                 Writeln(tf,'"' + GetvalinReg(RKey,Keypath,Value) + '"');
  6735.                 Writeln(tf);
  6736.  
  6737.                 Closefile(tf);
  6738.                 end;
  6739. end;
  6740.  
  6741. function TCakDir.RegListsubkey(RKey : HKey; KeyPath : string) : TStrings;
  6742. var keylist : TStrings;
  6743.     Reg: TRegistry;
  6744.     k : string;
  6745. begin
  6746.     Reg := TRegistry.Create;
  6747.     keylist := TStringlist.create;
  6748.  
  6749.     Reg.RootKey := RKEY;
  6750.     k := keypath;
  6751.     if k = '' then k := '\';
  6752.  
  6753.     if Reg.OpenKey(K, False) then
  6754.            Reg.GetKeyNames(keylist);
  6755.     Reg.CloseKey;
  6756.     Reg.Free;
  6757.     Result := keylist;
  6758. end;
  6759. function TCakDir.RegListVal(RKey : HKey; KeyPath : string) : TStrings;
  6760. var keylist : TStrings;
  6761.     Reg: TRegistry;
  6762.     k : string;
  6763. begin
  6764.     Reg := TRegistry.Create;
  6765.     keylist := TStringlist.create;
  6766.  
  6767.     Reg.RootKey := RKEY;
  6768.     k := keypath;
  6769.     if k = '' then k := '\';
  6770.  
  6771.     if Reg.OpenKey(K, False) then
  6772.            Reg.GetValueNames(keylist);
  6773.     Reg.CloseKey;
  6774.     Reg.Free;
  6775.     Result := keylist;
  6776. end;
  6777.  
  6778. {$IFDEF USE_CZIP}
  6779. procedure TCakDir.CrytoZip;
  6780. begin
  6781.         if Total_Archive = 0 then exit;
  6782.         if Archive_List[0]._ARCtype <> _ZIP then exit;
  6783.         processfrom := 0;
  6784.         processto := 0;
  6785.         processZIP(_CryptoZip);
  6786. end;
  6787. {$ENDIF}
  6788.  
  6789. function TCakDir.DeleteAllFiles(FilesOrDir: string): boolean;
  6790. { Sends files or directory to the recycle bin. }
  6791. var
  6792.   F:         TSHFileOpStruct;
  6793.   From:      string;
  6794.   Resultval: integer;
  6795. begin
  6796.   result := false;
  6797.   if length(filesordir) <= 3 then exit;// (delete root?)
  6798.   FillChar(F, SizeOf(F), #0);
  6799.   From          := FilesOrDir + #0;
  6800.   Screen.Cursor := crHourGlass;
  6801.   try
  6802.     F.wnd   := 0;
  6803.     F.wFunc := FO_DELETE;
  6804.     F.pFrom := PChar(From);
  6805.     F.pTo   := nil;
  6806.  
  6807.     F.fFlags := FOF_ALLOWUNDO or
  6808.       FOF_NOCONFIRMATION or
  6809.       FOF_SIMPLEPROGRESS or
  6810.       FOF_FILESONLY;
  6811.  
  6812.     F.fAnyOperationsAborted := False;
  6813.     F.hNameMappings := nil;
  6814.     Resultval := ShFileOperation(F);
  6815.     Result    := (ResultVal = 0);
  6816.   finally
  6817.     Screen.Cursor := crDefault;
  6818.   end;
  6819. end;
  6820.  
  6821. procedure TCakDir.SetDefaultTreasAs;
  6822. begin
  6823.      TreatAsZip := DefaultTreatAsZip;
  6824.      TreatAsRar := DefaultTreatAsRar;
  6825.      TreatAsCab := DefaultTreatAsCab;
  6826.      TreatAsArj := DefaultTreatAsArj;
  6827.      TreatAsLha := DefaultTreatAsLha;
  6828.      TreatAsTar := DefaultTreatAsTar;
  6829.      TreatAsTgz := DefaultTreatAsTgz;
  6830.      TreatAsAce := DefaultTreatAsAce;
  6831.      TreatAsBz2 := DefaultTreatAsBz2;
  6832.      TreatAsBel := DefaultTreatAsBel;
  6833.      TreatAsGca := DefaultTreatAsGca;
  6834.      TreatAsBza := DefaultTreatAsBza;
  6835.      TreatAsRs := DefaultTreatAsRs;
  6836.      TreatAsCzip := DefaultTreatAsCzip;
  6837.      TreatAsYz1 := DefaultTreatAsYz1;
  6838.      TreatAsUue := DefaultTreatAsUue;
  6839.      TreatAsXxe := DefaultTreatAsXxe;
  6840.      TreatAsB64 := DefaultTreatAsB64;
  6841.      TreatAsPak := DefaultTreatAsPak;
  6842.      TreatAsAks := DefaultTreatAsAks;
  6843. end;
  6844.  
  6845. function TCakDir.Get_Archive_Name : string;
  6846. begin
  6847.         if Total_Archive > 0 then
  6848.         result := Archive_List[0]._Arcname else
  6849.         result := '';
  6850. end;
  6851.  
  6852. procedure TCakDir.SetArchivetype(value : supportType);
  6853. begin
  6854.         if Total_Archive > 0 then
  6855.                 Archive_List[0]._Arctype := value;
  6856. end;
  6857.  
  6858. function TCakDir.GetArchivetype : supportType;
  6859. begin
  6860.         if Total_Archive = 0 then
  6861.                 Result := _WIT else
  6862.                 Result := Archive_List[0]._Arctype;
  6863. end;
  6864.  
  6865. function TCakDir.CanAdd : boolean;
  6866. begin
  6867.         if Total_Archive = 0 then
  6868.                 result := false else
  6869.                 Result := Cando(Archive_List[0]._Arctype,_Add);
  6870. end;
  6871.  
  6872. function TCakDir.CanExtract : boolean;
  6873. begin
  6874.         if Total_Archive = 0 then
  6875.                 result := false else
  6876.                 Result := Cando(Archive_List[0]._Arctype,_Extract);
  6877. end;
  6878. function TCakdir.pollfilelist(maskedname : string;subdir : boolean) : tstrings;
  6879. var sr : TSearchRec;
  6880.     astrings : tstrings;
  6881.     k : string;
  6882. begin
  6883.         astrings := tstringlist.create();
  6884.         k := Appendslash(extractfilepath(maskedname));
  6885.  
  6886.         if FindFirst(maskedname,faAnyfile and faHidden,sr) = 0 then
  6887.         begin
  6888.         if (sr.name <> '.') and (sr.name <> '..') then
  6889.                 if fileexists(k + sr.Name) then
  6890.                 astrings.Add(k + sr.Name);
  6891.         while FindNext(sr) = 0 do
  6892.         if (sr.name <> '.') and (sr.name <> '..') then
  6893.                 if fileexists(k + sr.Name) then
  6894.                 astrings.Add(k + sr.Name);
  6895.  
  6896.         end;
  6897.         FindClose(sr);
  6898.  
  6899.         if subdir then
  6900.         if pos('*',maskedname) <> 0 then
  6901.         begin
  6902.         if FindFirst(Appendslash(extractfilepath(maskedname)) + '*.*',faDirectory + faHidden ,sr) = 0 then
  6903.         begin
  6904.  
  6905.         if (sr.name <> '.') and (sr.name <> '..') then
  6906.         if directoryexists(k + sr.name) then
  6907.         astrings.addstrings(pollfilelist(appendslash(k + sr.name) +  Extractfilename(maskedname) ,subdir));
  6908.  
  6909.         While FindNext(sr) = 0 do
  6910.                 if (sr.name <> '.') and (sr.name <> '..') then
  6911.                 if directoryexists(k + sr.name) then
  6912.                 astrings.addstrings(pollfilelist(appendslash(k + sr.name) +  Extractfilename(maskedname) ,subdir));
  6913.  
  6914.         end;
  6915.         FindClose(sr);
  6916.         end;
  6917.  
  6918.         result := astrings;
  6919.  
  6920. end;
  6921.  
  6922. procedure TCakdir.GenerateIndex(path : string; masks : tstrings;  Indexfilename,Contentfilename : string);
  6923. var i,j : integer;
  6924.     FnHolder : tstringlist;
  6925.     dummy : tstrings;
  6926.     AvaliableChars : string;
  6927.     Lastchar : char;
  6928.     df : textfile;
  6929.     k : string;
  6930. procedure TD;
  6931. begin
  6932.         write(df,'<TD ALIGN=CENTER COLSPAN=3>');
  6933. end;
  6934. procedure TD2;
  6935. begin
  6936.         write(df,'<TD>');
  6937. end;
  6938. procedure EndTD;
  6939. begin
  6940.         write(df,'</TD>');
  6941. end;
  6942. procedure TR;
  6943. begin
  6944.         write(df,'<TR>');
  6945. end;
  6946. procedure TR2;
  6947. begin
  6948.         write(df,'<TR bgcolor="#FFFFCC">');
  6949. end;
  6950. procedure B;
  6951. begin
  6952.         write(df,'<B>');
  6953. end;
  6954. procedure EndB;
  6955. begin
  6956.         write(df,'</B>');
  6957. end;
  6958. procedure P20;
  6959. var i : integer;
  6960. begin
  6961.         for i := 1 to 10 do
  6962.                 Write(df,'<p> </p>');
  6963. end;
  6964. procedure writefilename(filename : string);
  6965. begin
  6966.         writeln(df,'<A HREF='+fnHolder.strings[i]+ '>' + Extractfilename(fnHolder.strings[i]) + '</A>');
  6967. end;
  6968. procedure writelink(display,link : string; wantreturn : boolean);
  6969. begin
  6970.         write(df,'<A HREF=' + link + '>' + display + '</A>');
  6971.         if wantreturn then writeln(df);
  6972. end;
  6973. procedure writeanchor(name : string; wantreturn : boolean);
  6974. begin
  6975.         Write(df,'<a name="' + name + '"></a>');
  6976.         if wantreturn then writeln(df);
  6977. end;
  6978. begin
  6979.         FnHolder := tstringlist.create();
  6980.         dummy := tstringlist.create();
  6981.         FnHolder.Sorted := true;
  6982.         
  6983.         assignfile(df,Indexfilename);
  6984.         Rewrite(df);
  6985.  
  6986.         for i := 0 to masks.count - 1 do
  6987.                 begin
  6988.                 dummy := pollfilelist(appendslash(path) + masks.strings[i],false);
  6989.                 FnHolder.addstrings(dummy);
  6990.                 end;
  6991.  
  6992.  
  6993.  
  6994.         AvaliableChars := '';
  6995.         For i := 0 to FnHolder.Count -1 do
  6996.                 if Uppercase(LastChar) <> Uppercase(Extractfilename(FnHolder.Strings[i])[1]) then
  6997.                         begin
  6998.                         LastChar := Extractfilename(FnHolder.Strings[i])[1];
  6999.                         AvaliableChars := AvaliableChars + Lastchar;
  7000.                         end;
  7001.  
  7002.         AvaliableChars := Uppercase(AvaliableChars);
  7003.  
  7004.         Writeln(df,'<HTML><HEAD><TITLE>Index for ' + path + '</TITLE>');
  7005.  
  7006.  
  7007.         writeln(df,'<TABLE BORDER=2 cellpadding=1 cellspacing=1 width="95%">');
  7008.         TD; B;
  7009.         for i := 1 to length(AvaliableChars) do
  7010.                 Writelink(AvaliableChars[i],'#' + AvaliableChars[i],true);
  7011.         EndB; EndTD;
  7012.  
  7013.         LastChar := ' ';
  7014.         for i := 0 to FnHolder.count -1 do
  7015.                 begin
  7016.                 if Uppercase(Extractfilename(FnHolder.Strings[i])[1]) <> Uppercase(Lastchar) then
  7017.                         begin
  7018.                         TR2;
  7019.                         LastChar := Uppercase(Extractfilename(FnHolder.Strings[i]))[1];
  7020.                         TD;
  7021.                         Writeanchor(lastchar,false);
  7022.                         B;
  7023.                         Write(df,lastchar);
  7024.                         EndB;
  7025.                         EndTD; Writeln(df);
  7026.                         end;
  7027.                 TR;
  7028.                 TD2;
  7029.                 Writefilename(fnHolder.strings[i]);
  7030.                 EndTD; Writeln(df);
  7031.                 TD2;
  7032.                 Write(df,SizeinK(Getfilesize(fnHolder.strings[i])));
  7033.                 ENDTD; Writeln(df);
  7034.                 TD2;
  7035.                 Writelink('Contents >>',contentfilename + '#fn_' + inttostr(i),false);  
  7036.                 ENDTD; Writeln(df);
  7037.  
  7038.                 end;
  7039.  
  7040.         writeln(df,'</TABLE>');
  7041.  
  7042.         writeln(df,'</HTML>');
  7043.         Closefile(df);
  7044.  
  7045.         assignfile(df,Contentfilename);
  7046.         Rewrite(df);
  7047.         for i := 0 to FnHolder.count -1 do
  7048.         if fileexists(FnHolder.strings[i]) then
  7049.         begin
  7050.                 Set_Archive_List(fnHolder.strings[i]);
  7051.                 List_Archive(0,0);
  7052.                 WriteAnchor('fn_'+inttostr(i),true);
  7053.                 Writefilename(fnHolder.strings[i]);
  7054.                 writeln(df,'<TABLE BORDER=2 cellpadding=1 cellspacing=1 width="95%">');
  7055.                 for j := 0 to Total_Contents - 1 do
  7056.                         begin
  7057.                         TR;
  7058.                         TD2;
  7059.                         Write(df,Archive_Contents[j]._Filename);
  7060.                         ENDTD; Writeln(df);
  7061.                         TD2;
  7062.                         Write(df,Archive_Contents[j]._Filetype);
  7063.                         ENDTD; Writeln(df);
  7064.                         TD2;
  7065.                         Write(df,SizeinK(Archive_Contents[j]._Filesize));
  7066.                         ENDTD; Writeln(df);
  7067.                         TD2;
  7068.  
  7069.                         Write(df,' ' + Archive_Contents[j]._Filedefpath);
  7070.                         ENDTD; Writeln(df);
  7071.                         end;
  7072.                 writeln(df,'</TABLE>');
  7073.                 Writelink('Back to index',indexfilename,true);
  7074.                 P20;
  7075.         end;
  7076.  
  7077.         writeln(df,'</HTML>');
  7078.         Closefile(df);
  7079.  
  7080.         dummy.free;
  7081.         FnHolder.free;
  7082.  
  7083. end;
  7084.  
  7085. procedure TCakdir.Thumbnail(Filename : string; cellHeight, cellWidth : Integer);
  7086. var i : integer;
  7087.     tf : textfile;
  7088.     k : string;
  7089. begin
  7090. assignfile(tf,filename);
  7091. rewrite(tf);
  7092. Writeln(tf,'<HTML><HEAD><TITLE>Thumbnails </TITLE>');
  7093. for i := 0 to Total_Contents - 1 do
  7094.         begin
  7095.         k := lowercase(Extractfileext(Archive_Contents[i]._filename));
  7096.         if (k = '.jpg') or (k = '.gif') or (k = '.png') then
  7097.                 begin
  7098.                 Write(tf,'<A HREF="'+ Archive_Contents[i]._filedefpath + Archive_Contents[i]._filename + '"');
  7099.                 Write(tf,'><img src="'+ Archive_Contents[i]._filedefpath + Archive_Contents[i]._filename + '"');
  7100.                 Write(tf,'width="' + inttostr(cellwidth)+ '" height="' + inttostr(cellheight) + '"></A>');
  7101.                 Writeln(tf);
  7102.                 end;
  7103.         end;
  7104. Writeln(tf,'</HTML>');
  7105. closefile(tf);
  7106. end;
  7107. procedure Register;
  7108. begin
  7109.   RegisterComponents('QZip', [TCakDir]);
  7110. end;
  7111. end.
  7112.  
  7113.  
  7114.  
  7115.