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