"Fossies" - the Fresh Open Source Software Archive

Member "peazip-8.0.0.src/unit_pea.pas" (22 May 2021, 314788 Bytes) of package /linux/misc/peazip-8.0.0.src.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) delphi source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "unit_pea.pas": 7.9.0_vs_8.0.0.

    1 unit Unit_pea;
    2 {
    3  DESCRIPTION     :  Unit providing PEA, UnPEA, Raw File Split/Join features.
    4                     Can either be compiled as a standalone GUI application with
    5                     parameters passed by Command Line or can be used within
    6                     another application calling *_lib_procedure procedures
    7                     with appropriate parameters
    8 
    9  REQUIREMENTS    :  FPC, Lazarus
   10 
   11  EXTERNAL DATA   :  ---
   12 
   13  MEMORY USAGE    :  ---
   14 
   15  DISPLAY MODE    :  ---
   16 
   17  REFERENCES      :  ---
   18 
   19  REMARK          :  ---
   20 
   21  Version  Date      Author      Modification
   22  -------  --------  -------     ------------------------------------------
   23  0.10     20060915  G.Tani
   24  0.11     20060920  G.Tani
   25  0.12     20060925  G.Tani
   26  0.12b    20061130  G.Tani
   27  0.12c    20070122  G.Tani
   28  0.12d    20070224  G.Tani
   29  0.13     20070503  G.Tani
   30  0.14     20070605  G.Tani
   31  0.15     20070804  G.Tani
   32  0.16     20071001  G.Tani
   33  0.17     20071028  G.Tani
   34  0.17b    20071124  G.Tani
   35  0.18     20080124  G.Tani
   36  0.19     20080318  G.Tani
   37  0.19b    20080511  G.Tani
   38  0.20     20080730  G.Tani
   39  0.21     20080922  G.Tani
   40  0.22     20081030  G.Tani
   41  0.23     20081118  G.Tani
   42  0.24     20090116  G.Tani
   43  0.25     20090215  G.Tani
   44  0.26     20090324  G.Tani
   45  0.27     20090709  G.Tani
   46  0.28     20091016  G.Tani
   47  0.29     20091028  G.Tani
   48  0.30     20091109  G.Tani
   49  0.31     20100613  G.Tani
   50  0.32     20101016  G.Tani
   51  0.33     20101122  G.Tani
   52  0.34     20101224  G.Tani
   53  0.35     20110226  G.Tani
   54  0.36     20110611  G.Tani
   55  0.37     20110726  G.Tani
   56  0.38     20110913  G.Tani
   57  0.39     20111005  G.Tani
   58  0.40     20120607  G.Tani
   59  0.41     20120805  G.Tani      Real time approximate calculation of possible compression in advanced List (Info) function
   60                                 Application auto closes accordingly to PeaZip policy for operation needing to automatically close (PEA, UNPEA, file split, file join, secure delete)
   61           20120805  G.Tani      Uniformed Button Panels design over the application
   62  0.42     20130221  G.Tani      New theming engine
   63                                 New high resolution application icon
   64           20130322  G.Tani      Recompiled with Lazarus 1.0.8
   65  0.43     20130408  G.Tani      Fixed single volume size issue for Pea format on Win64
   66  0.44     20130617  G.Tani      Code cleanup
   67           20130718  G.Tani      Recompiled with Lazarus 1.0.10
   68  0.45     20130928  G.Tani      Secure delete changes system files attribute to allow operation
   69                                 Recompiled with Lazarus 1.0.12
   70  0.46     20131122  G.Tani      Secure deletion: added VERY_FAST mode (single pass, random pattern) and ZERO (single pass overwriting data with zero)
   71                                 Adds Sanitize function (free space deletion) with ZERO mode and VERY_FAST to VERY_SLOW secure deletion modes
   72  0.47     20131222  G.Tani      Improved secure file delete and secure free space delete
   73                                  All modes with 4 or more iterations now uses overwrite with all 0 and overwrite with al 1 (FF byte) for the two first iterations, fasetr and more secure due to most recommendations for secure deletion protocols, as USAF System Security Instruction 5020, Schneier's Algorithm, Communications Security Establishment Canada ITSG-06, British HMG Infosec Standard 5 Enhanced Standard
   74                                 Various minor improvements, messagedlg used for all error/warning messages
   75  0.48     20140222  G.Tani      Standalone "PeaUtils" GUI for Pea utilities
   76                                  the GUI is displayed when pea executable is started with no parameter
   77                                  the GUI can be started pointing to a specific function (from script, command or link) with "peautils" "n-th function" (0 to 11, same order as in the function dropdown menu) parameters, i.e. pea peautils 0 for CRC32; further parameters are ignored as it is mean for interactive use
   78           20140309  G.Tani      Visual updates, recompiled for Lazarus 1.2.0
   79  0.49     20140706  G.Tani      Quick delete and Send to recycle bin (Windows) modes added to secure deletion routine
   80  0.50     20150718  G.Tani      Recompiled with Lazarus 1.4.0
   81                                 Updated libraries: crc_hash_2014-08-25, util_2015-05-04
   82  0.51     20150729  G.Tani      Aligned span pre-sets sizes with PeaZip values
   83  0.52     20151121  G.Tani      Improved reporting for file management tools
   84                                  can sort report by column
   85                                   helps identifying similar elements, as files with same size, date, checksum/hash, or directories containing same number of files and subdirs / total size
   86                                  can export to csv file
   87                                 Improved file hashing tool
   88                                  can now take directory as input to check contained files
   89                                  operation can be cancelled while running
   90                                  progress calculation is based on total input size
   91                                  show 32 character samples of file header and end of file regions (not exported in report as potentially unsafe)
   92                                  show information about each directory content: dirs, files, total size
   93                                   can be used to find possibly identical directories (same number of files and subdirs / total size)
   94                                  show each item (file or folder) % size of total input
   95                                  produce more stats about total content: larger/smaller file, newer/older file, total potential compression extimate
   96                                  new preview mode providing only meta information and file samples
   97                                  new list mode providing only meta information without checksum/hash nor file sample (replaces still available older info/list listfiles function)
   98                                 Improved secure delete
   99                                  operation can be cancelled while running (already deleted files will not be recovered)
  100                                  progress calculation based on total input size
  101                                  new 'header' mode, quick deletion overwriting with random data only file header up to 64 KB
  102                                 Improved secure free space deletion
  103                                  operation can be cancelled while running
  104                                  fixed: can now delete free space for system drive
  105  0.53     20160111  G.Tani      Recompiled for Lazarus 1.6.0 / FPC3
  106                                  file management functions now full support Unicode file/dir names on Windows
  107                                  PEA format can now handle Unicode file/dir names on Windows systems
  108                                 Can now display the result report as table or clipboard (toggle using titles line)
  109                                 New Ten theme
  110                                 Various fixes and improvements
  111  0.54     20160427  G.Tani      Pea file format revision 1.1
  112                                  introduced support for Twofish and Serpent encryption, EAX mode, 128 and 256 bit (stream -level algorithm)
  113                                  introduced support for SHA-3 256 and 512 hash (object, volume, and stream -level algorithm)
  114                                 File tools, improved hashing utility
  115                                  introduced support for SHA-3 256 and 512 hash
  116                                  added digest of each selected crc/hash (same crc/hash function on crc/hash values) if more than 1 file is analyzed, to allow quick result comparison
  117                                  various fixes
  118  0.55     20160618  G.Tani      Fixed errors checking old PEA 1.0 file format version / revision
  119  0.56     20160909  G.Tani      Various improvements for using the executable as standalone application, to be deployed as PeaUtils 1.0 spin-off package
  120                                  When used as standalone utility shows hamburger button with popup menu for Run as administaror, online help, updates, and donations
  121                                  Added CRC64 and hex preview options in standalone operations dropdown menu
  122  0.57     20160919  G.Tani      Various improvements before release of PeaUtils 1.0 spin-off package
  123                                  Added Byte to byte compare function
  124                                  Added Split and Join functions
  125                                  Replaced List with Analyze files and folders (provides more information)
  126                                  Reorganized functions dropdown menu
  127                                  Created Windows installer with most common functions available for context menu integration
  128  0.58     20161022  G.Tani      Visual updates
  129  0.59     20161204  G.Tani      Improved DPI awareness, improved PeaUtils layout
  130  0.60     20170211  G.Tani      Fixes to frontend for PeaUtils 1.1 spin-off package
  131  0.61     20170321  G.Tani      Updates for PeaUtils 1.2 spin-off package
  132                                  Checksum/hash now reports duplicate items (uses best selected algorithm, count identical items)
  133                                  Secure delete now waits the process to exit and updates the input list removing items successfully removed
  134  0.62     20170423  G.Tani      Improved how 0 byte files are handled in some cases
  135                                 Improved how version is reported in application's title bar
  136  0.63     20170804  G.Tani      Minor visual update
  137  0.64     20180209  G.Tani      Recompiled with Lazarus 1.8.0 with updated WE libraries
  138  0.65     20181203  G.Tani      Updated to Wolfgang Ehrhardt math library util_2018-11-27
  139  0.66     20191009  G.Tani      Recompiled with LCL scaling and autoscaling graphics
  140  0.67     20191222  G.Tani      WIPE: fixed reporting number of deleted item with RECYCLE option
  141  0.68     20200125  G.Tani      Fixed: pea/unpea now allows using keyfiles only as in PeaZip
  142  0.69     20200406  G.Tani      Minor updates
  143  0.70     20200423  G.Tani      Added function to save all or each single crc or hash value to file, from context menu of report window
  144                                 Checksum and hash values are now reported also for empty files, as defined by the standard of each function
  145                                 Recompiled with Lazarus 2.0.8
  146  0.71     20200508  G.Tani      New PEA format revision 1.2
  147                                  introduced support for BLAKE2S 256 bit and BLAKE2B 512 bit
  148  0.72     20200514  G.Tani      Improved theming
  149  0.73     20200805  G.Tani      Visual updates
  150                                 Added button to change case on the fly for checksum/hash (hex and lsbhex)
  151  0.74     20200905  G.Tani      New PEA format revision 1.3
  152                                  Introduced support for multiple encryption, cascading encryption with AES, Twofish, and Sepent, 256 bit in EAX mode
  153                                   Each cipher is separately keyed through PBKDF2, following steps are taken to ensure the 3 keys are statistically independent after key schedule:
  154                                    key schedule of each cipher is based on a different hash primitive which is run for a different number of iterations
  155                                     Whirlpool x 25000 for AES, SHA512 x 50000 for Twofish, SHA3-512 x 75000 for Serpent (Whirlpool is significantly slower than SHA512 that is slower than SHA3-512)
  156                                    key schedule of each cipher is provided a separate 96 byte pseudorandom salt
  157                                    password is modified when provided as input for key schedule of each cipher
  158                                     modification are trivial xor with non secret values and counters, with the sole purpose to initialize the key derivation with different values and be a further factor (alongside different salt, and different hash / iteration number) to guarantee keys are a statistically independent
  159                                   Password verification tag is the xor of the 3 password verification tags of each encryption function, and is written / verified after all 3 key initialization functions are completed before verification
  160                                   Each block between password verification tag and stream authentication tag is encrypted with all 3 ciphers
  161                                   A 1..128 bytes block of random data is added after password verification tag in order to mask exact archive size
  162                                   Each cipher generate its own 128 bit sized stream authentication tag, tags are concatenated and hashed with SHA3-384; the SHA3-384 value is checked for verification, this requires all the 3 tags to match to expected values and does not allow ciphers to be authenticated separately
  163  0.75     20201206  G.Tani      Recompiled with updated theming
  164  0.76     20210121  G.Tani      Improved quoting on Unix-like sistems, fixes
  165  0.77     20210302  G.Tani      Various fixes
  166  1.00     20210415  G.Tani      Added 512 bit hash functions to file utilities menu
  167                                 Updated theming to allow custom zooming and spacing accordingly to peazip binary
  168  1.01     20210522  G.Tani      Updated theming consistently with PeaZip 8.0 (allow optional alternate grid colors for readability)
  169                                 Added exit codes for main functions
  170                                  1 abnormal termination
  171                                  0 success
  172                                  -1 incomplete
  173                                  -2 completed with errors
  174                                   pea: some files cannot be archived (not found, not readable)
  175                                   unpea: errors detected in the archive
  176                                   wipe: some files cannot be deleted (locked, not found)
  177                                  -3 internal error
  178                                  -4 cancelled by user
  179                                 Batch and hidden *_report modes now save report to output path without needing user interaction
  180                                 Improved hiding the GUI in HIDDEN mode
  181                                 Improved byte to byte file comparison function
  182 
  183 (C) Copyright 2006 Giorgio Tani giorgio.tani.software@gmail.com
  184 
  185 The program is released under GNU LGPL http://www.gnu.org/licenses/lgpl.txt
  186 
  187     This library is free software; you can redistribute it and/or
  188     modify it under the terms of the GNU Lesser General Public
  189     License as published by the Free Software Foundation; either
  190     version 3 of the License, or (at your option) any later version.
  191 
  192     This library is distributed in the hope that it will be useful,
  193     but WITHOUT ANY WARRANTY; without even the implied warranty of
  194     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  195     Lesser General Public License for more details.
  196 
  197     You should have received a copy of the GNU Lesser General Public
  198     License along with this library; if not, write to the Free Software
  199     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  200 }
  201 
  202 {$mode objfpc}{$H+}
  203 {$INLINE ON}{$UNITPATH ./we}
  204 
  205 interface
  206 
  207 uses
  208 {$IFDEF MSWINDOWS}
  209 Windows, activex, ShlObj,
  210 {$ENDIF}
  211   Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, Process, UTF8Process, Spin,
  212   Buttons, ComCtrls, StdCtrls, Menus, strutils, zuncompr, zcompres,
  213   hash, adler32, CRC16, CRC24, CRC32, CRC64, ED2K, MD4, MD5, RMD160, SHA1, SHA224,
  214   SHA256, SHA3_256, SHA384, SHA3_384, SHA512, SHA3_512, Whirl512, Blake2s, Blake2b,
  215   aes_ctr, AES_Type, AES_EAX, fcrypta, FCAES256,
  216   tf_eax, fcryptt, fctf256,
  217   sp_eax, fcrypts, fcsp256,
  218   mem_util, list_utils, img_utils, pea_utils, rfs_utils, ansiutf8_utils, unit_report, types;
  219 
  220 type
  221 
  222   { TForm_pea }
  223 
  224   TForm_pea = class(TForm)
  225     Bevel10: TBevel;
  226     Bevel11: TBevel;
  227     Bevel9: TBevel;
  228     ButtonDone1: TBitBtn;
  229     ButtonPeaExit1: TBitBtn;
  230     ButtonPW1: TBitBtn;
  231     ButtonPW2: TBitBtn;
  232     ButtonPeaExit: TBitBtn;
  233     ButtonRefSize: TButton;
  234     ButtonUtilsCancel: TBitBtn;
  235     ButtonToolsCancel: TBitBtn;
  236     ButtonUtilsOK: TBitBtn;
  237     ButtonRFSinteractive: TBitBtn;
  238     ButtonRFSinteractive1: TBitBtn;
  239     ButtonUtilsReset: TSpeedButton;
  240     ComboBox1: TComboBox;
  241     ComboBox2: TComboBox;
  242     ComboBox3: TComboBox;
  243     ComboBoxUnits: TComboBox;
  244     ComboBoxUtils: TComboBox;
  245     EditConfirm1: TEdit;
  246     EditPW1: TEdit;
  247     ImageUtils: TImage;
  248     Image7: TImage;
  249     Image3: TImage;
  250     Image4: TImage;
  251     Image5: TImage;
  252     ImageList1: TImageList;
  253     ImageSplit: TImage;
  254     Label1: TLabel;
  255     Label2: TLabel;
  256     LabelConfirm1: TLabel;
  257     LabelDecrypt2: TLabel;
  258     LabelDecrypt3: TLabel;
  259     LabelDecrypt4: TLabel;
  260     LabelDecrypt5: TLabel;
  261     LabelDecrypt6: TLabel;
  262     LabelE1: TLabel;
  263     LabelEncrypt2: TLabel;
  264     LabelEncrypt3: TLabel;
  265     LabelEncrypt4: TLabel;
  266     LabelEncrypt5: TLabel;
  267     LabelEncrypt6: TLabel;
  268     LabelHint1: TLabel;
  269     LabelKeyFile1: TLabel;
  270     LabelLog1: TBitBtn;
  271     LabelOpen: TBitBtn;
  272     labelopenfile0: TLabel;
  273     labelopenfile2: TLabel;
  274     labelopenfile3: TLabel;
  275     LabelOut1: TLabel;
  276     LabelPS1: TLabel;
  277     LabelPW1: TLabel;
  278     LabelKeyFileName1: TLabel;
  279     LabelTools5: TLabel;
  280     LabelUtilsFun: TLabel;
  281     LabelSample1: TLabel;
  282     LabelSample2: TLabel;
  283     LabelTime1: TLabel;
  284     LabelTools3: TLabel;
  285     LabelTools4: TLabel;
  286     LabelTools2: TLabel;
  287     LabelUtilsInput: TLabel;
  288     ListMemo: TMemo;
  289     MainMenu1: TMainMenu;
  290     mainmenuhelp: TMenuItem;
  291     MenuItem1: TMenuItem;
  292     Panelsp1: TPanel;
  293     Panelsp0: TPanel;
  294     Panelsp2: TPanel;
  295     pmupdates: TMenuItem;
  296     pmdonations: TMenuItem;
  297     pmhelp: TMenuItem;
  298     pmrunasadmin: TMenuItem;
  299     OpenDialog1: TOpenDialog;
  300     OpenDialog2: TOpenDialog;
  301     PanelDecrypt1: TPanel;
  302     PanelEncrypt1: TPanel;
  303     Panel1: TPanel;
  304     PanelPW1: TPanel;
  305     PanelUtils: TPanel;
  306     PanelRFSinteractive: TPanel;
  307     PanelTools: TPanel;
  308     peautilsmenu: TPopupMenu;
  309     ProgressBar1: TProgressBar;
  310     Shape2: TShape;
  311     ShapeE1: TShape;
  312     ShapeE2: TShape;
  313     peautilsbtn: TSpeedButton;
  314     SpinEdit1: TSpinEdit;
  315     Timer1: TTimer;
  316     procedure ButtonDone1Click(Sender: TObject);
  317     procedure ButtonPeaExitClick(Sender: TObject);
  318     procedure ButtonPW1Click(Sender: TObject);
  319     procedure ButtonPW2Click(Sender: TObject);
  320     procedure ButtonRFSinteractive1Click(Sender: TObject);
  321     procedure ButtonRFSinteractiveClick(Sender: TObject);
  322     procedure ButtonToolsCancelClick(Sender: TObject);
  323     procedure ButtonUtilsCancelClick(Sender: TObject);
  324     procedure ButtonUtilsResetClick(Sender: TObject);
  325     procedure ButtonUtilsOKClick(Sender: TObject);
  326     procedure ComboBox1Change(Sender: TObject);
  327     procedure ComboBoxUtilsChange(Sender: TObject);
  328     procedure EditPW1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  329     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  330     procedure FormCreate(Sender: TObject);
  331     procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
  332     procedure FormShow(Sender: TObject);
  333     procedure ImageUtilsClick(Sender: TObject);
  334     procedure LabelE1Click(Sender: TObject);
  335     procedure LabelKeyFile1Click(Sender: TObject);
  336     procedure LabelLog1Click(Sender: TObject);
  337     procedure LabelOpenClick(Sender: TObject);
  338     procedure labelopenfile0Click(Sender: TObject);
  339     procedure labelopenfile2Click(Sender: TObject);
  340     procedure mainmenuhelpClick(Sender: TObject);
  341     procedure pmupdatesClick(Sender: TObject);
  342     procedure pmdonationsClick(Sender: TObject);
  343     procedure PanelPW1MouseMove(Sender: TObject; Shift: TShiftState; X,
  344       Y: Integer);
  345     procedure peautilsbtnClick(Sender: TObject);
  346     procedure pmhelpClick(Sender: TObject);
  347     procedure pmrunasadminClick(Sender: TObject);
  348     procedure Timer1Timer(Sender: TObject);
  349   private
  350     { private declarations }
  351   public
  352     { public declarations }
  353   end;
  354 
  355   Type fileofbyte = file of byte;
  356 
  357 const
  358   P_RELEASE          = '1.00'; //declares release version for the whole build
  359   PEAUTILS_RELEASE   = '1.3'; //declares for reference last peautils release
  360   PEA_FILEFORMAT_VER = 1;
  361   PEA_FILEFORMAT_REV = 3; //version and revision declared to be implemented must match with the ones in pea_utils, otherwise a warning will be raised (form caption)
  362   SBUFSIZE           = 32768;
  363   {32KB of size for reading small buffers, used for ciphers and hashes}
  364   WBUFSIZE           = 1048576;
  365   {1MB of size for reading whide buffers, used for compression.
  366   Decompression may read arbitrarily sized buffers up to array size used for
  367   wide buffers -64KB (left for possible data expansion)}
  368   {$IFDEF MSWINDOWS}
  369   DEFAULT_THEME = 'ten-embedded';
  370   EXEEXT        = '.exe';
  371   {$ELSE}
  372   DEFAULT_THEME = 'ten-embedded';
  373   EXEEXT        = '';
  374   {$ENDIF}
  375   WS_EX_LAYERED      = $80000;
  376   LWA_ALPHA          = $2;
  377   FIRSTDOM      = 'https://peazip.github.io/';
  378   SECONDDOM     = 'https://peazip.sourceforge.io/';
  379 
  380 var
  381   Form_pea: TForm_pea;
  382    wbuf1,wbuf2:array[0..1114111] of byte; //>1MB wide buffers (1MB+ 64KB)
  383    fun,pw,keyfile_name,output,vol_algo,graphicsfolder,caption_build,delimiter,confpath:ansistring;
  384    vol_size:qword;
  385    desk_env:byte;
  386    interacting,control,details,height_set,toolactioncancelled:boolean;
  387    ment,kent,fent,ment_sample: THashContext;
  388    mentd: TWhirlDigest;
  389    mentd_sample: TSHA256Digest;
  390    fingerprint: TSHA512Digest;
  391    in_param,in_files,exp_files,status_objects,status_volumes,exp_fattr_dec,fattr_dec:TFoundList;
  392    status_files:TFoundListBool;
  393    fsizes,exp_fsizes:TFoundListSizes;
  394    ftimes,exp_ftimes:TFoundListAges;
  395    fattr,exp_fattr:TFoundListAttrib;
  396    obj_tags,exp_obj_tags,volume_tags,exp_volume_tags:TFoundListArray64;
  397    Bfd,Bmail,Bhd,Bdvd,Binfo,Blog,Bok,Bcancel,Butils,Badmin:TBitmap;
  398    fshown:boolean;
  399    //theming
  400    conf:text;
  401    opacity,closepolicy,qscale,qscaleimages,pspacing,pzooming,gridaltcolor:integer;
  402    executable_path,persistent_source,color1,color2,color3,color4,color5:string;
  403 
  404 {
  405 PEA features can be called using different modes of operation:
  406 INTERACTIVE the form is visible, user's input is requested if needed (can be used only calling PEA from command line, it's not allowed in *_lib_procedure procedures)
  407 BATCH       the form is visible, user's input not requested: if passphrase/keyfile are needed are got from next two parameters of command line
  408 HIDDEN      the form is not visible, user input not requested (as for BATCH)
  409 *_REPORT    can be applied to each mode, the program operates as described for the mode used and then an automated job report is saved at the end of the operation
  410 mode of operation is declared as opmode in *_lib_procedure, then passed to *_procedure as pw_param
  411 INTERACTIVE* modes can be used only for PEA and UnPEA (since only those features may require keying), other modes can be used also for RFS and RFJ
  412 }
  413 
  414 //procedure to call pea within another application
  415 procedure pea_lib_procedure ( out_param: ansistring;                            //archive qualified name (without .(volume number).PEA suffix) or AUTONAME
  416                               ch_size: qword;                                   //size of volumes, 0 for single volume (current implementation up to 2^64 byte of size for volume)
  417                               compr: ansistring;                                //compression scheme to use
  418                               volume_algo:ansistring;                           //algorithm for volume integrity check
  419                               obj_algo: ansistring;                             //algorithm for object integrity check
  420                               algo:ansistring;                                  //algorithm for stream integrity check
  421                               password,keyf_name:ansistring;                    //password and keyfile qualified name (if needed by stream algo)
  422                               in_param:TFoundList;                              //array of ansistring containing input qualified names
  423                               opmode:ansistring);                               //mode of operation
  424 
  425 procedure pea_procedure ( out_param: ansistring;
  426                           ch_size: qword;
  427                           compr: ansistring;
  428                           compr_level: byte;
  429                           volume_algo:ansistring;
  430                           volume_authsize:byte;
  431                           obj_algo: ansistring;
  432                           obj_authsize: byte;
  433                           algo:ansistring;
  434                           headersize,authsize: byte;
  435                           pwneeded: boolean;
  436                           pw_param,password,keyf_name:ansistring;
  437                           in_param:TFoundList);
  438 
  439 //procedure to call unpea within another application
  440 procedure unpea_lib_procedure ( in_qualified_name,                              //archive qualified name
  441                                 out_param,                                      //dir were extracting the archive (or AUTONAME)
  442                                 date_param,                                     //actually only supported RESETDATE, reset date of extracted files
  443                                 attr_param,                                     //RESETATTR (or SETATTR only on Windows to set object's attributes as on original objects)
  444                                 struct_param,                                   //actually only supported EXTRACT2DIR, create a dir and extract archive in the dir using shortest paths for archived objects
  445                                 password,keyf_name:ansistring;                  //password and keyfile qualified name (if needed)
  446                                 opmode:ansistring);                             //mode of operation
  447 
  448 procedure unpea_procedure ( in_qualified_name,
  449                             out_param,
  450                             date_param,
  451                             attr_param,
  452                             struct_param,
  453                             pw_param,
  454                             password,
  455                             keyf_name:ansistring);
  456 
  457 //procedure to call raw file split within another application
  458 procedure rfs_lib_procedure ( out_param:ansistring;                             //qualified name for output volumes (without .(volume number) suffix) or AUTONAME
  459                               ch_size:qword;                                    //size of volumes, 0 for single volume (current implementation up to 2^64 byte of size for volume)
  460                               volume_algo,                                      //algorithm for volume integrity check
  461                               in_qualified_name:ansistring;                     //qualified name of input file
  462                               opmode:ansistring);                               //mode of operation
  463 
  464 procedure rfs_procedure ( out_param:ansistring;
  465                           ch_size:qword;
  466                           volume_algo:ansistring;
  467                           volume_authsize:byte;
  468                           pw_param:ansistring;
  469                           in_qualified_name:ansistring);
  470 
  471 //procedure to call raw file join within another application
  472 procedure rfj_lib_procedure ( in_qualified_name,                                //qualified name of first volume of the split file
  473                               out_param,                                        //qualified name to give to the output rejoined file (or AUTONAME)
  474                               opmode:ansistring);                               //mode of operation
  475 
  476 procedure rfj_procedure ( in_qualified_name,
  477                           pw_param,
  478                           out_param:ansistring);
  479                           
  480 implementation
  481 
  482 {
  483 misc procedures
  484 }
  485 
  486 //timing
  487 procedure timing(tsin:TTimeStamp; size:qword);
  488 var tsout:TTimeStamp;
  489 time,speed:qword;
  490 begin
  491 tsout:=datetimetotimestamp(now);
  492 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
  493 if time<=0 then time:=100000;
  494 speed:=(size * 1000) div time;
  495 Form_pea.LabelTime1.Caption:='Processed '+nicenumber(inttostr(size))+' in '+nicetime(inttostr(time))+' @ '+nicenumber(inttostr(speed))+'/s';
  496 Form_pea.ButtonDone1.Visible:=true;
  497 end;
  498 
  499 //if an error is encountered calling a PEA_utils procedure, show error description then halt, otherwise (error code is 0) continue
  500 procedure test_pea_error ( s:ansistring;
  501                            err:integer);
  502 var
  503    decoded_err:ansistring;
  504 begin
  505 if err<>0 then
  506    begin
  507    decode_pea_error(err,decoded_err);
  508    MessageDlg('Error '+s+': '+inttostr(err)+' '+decoded_err, mtError, [mbOK], 0);
  509    halt(-3);
  510    end;
  511 end;
  512 
  513 //when an internal error is encountered, show error description then halt
  514 procedure internal_error (s:ansistring);
  515 begin
  516 MessageDlg(s, mtError, [mbOK], 0);
  517 halt(-3);
  518 end;
  519 
  520 procedure clean_global_vars;
  521 begin
  522 SetLength(in_param,0);
  523 SetLength(in_files,0);
  524 SetLength(exp_files,0);
  525 SetLength(status_objects,0);
  526 SetLength(status_volumes,0);
  527 SetLength(exp_fattr_dec,0);
  528 SetLength(fattr_dec,0);
  529 SetLength(status_files,0);
  530 SetLength(fsizes,0);
  531 SetLength(exp_fsizes,0);
  532 SetLength(ftimes,0);
  533 SetLength(exp_ftimes,0);
  534 SetLength(fattr,0);
  535 SetLength(exp_fattr,0);
  536 SetLength(obj_tags,0);
  537 SetLength(exp_obj_tags,0);
  538 SetLength(volume_tags,0);
  539 SetLength(exp_volume_tags,0);
  540 output:='';
  541 vol_size:=0;
  542 vol_algo:='';
  543 end;
  544 
  545 procedure checkspace(outpath:ansistring; chsize:qword);
  546 var size_ok:boolean;
  547 begin
  548 size_ok:=false;
  549 repeat
  550    if ((chsize>diskfree(0)) and (chsize<>1024*1024*1024*1024*1024)) then
  551       if MessageDlg('Output path '+outpath+' seems to not have enough free space for an output volume, try to free some space on it or exchange it with an empty one if it''s a removable media. Do you want to test the path another time?',mtWarning,[mbYes, mbNo],0)=6 then
  552       else halt(-3)
  553    else size_ok:=true;
  554 until size_ok=true;
  555 end;
  556 
  557 procedure checkspacepea(outpath:ansistring; chsize,volume_authsize:qword);
  558 var size_ok:boolean;
  559 begin
  560 size_ok:=false;
  561 repeat
  562    if ((chsize>diskfree(0)) and (chsize<>1024*1024*1024*1024*1024-volume_authsize)) then
  563       if MessageDlg('Output path '+outpath+' seems to not have enough free space for an output volume, try to free some space on it or exchange it with an empty one if it''s a removable media. Do you want to test the path another time?',mtWarning,[mbYes, mbNo],0)=6 then
  564       else halt(-3)
  565    else size_ok:=true;
  566 until size_ok=true;
  567 end;
  568 
  569 procedure check_chunk ( in_folder:ansistring;
  570                         j:dword;
  571                         var chunks_ok:boolean);
  572 begin
  573 chunks_ok:=false;
  574 if MessageDlg('The path "'+in_folder+'" seem not containing volume '+inttostr(j)+' (i.e. volumes are on multiple removable media and you have to change the media). Check again?',mtWarning,[mbYes, mbNo],0)=6 then
  575 else internal_error('Impossible to read requested volume(s). Not found volume '+inttostr(j));
  576 end;
  577 
  578 procedure read_from_chunks ( in_folder,in_name:ansistring;                      //path and base name of input file; actual PEA filename get updated by update_pea_filename procedure
  579                              byte_to_read:dword;                                //size to be read from chunks
  580                              var buf: array of byte;                            //buffer with output data
  581                              var tmp_buf: array of byte;                        //buffer used to temporarily store the data to compose in the output buffer
  582                              volume_tag_size:byte;                              //size of volume tag, data to be skipped at the end of each volume;
  583                              maxsize:dword;                                     //max size to read at once
  584                              singlevolume:boolean);
  585 var
  586    i,j,k,ind,numread:dword;
  587    total:qword;
  588    chunks_ok:boolean;
  589    in_file:ansistring;
  590    f_in:file of byte;
  591 begin
  592 j:=1;
  593 ind:=0;
  594 chunks_ok:=true;
  595 in_file:=in_name;
  596 while ((chunks_ok=true) and (ind<byte_to_read)) do
  597    begin
  598    if singlevolume=false then update_pea_filename(in_name,j,in_file);
  599    repeat
  600       if fileexists(in_folder+in_file) then
  601          begin
  602          chunks_ok:=true;
  603          assignfile(f_in,in_folder+in_file);
  604          filemode:=0;
  605          reset(f_in);
  606          if IOResult<>0 then internal_error('IO error opening '+in_folder+in_file);
  607          srcfilesize(in_folder+in_file,total);
  608          total:=total-volume_tag_size;
  609          //total:=system.filesize(f_in)-volume_tag_size;
  610          while ((total>0) and (ind<byte_to_read)) do
  611             begin
  612             if total>maxsize then i:=maxsize else i:=total;
  613             blockread (f_in,tmp_buf,i,numread);
  614             if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
  615             dec(total,numread);
  616             for k:=0 to numread-1 do buf[ind+k]:=tmp_buf[k];
  617             inc(ind,numread);
  618             end;
  619          close(f_in);
  620          if IOResult<>0 then internal_error('IO error closing '+in_folder+in_file);
  621          j:=j+1;
  622          end
  623       else check_chunk(in_folder,j,chunks_ok);
  624    until chunks_ok=true;
  625    end;
  626 end;
  627 
  628 procedure gen_rand(var arr: array of byte);
  629 var
  630    ment1,kent1,fent1: THashContext;
  631 begin
  632 ment1:=ment;
  633 kent1:=kent;
  634 fent1:=fent;
  635 generate_keyf (arr,persistent_source,fingerprint,ment1,kent1,fent1);
  636 end;
  637 
  638 procedure shl_rand(var arr: array of byte);
  639 var
  640    randf: file of byte;
  641    randarr: TKey2048;
  642    i,j: integer;
  643 begin
  644 try
  645 //read current rand seed file
  646 assignfile(randf,persistent_source);
  647 filemode:=0;
  648 reset(randf);
  649 blockread(randf,randarr,256,j);
  650 closefile(randf);
  651 //left shift by one byte the array of the rand seed
  652 for i:=0 to 254 do arr[i]:=randarr[i+1];
  653 arr[255]:=randarr[0];
  654 except
  655 end;
  656 end;
  657 
  658 {
  659 PEA: Pack (archive, compress and split) Encrypt and Authenticate
  660 The program accept n objects (files, dirs) as input, merge them into a single
  661 archive and give m output chunks of desired size.
  662 Number of objects to be archived is actually only memory limited, not format
  663 limited (PEA format allow unlimited input objects); each object can be up to 2^64
  664 byte in size.
  665 PEA file format version 1 revision 0 can create a single stream, optionally
  666 encrypted and authenticated, containing all objects to be archived, keyed by
  667 passphrase and optionally keyfile (two factor authentication).
  668 Metadata associated to archived objects are: qualified name, last modification
  669 time, attributes; if more advanced archiving/restoring/backup features are
  670 needed it's recommended using asynchronously tar or similar programs more focused
  671 on that needs before sending the resulting file to PEA.
  672 
  673 Notes:
  674 - W.Ehrhardt's hash and crypto libraries are used for hashes, checksums, ciphers
  675   and key scheduling (PBKDF2);
  676 - Lazarus paszlib compression libraries were used to build a custom compression
  677   scheme (PCOMPESS*);
  678 }
  679 
  680 procedure PEA;
  681 var
  682    out_param,compr,volume_algo,obj_algo,algo,pw_param,password,keyf_name,list_param,listfile_param:ansistring;
  683    ch_size:qword;
  684    compr_level,volume_authsize,obj_authsize,headersize,authsize:byte;
  685    pwneeded:boolean;
  686 
  687 
  688 procedure parse_pea_cl; //exit at first error with descriptive message, including parameters passed if relevant
  689 var i,k:dword;
  690 begin
  691 i:=0;
  692 try
  693    out_param:=(paramstr(2));
  694    //// control volume size
  695    try
  696       ch_size:=strtoqword(paramstr(3));
  697       if ch_size=0 then ch_size:=1024*1024*1024*1024*1024;//high(ch_size); set to 1024 TB// if chunk size is set to 0 no chunks will be done
  698    except
  699       internal_error('"'+paramstr(3)+'" is not a valid chunk size; values allowed are 1..2^64, 0 to don''t split the input');
  700    end;
  701    //get compression algorithm
  702    compr:=upcase(paramstr(4));
  703    if decode_compression_algo(compr,compr_level)<>0 then
  704       internal_error('"'+compr+'" is not a valid compression algorithm, please refer to the documentation for supported ones');
  705    //get volume control algorithm
  706    volume_algo:=upcase(paramstr(5));
  707    if decode_volume_control_algo(volume_algo,volume_authsize)<>0 then
  708       internal_error('"'+volume_algo+'" is not a valid control algorithm for volume check, please refer to the documentation for supported ones');
  709    if ch_size<volume_authsize+10 then ch_size:=volume_authsize+10;//chunk size is set at least 10 byte over volume size, in order to have at least 10 byte of data in the first volume to allow to read archive header at once (needed to know volume authsize in UnPEA)
  710    ch_size:=ch_size-volume_authsize;
  711    //get object control algorithm
  712    obj_algo:=upcase(paramstr(6));
  713    if decode_obj_control_algo(obj_algo,obj_authsize)<>0 then
  714       internal_error('"'+obj_algo+'" is not a valid control algorithm for object check, please refer to the documentation for supported ones');
  715    //get control algorithm
  716    algo:=upcase(paramstr(7));
  717    if decode_control_algo(algo,headersize,authsize,pwneeded)<>0 then
  718       internal_error('"'+algo+'" is not a valid control algorithm, please refer to the documentation for supported ones');
  719    //get operation mode
  720    inc(i,1);
  721    pw_param:=upcase(paramstr(7+i));
  722    if pwneeded=true then
  723       begin
  724       if (pw_param<>'INTERACTIVE') and (pw_param<>'INTERACTIVE_REPORT') then
  725          begin
  726          inc(i,1);
  727          password:=(paramstr(7+i));
  728          inc(i,1);
  729          keyf_name:=(paramstr(7+i));
  730          end
  731       else
  732          if (pw_param<>'INTERACTIVE') and (pw_param<>'BATCH') and (pw_param<>'HIDDEN') and (pw_param<>'INTERACTIVE_REPORT') and (pw_param<>'BATCH_REPORT') and (pw_param<>'HIDDEN_REPORT') then
  733             internal_error('"'+pw_param+'" is not a valid operation mode parameter, please refer to the documentation');
  734       end;
  735    //get input list (it will be expanded in pea_procedure)
  736    list_param:=upcase(paramstr(8+i));
  737    if paramstr(8+i)<>'' then
  738       if list_param='FROMCL' then //get input files by CL
  739          begin
  740          for k:=0 to paramcount-9-i do
  741             begin
  742             SetLength(in_param,k+1);
  743             in_param[k]:=(paramstr(k+9+i));
  744             end;
  745          end
  746       else
  747          if list_param='FROMFILE' then //get input files from a list file (an ansi text file containing a list of object names, each object in a line)
  748             begin
  749             listfile_param:=(paramstr(9+i));
  750             case read_filelist(listfile_param,in_param) of
  751               13: internal_error('The list file '+listfile_param+' is empty');
  752               14: internal_error('Cannot access the specified list file '+listfile_param);
  753                end;
  754             end
  755          else internal_error('Input method '+list_param+' not allowed')
  756    else internal_error('No accessible input object found');
  757 except
  758    internal_error('Received incorrect Command Line. See the documentation for the correct synopsis.');
  759 end;
  760 end;
  761 
  762 begin
  763 parse_pea_cl;
  764 pea_procedure(out_param,ch_size,compr,compr_level,volume_algo,volume_authsize,obj_algo,obj_authsize,algo,headersize,authsize,pwneeded,pw_param,password,keyf_name,in_param);
  765 end;
  766 
  767 procedure pea_lib_procedure ( out_param: ansistring;                            //archive qualified name (without .(volume number).PEA suffix) or AUTONAME
  768                               ch_size: qword;                                   //size of volumes, 0 for single volume (current implementation up to 2^64 byte of size for volume)
  769                               compr: ansistring;                                //compression scheme to use
  770                               volume_algo:ansistring;                           //algorithm for volume integrity check
  771                               obj_algo: ansistring;                             //algorithm for object integrity check
  772                               algo:ansistring;                                  //algorithm for stream integrity check
  773                               password,keyf_name:ansistring;                    //password and keyfile qualified name (if needed by stream algo)
  774                               in_param:TFoundList;                              //array of ansistring containing input qualified names
  775                               opmode:ansistring);                               //mode of operation: VISIBLE the form is visible, HIDDEN the form is not visible, MESSAGE the form is not visible, a message is sent as popup at the end of the operation
  776 var
  777    pw_param:ansistring;
  778    compr_level,volume_authsize,obj_authsize,headersize,authsize:byte;
  779    pwneeded:boolean;
  780 begin
  781 //// control volume size
  782 if ch_size=0 then ch_size:=1024*1024*1024*1024*1024; // if chunk size is set to 0 no chunks will be done
  783 //get compression algorithm
  784 if decode_compression_algo(compr,compr_level)<>0 then
  785    internal_error('"'+compr+'" is not a valid compression algorithm, please refer to the documentation for supported ones');
  786 //get volume control algorithm
  787 if decode_volume_control_algo(volume_algo,volume_authsize)<>0 then
  788    internal_error('"'+volume_algo+'" is not a valid control algorithm for volume check, please refer to the documentation for supported ones');
  789 if ch_size<volume_authsize+1 then ch_size:=volume_authsize+1;
  790 ch_size:=ch_size-volume_authsize;
  791 //get object control algorithm
  792 if decode_obj_control_algo(obj_algo,obj_authsize)<>0 then
  793    internal_error('"'+obj_algo+'" is not a valid control algorithm for object check, please refer to the documentation for supported ones');
  794 //get control algorithm
  795 if decode_control_algo(algo,headersize,authsize,pwneeded)<>0 then
  796    internal_error('"'+algo+'" is not a valid control algorithm, please refer to the documentation for supported ones');
  797 //input list (will be expanded in pea_procedure) is jet loaded in in_param, TFoundList (array of ansistring)
  798 //get operation mode
  799 if (upcase(opmode)<>'INTERACTIVE') and (upcase(opmode)<>'BATCH') and (upcase(opmode)<>'HIDDEN') and (upcase(opmode)<>'INTERACTIVE_REPORT') and (upcase(opmode)<>'BATCH_REPORT') and (upcase(opmode)<>'HIDDEN_REPORT') then
  800    internal_error('"'+upcase(opmode)+'" is not a valid operation mode parameter, please refer to the documentation');
  801 if (upcase(opmode)='INTERACTIVE') or (upcase(opmode)='INTERACTIVE_REPORT') then
  802    internal_error('INTERACTIVE* modes are not allowed calling pea_lib_procedure, use BATCH* or HIDDEN* modes');
  803 pw_param:=upcase(opmode);
  804 pea_procedure(out_param,ch_size,compr,compr_level,volume_algo,volume_authsize,obj_algo,obj_authsize,algo,headersize,authsize,pwneeded,pw_param,password,keyf_name,in_param);
  805 end;
  806 
  807 procedure pea_procedure ( out_param: ansistring;
  808                           ch_size: qword;
  809                           compr: ansistring;
  810                           compr_level: byte;
  811                           volume_algo:ansistring;
  812                           volume_authsize:byte;
  813                           obj_algo: ansistring;
  814                           obj_authsize: byte;
  815                           algo:ansistring;
  816                           headersize,authsize: byte;
  817                           pwneeded: boolean;
  818                           pw_param,password,keyf_name:ansistring;
  819                           in_param:TFoundList);
  820 var
  821    hdr : TFCAHdr;
  822    fhdr : TFCFHdr;
  823    shdr : TFCSHdr;
  824    hdr256 : TFCA256Hdr;
  825    fhdr256 : TFCF256Hdr;
  826    shdr256 : TFCS256Hdr;
  827    cxe : TAES_EAXContext;
  828    cxf : Ttf_EAXContext;
  829    cxs : Tsp_EAXContext;
  830    cxh : TFCA_HMAC_Context;
  831    randarr: TKey2048;
  832    auth,auth2,auth3 : array [0..15] of byte; //valid type conversion for TFCA_AuthBlock and TFCA256_AuthBlock
  833    Blake2sContext,Blake2sContext_obj,Blake2sContext_volume:blake2s_ctx;
  834    Blake2sDigest,Blake2sDigest_obj,Blake2sDigest_volume:TBlake2sDigest;
  835    Blake2bDigest,Blake2bDigest_obj,Blake2bDigest_volume:TBlake2bDigest;
  836    HashContext,HashContext_obj,HashContext_volume: THashContext;
  837    Whirl512Digest,Whirl512Digest_obj,Whirl512Digest_volume: TWhirlDigest;
  838    SHA512Digest,SHA512Digest_obj,SHA512Digest_volume: TSHA512Digest;
  839    SHA256Digest,SHA256Digest_obj,SHA256Digest_volume: TSHA256Digest;
  840    SHA3_512Digest,SHA3_512Digest_obj,SHA3_512Digest_volume: TSHA3_512Digest;
  841    SHA3_256Digest,SHA3_256Digest_obj,SHA3_256Digest_volume: TSHA3_256Digest;
  842    SHA1Digest,SHA1Digest_obj,SHA1Digest_volume: TSHA1Digest;
  843    RMD160Digest,RMD160Digest_obj,RMD160Digest_volume: TRMD160Digest;
  844    MD5Digest,MD5Digest_obj,MD5Digest_volume: TMD5Digest;
  845    crc64,crc64_obj,crc64_volume:TCRC64;
  846    ts_start:TTimeStamp;
  847    r: TSearchRec;
  848    f_in,f_out:file of byte;
  849    sbuf1,sbuf2:array [0..65535] of byte;
  850    auth_buf:array [0..63] of byte;
  851    filename_size,pw_len:word;
  852    err,adler,crc32,adler_obj,crc32_obj,adler_volume,crc32_volume:longint;
  853    i,j,k,addr,n_skipped,n_input_files,n_dirs,obj_ok,ch_number_expected,numread,compsize,compsize_d,num_res:dword;
  854    n_exp,file_size,total,cent_size,prog_size,prog_compsize,in_size,out_size,exp_size,ch_res:qword;
  855    in_qualified_name,out_file,out_path,out_name,s:ansistring;
  856    ansi_qualified_name:ansistring;
  857    inskipped:boolean;
  858 label 1;
  859 
  860 procedure clean_variables;
  861 begin
  862 i:=0;
  863 j:=0;
  864 k:=0;
  865 addr:=0;
  866 n_skipped:=0;
  867 n_input_files:=0;
  868 n_dirs:=0;
  869 obj_ok:=0;
  870 ch_number_expected:=0;
  871 numread:=0;
  872 compsize:=0;
  873 compsize_d:=0;
  874 num_res:=0;
  875 n_exp:=0;
  876 file_size:=0;
  877 total:=0;
  878 cent_size:=0;
  879 prog_size:=0;
  880 prog_compsize:=0;
  881 in_size:=0;
  882 out_size:=0;
  883 exp_size:=0;
  884 ch_res:=0;
  885 clean_global_vars;
  886 end;
  887 
  888 procedure expand_inputlist;
  889 var i,k:dword;
  890 fh_overhead:qword;
  891 begin
  892 addr:=0;
  893 n_skipped:=0;
  894 in_size:=0;
  895 fh_overhead:=0;
  896 for i:=0 to length(in_param)-1 do
  897    begin
  898    if filegetattr(in_param[i]) > 0 then
  899       if filegetattr(in_param[i]) and faDirectory <>0 then //Object is a dir
  900          begin
  901          expand(in_param[i],exp_files,exp_fsizes,exp_ftimes,exp_fattr,exp_fattr_dec,n_exp);
  902          SetLength(in_files,length(in_files)+n_exp);
  903          SetLength(status_files,length(status_files)+n_exp);
  904          SetLength(fsizes,length(fsizes)+n_exp);
  905          SetLength(ftimes,length(ftimes)+n_exp);
  906          SetLength(fattr,length(fattr)+n_exp);
  907          SetLength(fattr_dec,length(fattr_dec)+n_exp);
  908          if in_param[i][length(in_param[i])]<>DirectorySeparator then in_param[i]:=in_param[i]+DirectorySeparator;
  909          for k:=0 to n_exp-1 do
  910             begin
  911             in_files[addr+k]:=exp_files[k];
  912             status_files[addr+k]:=true;
  913             fsizes[addr+k]:=exp_fsizes[k];
  914             in_size:=in_size+exp_fsizes[k];
  915             ftimes[addr+k]:=exp_ftimes[k];
  916             fattr[addr+k]:=exp_fattr[k];
  917             if (exp_fattr[k] and faDirectory)=0 then fh_overhead:=fh_overhead+length(exp_files[k])+18
  918             else fh_overhead:=fh_overhead+length(exp_files[k])+10;
  919             fattr_dec[addr+k]:=exp_fattr_dec[k];
  920             end;
  921          addr:=addr+n_exp;
  922          end
  923       else //Object is a file
  924          begin
  925          expand(in_param[i],exp_files,exp_fsizes,exp_ftimes,exp_fattr,exp_fattr_dec,n_exp);
  926          SetLength(in_files,length(in_files)+1);
  927          SetLength(status_files,length(status_files)+1);
  928          SetLength(fsizes,length(fsizes)+1);
  929          SetLength(ftimes,length(ftimes)+1);
  930          SetLength(fattr,length(fattr)+1);
  931          SetLength(fattr_dec,length(fattr_dec)+1);
  932          in_files[addr]:=in_param[i];
  933          status_files[addr]:=true;
  934          fsizes[addr]:=exp_fsizes[0];
  935          fh_overhead:=fh_overhead+length(exp_files[0])+18;
  936          in_size:=in_size+exp_fsizes[0];
  937          ftimes[addr]:=exp_ftimes[0];
  938          fattr[addr]:=exp_fattr[0];
  939          fattr_dec[addr]:=exp_fattr_dec[0];
  940          addr:=addr+1;
  941          end
  942    else //Object not accessible
  943       begin
  944       SetLength(in_files,length(in_files)+1);
  945       SetLength(status_files,length(status_files)+1);
  946       SetLength(fsizes,length(fsizes)+1);
  947       SetLength(ftimes,length(ftimes)+1);
  948       SetLength(fattr,length(fattr)+1);
  949       SetLength(fattr_dec,length(fattr_dec)+1);
  950       in_files[addr]:=in_param[i];
  951       status_files[addr]:=false;
  952       inc(n_skipped,1);
  953       addr:=addr+1;
  954       end;
  955    end;
  956 n_input_files:=addr;
  957 exp_size:=in_size+headersize+authsize+6+fh_overhead;
  958 if n_skipped=n_input_files then internal_error('No valid input found');
  959 end;
  960 
  961 //clean keying-related variables
  962 procedure clean_keying_vars;
  963 var
  964    k:integer;
  965 begin
  966 for k:=0 to SBUFSIZE do sbuf2[k]:=0;
  967 pw:='';
  968 password:='';
  969 keyfile_name:='';
  970 keyf_name:='';
  971 pw_len:=0;
  972 k:=0;
  973 end;
  974 
  975 procedure init_obj_control_algo;
  976 begin
  977 case upcase(obj_algo) of
  978 'WHIRLPOOL' : Whirl_Init(HashContext_obj);
  979 'SHA512' : SHA512Init(HashContext_obj);
  980 'SHA256' : SHA256Init(HashContext_obj);
  981 'SHA3_512' : SHA3_512Init(HashContext_obj);
  982 'SHA3_256' : SHA3_256Init(HashContext_obj);
  983 'SHA1' : SHA1Init(HashContext_obj);
  984 'BLAKE2S' : Blake2s_Init(Blake2sContext_obj,nil,0,BLAKE2S_MaxDigLen);
  985 'BLAKE2B' : Blake2b_Init(HashContext_obj,nil,0,BLAKE2B_MaxDigLen);
  986 'RIPEMD160' : RMD160Init(HashContext_obj);
  987 'MD5' : MD5Init(HashContext_obj);
  988 'CRC64' : CRC64Init(crc64_obj);
  989 'CRC32' : CRC32Init(crc32_obj);
  990 'ADLER32' : Adler32Init(adler_obj);
  991 end;
  992 end;
  993 
  994 procedure init_volume_control_algo;
  995 begin
  996 case upcase(volume_algo) of
  997 'WHIRLPOOL' : Whirl_Init(HashContext_volume);
  998 'SHA512' : SHA512Init(HashContext_volume);
  999 'SHA256' : SHA256Init(HashContext_volume);
 1000 'SHA3_512' : SHA3_512Init(HashContext_volume);
 1001 'SHA3_256' : SHA3_256Init(HashContext_volume);
 1002 'SHA1' : SHA1Init(HashContext_volume);
 1003 'BLAKE2S' : Blake2s_Init(Blake2sContext_volume,nil,0,BLAKE2S_MaxDigLen);
 1004 'BLAKE2B' : Blake2b_Init(HashContext_volume,nil,0,BLAKE2B_MaxDigLen);
 1005 'RIPEMD160' : RMD160Init(HashContext_volume);
 1006 'MD5' : MD5Init(HashContext_volume);
 1007 'CRC64' : CRC64Init(crc64_volume);
 1008 'CRC32' : CRC32Init(crc32_volume);
 1009 'ADLER32' : Adler32Init(adler_volume);
 1010 end;
 1011 end;
 1012 
 1013 procedure update_control_algo(var buf:array of byte; size:word);
 1014 var k:integer;
 1015 begin
 1016 case upcase(algo) of
 1017 'TRIATS':
 1018 begin
 1019 if FCA_EAX256_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1020 if FCF_EAX256_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1021 if FCS_EAX256_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1022 end;
 1023 'TRITSA':
 1024 begin
 1025 if FCF_EAX256_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1026 if FCS_EAX256_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1027 if FCA_EAX256_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1028 end;
 1029 'TRISAT':
 1030 begin
 1031 if FCS_EAX256_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1032 if FCA_EAX256_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1033 if FCF_EAX256_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1034 end;
 1035 'EAX256' : if FCA_EAX256_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1036 'TF256' : if FCF_EAX256_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1037 'SP256' : if FCS_EAX256_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1038 'EAX' : if FCA_EAX_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1039 'TF' : if FCf_EAX_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1040 'SP' : if FCs_EAX_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1041 'HMAC' : if FCA_HMAC_encrypt(cxh, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 1042 'WHIRLPOOL' : Whirl_Update(HashContext, @buf, size);
 1043 'SHA512' : SHA512Update(HashContext, @buf, size);
 1044 'SHA256' : SHA256Update(HashContext, @buf, size);
 1045 'SHA3_512' : SHA3_512Update(HashContext, @buf, size);
 1046 'SHA3_256' : SHA3_256Update(HashContext, @buf, size);
 1047 'SHA1' : SHA1Update(HashContext, @buf, size);
 1048 'BLAKE2S' : Blake2s_update(Blake2sContext,@buf,size);
 1049 'BLAKE2B' : Blake2b_update(HashContext,@buf,size);
 1050 'RIPEMD160' : RMD160Update(HashContext, @buf, size);
 1051 'MD5' : MD5Update(HashContext, @buf, size);
 1052 'CRC64' : CRC64Update(crc64, @buf, size);
 1053 'CRC32' : CRC32Update(crc32, @buf, size);
 1054 'ADLER32' : Adler32Update(adler, @buf, size);
 1055 end;
 1056 end;
 1057 
 1058 procedure update_obj_control_algo(buf:array of byte; size:word);
 1059 begin
 1060 case upcase(obj_algo) of
 1061 'WHIRLPOOL' : Whirl_Update(HashContext_obj, @buf, size);
 1062 'SHA512' : SHA512Update(HashContext_obj, @buf, size);
 1063 'SHA256' : SHA256Update(HashContext_obj, @buf, size);
 1064 'SHA3_512' : SHA3_512Update(HashContext_obj, @buf, size);
 1065 'SHA3_256' : SHA3_256Update(HashContext_obj, @buf, size);
 1066 'SHA1' : SHA1Update(HashContext_obj, @buf, size);
 1067 'BLAKE2S' : Blake2s_update(Blake2sContext_obj,@buf,size);
 1068 'BLAKE2B' : Blake2b_update(HashContext_obj,@buf,size);
 1069 'RIPEMD160' : RMD160Update(HashContext_obj, @buf, size);
 1070 'MD5' : MD5Update(HashContext_obj, @buf, size);
 1071 'CRC64' : CRC64Update(crc64_obj, @buf, size);
 1072 'CRC32' : CRC32Update(crc32_obj, @buf, size);
 1073 'ADLER32' : Adler32Update(adler_obj, @buf, size);
 1074 end;
 1075 end;
 1076 
 1077 procedure update_volume_control_algo(buf:array of byte; size:word);
 1078 begin
 1079 case upcase(volume_algo) of
 1080 'WHIRLPOOL' : Whirl_Update(HashContext_volume, @buf, size);
 1081 'SHA512' : SHA512Update(HashContext_volume, @buf, size);
 1082 'SHA256' : SHA256Update(HashContext_volume, @buf, size);
 1083 'SHA3_512' : SHA3_512Update(HashContext_volume, @buf, size);
 1084 'SHA3_256' : SHA3_256Update(HashContext_volume, @buf, size);
 1085 'SHA1' : SHA1Update(HashContext_volume, @buf, size);
 1086 'BLAKE2S' : Blake2s_update(Blake2sContext_volume,@buf,size);
 1087 'BLAKE2B' : Blake2b_update(HashContext_volume,@buf,size);
 1088 'RIPEMD160' : RMD160Update(HashContext_volume, @buf, size);
 1089 'MD5' : MD5Update(HashContext_volume, @buf, size);
 1090 'CRC64' : CRC64Update(crc64_volume, @buf, size);
 1091 'CRC32' : CRC32Update(crc32_volume, @buf, size);
 1092 'ADLER32' : Adler32Update(adler_volume, @buf, size);
 1093 end;
 1094 end;
 1095 
 1096 procedure finish_control_algo;
 1097 begin
 1098 case upcase(algo) of
 1099 'TRIATS':
 1100 begin
 1101 FCA_EAX256_final(cxe, auth);
 1102 FCF_EAX256_final(cxf, auth2);
 1103 FCS_EAX256_final(cxs, auth3);
 1104 end;
 1105 'TRITSA':
 1106 begin
 1107 FCF_EAX256_final(cxf, auth);
 1108 FCS_EAX256_final(cxs, auth2);
 1109 FCA_EAX256_final(cxe, auth3);
 1110 end;
 1111 'TRISAT':
 1112 begin
 1113 FCS_EAX256_final(cxs, auth);
 1114 FCA_EAX256_final(cxe, auth2);
 1115 FCF_EAX256_final(cxf, auth3);
 1116 end;
 1117 'EAX256' : FCA_EAX256_final(cxe, auth);
 1118 'TF256' : FCF_EAX256_final(cxf, auth);
 1119 'SP256' : FCS_EAX256_final(cxs, auth);
 1120 'EAX' : FCA_EAX_final(cxe, auth);
 1121 'TF' : FCf_EAX_final(cxf, auth);
 1122 'SP' : FCs_EAX_final(cxs, auth);
 1123 'HMAC' : FCA_HMAC_final(cxh, auth);
 1124 'WHIRLPOOL' : Whirl_Final(HashContext,WHIRL512Digest);
 1125 'SHA512' : SHA512Final(HashContext,SHA512Digest);
 1126 'SHA256' : SHA256Final(HashContext,SHA256Digest);
 1127 'SHA3_512' : SHA3_512Final(HashContext,SHA3_512Digest);
 1128 'SHA3_256' : SHA3_256Final(HashContext,SHA3_256Digest);
 1129 'SHA1' : SHA1Final(HashContext,SHA1Digest);
 1130 'BLAKE2S' : blake2s_Final(Blake2sContext,Blake2sDigest);
 1131 'BLAKE2B' : blake2b_Final(HashContext,Blake2bDigest);
 1132 'RIPEMD160' : RMD160Final(HashContext,RMD160Digest);
 1133 'MD5' : MD5Final(HashContext,MD5Digest);
 1134 'CRC64' : CRC64Final(crc64);
 1135 'CRC32' : CRC32Final(crc32);
 1136 'ADLER32' : Adler32Final(adler);
 1137 end;
 1138 end;
 1139 
 1140 procedure finish_obj_control_algo;
 1141 begin
 1142 case upcase(obj_algo) of
 1143 'WHIRLPOOL' : Whirl_Final(HashContext_obj,WHIRL512Digest_obj);
 1144 'SHA512' : SHA512Final(HashContext_obj,SHA512Digest_obj);
 1145 'SHA256' : SHA256Final(HashContext_obj,SHA256Digest_obj);
 1146 'SHA3_512' : SHA3_512Final(HashContext_obj,SHA3_512Digest_obj);
 1147 'SHA3_256' : SHA3_256Final(HashContext_obj,SHA3_256Digest_obj);
 1148 'SHA1' : SHA1Final(HashContext_obj,SHA1Digest_obj);
 1149 'BLAKE2S' : blake2s_Final(Blake2sContext_obj,Blake2sDigest_obj);
 1150 'BLAKE2B' : blake2b_Final(HashContext_obj,Blake2bDigest_obj);
 1151 'RIPEMD160' : RMD160Final(HashContext_obj,RMD160Digest_obj);
 1152 'MD5' : MD5Final(HashContext_obj,MD5Digest_obj);
 1153 'CRC64' : CRC64Final(crc64_obj);
 1154 'CRC32' : CRC32Final(crc32_obj);
 1155 'ADLER32' : Adler32Final(adler_obj);
 1156 end;
 1157 end;
 1158 
 1159 procedure finish_volume_control_algo;
 1160 begin
 1161 case upcase(volume_algo) of
 1162 'WHIRLPOOL' : Whirl_Final(HashContext_volume,WHIRL512Digest_volume);
 1163 'SHA512' : SHA512Final(HashContext_volume,SHA512Digest_volume);
 1164 'SHA256' : SHA256Final(HashContext_volume,SHA256Digest_volume);
 1165 'SHA3_512' : SHA3_512Final(HashContext_volume,SHA3_512Digest_volume);
 1166 'SHA3_256' : SHA3_256Final(HashContext_volume,SHA3_256Digest_volume);
 1167 'SHA1' : SHA1Final(HashContext_volume,SHA1Digest_volume);
 1168 'BLAKE2S' : blake2s_Final(Blake2sContext_volume,Blake2sDigest_volume);
 1169 'BLAKE2B' : blake2b_Final(HashContext_volume,Blake2bDigest_volume);
 1170 'RIPEMD160' : RMD160Final(HashContext_volume,RMD160Digest_volume);
 1171 'MD5' : MD5Final(HashContext_volume,MD5Digest_volume);
 1172 'CRC64' : CRC64Final(crc64_volume);
 1173 'CRC32' : CRC32Final(crc32_volume);
 1174 'ADLER32' : Adler32Final(adler_volume);
 1175 end;
 1176 end;
 1177 
 1178 procedure write_volume_check;
 1179 var k:dword;
 1180 begin
 1181 if upcase(volume_algo)<>'NOALGO' then
 1182    begin
 1183    case upcase(volume_algo) of
 1184       'WHIRLPOOL' : for k:=0 to volume_authsize-1 do auth_buf[k]:=WHIRL512Digest_volume[k];
 1185       'SHA512' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA512Digest_volume[k];
 1186       'SHA256' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA256Digest_volume[k];
 1187       'SHA3_512' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA3_512Digest_volume[k];
 1188       'SHA3_256' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA3_256Digest_volume[k];
 1189       'SHA1' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA1Digest_volume[k];
 1190       'BLAKE2S' : for k:=0 to volume_authsize-1 do auth_buf[k]:=Blake2sDigest_volume[k];
 1191       'BLAKE2B' : for k:=0 to volume_authsize-1 do auth_buf[k]:=Blake2bDigest_volume[k];
 1192       'RIPEMD160' : for k:=0 to volume_authsize-1 do auth_buf[k]:=RMD160Digest_volume[k];
 1193       'MD5' : for k:=0 to volume_authsize-1 do auth_buf[k]:=MD5Digest_volume[k];
 1194       'CRC64' :
 1195       begin
 1196       dword2bytebuf(crc64_volume.lo32,auth_buf,0);
 1197       dword2bytebuf(crc64_volume.hi32,auth_buf,4);
 1198       end;
 1199       'CRC32' : dword2bytebuf(crc32_volume,auth_buf,0);
 1200       'ADLER32' : dword2bytebuf(adler_volume,auth_buf,0);
 1201       end;
 1202    for k:=0 to volume_authsize-1 do volume_tags[j-1,k]:=auth_buf[k];
 1203    blockwrite (f_out,auth_buf,volume_authsize);
 1204    prog_compsize:=prog_compsize+volume_authsize;
 1205    prog_size:=prog_size+volume_authsize;
 1206    end;
 1207 end;
 1208 
 1209 procedure write2chunks ( var num_res: dword;                     //amount of data to write
 1210                          var buf_data: array of byte;            //data buffer
 1211                          var f_out: fileofbyte;                  //output file
 1212                          var out_path,out_name: ansistring;      //name and path for the output;
 1213                          var i: dword;                           //chunk progressive number
 1214                          var ch_size:qword;                      //chunk size
 1215                          var ch_res: qword);                     //residual space in the given chunk
 1216 var ci,cj,k,numwritten:dword;
 1217     addr,buf:qword;
 1218     out_file:ansistring;
 1219 begin
 1220 addr:=0;
 1221 numwritten:=0;
 1222 while num_res>0 do
 1223    begin
 1224    if num_res<=ch_res then
 1225       begin
 1226       blockwrite (f_out,buf_data,num_res,numwritten);
 1227       if IOResult<>0 then internal_error('IO error writing to volume '+inttostr(i));
 1228       ci:=0;
 1229       while ci<numwritten do
 1230          begin
 1231          if numwritten-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=numwritten-ci;
 1232          for k:=0 to cj-1 do sbuf1[k]:=buf_data[ci+k];
 1233          update_volume_control_algo(sbuf1,cj);
 1234          inc(ci,cj);
 1235          end;
 1236       num_res:=num_res-numwritten;
 1237       ch_res:=ch_res-numwritten;
 1238       addr:=0;
 1239       end
 1240    else
 1241       begin
 1242       SetLength(volume_tags,length(volume_tags)+1);
 1243       blockwrite (f_out,buf_data,ch_res,numwritten);
 1244       if IOResult<>0 then internal_error('IO error writing to volume '+inttostr(i));
 1245       ci:=0;
 1246       while ci<numwritten do
 1247          begin
 1248          if numwritten-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=numwritten-ci;
 1249          for k:=0 to cj-1 do sbuf1[k]:=buf_data[ci+k];
 1250          update_volume_control_algo(sbuf1,cj);
 1251          inc(ci,cj);
 1252          end;
 1253       finish_volume_control_algo;
 1254       write_volume_check;
 1255       if IOResult<>0 then internal_error('IO error writing volume control tag to volume '+inttostr(i));
 1256       close(f_out);
 1257       if IOResult<>0 then internal_error('IO error closing volume '+inttostr(i));
 1258       i:=i+1;
 1259       update_pea_filename(out_name,i,out_file);
 1260       checkspacepea(out_path,ch_size,volume_authsize);
 1261       assignfile(f_out,out_path+out_file);
 1262       rewrite(f_out); //it will overwrite orphaned files with same name to preserve name coherence
 1263       if IOResult<>0 then internal_error('IO error opening volume '+inttostr(i));
 1264       init_volume_control_algo;
 1265       num_res:=num_res-numwritten;
 1266       if num_res<ch_size then buf:=num_res else buf:=ch_size;
 1267       addr:=addr+numwritten;
 1268       for k:=0 to buf do buf_data[k]:=buf_data[addr+k];
 1269       ch_res:=ch_size;
 1270       end;
 1271    end;
 1272 end;
 1273 
 1274 procedure init_control_algo;
 1275 var
 1276   i:integer;
 1277   sbufx,tsbuf2:array [0..65535] of byte;
 1278   tpw_len,verw:Word;
 1279 begin
 1280 case upcase(algo) of
 1281 'TRIATS','TRITSA','TRISAT':
 1282 begin
 1283 for i:=0 to pw_len-1 do tsbuf2[i]:=sbuf2[i]; tpw_len:=pw_len;
 1284 case upcase(algo) of
 1285    'TRIATS': test_pea_error('creating stream crypto subheader with '+algo,pea_eax256_subhdrP (cxe,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,hdr256,sbuf1,num_res));
 1286    'TRITSA': test_pea_error('creating stream crypto subheader with '+algo,pea_tfeax256_subhdrP (cxf,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,fhdr256,sbuf1,num_res));
 1287    'TRISAT': test_pea_error('creating stream crypto subheader with '+algo,pea_speax256_subhdrP (cxs,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,shdr256,sbuf1,num_res));
 1288    end;
 1289 prog_size:=prog_size+num_res;
 1290 prog_compsize:=prog_compsize+num_res;
 1291 write2chunks ( num_res,
 1292                sbuf1,
 1293                f_out,
 1294                out_path,out_name,
 1295                j,
 1296                ch_size,
 1297                ch_res);
 1298 for i:=0 to tpw_len-1 do sbuf2[i]:=tsbuf2[i]; pw_len:=tpw_len;
 1299 for i:=0 to tpw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len+i) xor ord(upcase(algo[length(algo)-1]));
 1300 case upcase(algo) of
 1301    'TRIATS': test_pea_error('creating stream crypto subheader with '+algo,pea_tfeax256_subhdrP (cxf,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,fhdr256,sbuf1,num_res));
 1302    'TRITSA': test_pea_error('creating stream crypto subheader with '+algo,pea_speax256_subhdrP (cxs,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,shdr256,sbuf1,num_res));
 1303    'TRISAT': test_pea_error('creating stream crypto subheader with '+algo,pea_eax256_subhdrP (cxe,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,hdr256,sbuf1,num_res));
 1304    end;
 1305 prog_size:=prog_size+num_res;
 1306 prog_compsize:=prog_compsize+num_res;
 1307 write2chunks ( num_res,
 1308                sbuf1,
 1309                f_out,
 1310                out_path,out_name,
 1311                j,
 1312                ch_size,
 1313                ch_res);
 1314 for i:=0 to tpw_len-1 do sbuf2[i]:=tsbuf2[i]; pw_len:=tpw_len;
 1315 for i:=0 to tpw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len xor i) xor ord(upcase(algo[length(algo)]));
 1316 case upcase(algo) of
 1317    'TRIATS': test_pea_error('creating stream crypto subheader with '+algo,pea_speax256_subhdrP (cxs,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,shdr256,sbuf1,num_res));
 1318    'TRITSA': test_pea_error('creating stream crypto subheader with '+algo,pea_eax256_subhdrP (cxe,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,hdr256,sbuf1,num_res));
 1319    'TRISAT': test_pea_error('creating stream crypto subheader with '+algo,pea_tfeax256_subhdrP (cxf,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,fhdr256,sbuf1,num_res));
 1320    end;
 1321 for i:=0 to tpw_len-1 do tsbuf2[i]:=0; tpw_len:=0;
 1322 verw:=hdr256.PW_Ver xor fhdr256.PW_Ver xor shdr256.PW_Ver;
 1323 word2bytebuf(verw,sbuf1,14);
 1324 verw:=0;
 1325 end;
 1326 'EAX256' : test_pea_error('creating stream crypto subheader with '+algo,pea_eax256_subhdr (cxe,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,hdr256,sbuf1,num_res));
 1327 'TF256' : test_pea_error('creating stream crypto subheader with '+algo,pea_tfeax256_subhdr (cxf,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,fhdr256,sbuf1,num_res));
 1328 'SP256' : test_pea_error('creating stream crypto subheader with '+algo,pea_speax256_subhdr (cxs,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,shdr256,sbuf1,num_res));
 1329 'EAX' : test_pea_error('creating stream crypto subheader with '+algo,pea_eax_subhdr (cxe,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,hdr,sbuf1,num_res));
 1330 'TF' : test_pea_error('creating stream crypto subheader with '+algo,pea_tfeax_subhdr (cxf,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,fhdr,sbuf1,num_res));
 1331 'SP' : test_pea_error('creating stream crypto subheader with '+algo,pea_speax_subhdr (cxs,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,shdr,sbuf1,num_res));
 1332 'HMAC' : test_pea_error('creating stream crypto subheader with '+algo,pea_hmac_subhdr (cxh,persistent_source,fingerprint,ment,kent,fent,7,sbuf2,pw_len,hdr,sbuf1,num_res));
 1333 'WHIRLPOOL' : Whirl_Init(HashContext);
 1334 'SHA512' : SHA512Init(HashContext);
 1335 'SHA256' : SHA256Init(HashContext);
 1336 'SHA3_512' : SHA3_512Init(HashContext);
 1337 'SHA3_256' : SHA3_256Init(HashContext);
 1338 'SHA1' : SHA1Init(HashContext);
 1339 'BLAKE2S' : Blake2s_Init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen);
 1340 'BLAKE2B' : Blake2b_Init(HashContext,nil,0,BLAKE2B_MaxDigLen);
 1341 'RIPEMD160' : RMD160Init(HashContext);
 1342 'MD5' : MD5Init(HashContext);
 1343 'CRC64' : CRC64Init(crc64);
 1344 'CRC32' : CRC32Init(crc32);
 1345 'ADLER32' : Adler32Init(adler);
 1346 end;
 1347 end;
 1348 
 1349 procedure compress_file;
 1350 {
 1351 PCOMPRESS1..3 is a deflate-based scheme of compression that allows decompression
 1352 of single blocks without need of decompressing preceding blocks:
 1353 that slightly degrade compression compared to classical schemes but allow fast
 1354 access to arbitrary sectors knowing position in input data (feature not used in
 1355 this application)
 1356 }
 1357 var ci,cj,k:dword;
 1358 begin
 1359 //file data area
 1360 while ((numread<>0) and (total<file_size)) do
 1361    begin
 1362    blockread (f_in,wbuf1,WBUFSIZE,numread);
 1363    inc(total,numread);
 1364    inc(prog_size,numread);
 1365    compsize:=numread+65536;
 1366    {leave some room for expansion in compsize (64kb), however expanded blocks
 1367    will be substituted by original blocks and compressed size will be set equal
 1368    to input size, triggering decompression routine to not decompress but rather
 1369    use the block as is (speeding up a bit operations on files that doesn't
 1370    compress well or at all in case of user's misuse)}
 1371    err:=zcompres.compress2(@wbuf2[0], compsize, wbuf1[0], numread, compr_level);
 1372    if (err<>0) or (compsize>=numread) then
 1373       begin
 1374       wbuf2:=wbuf1;
 1375       compsize:=numread;
 1376       end;
 1377    compsize_d:=compsize;
 1378    //check of uncompressed size and data in the order it will be written
 1379    dword2bytebuf(compsize,sbuf1,0);
 1380    update_obj_control_algo(sbuf1,4);
 1381    ci:=0;
 1382    while ci<numread do
 1383       begin
 1384       if numread-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=numread-ci;
 1385       for k:=0 to cj-1 do sbuf1[k]:=wbuf1[ci+k];
 1386       update_obj_control_algo(sbuf1,cj);
 1387       inc(ci,cj);
 1388       end;
 1389    //compressed block size field, dword
 1390    dword2bytebuf(compsize,wbuf1,0);
 1391    //compressed block data field, variable sized
 1392    for k:=0 to compsize_d-1 do wbuf1[k+4]:=wbuf2[k];
 1393    ci:=0;
 1394    while ci<compsize_d+4 do
 1395       begin
 1396       if compsize_d+4-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=compsize_d+4-ci;
 1397       for k:=0 to cj-1 do sbuf1[k]:=wbuf1[ci+k];
 1398       update_control_algo(sbuf1,cj);
 1399       for k:=0 to cj-1 do wbuf1[ci+k]:=sbuf1[k];
 1400       inc(ci,cj);
 1401       end;
 1402    num_res:=compsize_d+4;
 1403    prog_compsize:=prog_compsize+num_res;
 1404    write2chunks ( num_res,
 1405                   wbuf1,
 1406                   f_out,
 1407                   out_path,out_name,
 1408                   j,
 1409                   ch_size,
 1410                   ch_res);
 1411    Form_pea.ProgressBar1.Position:=prog_size div cent_size;
 1412    Application.ProcessMessages;
 1413    end;
 1414 // uncompressed size of last buffer field (since it can not match the buffer size), dword
 1415 dword2bytebuf(numread,sbuf1,0);
 1416 update_obj_control_algo(sbuf1,4);
 1417 update_control_algo(sbuf1,4);
 1418 num_res:=4;
 1419 prog_compsize:=prog_compsize+4;
 1420 write2chunks ( num_res,
 1421                sbuf1,
 1422                f_out,
 1423                out_path,out_name,
 1424                j,
 1425                ch_size,
 1426                ch_res);
 1427 end;
 1428 
 1429 procedure nocompress_file;
 1430 begin
 1431 while ((numread<>0) and (total<file_size)) do
 1432    begin
 1433    blockread (f_in,sbuf1,SBUFSIZE,numread);
 1434    inc(total,numread);
 1435    inc(prog_size,numread);
 1436    update_obj_control_algo(sbuf1,numread);
 1437    update_control_algo(sbuf1,numread);
 1438    num_res:=numread;
 1439    write2chunks ( num_res,
 1440                   sbuf1,
 1441                   f_out,
 1442                   out_path,out_name,
 1443                   j,
 1444                   ch_size,
 1445                   ch_res);
 1446    Form_pea.ProgressBar1.Position:=prog_size div cent_size;
 1447    Application.ProcessMessages;
 1448    end;
 1449 end;
 1450 
 1451 procedure write_eos; //unused in PEA file format 1.0
 1452 //write a trigger object that declare the end of the stream
 1453 begin
 1454 trigger_eos(sbuf1);
 1455 update_control_algo(sbuf1,6);
 1456 num_res:=6;
 1457 prog_size:=prog_size+6;
 1458 prog_compsize:=prog_compsize+6;
 1459 write2chunks ( num_res,
 1460                sbuf1,
 1461                f_out,
 1462                out_path,out_name,
 1463                j,
 1464                ch_size,
 1465                ch_res);
 1466 end;
 1467 
 1468 procedure write_eoa;
 1469 //write a trigger object that declare the end of the archive (instead of EOS in the last stream of the archive)
 1470 begin
 1471 trigger_eoa(sbuf1);
 1472 update_control_algo(sbuf1,6);
 1473 num_res:=6;
 1474 prog_size:=prog_size+6;
 1475 prog_compsize:=prog_compsize+6;
 1476 write2chunks ( num_res,
 1477                sbuf1,
 1478                f_out,
 1479                out_path,out_name,
 1480                j,
 1481                ch_size,
 1482                ch_res);
 1483 end;
 1484 
 1485 procedure write_auth;
 1486 var
 1487   k:dword;
 1488   ct384:THashContext;
 1489   dg384:TSHA3_384Digest;
 1490 begin
 1491 finish_control_algo;
 1492 case upcase(algo) of
 1493    'TRIATS','TRITSA','TRISAT':
 1494    begin
 1495    for k:=0 to 15 do sbuf1[k]:=auth[k];
 1496    for k:=16 to 31 do sbuf1[k]:=auth2[k-16];
 1497    for k:=32 to 47 do sbuf1[k]:=auth3[k-32];
 1498    SHA3_384Init(ct384);
 1499    SHA3_384Update(ct384, @sbuf1, 48);
 1500    SHA3_384Final(ct384, dg384);
 1501    for k:=0 to 47 do sbuf1[k]:=dg384[k];
 1502    end;
 1503    'EAX256','TF256','SP256','EAX','TF','SP','HMAC': for k:=0 to authsize-1 do sbuf1[k]:=auth[k];
 1504    'WHIRLPOOL' : for k:=0 to authsize-1 do sbuf1[k]:=WHIRL512Digest[k];
 1505    'SHA512' : for k:=0 to authsize-1 do sbuf1[k]:=SHA512Digest[k];
 1506    'SHA256' : for k:=0 to authsize-1 do sbuf1[k]:=SHA256Digest[k];
 1507    'SHA3_512' : for k:=0 to authsize-1 do sbuf1[k]:=SHA3_512Digest[k];
 1508    'SHA3_256' : for k:=0 to authsize-1 do sbuf1[k]:=SHA3_256Digest[k];
 1509    'SHA1' : for k:=0 to authsize-1 do sbuf1[k]:=SHA1Digest[k];
 1510    'BLAKE2S' : for k:=0 to authsize-1 do sbuf1[k]:=Blake2sDigest[k];
 1511    'BLAKE2B' : for k:=0 to authsize-1 do sbuf1[k]:=Blake2bDigest[k];
 1512    'RIPEMD160' : for k:=0 to authsize-1 do sbuf1[k]:=RMD160Digest[k];
 1513    'MD5' : for k:=0 to authsize-1 do sbuf1[k]:=MD5Digest[k];
 1514    'CRC64' :
 1515    begin
 1516    dword2bytebuf(crc64.lo32,sbuf1,0);
 1517    dword2bytebuf(crc64.hi32,sbuf1,4);
 1518    end;
 1519    'CRC32' : dword2bytebuf(crc32,sbuf1,0);
 1520    'ADLER32' : dword2bytebuf(adler,sbuf1,0);
 1521    end;
 1522 s:='';
 1523 num_res:=authsize;
 1524 prog_size:=prog_size+num_res;
 1525 prog_compsize:=prog_compsize+num_res;
 1526 write2chunks ( num_res,
 1527                sbuf1,
 1528                f_out,
 1529                out_path,out_name,
 1530                j,
 1531                ch_size,
 1532                ch_res);
 1533 end;
 1534 
 1535 procedure write_obj_check;
 1536 var k:dword;
 1537 begin
 1538 if upcase(obj_algo)<>'NOALGO' then
 1539    begin
 1540    case upcase(obj_algo) of
 1541       'WHIRLPOOL' : for k:=0 to obj_authsize-1 do sbuf1[k]:=WHIRL512Digest_obj[k];
 1542       'SHA512' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA512Digest_obj[k];
 1543       'SHA256' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA256Digest_obj[k];
 1544       'SHA3_512' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA3_512Digest_obj[k];
 1545       'SHA3_256' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA3_256Digest_obj[k];
 1546       'SHA1' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA1Digest_obj[k];
 1547       'BLAKE2S' : for k:=0 to obj_authsize-1 do sbuf1[k]:=Blake2sDigest_obj[k];
 1548       'BLAKE2B' : for k:=0 to obj_authsize-1 do sbuf1[k]:=Blake2bDigest_obj[k];
 1549       'RIPEMD160' : for k:=0 to obj_authsize-1 do sbuf1[k]:=RMD160Digest_obj[k];
 1550       'MD5' : for k:=0 to obj_authsize-1 do sbuf1[k]:=MD5Digest_obj[k];
 1551       'CRC64' :
 1552       begin
 1553       dword2bytebuf(crc64_obj.lo32,sbuf1,0);
 1554       dword2bytebuf(crc64_obj.hi32,sbuf1,4);
 1555       end;
 1556       'CRC32' : dword2bytebuf(crc32_obj,sbuf1,0);
 1557       'ADLER32' : dword2bytebuf(adler_obj,sbuf1,0);
 1558       end;
 1559    for k:=0 to obj_authsize-1 do obj_tags[i,k]:=sbuf1[k];
 1560    update_control_algo(sbuf1,obj_authsize);
 1561    num_res:=obj_authsize;
 1562    prog_size:=prog_size+num_res;
 1563    prog_compsize:=prog_compsize+num_res;
 1564    write2chunks ( num_res,
 1565                   sbuf1,
 1566                   f_out,
 1567                   out_path,out_name,
 1568                   j,
 1569                   ch_size,
 1570                   ch_res);
 1571    end;
 1572 end;
 1573 
 1574 procedure first_gui_output;
 1575 var i,k:integer;
 1576 begin
 1577 Form_pea.ProgressBar1.Position:=0;
 1578 Form_pea.LabelEncrypt2.Caption:='Input: ';
 1579 if length(in_param)>4 then k:=4 else k:=length(in_param);
 1580 for i:=0 to k-1 do Form_pea.LabelEncrypt2.Caption:=Form_pea.LabelEncrypt2.Caption+in_param[i]+', ';
 1581 if length(in_param)>4 then Form_pea.LabelEncrypt2.Caption:=Form_pea.LabelEncrypt2.Caption+' ...';
 1582 Form_pea.LabelEncrypt3.Caption:='Output: '+out_param+'.*';
 1583 Form_pea.LabelEncrypt4.Caption:='Using: '+compr+'; stream: '+algo+', object(s): '+obj_algo+', volume(s): '+volume_algo;
 1584 Form_pea.LabelTime1.Caption:='Creating archive...';
 1585 Form_pea.Panel1.visible:=true;
 1586 Form_pea.LabelE1.Visible:=true;
 1587 end;
 1588 
 1589 procedure evaluate_volumes;
 1590 begin
 1591 if exp_size>0 then
 1592    begin
 1593    ch_number_expected:=(exp_size div ch_size)+1;
 1594    if (exp_size mod ch_size)=0 then ch_number_expected:=ch_number_expected-1;
 1595    end
 1596 else ch_number_expected:=0;
 1597 if ch_number_expected>9999 then
 1598    if (upcase(compr)='PCOMPRESS0') then
 1599       if MessageDlg('Expected '+inttostr(ch_number_expected)+' volumes. It seems a lot! Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 1600       else halt(-3)
 1601    else
 1602       if MessageDlg('Up to '+inttostr(ch_number_expected)+' volumes are expected. It seems a lot, even if the selected compression scheme may reduce the actual number. Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 1603       else halt(-3);
 1604 if ch_number_expected>0 then
 1605    if (upcase(compr)<>'PCOMPRESS0') then
 1606       if ch_size<>1024*1024*1024*1024*1024-volume_authsize then Form_pea.LabelEncrypt5.Caption:='Volume number and total output size may vary due to the compressibility of the input; volume size: '+inttostr(ch_size+volume_authsize)+' B'
 1607       else Form_pea.LabelEncrypt5.Caption:='Expected a single volume archive, output size may vary due to the compressibility of the input'
 1608    else
 1609       if ch_size<>1024*1024*1024*1024*1024-volume_authsize then Form_pea.LabelEncrypt5.Caption:='Expected '+inttostr(ch_number_expected)+' volume(s) of '+inttostr(ch_size+volume_authsize)+' B for a total output size of '+inttostr(exp_size)+' B'
 1610       else Form_pea.LabelEncrypt5.Caption:='Expected a single volume archive of '+inttostr(exp_size)+' B of size'
 1611 else Form_pea.LabelEncrypt5.Caption:='Unknown number of volumes expected';
 1612 end;
 1613 
 1614 procedure evaluate_output;
 1615 begin
 1616 if upcase(out_param) = 'AUTONAME' then out_param:=in_param[0];
 1617 out_file:=extractfilename(out_param);
 1618 out_path:=extractfilepath(out_param);
 1619 if out_file='' then extractdirname(out_param,out_path,out_file); //first input object is a dir, output is set as a file in the same path of the dir and prefixing dir name as name
 1620 if out_path='' then out_path:=executable_path;
 1621 if setcurrentdir(out_path)<>true then out_path:=executable_path; //from this point output path is set as current path; if output path is missing or non accessible executable_path (path where the executable is in) is set as output path
 1622 if out_path[length(out_path)]<>DirectorySeparator then out_path:=out_path+DirectorySeparator;
 1623 Form_pea.LabelEncrypt3.Caption:='Output: '+out_path+out_file+'.*';
 1624 if exp_size>diskfree(0) then
 1625    if (upcase(compr)='PCOMPRESS0') then
 1626       if MessageDlg('Output path '+out_path+' seems to not have enough free space, you should continue only if it is a removable support and you have enough removable media. Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 1627       else halt(-3)
 1628    else
 1629       if MessageDlg('Output path '+out_path+' seems to not have enough free space, you should continue only if it is a removable support and you have enough removable media (however the selected compression scheme may reduce the total space needed for the output). Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 1630       else halt(-3);
 1631 end;
 1632 
 1633 procedure do_report_PEA;
 1634 var
 1635    h,k:dword;
 1636    s:ansistring;
 1637 begin
 1638 Form_report.InputT.Caption:='Input';
 1639 Form_report.OutputT.Caption:='Output';
 1640 Form_report.Caption:='Log PEA';
 1641 Form_report.StringGrid1.ColCount:=7;
 1642 Form_report.StringGrid1.Cells[0,0]:='Original object name';
 1643 Form_report.StringGrid1.Cells[1,0]:='Status';
 1644 Form_report.StringGrid1.Cells[2,0]:='Size (B)';
 1645 Form_report.StringGrid1.Cells[3,0]:='Age';
 1646 Form_report.StringGrid1.Cells[4,0]:='Attrib';
 1647 Form_report.StringGrid1.Cells[5,0]:='Attrib n.';
 1648 Form_report.StringGrid1.Cells[6,0]:=obj_algo;
 1649 Form_report.StringGrid1.RowCount:=n_input_files+1;
 1650 obj_ok:=0;
 1651 for k:=0 to n_input_files-1 do
 1652     begin
 1653     Form_report.StringGrid1.Cells[0,k+1]:=in_files[k];
 1654     if status_files[k]=true then Form_report.StringGrid1.Cells[1,k+1]:='Archived'
 1655     else
 1656        begin
 1657        inskipped:=true;
 1658        Form_report.StringGrid1.Cells[1,k+1]:='Skipped';
 1659        end;
 1660     if status_files[k]=true then
 1661        begin
 1662        Form_report.StringGrid1.Cells[2,k+1]:=inttostr(fsizes[k]);
 1663        if ftimes[k]<>0 then Form_report.StringGrid1.Cells[3,k+1]:=datetimetostr(filedatetodatetime(ftimes[k]));
 1664        Form_report.StringGrid1.Cells[4,k+1]:=fattr_dec[k];
 1665        Form_report.StringGrid1.Cells[5,k+1]:=inttostr(fattr[k]);
 1666        if upcase(obj_algo)<>'NOALGO' then
 1667           begin
 1668           s:='';
 1669           for h:=0 to obj_authsize-1 do s:=s+hexstr(@obj_tags[k,h],1);
 1670           Form_report.StringGrid1.Cells[6,k+1]:=s;
 1671           end;
 1672        inc(obj_ok,1);
 1673        end;
 1674     end;
 1675 Form_report.StringGrid1.AutosizeColumns;
 1676 Form_report.StringGrid2.ColCount:=2;
 1677 Form_report.StringGrid2.Cells[0,0]:='Volume';
 1678 Form_report.StringGrid2.Cells[1,0]:=volume_algo;
 1679 Form_report.StringGrid2.RowCount:=j+1;
 1680 for k:=0 to j-1 do
 1681     begin
 1682     update_pea_filename(out_path+out_name,k+1,s);
 1683     Form_report.StringGrid2.Cells[0,k+1]:=s;
 1684     if upcase(volume_algo)<>'NOALGO' then
 1685        begin
 1686        s:='';
 1687        for h:=0 to volume_authsize-1 do s:=s+hexstr(@volume_tags[k,h],1);
 1688        Form_report.StringGrid2.Cells[1,k+1]:=s;
 1689        end;
 1690     end;
 1691 Form_report.StringGrid2.AutosizeColumns;
 1692 //operation parameters
 1693 Form_report.Label1.Caption:=Form_pea.LabelEncrypt4.Caption;
 1694 //input
 1695 Form_report.Label2.Caption:='Archived '+inttostr(obj_ok)+' objects ('+inttostr(n_dirs)+' dirs, '+inttostr(obj_ok-n_dirs)+' files) of '+inttostr(n_input_files)+' ('+inttostr(n_input_files-obj_ok)+' not found); input '+inttostr(in_size)+' B';
 1696 //output
 1697 Form_report.Label3.Caption:=Form_pea.LabelEncrypt6.Caption;
 1698 //output name
 1699 Form_report.Label4.Caption:=Form_pea.LabelEncrypt3.Caption;
 1700 end;
 1701 
 1702 procedure last_gui_output;
 1703 begin
 1704 Form_pea.ProgressBar1.Position:=100;
 1705 Form_pea.LabelEncrypt3.Caption:='Output: '+out_path+out_name+'.*; tag: '+s;
 1706 if compr<>'PCOMPRESS0' then out_size:=prog_compsize
 1707 else out_size:=prog_size;
 1708 if ch_size<>1024*1024*1024*1024*1024-volume_authsize then Form_pea.LabelEncrypt6.Caption:=inttostr(j)+' volume(s), '+inttostr(ch_size+volume_authsize)+' B; total '+inttostr(out_size)+' B'
 1709 else Form_pea.LabelEncrypt6.Caption:='Single volume, '+inttostr(out_size)+' B';
 1710 if compr<>'PCOMPRESS0' then if in_size<>0 then Form_pea.LabelEncrypt6.Caption:=Form_pea.LabelEncrypt6.Caption+', '+inttostr((out_size * 100) div (in_size+1))+'% of input';
 1711 do_report_PEA;
 1712 Form_pea.LabelEncrypt5.Caption:=Form_report.Label2.Caption;
 1713 Form_pea.LabelOut1.Caption:=inttostr((out_size * 100) div (in_size+1))+'% of input size';
 1714 if ((out_size * 200) div (in_size+1))<16 then Form_pea.ShapeE2.Width:=16
 1715 else
 1716    if ((out_size * 200) div (in_size+1))>300 then Form_pea.ShapeE2.Width:=300
 1717    else Form_pea.ShapeE2.Width:=(out_size * 200) div (in_size+1);
 1718 end;
 1719 
 1720 begin
 1721 exitcode:=-1;
 1722 clean_variables;
 1723 inskipped:=false;
 1724 get_fingerprint (fingerprint,false);
 1725 if (upcase(pw_param)<>'HIDDEN') and (upcase(pw_param)<>'HIDDEN_REPORT') then Form_pea.Visible:=true else Form_pea.Visible:=false;
 1726 Form_pea.Caption:='Pea';
 1727 Form_pea.PanelDecrypt1.visible:=false;
 1728 Form_pea.PanelEncrypt1.visible:=true;
 1729 ts_start:=datetimetotimestamp(now);
 1730 i:=0;
 1731 //give preliminary information on work status to the GUI
 1732 first_gui_output;
 1733 {
 1734 expand the list of input objects and evaluate input and expected uncompressed
 1735 output size (taking overheads in account):
 1736 if the object is a file add file name to the list;
 1737 if the object is a dir, recursively add the content to the list (any object in
 1738 the dir and all subdir will be added to the list; if you want only file sin the
 1739 root dir to be added to the list, add them as files, don't add the dir);
 1740 if the object is not found mark it as skipped in the status list, otherwise mark
 1741 it as ok (the different lists indexes must remain sincronized)
 1742 }
 1743 expand_inputlist;
 1744 cent_size:=(exp_size div 100)+1; //1% of expected output size, used for progress indication
 1745 {
 1746 evaluate volumes number;
 1747 at 9999 objects the program will warn and proceed only after user's permission,
 1748 however the program has no sort of problem until 999999 chunks (but the host
 1749 system may!)
 1750 }
 1751 evaluate_volumes;
 1752 {
 1753 get output path and name;
 1754 evaluate if the path has enough free space for expected output.
 1755 }
 1756 evaluate_output;
 1757 //check if output path has room for a chunk of given size (mandatory)
 1758 checkspacepea(out_path,ch_size,volume_authsize);
 1759 {
 1760 start the actual operation routine
 1761 1) generate the archive header;
 1762 2a) generate the stream header (current implementation allow only a stream for archive)
 1763 2b) if using AE as stream check algorithm, initialize the encryption and generate additional header data needed for the encryption (similar to FCA file header);
 1764 2c) if compression is used write compressed buffer's size
 1765 3) add objects to archive; if the object is a non-empty file write the data to the archive, synchronously doing optional compression and control at stream, object and volume level; write object level control tag at the end of each object
 1766 4) generate End Of Archive trigger followed by the appropriate control tag
 1767 5) write the optional volume control tag at the end of each volume (starting from an appropriate position before volume end, due to the tag size required)
 1768 }
 1769 //1) generate archive header
 1770 out_name:=out_file;
 1771 if ch_size=1024*1024*1024*1024*1024-volume_authsize then
 1772    assignfile(f_out,out_file+'.pea')
 1773 else
 1774    assignfile(f_out,out_file+'.000001.pea');//current dir was jet set to out_path
 1775 rewrite(f_out);
 1776 if IOResult<>0 then internal_error('IO error opening first volume');
 1777 SetLength(volume_tags,length(volume_tags)+1);
 1778 init_volume_control_algo;
 1779 test_pea_error('creating archive header',pea_archive_hdr(volume_algo,sbuf1,num_res));
 1780 j:=1;
 1781 ch_res:=ch_size;
 1782 prog_size:=num_res;
 1783 prog_compsize:=num_res;
 1784 write2chunks ( num_res,
 1785                sbuf1,
 1786                f_out,
 1787                out_path,out_name,
 1788                j,
 1789                ch_size,
 1790                ch_res);
 1791 for i:=0 to 9 do auth_buf[i]:=sbuf1[i];
 1792 //2a) generate stream header
 1793 test_pea_error('creating stream header',pea_stream_hdr(compr,algo,obj_algo,sbuf1,num_res));
 1794 prog_size:=prog_size+num_res;
 1795 prog_compsize:=prog_compsize+num_res;
 1796 write2chunks ( num_res,
 1797                sbuf1,
 1798                f_out,
 1799                out_path,out_name,
 1800                j,
 1801                ch_size,
 1802                ch_res);
 1803 for i:=0 to 9 do auth_buf[i+10]:=sbuf1[i];
 1804 // 2b) init stream control algorithm, generate crypto subheader if needed
 1805 if pwneeded=true then
 1806    begin
 1807    //get password
 1808    if (upcase(pw_param)='INTERACTIVE') or (upcase(pw_param)='INTERACTIVE_REPORT') then
 1809       begin
 1810       //password is pw string that was already entered in EditPW.Text
 1811       //keyfile name is keyfile_name already entered
 1812       end
 1813    else
 1814       begin
 1815       pw:=password; //pw is got from commandline (not recommended)
 1816       keyfile_name:=keyf_name; //keyfile name is got from command line
 1817       end;
 1818    pw_len:=length(pw);
 1819    if pw_len=0 then internal_error('invalid password length');
 1820    for k:=0 to pw_len-1 do sbuf2[k]:=ord(pw[k+1]);//copy password into an array of byte
 1821    //append headers to password's array (sbuf2)
 1822    for i:=0 to 1 do auth_buf[i+20]:=sbuf1[i];
 1823    for k:=0 to 21 do sbuf2[pw_len+k]:=auth_buf[k];
 1824    pw_len:=pw_len+22;
 1825    //append keyfile to password's array (sbuf2)
 1826    if upcase(keyfile_name)<>'NOKEYFILE' then
 1827       test_pea_error('accessing keyfile',use_keyfile(keyfile_name,2048,numread,sbuf2,pw_len));
 1828    end;
 1829 init_control_algo;
 1830 clean_keying_vars;
 1831 prog_size:=prog_size+num_res;
 1832 prog_compsize:=prog_compsize+num_res;
 1833 write2chunks ( num_res,
 1834                sbuf1,
 1835                f_out,
 1836                out_path,out_name,
 1837                j,
 1838                ch_size,
 1839                ch_res);
 1840 case upcase(algo) of
 1841    'TRIATS','TRITSA','TRISAT': //mask exact archive size extending header 1..128 byte with random data (encrypted)
 1842    begin
 1843    gen_rand(randarr);
 1844    randarr[0]:=randarr[0] div 2;
 1845    for i:=0 to 127 do sbuf1[i]:=randarr[i];
 1846    update_control_algo(sbuf1,randarr[0]+1);
 1847    num_res:=randarr[0]+1;
 1848    prog_size:=prog_size+num_res;
 1849    prog_compsize:=prog_compsize+num_res;
 1850    write2chunks ( num_res,
 1851                sbuf1,
 1852                f_out,
 1853                out_path,out_name,
 1854                j,
 1855                ch_size,
 1856                ch_res);
 1857    for i:=0 to 255 do randarr[i]:=0;
 1858    end;
 1859    end;
 1860 if pwneeded=false then update_control_algo(auth_buf,20); //check the archive and stream headers
 1861 // 2c) buffer size field (data to compress at once), dword, stream specific
 1862 if upcase(compr)<>'PCOMPRESS0' then
 1863    begin
 1864    dword2bytebuf(WBUFSIZE,sbuf1,0);
 1865    update_control_algo(sbuf1,4);
 1866    num_res:=4;
 1867    prog_compsize:=prog_compsize+num_res;
 1868    write2chunks ( num_res,
 1869                   sbuf1,
 1870                   f_out,
 1871                   out_path,out_name,
 1872                   j,
 1873                   ch_size,
 1874                   ch_res);
 1875    end;
 1876 //3) for each object: if the object is accessible add it to the archive
 1877 n_dirs:=0;
 1878 for i:=0 to n_input_files-1 do
 1879    begin
 1880    SetLength(obj_tags,length(obj_tags)+1);
 1881    if status_files[i]=false then goto 1; //the object, during creation of the list, was not accessible
 1882    in_qualified_name:=in_files[i];
 1883    addr:=i;
 1884    k:=check_in(f_in,in_qualified_name,status_files,i);
 1885    if k<>0 then
 1886       begin
 1887       inc(n_skipped,1);
 1888       goto 1; //the object is actually not accessible
 1889       end;
 1890    init_obj_control_algo;
 1891    //2 byte (word) sized field for size of the input object qualified name, if = 0 then the object is a trigger
 1892    ansi_qualified_name:=utf8toansi(in_qualified_name);
 1893    filename_size:=length(ansi_qualified_name);//(in_files[i]);
 1894    word2bytebuf(filename_size,sbuf1,0);
 1895    //variable sized field for input object qualified name
 1896    for k:=0 to filename_size-1 do sbuf1[k+2]:=ord(ansi_qualified_name[k+1]);
 1897    //4 byte (dword) sized field for input object last modification time
 1898    if filegetattr(in_files[i]) and faDirectory = 0 then k:=fileage(in_qualified_name)
 1899    else
 1900       begin
 1901       if findfirst(in_files[i]+'.',faDirectory,r) = 0 then k:=r.Time
 1902       else k:=datetimetofiledate(now); //should not happen
 1903       FindClose(r);
 1904       end;
 1905    dword2bytebuf(k,sbuf1,filename_size+2);
 1906    //4 byte (dword) sized field for input object attributes
 1907    k:=filegetattr(in_qualified_name);
 1908    dword2bytebuf(k,sbuf1,filename_size+6);
 1909    if filegetattr(in_qualified_name) and faDirectory <>0 then //the object is a directory
 1910       begin
 1911       update_obj_control_algo(sbuf1,filename_size+10);
 1912       update_control_algo(sbuf1,filename_size+10);
 1913       num_res:=filename_size+10;
 1914       prog_size:=prog_size+num_res;
 1915       prog_compsize:=prog_compsize+num_res;
 1916       inc(n_dirs,1);
 1917       write2chunks ( num_res,
 1918                      sbuf1,
 1919                      f_out,
 1920                      out_path,out_name,
 1921                      j,
 1922                      ch_size,
 1923                      ch_res);
 1924       finish_obj_control_algo;
 1925       write_obj_check;
 1926       end
 1927    else //the object is a file
 1928       begin
 1929       //8 byte (qword) sized field for input file size
 1930       srcfilesize(in_qualified_name,file_size);
 1931       //file_size:=system.filesize(f_in);
 1932       qword2bytebuf(file_size,sbuf1,filename_size+10);
 1933       update_obj_control_algo(sbuf1,filename_size+18);
 1934       update_control_algo(sbuf1,filename_size+18);
 1935       num_res:=filename_size+18;
 1936       prog_size:=prog_size+num_res;
 1937       prog_compsize:=prog_compsize+num_res;
 1938       write2chunks ( num_res,
 1939                      sbuf1,
 1940                      f_out,
 1941                      out_path,out_name,
 1942                      j,
 1943                      ch_size,
 1944                      ch_res);
 1945       if file_size>0 then //non empty file
 1946          begin
 1947          ////// for each file: 3) mangle and write file data
 1948          total:=0;
 1949          numread:=1;
 1950          if upcase(compr)<>'PCOMPRESS0' then compress_file
 1951          else nocompress_file; //no compression
 1952          closefile(f_in);
 1953          end;
 1954       finish_obj_control_algo;
 1955       write_obj_check;
 1956       end;
 1957    1:
 1958    end;
 1959 //4) close stream: write trigger of end of archive (since PEA1.0 files contain a single stream) and write authentication tag (if applicable)
 1960 write_eoa;
 1961 if upcase(algo)<>'NOALGO' then write_auth
 1962 else s:='no control tag';
 1963 //5) generate last volume control tag
 1964 SetLength(volume_tags,length(volume_tags)+1);
 1965 finish_volume_control_algo;
 1966 write_volume_check;
 1967 closefile(f_out);
 1968 if IOResult<>0 then internal_error('IO error closing last volume');
 1969 //give final job information to the GUI
 1970 last_gui_output;
 1971 //calculate operation time
 1972 timing(ts_start,in_size);
 1973 //make accessible exit button and link to the detailed job log
 1974 Form_pea.LabelLog1.Visible:=true;
 1975 Form_pea.LabelOpen.Caption:='Explore';
 1976 output:=out_path;
 1977 Form_pea.LabelOpen.visible:=true;
 1978 Form_pea.ButtonDone1.Visible:=true;
 1979 Form_pea.ButtonPeaExit.Visible:=false;
 1980 if (upcase(pw_param)='INTERACTIVE_REPORT') or (upcase(pw_param)='BATCH_REPORT') or (upcase(pw_param)='HIDDEN_REPORT') then save_report('Auto log PEA','txt',upcase(pw_param),out_path);
 1981 if inskipped=true then exitcode:=-2 else exitcode:=0;
 1982 Sleep(500);
 1983 if closepolicy>0 then Form_pea.Close; //error conditions are intercepted before and handled with internal_error procedure
 1984 end;
 1985 
 1986 {
 1987 UnPEA
 1988 Decrypt, authenticate, join, decompress, extract PEA format archives
 1989 
 1990 Error management:
 1991 - errors in objects, stream or volumes are checked by strong functions and
 1992   reported in job log, that can be saved, at the end of the job a popup message
 1993   will warn that such errors were encountered;
 1994 - errors that prevent the application to work make the application quit with a
 1995   descriptive message, if the error is of unknown nature application will
 1996   autosave a job log allowing further analysis.
 1997 
 1998 Known issues:
 1999 - FPC's set object attributes works only on Windows, set object date seem not
 2000 actually working (both are currently not supported on *x);
 2001 }
 2002 
 2003 procedure unpea;
 2004 var
 2005    in_qualified_name,out_param,date_param,attr_param,struct_param,pw_param,password,keyf_name:ansistring;
 2006    i:integer;
 2007 
 2008 procedure parse_unpea_cl;
 2009 begin
 2010 i:=0;
 2011 try
 2012    in_qualified_name:=(paramstr(2));
 2013    if not(fileexists(in_qualified_name)) then
 2014       internal_error('"'+in_qualified_name+'" not exist');
 2015    out_param:=(paramstr(3));
 2016    date_param:=upcase(paramstr(4)); //how to use file age information: SETDATE (not supported on *x) set the output file date to the input file date, RESETDATE gives new file age
 2017    if date_param<>'RESETDATE' then  //(date_param<>'SETDATE') or
 2018       internal_error('"'+date_param+'" is not a valid parameter for file age metadata: RESETDATE (gives new file age) is actually the only option featured by the program');
 2019    attr_param:=upcase(paramstr(5)); //like the previous, about attribute data: SETATTR (not supported on *x) set the output objects attributes as saved in the archive; RESETATTR set the output object attribute as they are by default for the target system and position
 2020    if not ((attr_param='SETATTR') or (attr_param='RESETATTR')) then
 2021       internal_error('"'+attr_param+'" is not a valid parameter for file attributes metadata: SETATTR (not supported on *x) set the output objects attributes as saved in the archive; RESETATTR set the output objects attributes as they are by default for the target system and position');
 2022    struct_param:=upcase(paramstr(6)); //EXTRACT2DIR: make a dir with output object with shortest possible path derived from input structures
 2023    if struct_param<>'EXTRACT2DIR' then
 2024       internal_error('"'+struct_param+'" is not a valid parameter for output structure, the only parameter supported is EXTRACT2DIR: make a dir with output object with shortest possible path derived from input structures');
 2025    //get operation mode
 2026    pw_param:=upcase(paramstr(7));
 2027    if (pw_param<>'INTERACTIVE') and (pw_param<>'INTERACTIVE_REPORT') then
 2028       begin
 2029       inc(i,1);
 2030       password:=(paramstr(7+i));
 2031       inc(i,1);
 2032       keyf_name:=(paramstr(7+i));
 2033       end
 2034    else if (pw_param<>'INTERACTIVE') and (pw_param<>'BATCH') and (pw_param<>'HIDDEN') and (pw_param<>'INTERACTIVE_REPORT') and (pw_param<>'BATCH_REPORT') and (pw_param<>'HIDDEN_REPORT') then
 2035       internal_error('"'+pw_param+'" is not a valid operation mode parameter, please refer to the documentation');
 2036 except
 2037    internal_error('Received incorrect Command Line. See the documentation for the correct synopsis.');
 2038 end;
 2039 end;
 2040 
 2041 begin
 2042 parse_unpea_cl; //parse and validate command line
 2043 unpea_procedure(in_qualified_name,out_param,date_param,attr_param,struct_param,pw_param,password,keyf_name);
 2044 end;
 2045 
 2046 procedure unpea_lib_procedure ( in_qualified_name,                              //archive qualified name
 2047                                 out_param,                                      //dir were extracting the archive (or AUTONAME)
 2048                                 date_param,                                     //actually only supported RESETDATE, reset date of extracted files
 2049                                 attr_param,                                     //RESETATTR (or SETATTR only on Windows to set object's attributes as on original objects)
 2050                                 struct_param,                                   //actually only supported EXTRACT2DIR, create a dir and extract archive in the dir using shortest paths for archived objects
 2051                                 password,keyf_name:ansistring;                  //password and keyfile qualified name (if needed)
 2052                                 opmode:ansistring);                             //mode of operation: VISIBLE the form is visible, HIDDEN the form is not visible, MESSAGE the form is not visible, a message is sent as popup at the end of the operation
 2053 var
 2054    pw_param:ansistring;
 2055 begin
 2056 if not(fileexists(in_qualified_name)) then
 2057    internal_error('"'+in_qualified_name+'" not exist');
 2058 //how to use file age information: SETDATE (not supported on *x) set the output file date to the input file date, RESETDATE gives new file age
 2059 if date_param<>'RESETDATE' then  //(date_param<>'SETDATE') or
 2060    internal_error('"'+date_param+'" is not a valid parameter for file age metadata: RESETDATE (gives new file age) is actually the only option featured by the program');
 2061 //like the previous, about attribute data: SETATTR (not supported on *x) set the output objects attributes as saved in the archive; RESETATTR set the output object attribute as they are by default for the target system and position
 2062 if not ((attr_param='SETATTR') or (attr_param='RESETATTR')) then
 2063    internal_error('"'+attr_param+'" is not a valid parameter for file attributes metadata: SETATTR (not supported on *x) set the output objects attributes as saved in the archive; RESETATTR set the output objects attributes as they are by default for the target system and position');
 2064 //EXTRACT2DIR: make a dir with output object with shortest possible path derived from input structures
 2065 if struct_param<>'EXTRACT2DIR' then
 2066    internal_error('"'+struct_param+'" is not a valid parameter for output structure, the only parameter supported is EXTRACT2DIR: make a dir with output object with shortest possible path derived from input structures');
 2067 //get operation mode
 2068 if (upcase(opmode)<>'INTERACTIVE') and (upcase(opmode)<>'BATCH') and (upcase(opmode)<>'HIDDEN') and (upcase(opmode)<>'INTERACTIVE_REPORT') and (upcase(opmode)<>'BATCH_REPORT') and (upcase(opmode)<>'HIDDEN_REPORT') then
 2069    internal_error('"'+upcase(opmode)+'" is not a valid operation mode, please refer to the documentation');
 2070 if (upcase(opmode)='INTERACTIVE') or (upcase(opmode)='INTERACTIVE_REPORT') then
 2071    internal_error('INTERACTIVE* modes are not allowed calling unpea_lib_procedure, use BATCH* or HIDDEN* modes');
 2072 pw_param:=upcase(opmode);
 2073 unpea_procedure(in_qualified_name,out_param,date_param,attr_param,struct_param,pw_param,password,keyf_name);
 2074 end;
 2075 
 2076 procedure unpea_procedure ( in_qualified_name,
 2077                             out_param,
 2078                             date_param,
 2079                             attr_param,
 2080                             struct_param,
 2081                             pw_param,
 2082                             password,
 2083                             keyf_name:ansistring);
 2084 var
 2085    hdr,hdrd : TFCAHdr;
 2086    fhdr,fhdrd : TFCFHdr;
 2087    shdr,shdrd : TFCSHdr;
 2088    hdr256,hdrd256 : TFCA256Hdr;
 2089    fhdr256,fhdrd256 : TFCF256Hdr;
 2090    shdr256,shdrd256 : TFCS256Hdr;
 2091    cxe : TAES_EAXContext;
 2092    cxf : Ttf_EAXContext;
 2093    cxs : Tsp_EAXContext;
 2094    cxh : TFCA_HMAC_Context;
 2095    auth,auth2,auth3 : array [0..15] of byte;//TFCA_AuthBlock;
 2096    HashContext,HashContext_obj,HashContext_volume: THashContext;
 2097    Blake2sContext,Blake2sContext_obj,Blake2sContext_volume:blake2s_ctx;
 2098    Blake2sDigest,Blake2sDigest_obj,Blake2sDigest_volume:TBlake2sDigest;
 2099    Blake2bDigest,Blake2bDigest_obj,Blake2bDigest_volume:TBlake2bDigest;
 2100    Whirl512Digest,Whirl512Digest_obj,Whirl512Digest_volume: TWhirlDigest;
 2101    SHA512Digest,SHA512Digest_obj,SHA512Digest_volume: TSHA512Digest;
 2102    SHA256Digest,SHA256Digest_obj,SHA256Digest_volume: TSHA256Digest;
 2103    SHA3_512Digest,SHA3_512Digest_obj,SHA3_512Digest_volume: TSHA3_512Digest;
 2104    SHA3_256Digest,SHA3_256Digest_obj,SHA3_256Digest_volume: TSHA3_256Digest;
 2105    SHA1Digest,SHA1Digest_obj,SHA1Digest_volume: TSHA1Digest;
 2106    RMD160Digest,RMD160Digest_obj,RMD160Digest_volume: TRMD160Digest;
 2107    MD5Digest,MD5Digest_obj,MD5Digest_volume: TMD5Digest;
 2108    crc64,crc64_obj,crc64_volume:TCRC64;
 2109    ts_start:TTimeStamp;
 2110    f_in,f_out:file of byte;
 2111    sbuf1,sbuf2:array [0..65535] of byte;
 2112    tagbuf,exp_auth:array [0..63] of byte;
 2113    compr_level,headersize,authsize,obj_authsize,volume_authsize,archive_datetimeencoding,storead:byte;
 2114    pw_len,fns:word;
 2115    adler,crc32,adler_obj,crc32_obj,adler_volume,crc32_volume:longint;
 2116    i,j,ci,cj,h,k,numread,numwritten,n_chunks,n_dirs,n_input_files,compsize,uncompsize,addr,fage,fattrib,buf_size:dword;
 2117    total,wrk_space,exp_space,cent_size,fs,out_size,qw0,qw1,qw2,qw3,qw4,qw5,qw6,qw7:qword;
 2118    nobj:int64;
 2119    stream_error,obj_error,volume_error,end_of_archive,pwneeded,chunks_ok,filenamed,out_created,no_more_files,readingstream,readingheader,readingfns,readingtrigger,readingfn,readingfs,readingfage,readingfattrib,readingcompsize,fassigned,readingf,readingcompblock,readingobjauth,readingauth,singlevolume:boolean;
 2120    subroot,basedir,s,in_file,in_name,in_folder,out_path,out_file,algo,obj_algo,volume_algo,compr,fn:ansistring;
 2121 label 1;
 2122 
 2123 procedure clean_variables;
 2124 begin
 2125 i:=0;
 2126 j:=0;
 2127 h:=0;
 2128 k:=0;
 2129 numread:=0;
 2130 numwritten:=0;
 2131 n_chunks:=0;
 2132 n_dirs:=0;
 2133 n_input_files:=0;
 2134 compsize:=0;
 2135 uncompsize:=0;
 2136 addr:=0;
 2137 fage:=0;
 2138 fattrib:=0;
 2139 total:=0;
 2140 cent_size:=0;
 2141 wrk_space:=0;
 2142 exp_space:=0;
 2143 fs:=0;
 2144 nobj:=0;
 2145 out_size:=0;
 2146 clean_global_vars;
 2147 end;
 2148 
 2149 procedure evaluate_archive_size(var exp_space:qword; var cent_size:qword); //succeed if all chunks are accessible
 2150 var qw:qword;
 2151 begin
 2152 j:=1;
 2153 no_more_files:=false;
 2154 exp_space:=0;
 2155 while no_more_files=false do
 2156    begin
 2157    if singlevolume=false then update_pea_filename(in_name,j,in_file)
 2158    else no_more_files:=true;
 2159    if fileexists(in_folder+in_file) then
 2160       begin
 2161       assignfile(f_in,in_folder+in_file);
 2162       filemode:=0;
 2163       reset(f_in);
 2164       srcfilesize(in_folder+in_file,qw);
 2165       exp_space:=exp_space+qw;
 2166       //exp_space:=exp_space+system.filesize(f_in);
 2167       closefile(f_in);
 2168       j:=j+1;
 2169       end
 2170    else no_more_files:=true;
 2171    end;
 2172 n_chunks:=j-1;
 2173 cent_size:=(exp_space div 100)+1;
 2174 Form_pea.LabelDecrypt2.Caption:='Input: '+in_name+'.*, expected '+inttostr(n_chunks)+' volume(s), total '+inttostr(exp_space)+' B';
 2175 end;
 2176 
 2177 procedure evaluate_output;
 2178 begin
 2179 if upcase(out_param) = 'AUTONAME' then out_param:=in_folder+in_name;
 2180 out_file:=extractfilename(out_param);
 2181 out_path:=extractfilepath(out_param);
 2182 if out_file='' then out_file:=in_name; //if no output name is explicitly given, the output name is assumed to be the name of the first input file
 2183 if out_path='' then out_path:=in_folder; //if no output path is explicitly given, the output path is assumed to be the path of the first input file
 2184 if out_path='' then out_path:=executable_path;
 2185 if setcurrentdir(out_path)<>true then out_path:=executable_path; //from this point output path is set as current path; if output path is missing or non accessible executable_path is set as output path
 2186 if out_path[length(out_path)]<>DirectorySeparator then out_path:=out_path+DirectorySeparator;
 2187 Form_pea.LabelDecrypt3.Caption:='Output: '+out_path+out_file+DirectorySeparator;
 2188 if exp_space>diskfree(0) then
 2189    if (upcase(compr)='PCOMPRESS0') then
 2190       if MessageDlg('Output path '+out_path+' seems to not have enough free space, you should continue only if it is a removable support and you have enough removable media. Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 2191       else halt(-3)
 2192    else
 2193       if MessageDlg('Output path '+out_path+' seems to not have enough free space, you should continue only if it is a removable support and you have enough removable media (however the selected compression scheme may reduce the total space needed for the output). Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 2194       else halt(-3);
 2195 end;
 2196 
 2197 procedure ansiextract2dir;
 2198 var
 2199    afn,fnpath,fnname,aout_path,aout_file:ansistring;
 2200 begin
 2201 afn:=fn;
 2202 aout_path:=utf8toansi(out_path);
 2203 aout_file:=utf8toansi(out_file);
 2204 if afn[length(afn)]=DirectorySeparator then
 2205    begin
 2206    ansiextractdirname(afn,fnpath,fnname);
 2207    if subroot='' then
 2208       begin
 2209       subroot:=fnpath;
 2210       basedir:=afn;
 2211       end;
 2212    if ansicontainsstr(fnpath,basedir) then
 2213       begin
 2214       s:=copy(fnpath,length(subroot)+1,length(fnpath)-length(subroot)-1);
 2215       end
 2216    else
 2217       begin
 2218       subroot:=fnpath;
 2219       basedir:=afn;
 2220       s:='';
 2221       end;
 2222    try
 2223       if s<>'' then mkdir(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname)
 2224       else mkdir(aout_path+aout_file+directoryseparator+fnname);
 2225    except
 2226       if IOResult<>0 then internal_error('IO error creating dir '+ansitoutf8(fnname));
 2227    end;
 2228    {$IFDEF MSWINDOWS}
 2229    if attr_param='SETATTR' then filesetattr(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname,fattrib);
 2230    filesetdate(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname,fage);
 2231    {$ENDIF}
 2232    readingfns:=true;
 2233    end
 2234 else
 2235    begin
 2236    fnname:=extractfilename(afn);
 2237    fnpath:=extractfilepath(afn);
 2238    if subroot='' then
 2239       begin
 2240       subroot:=fnpath;
 2241       s:='';
 2242       end
 2243    else s:=copy(fnpath,length(subroot)+1,length(fnpath)-length(subroot)-1);
 2244       if setcurrentdir(aout_path+aout_file+directoryseparator+s)<>true then s:='';
 2245       h:=0;
 2246       filenamed:=false;
 2247       repeat
 2248          if h=0 then
 2249             if fileexists(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname) then inc(h,1)
 2250             else filenamed:=true
 2251          else
 2252             if fileexists(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname+' - '+inttostr(h)+extractfileext(afn)) then inc(h,1)
 2253             else filenamed:=true;
 2254       until filenamed = true;
 2255       if h>0 then fnname:=fnname+' - '+inttostr(h)+extractfileext(afn);
 2256       assignfile(f_out,aout_path+aout_file+directoryseparator+s+directoryseparator+fnname);
 2257       setcurrentdir(aout_path+aout_file);
 2258       rewrite(f_out);
 2259       if IOResult<>0 then internal_error('IO error creating '+ansitoutf8(fnname));
 2260       {$IFDEF MSWINDOWS}
 2261       if attr_param='SETATTR' then filesetattr(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname,fattrib);
 2262       //filesetdate(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname,fage); fails
 2263       {$ENDIF}
 2264       readingfs:=true;
 2265       fassigned:=true;
 2266       end;
 2267 end;
 2268 
 2269 procedure init_AE256_control_algo;
 2270 var
 2271    i:integer;
 2272    tsbuf2:array [0..65535] of byte;
 2273    verw:word;
 2274 begin
 2275 case  upcase(algo) of
 2276 'TRIATS':
 2277 begin
 2278 for i:=0 to pw_len-1 do tsbuf2[i]:=sbuf2[i];
 2279 hdr256.FCAsig:=hdr.FCAsig;
 2280 hdr256.Flags:=hdr.Flags;
 2281 hdr256.Salt:=hdr.Salt;
 2282 hdr256.PW_Ver:=hdr.PW_Ver;
 2283 hdrd256:=hdr256;
 2284 if FCA_EAX256_initP(cxe, @sbuf2, pw_len, hdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2285 fhdr256.FCfsig:=fhdr.FCfsig;
 2286 fhdr256.Flags:=fhdr.Flags;
 2287 fhdr256.Salt:=fhdr.Salt;
 2288 fhdr256.PW_Ver:=fhdr.PW_Ver;
 2289 fhdrd256:=fhdr256;
 2290 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i] xor (pw_len+i) xor ord(upcase(algo[length(algo)-1]));
 2291 if FCf_EAX256_initP(cxf, @sbuf2, pw_len, fhdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2292 shdr256.FCssig:=shdr.FCssig;
 2293 shdr256.Flags:=shdr.Flags;
 2294 shdr256.Salt:=shdr.Salt;
 2295 shdr256.PW_Ver:=shdr.PW_Ver;
 2296 shdrd256:=shdr256;
 2297 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i];
 2298 for i:=0 to pw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len xor i) xor ord(upcase(algo[length(algo)]));
 2299 if FCs_EAX256_initP(cxs, @sbuf2, pw_len, shdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2300 verw:=hdrd256.PW_Ver xor fhdrd256.PW_Ver xor shdrd256.PW_Ver;
 2301 if shdr256.PW_ver<>verw then internal_error('Wrong password or keyfile');
 2302 for i:=0 to pw_len-1 do tsbuf2[i]:=0;
 2303 verw:=0;
 2304 end;
 2305 'TRITSA':
 2306 begin
 2307 for i:=0 to pw_len-1 do tsbuf2[i]:=sbuf2[i];
 2308 fhdr256.FCfsig:=fhdr.FCfsig;
 2309 fhdr256.Flags:=fhdr.Flags;
 2310 fhdr256.Salt:=fhdr.Salt;
 2311 fhdr256.PW_Ver:=fhdr.PW_Ver;
 2312 fhdrd256:=fhdr256;
 2313 if FCf_EAX256_initP(cxf, @sbuf2, pw_len, fhdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2314 shdr256.FCssig:=shdr.FCssig;
 2315 shdr256.Flags:=shdr.Flags;
 2316 shdr256.Salt:=shdr.Salt;
 2317 shdr256.PW_Ver:=shdr.PW_Ver;
 2318 shdrd256:=shdr256;
 2319 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i] xor (pw_len+i) xor ord(upcase(algo[length(algo)-1]));
 2320 if FCs_EAX256_initP(cxs, @sbuf2, pw_len, shdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2321 hdr256.FCAsig:=hdr.FCAsig;
 2322 hdr256.Flags:=hdr.Flags;
 2323 hdr256.Salt:=hdr.Salt;
 2324 hdr256.PW_Ver:=hdr.PW_Ver;
 2325 hdrd256:=hdr256;
 2326 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i];
 2327 for i:=0 to pw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len xor i) xor ord(upcase(algo[length(algo)]));
 2328 if FCA_EAX256_initP(cxe, @sbuf2, pw_len, hdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2329 verw:=hdrd256.PW_Ver xor fhdrd256.PW_Ver xor shdrd256.PW_Ver;
 2330 if hdr256.PW_ver<>verw then internal_error('Wrong password or keyfile');
 2331 for i:=0 to pw_len-1 do tsbuf2[i]:=0;
 2332 verw:=0;
 2333 end;
 2334 'TRISAT':
 2335 begin
 2336 for i:=0 to pw_len-1 do tsbuf2[i]:=sbuf2[i];
 2337 shdr256.FCssig:=shdr.FCssig;
 2338 shdr256.Flags:=shdr.Flags;
 2339 shdr256.Salt:=shdr.Salt;
 2340 shdr256.PW_Ver:=shdr.PW_Ver;
 2341 shdrd256:=shdr256;
 2342 if FCs_EAX256_initP(cxs, @sbuf2, pw_len, shdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2343 hdr256.FCAsig:=hdr.FCAsig;
 2344 hdr256.Flags:=hdr.Flags;
 2345 hdr256.Salt:=hdr.Salt;
 2346 hdr256.PW_Ver:=hdr.PW_Ver;
 2347 hdrd256:=hdr256;
 2348 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i] xor (pw_len+i) xor ord(upcase(algo[length(algo)-1]));
 2349 if FCA_EAX256_initP(cxe, @sbuf2, pw_len, hdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2350 fhdr256.FCfsig:=fhdr.FCfsig;
 2351 fhdr256.Flags:=fhdr.Flags;
 2352 fhdr256.Salt:=fhdr.Salt;
 2353 fhdr256.PW_Ver:=fhdr.PW_Ver;
 2354 fhdrd256:=fhdr256;
 2355 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i];
 2356 for i:=0 to pw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len xor i) xor ord(upcase(algo[length(algo)]));
 2357 if FCf_EAX256_initP(cxf, @sbuf2, pw_len, fhdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2358 verw:=hdrd256.PW_Ver xor fhdrd256.PW_Ver xor shdrd256.PW_Ver;
 2359 if fhdr256.PW_ver<>verw then internal_error('Wrong password or keyfile');
 2360 for i:=0 to pw_len-1 do tsbuf2[i]:=0;
 2361 verw:=0;
 2362 end;
 2363 'EAX256':
 2364 begin
 2365 hdr256.FCAsig:=hdr.FCAsig;
 2366 hdr256.Flags:=hdr.Flags;
 2367 hdr256.Salt:=hdr.Salt;
 2368 hdr256.PW_Ver:=hdr.PW_Ver;
 2369 hdrd256:=hdr256;
 2370 if FCA_EAX256_init(cxe, @sbuf2, pw_len, hdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2371 if hdr256.PW_ver<>hdrd256.PW_ver then internal_error('eax Wrong password or keyfile');
 2372 end;
 2373 'TF256':
 2374 begin
 2375 fhdr256.FCfsig:=fhdr.FCfsig;
 2376 fhdr256.Flags:=fhdr.Flags;
 2377 fhdr256.Salt:=fhdr.Salt;
 2378 fhdr256.PW_Ver:=fhdr.PW_Ver;
 2379 fhdrd256:=fhdr256;
 2380 if FCf_EAX256_init(cxf, @sbuf2, pw_len, fhdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2381 if fhdr256.PW_ver<>fhdrd256.PW_ver then internal_error('Wrong password or keyfile');
 2382 end;
 2383 'SP256':
 2384 begin
 2385 shdr256.FCssig:=shdr.FCssig;
 2386 shdr256.Flags:=shdr.Flags;
 2387 shdr256.Salt:=shdr.Salt;
 2388 shdr256.PW_Ver:=shdr.PW_Ver;
 2389 shdrd256:=shdr256;
 2390 if FCs_EAX256_init(cxs, @sbuf2, pw_len, shdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2391 if shdr256.PW_ver<>shdrd256.PW_ver then internal_error('Wrong password or keyfile');
 2392 end;
 2393 end;
 2394 end;
 2395 
 2396 procedure init_AE128_control_algo;
 2397 begin
 2398 case upcase(algo) of
 2399 'TF':
 2400 begin
 2401 fhdrd:=fhdr;
 2402 if FCf_EAX_init(cxf, @sbuf2, pw_len, fhdrd)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2403 if fhdr.PW_ver<>fhdrd.PW_ver then internal_error('Wrong password or keyfile');
 2404 end;
 2405 'SP':
 2406 begin
 2407 shdrd:=shdr;
 2408 if FCs_EAX_init(cxs, @sbuf2, pw_len, shdrd)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2409 if shdr.PW_ver<>shdrd.PW_ver then internal_error('Wrong password or keyfile');
 2410 end;
 2411 else
 2412 begin
 2413 hdrd:=hdr;
 2414 if upcase(algo)='EAX' then if FCA_EAX_init(cxe, @sbuf2, pw_len, hdrd)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2415 if upcase(algo)='HMAC' then if FCA_HMAC_init(cxh, @sbuf2, pw_len, hdrd)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
 2416 if hdr.PW_ver<>hdrd.PW_ver then internal_error('Wrong password or keyfile');
 2417 end;
 2418 end;
 2419 end;
 2420 
 2421 procedure init_nonAE_control_algo;
 2422 begin
 2423 case upcase(algo) of
 2424 'WHIRLPOOL' : Whirl_Init(HashContext);
 2425 'SHA512' : SHA512Init(HashContext);
 2426 'SHA256' : SHA256Init(HashContext);
 2427 'SHA3_512' : SHA3_512Init(HashContext);
 2428 'SHA3_256' : SHA3_256Init(HashContext);
 2429 'SHA1' : SHA1Init(HashContext);
 2430 'BLAKE2S' : Blake2s_Init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen);
 2431 'BLAKE2B' : Blake2b_Init(HashContext,nil,0,BLAKE2B_MaxDigLen);
 2432 'RIPEMD160' : RMD160Init(HashContext);
 2433 'MD5' : MD5Init(HashContext);
 2434 'CRC64' : CRC64Init(crc64);
 2435 'CRC32' : CRC32Init(crc32);
 2436 'ADLER32' : Adler32Init(adler);
 2437 end;
 2438 end;
 2439 
 2440 procedure init_obj_control_algo;
 2441 begin
 2442 case upcase(obj_algo) of
 2443 'WHIRLPOOL' : Whirl_Init(HashContext_obj);
 2444 'SHA512' : SHA512Init(HashContext_obj);
 2445 'SHA256' : SHA256Init(HashContext_obj);
 2446 'SHA3_512' : SHA3_512Init(HashContext_obj);
 2447 'SHA3_256' : SHA3_256Init(HashContext_obj);
 2448 'SHA1' : SHA1Init(HashContext_obj);
 2449 'BLAKE2S' : Blake2s_Init(Blake2sContext_obj,nil,0,BLAKE2S_MaxDigLen);
 2450 'BLAKE2B' : Blake2b_Init(HashContext_obj,nil,0,BLAKE2B_MaxDigLen);
 2451 'RIPEMD160' : RMD160Init(HashContext_obj);
 2452 'MD5' : MD5Init(HashContext_obj);
 2453 'CRC64' : CRC64Init(crc64_obj);
 2454 'CRC32' : CRC32Init(crc32_obj);
 2455 'ADLER32' : Adler32Init(adler_obj);
 2456 end;
 2457 end;
 2458 
 2459 procedure init_volume_control_algo;
 2460 begin
 2461 case upcase(volume_algo) of
 2462 'WHIRLPOOL' : Whirl_Init(HashContext_volume);
 2463 'SHA512' : SHA512Init(HashContext_volume);
 2464 'SHA256' : SHA256Init(HashContext_volume);
 2465 'SHA3_512' : SHA3_512Init(HashContext_volume);
 2466 'SHA3_256' : SHA3_256Init(HashContext_volume);
 2467 'SHA1' : SHA1Init(HashContext_volume);
 2468 'BLAKE2S' : Blake2s_Init(Blake2sContext_volume,nil,0,BLAKE2S_MaxDigLen);
 2469 'BLAKE2B' : Blake2b_Init(HashContext_volume,nil,0,BLAKE2B_MaxDigLen);
 2470 'RIPEMD160' : RMD160Init(HashContext_volume);
 2471 'MD5' : MD5Init(HashContext_volume);
 2472 'CRC64' : CRC64Init(crc64_volume);
 2473 'CRC32' : CRC32Init(crc32_volume);
 2474 'ADLER32' : Adler32Init(adler_volume);
 2475 end;
 2476 end;
 2477 
 2478 procedure update_control_algo(var buf:array of byte; size:word);
 2479 var k:integer;
 2480 begin
 2481 case upcase(algo) of
 2482 'TRIATS':
 2483 begin
 2484 if FCS_EAX256_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2485 if FCF_EAX256_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2486 if FCA_EAX256_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2487 end;
 2488 'TRITSA':
 2489 begin
 2490 if FCA_EAX256_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2491 if FCS_EAX256_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2492 if FCF_EAX256_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2493 end;
 2494 'TRISAT':
 2495 begin
 2496 if FCF_EAX256_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2497 if FCA_EAX256_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2498 if FCS_EAX256_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2499 end;
 2500 'EAX256' : if FCA_EAX256_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2501 'TF256' : if FCF_EAX256_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2502 'SP256' : if FCS_EAX256_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2503 'EAX' : if FCA_EAX_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2504 'TF' : if FCf_EAX_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2505 'SP' : if FCs_EAX_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2506 'HMAC' : if FCA_HMAC_decrypt(cxh, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
 2507 'WHIRLPOOL' : Whirl_Update(HashContext, @buf, size);
 2508 'SHA512' : SHA512Update(HashContext, @buf, size);
 2509 'SHA256' : SHA256Update(HashContext, @buf, size);
 2510 'SHA3_512' : SHA3_512Update(HashContext, @buf, size);
 2511 'SHA3_256' : SHA3_256Update(HashContext, @buf, size);
 2512 'SHA1' : SHA1Update(HashContext, @buf, size);
 2513 'BLAKE2S' : Blake2s_update(Blake2sContext,@buf,size);
 2514 'BLAKE2B' : Blake2b_update(HashContext,@buf,size);
 2515 'RIPEMD160' : RMD160Update(HashContext, @buf, size);
 2516 'MD5' : MD5Update(HashContext, @buf, size);
 2517 'CRC64' : CRC64Update(crc64, @buf, size);
 2518 'CRC32' : CRC32Update(crc32, @buf, size);
 2519 'ADLER32' : Adler32Update(adler, @buf, size);
 2520 end;
 2521 end;
 2522 
 2523 procedure update_obj_control_algo(buf:array of byte; size:word);
 2524 begin
 2525 case upcase(obj_algo) of
 2526 'WHIRLPOOL' : Whirl_Update(HashContext_obj, @buf, size);
 2527 'SHA512' : SHA512Update(HashContext_obj, @buf, size);
 2528 'SHA256' : SHA256Update(HashContext_obj, @buf, size);
 2529 'SHA3_512' : SHA3_512Update(HashContext_obj, @buf, size);
 2530 'SHA3_256' : SHA3_256Update(HashContext_obj, @buf, size);
 2531 'SHA1' : SHA1Update(HashContext_obj, @buf, size);
 2532 'BLAKE2S' : Blake2s_update(Blake2sContext_obj,@buf,size);
 2533 'BLAKE2B' : Blake2b_update(HashContext_obj,@buf,size);
 2534 'RIPEMD160' : RMD160Update(HashContext_obj, @buf, size);
 2535 'MD5' : MD5Update(HashContext_obj, @buf, size);
 2536 'CRC64' : CRC64Update(crc64_obj, @buf, size);
 2537 'CRC32' : CRC32Update(crc32_obj, @buf, size);
 2538 'ADLER32' : Adler32Update(adler_obj, @buf, size);
 2539 end;
 2540 end;
 2541 
 2542 procedure update_volume_control_algo(buf:array of byte; size:word);
 2543 begin
 2544 case upcase(volume_algo) of
 2545 'WHIRLPOOL' : Whirl_Update(HashContext_volume, @buf, size);
 2546 'SHA512' : SHA512Update(HashContext_volume, @buf, size);
 2547 'SHA256' : SHA256Update(HashContext_volume, @buf, size);
 2548 'SHA3_512' : SHA3_512Update(HashContext_volume, @buf, size);
 2549 'SHA3_256' : SHA3_256Update(HashContext_volume, @buf, size);
 2550 'SHA1' : SHA1Update(HashContext_volume, @buf, size);
 2551 'BLAKE2S' : Blake2s_update(Blake2sContext_volume,@buf,size);
 2552 'BLAKE2B' : Blake2b_update(HashContext_volume,@buf,size);
 2553 'RIPEMD160' : RMD160Update(HashContext_volume, @buf, size);
 2554 'MD5' : MD5Update(HashContext_volume, @buf, size);
 2555 'CRC64' : CRC64Update(crc64_volume, @buf, size);
 2556 'CRC32' : CRC32Update(crc32_volume, @buf, size);
 2557 'ADLER32' : Adler32Update(adler_volume, @buf, size);
 2558 end;
 2559 end;
 2560 
 2561 procedure finish_control_algo;
 2562 begin
 2563 case upcase(algo) of
 2564 'TRIATS':
 2565 begin
 2566 FCA_EAX256_final(cxe, auth);
 2567 FCF_EAX256_final(cxf, auth2);
 2568 FCS_EAX256_final(cxs, auth3);
 2569 end;
 2570 'TRITSA':
 2571 begin
 2572 FCF_EAX256_final(cxf, auth);
 2573 FCS_EAX256_final(cxs, auth2);
 2574 FCA_EAX256_final(cxe, auth3);
 2575 end;
 2576 'TRISAT':
 2577 begin
 2578 FCS_EAX256_final(cxs, auth);
 2579 FCA_EAX256_final(cxe, auth2);
 2580 FCF_EAX256_final(cxf, auth3);
 2581 end;
 2582 'EAX256' : FCA_EAX256_final(cxe, auth);
 2583 'TF256' : FCf_EAX256_final(cxf, auth);
 2584 'SP256' : FCs_EAX256_final(cxs, auth);
 2585 'EAX' : FCA_EAX_final(cxe, auth);
 2586 'TF' : FCf_EAX_final(cxf, auth);
 2587 'SP' : FCs_EAX_final(cxs, auth);
 2588 'HMAC' : FCA_HMAC_final(cxh, auth);
 2589 'WHIRLPOOL' : Whirl_Final(HashContext,WHIRL512Digest);
 2590 'SHA512' : SHA512Final(HashContext,SHA512Digest);
 2591 'SHA256' : SHA256Final(HashContext,SHA256Digest);
 2592 'SHA3_512' : SHA3_512Final(HashContext,SHA3_512Digest);
 2593 'SHA3_256' : SHA3_256Final(HashContext,SHA3_256Digest);
 2594 'SHA1' : SHA1Final(HashContext,SHA1Digest);
 2595 'BLAKE2S' : blake2s_Final(Blake2sContext,Blake2sDigest);
 2596 'BLAKE2B' : blake2b_Final(HashContext,Blake2bDigest);
 2597 'RIPEMD160' : RMD160Final(HashContext,RMD160Digest);
 2598 'MD5' : MD5Final(HashContext,MD5Digest);
 2599 'CRC64' : CRC64Final(crc64);
 2600 'CRC32' : CRC32Final(crc32);
 2601 'ADLER32' : Adler32Final(adler);
 2602 end;
 2603 end;
 2604 
 2605 procedure finish_obj_control_algo;
 2606 begin
 2607 case upcase(obj_algo) of
 2608 'WHIRLPOOL' : Whirl_Final(HashContext_obj,WHIRL512Digest_obj);
 2609 'SHA512' : SHA512Final(HashContext_obj,SHA512Digest_obj);
 2610 'SHA256' : SHA256Final(HashContext_obj,SHA256Digest_obj);
 2611 'SHA3_512' : SHA3_512Final(HashContext_obj,SHA3_512Digest_obj);
 2612 'SHA3_256' : SHA3_256Final(HashContext_obj,SHA3_256Digest_obj);
 2613 'SHA1' : SHA1Final(HashContext_obj,SHA1Digest_obj);
 2614 'BLAKE2S' : blake2s_Final(Blake2sContext_obj,Blake2sDigest_obj);
 2615 'BLAKE2B' : blake2b_Final(HashContext_obj,Blake2bDigest_obj);
 2616 'RIPEMD160' : RMD160Final(HashContext_obj,RMD160Digest_obj);
 2617 'MD5' : MD5Final(HashContext_obj,MD5Digest_obj);
 2618 'CRC64' : CRC64Final(crc64_obj);
 2619 'CRC32' : CRC32Final(crc32_obj);
 2620 'ADLER32' : Adler32Final(adler_obj);
 2621 end;
 2622 end;
 2623 
 2624 procedure finish_volume_control_algo;
 2625 begin
 2626 case upcase(volume_algo) of
 2627 'WHIRLPOOL' : Whirl_Final(HashContext_volume,WHIRL512Digest_volume);
 2628 'SHA512' : SHA512Final(HashContext_volume,SHA512Digest_volume);
 2629 'SHA256' : SHA256Final(HashContext_volume,SHA256Digest_volume);
 2630 'SHA3_512' : SHA3_512Final(HashContext_volume,SHA3_512Digest_volume);
 2631 'SHA3_256' : SHA3_256Final(HashContext_volume,SHA3_256Digest_volume);
 2632 'SHA1' : SHA1Final(HashContext_volume,SHA1Digest_volume);
 2633 'BLAKE2S' : blake2s_Final(Blake2sContext_volume,Blake2sDigest_volume);
 2634 'BLAKE2B' : blake2b_Final(HashContext_volume,Blake2bDigest_volume);
 2635 'RIPEMD160' : RMD160Final(HashContext_volume,RMD160Digest_volume);
 2636 'MD5' : MD5Final(HashContext_volume,MD5Digest_volume);
 2637 'CRC64' : CRC64Final(crc64_volume);
 2638 'CRC32' : CRC32Final(crc32_volume);
 2639 'ADLER32' : Adler32Final(adler_volume);
 2640 end;
 2641 end;
 2642 
 2643 procedure authenticate_stream;
 2644 var
 2645    k:dword;
 2646    tag_match:boolean;
 2647    ct384:THashContext;
 2648    dg384:TSHA3_384Digest;
 2649 begin
 2650 if upcase(algo)<>'NOALGO' then
 2651    begin
 2652    for k:=0 to authsize-1 do exp_auth[k]:=sbuf1[k];
 2653    case upcase(algo) of
 2654       'TRIATS','TRITSA','TRISAT':
 2655       begin
 2656       for k:=0 to authsize-1 do sbuf1[k]:=auth[k];
 2657       for k:=16 to 31 do sbuf1[k]:=auth2[k-16];
 2658       for k:=32 to 47 do sbuf1[k]:=auth3[k-32];
 2659       SHA3_384Init(ct384);
 2660       SHA3_384Update(ct384, @sbuf1, 48);
 2661       SHA3_384Final(ct384, dg384);
 2662       for k:=0 to 47 do sbuf1[k]:=dg384[k];
 2663       end;
 2664       'EAX256','TF256','SP256','EAX','TF','SP','HMAC' : for k:=0 to authsize-1 do sbuf1[k]:=auth[k];
 2665       'WHIRLPOOL' : for k:=0 to authsize-1 do sbuf1[k]:=WHIRL512Digest[k];
 2666       'SHA512' : for k:=0 to authsize-1 do sbuf1[k]:=SHA512Digest[k];
 2667       'SHA256' : for k:=0 to authsize-1 do sbuf1[k]:=SHA256Digest[k];
 2668       'SHA3_512' : for k:=0 to authsize-1 do sbuf1[k]:=SHA3_512Digest[k];
 2669       'SHA3_256' : for k:=0 to authsize-1 do sbuf1[k]:=SHA3_256Digest[k];
 2670       'SHA1' : for k:=0 to authsize-1 do sbuf1[k]:=SHA1Digest[k];
 2671       'BLAKE2S' : for k:=0 to authsize-1 do sbuf1[k]:=Blake2sDigest[k];
 2672       'BLAKE2B' : for k:=0 to authsize-1 do sbuf1[k]:=Blake2bDigest[k];
 2673       'RIPEMD160' : for k:=0 to authsize-1 do sbuf1[k]:=RMD160Digest[k];
 2674       'MD5' : for k:=0 to authsize-1 do sbuf1[k]:=MD5Digest[k];
 2675       'CRC64' :
 2676       begin
 2677       dword2bytebuf(crc64.lo32,sbuf1,0);
 2678       dword2bytebuf(crc64.hi32,sbuf1,4);
 2679       end;
 2680       'CRC32' : dword2bytebuf(crc32,sbuf1,0);
 2681       'ADLER32' : dword2bytebuf(adler,sbuf1,0);
 2682       end;
 2683    tag_match:=true;
 2684    for k:=0 to authsize-1 do if sbuf1[k]<>exp_auth[k] then
 2685       begin
 2686       tag_match:=false;
 2687       break;
 2688       end;
 2689    if tag_match=false then
 2690       begin
 2691       Form_pea.LabelDecrypt5.Caption:='The archive''s stream of data seem corrupted or tampered! You should not trust the stream''s content!';
 2692       stream_error:=true;
 2693       end
 2694    else
 2695       begin
 2696       s:='';
 2697       for k:=0 to authsize-1 do s:=s+hexstr(@sbuf1[k],1);
 2698       if (upcase(algo)='TRIATS') or (upcase(algo)='TRITSA') or (upcase(algo)='TRISAT') or
 2699       (upcase(algo)='EAX256') or (upcase(algo)='TF256') or (upcase(algo)='SP256') or
 2700       (upcase(algo)='EAX') or (upcase(algo)='TF') or (upcase(algo)='SP') or (upcase(algo)='HMAC') then Form_pea.LabelDecrypt5.Caption:='Archive''s stream correctly authenticated, tag: '+s
 2701       else Form_pea.LabelDecrypt5.Caption:='Archive''s stream correctly verified';
 2702       end;
 2703    end;
 2704 end;
 2705 
 2706 procedure check_obj;
 2707 var
 2708    k:dword;
 2709    tag_match:boolean;
 2710 begin
 2711 if upcase(obj_algo)<>'NOALGO' then
 2712    begin
 2713    for k:=0 to obj_authsize-1 do exp_obj_tags[nobj,k]:=sbuf1[k];
 2714    case upcase(obj_algo) of
 2715       'WHIRLPOOL' : for k:=0 to obj_authsize-1 do sbuf1[k]:=WHIRL512Digest_obj[k];
 2716       'SHA512' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA512Digest_obj[k];
 2717       'SHA256' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA256Digest_obj[k];
 2718       'SHA3_512' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA3_512Digest_obj[k];
 2719       'SHA3_256' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA3_256Digest_obj[k];
 2720       'SHA1' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA1Digest_obj[k];
 2721       'BLAKE2S' : for k:=0 to obj_authsize-1 do sbuf1[k]:=Blake2sDigest_obj[k];
 2722       'BLAKE2B' : for k:=0 to obj_authsize-1 do sbuf1[k]:=Blake2bDigest_obj[k];
 2723       'RIPEMD160' : for k:=0 to obj_authsize-1 do sbuf1[k]:=RMD160Digest_obj[k];
 2724       'MD5' : for k:=0 to obj_authsize-1 do sbuf1[k]:=MD5Digest_obj[k];
 2725       'CRC64' :
 2726       begin
 2727       dword2bytebuf(crc64_obj.lo32,sbuf1,0);
 2728       dword2bytebuf(crc64_obj.hi32,sbuf1,4);
 2729       end;
 2730       'CRC32' : dword2bytebuf(crc32_obj,sbuf1,0);
 2731       'ADLER32' : dword2bytebuf(adler_obj,sbuf1,0);
 2732       end;
 2733    for k:=0 to obj_authsize-1 do obj_tags[nobj,k]:=sbuf1[k];
 2734    tag_match:=true;
 2735    for k:=0 to obj_authsize-1 do if obj_tags[nobj,k]<>exp_obj_tags[nobj,k] then
 2736       begin
 2737       tag_match:=false;
 2738       break;
 2739       end;
 2740    if tag_match=true then status_objects[nobj]:='Object is OK'
 2741    else
 2742       begin
 2743       status_objects[nobj]:='Wrong tag!';
 2744       obj_error:=true;
 2745       end;
 2746    end;
 2747 end;
 2748 
 2749 procedure check_volume;
 2750 var
 2751    k:dword;
 2752    tag_match:boolean;
 2753 begin
 2754 if upcase(volume_algo)<>'NOALGO' then
 2755    begin
 2756    for k:=0 to volume_authsize-1 do exp_volume_tags[j-1,k]:=tagbuf[k];
 2757    case upcase(volume_algo) of
 2758       'WHIRLPOOL' : for k:=0 to volume_authsize-1 do tagbuf[k]:=WHIRL512Digest_volume[k];
 2759       'SHA512' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA512Digest_volume[k];
 2760       'SHA256' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA256Digest_volume[k];
 2761       'SHA3_512' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA3_512Digest_volume[k];
 2762       'SHA3_256' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA3_256Digest_volume[k];
 2763       'SHA1' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA1Digest_volume[k];
 2764       'BLAKE2S' : for k:=0 to volume_authsize-1 do tagbuf[k]:=Blake2sDigest_volume[k];
 2765       'BLAKE2B' : for k:=0 to volume_authsize-1 do tagbuf[k]:=Blake2bDigest_volume[k];
 2766       'RIPEMD160' : for k:=0 to volume_authsize-1 do tagbuf[k]:=RMD160Digest_volume[k];
 2767       'MD5' : for k:=0 to volume_authsize-1 do tagbuf[k]:=MD5Digest_volume[k];
 2768       'CRC64' :
 2769       begin
 2770       dword2bytebuf(crc64_volume.lo32,tagbuf,0);
 2771       dword2bytebuf(crc64_volume.hi32,tagbuf,4);
 2772       end;
 2773       'CRC32' : dword2bytebuf(crc32_volume,tagbuf,0);
 2774       'ADLER32' : dword2bytebuf(adler_volume,tagbuf,0);
 2775       end;
 2776    for k:=0 to volume_authsize-1 do volume_tags[j-1,k]:=tagbuf[k];
 2777    tag_match:=true;
 2778    for k:=0 to volume_authsize-1 do if volume_tags[j-1,k]<>exp_volume_tags[j-1,k] then
 2779       begin
 2780       tag_match:=false;
 2781       break;
 2782       end;
 2783    if tag_match=true then status_volumes[j-1]:='Volume is OK'
 2784    else
 2785       begin
 2786       status_volumes[j-1]:='Wrong tag!';
 2787       volume_error:=true;
 2788       end;
 2789    end;
 2790 end;
 2791 
 2792 procedure do_report_unPEA;
 2793 var
 2794    h,k,obj_ok:dword;
 2795    s:ansistring;
 2796    system_datetimeencoding:byte;
 2797 begin
 2798 get_system_datetimeencoding(system_datetimeencoding);
 2799 Form_report.InputT.Caption:='Objects';
 2800 Form_report.OutputT.Caption:='Volumes';
 2801 Form_report.Caption:='Log UnPEA';
 2802 Form_report.StringGrid1.ColCount:=8;
 2803 Form_report.StringGrid1.Cells[0,0]:='Original object name';
 2804 Form_report.StringGrid1.Cells[1,0]:='Status';
 2805 Form_report.StringGrid1.Cells[2,0]:='Size (B)';
 2806 Form_report.StringGrid1.Cells[3,0]:='Age';
 2807 Form_report.StringGrid1.Cells[4,0]:='Attrib';
 2808 Form_report.StringGrid1.Cells[5,0]:='Attrib n.';
 2809 Form_report.StringGrid1.Cells[6,0]:='calculated ('+obj_algo+')';
 2810 Form_report.StringGrid1.Cells[7,0]:='found';
 2811 Form_report.StringGrid1.RowCount:=nobj+2;
 2812 obj_ok:=0;
 2813 for k:=0 to nobj do
 2814     begin
 2815     Form_report.StringGrid1.Cells[0,k+1]:=ansitoutf8(in_files[k]);
 2816     Form_report.StringGrid1.Cells[1,k+1]:=status_objects[k];
 2817     Form_report.StringGrid1.Cells[2,k+1]:=inttostr(fsizes[k]);
 2818     if system_datetimeencoding=archive_datetimeencoding then
 2819        begin
 2820        try
 2821           if ftimes[k]<>0 then Form_report.StringGrid1.Cells[3,k+1]:=datetimetostr(filedatetodatetime(ftimes[k]));
 2822        except
 2823           Form_report.StringGrid1.Cells[3,k+1]:='Non valid DateTime';
 2824        end;
 2825        end
 2826     else Form_report.StringGrid1.Cells[3,k+1]:='DateTime conversion not available';
 2827     Form_report.StringGrid1.Cells[4,k+1]:=fattr_dec[k];
 2828     Form_report.StringGrid1.Cells[5,k+1]:=inttostr(fattr[k]);
 2829     if upcase(obj_algo)<>'NOALGO' then
 2830        begin
 2831        s:='';
 2832        for h:=0 to obj_authsize-1 do s:=s+hexstr(@obj_tags[k,h],1);
 2833        Form_report.StringGrid1.Cells[6,k+1]:=s;
 2834        s:='';
 2835        for h:=0 to obj_authsize-1 do s:=s+hexstr(@exp_obj_tags[k,h],1);
 2836        Form_report.StringGrid1.Cells[7,k+1]:=s;
 2837        end;
 2838     inc(obj_ok,1);
 2839     end;
 2840 Form_report.StringGrid1.AutosizeColumns;
 2841 Form_report.StringGrid2.ColCount:=4;
 2842 Form_report.StringGrid2.Cells[0,0]:='Volume';
 2843 Form_report.StringGrid2.Cells[1,0]:='Status';
 2844 Form_report.StringGrid2.Cells[2,0]:='calculated ('+volume_algo+')';
 2845 Form_report.StringGrid2.Cells[3,0]:='found';
 2846 Form_report.StringGrid2.RowCount:=j;
 2847 for k:=0 to j-2 do
 2848     begin
 2849     if singlevolume=false then update_pea_filename((in_name),k+1,s)
 2850     else s:=(in_name);
 2851     Form_report.StringGrid2.Cells[0,k+1]:=s;
 2852     if upcase(volume_algo)<>'NOALGO' then
 2853        begin
 2854        Form_report.StringGrid2.Cells[1,k+1]:=status_volumes[k];
 2855        s:='';
 2856        for h:=0 to volume_authsize-1 do s:=s+hexstr(@volume_tags[k,h],1);
 2857        Form_report.StringGrid2.Cells[2,k+1]:=s;
 2858        s:='';
 2859        for h:=0 to volume_authsize-1 do s:=s+hexstr(@exp_volume_tags[k,h],1);
 2860        Form_report.StringGrid2.Cells[3,k+1]:=s;
 2861        end;
 2862     end;
 2863 Form_report.StringGrid2.AutosizeColumns;
 2864 Form_report.Label1.Caption:=in_folder+in_name+'.* -> '+out_path+out_file+DirectorySeparator;
 2865 Form_report.Label2.Caption:=Form_pea.LabelDecrypt4.Caption;
 2866 Form_report.Label3.Caption:='Input: '+inttostr(j-1)+' volume(s), '+inttostr(wrk_space)+' B -> Extracted '+inttostr(obj_ok)+' objects ('+inttostr(n_dirs)+' dirs, '+inttostr(obj_ok-n_dirs)+' files) of '+inttostr(n_input_files)+' ('+inttostr(n_input_files-obj_ok)+' not extracted); total output: '+inttostr(out_size)+' B';
 2867 Form_report.Label4.Caption:=Form_pea.LabelDecrypt5.Caption+' '+Form_pea.LabelDecrypt6.Caption
 2868 end;
 2869 
 2870 //clean keying-related variables
 2871 procedure clean_keying_vars;
 2872 var
 2873    k:integer;
 2874 begin
 2875 for k:=0 to pw_len-1 do sbuf2[k]:=0;
 2876 pw:='';
 2877 password:='';
 2878 keyfile_name:='';
 2879 keyf_name:='';
 2880 pw_len:=0;
 2881 k:=0;
 2882 end;
 2883 
 2884 function report_errors:integer;
 2885 var
 2886    s:ansistring;
 2887 begin
 2888 result:=0;
 2889 if (stream_error=false) and (obj_error=false) and (volume_error=false) then exit;
 2890 result:=-1;
 2891 s:='Error(s) found in: ';
 2892 if stream_error=true then s:=s+'stream; ';
 2893 if obj_error=true then s:=s+'object(s); ';
 2894 if volume_error=true then s:=s+'volume(s); ';
 2895 s:=s+'please check job log!';
 2896 MessageDlg(s, mtError, [mbOK], 0);
 2897 end;
 2898 
 2899 begin
 2900 exitcode:=-1;
 2901 clean_variables;
 2902 if (upcase(pw_param)<>'HIDDEN') and (upcase(pw_param)<>'HIDDEN_REPORT') then Form_pea.Visible:=true else Form_pea.Visible:=false;
 2903 Form_pea.PanelDecrypt1.visible:=true;
 2904 Form_pea.PanelEncrypt1.visible:=false;
 2905 Form_pea.Caption:='UnPea';
 2906 ts_start:=datetimetotimestamp(now);
 2907 stream_error:=false;
 2908 obj_error:=false;
 2909 volume_error:=false;
 2910 Form_pea.ProgressBar1.Position:=0;
 2911 Form_pea.LabelDecrypt2.Caption:='Input: '+in_qualified_name;
 2912 Form_pea.LabelDecrypt3.Caption:='Output: '+out_param;
 2913 Form_pea.LabelTime1.Caption:='Opening archive...';
 2914 in_folder:=extractfilepath(in_qualified_name);
 2915 if in_folder='' then in_folder:=executable_path;
 2916 in_file:=extractfilename(in_qualified_name);
 2917 if upcase(copy(in_qualified_name,length(in_qualified_name)-10,11))<>'.000001.PEA' then
 2918    begin
 2919    singlevolume:=true;
 2920    end
 2921 else
 2922    begin
 2923    singlevolume:=false;
 2924    delete(in_file,length(in_file)-10,11);
 2925    end;
 2926 in_name:=in_file;
 2927 //try to evaluate archive size (succeed if all chunks are accessible)
 2928 evaluate_archive_size(exp_space,cent_size);
 2929 //check output name and path
 2930 evaluate_output;
 2931 //try to check if the path has enough room for the output (formerly guessed archive size is used, actual output size is unknown unless all data is extracted and all headers are parsed)
 2932 setcurrentdir(extractfilepath(out_param));
 2933 if exp_space>diskfree(0) then
 2934    if MessageDlg('Output path '+extractfilepath(out_param)+' seems to not have enough free space. Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 2935    else halt(-3);
 2936 {blockread 10 byte archive header; since volume tag size is unknown to UnPEA,
 2937 PEA set first volume size mandatory at least 10 byte (plus volume tag) in order
 2938 to make UnPEA able to blockread the archive header and calculate the volume tag
 2939 size}
 2940 assignfile(f_in,in_qualified_name);
 2941 filemode:=0;
 2942 reset(f_in);
 2943 blockread (f_in,sbuf1,10,numread);
 2944 if IOResult<>0 then internal_error('IO error reading from '+in_qualified_name);
 2945 close(f_in);
 2946 test_pea_error('parsing archive header',pea_parse_archive_header(sbuf1,volume_algo,archive_datetimeencoding));
 2947 decode_volume_control_algo (volume_algo,volume_authsize);
 2948 //read 10 byte archive header plus 10 byte stream header plus other 16 byte crypto subheader (if AE is used) plus 4 byte for compression buffer size (if compression is used)
 2949 read_from_chunks ( in_folder,in_name,
 2950                    40,
 2951                    sbuf1,sbuf2,
 2952                    volume_authsize,
 2953                    40,
 2954                    singlevolume);
 2955 for i:=0 to 22 do tagbuf[i]:=sbuf1[i]; //write plaintext header
 2956 for i:=0 to 29 do sbuf1[i]:=sbuf1[i+10]; //discard 10 byte of archive header
 2957 test_pea_error('parsing stream header',pea_parse_stream_header(sbuf1, compr, compr_level, algo, obj_algo));
 2958 decode_control_algo ( algo,
 2959                       headersize,
 2960                       authsize,
 2961                       pwneeded);
 2962 if compr<>'PCOMPRESS0' then headersize:=headersize+14//stream header size + 10 (archive header size) + 4 (compression buffer field size, if compression is used)
 2963 else headersize:=headersize+10;
 2964 decode_obj_control_algo (obj_algo,obj_authsize);
 2965 for i:=0 to 19 do sbuf1[i]:=sbuf1[i+10]; //discard 10 bytes of stream header
 2966 if pwneeded=true then //initialize AE (appending headers to password)
 2967    begin
 2968    //read AE header
 2969    case upcase(algo) of
 2970    'TRIATS','TRITSA','TRISAT':
 2971    begin
 2972    case upcase(algo) of
 2973       'TRIATS': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr));
 2974       'TRITSA': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaderf(sbuf1,fhdr));
 2975       'TRISAT': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaders(sbuf1,shdr));
 2976       end;
 2977    read_from_chunks ( in_folder,in_name,
 2978                    56,
 2979                    sbuf1,sbuf2,
 2980                    volume_authsize,
 2981                    56,
 2982                    singlevolume);
 2983    for i:=0 to 15 do sbuf1[i]:=sbuf1[i+36];
 2984    case upcase(algo) of
 2985       'TRIATS': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaderf(sbuf1,fhdr));
 2986       'TRITSA': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaders(sbuf1,shdr));
 2987       'TRISAT': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr));
 2988       end;
 2989    read_from_chunks ( in_folder,in_name,
 2990                    72,
 2991                    sbuf1,sbuf2,
 2992                    volume_authsize,
 2993                    72,
 2994                    singlevolume);
 2995    for i:=0 to 15 do sbuf1[i]:=sbuf1[i+52];
 2996    case upcase(algo) of
 2997       'TRIATS': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaders(sbuf1,shdr));
 2998       'TRITSA': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr));
 2999       'TRISAT': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaderf(sbuf1,fhdr));
 3000       end;
 3001    end;
 3002    'EAX','EAX256': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr));
 3003    'TF','TF256': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaderf(sbuf1,fhdr));
 3004    'SP','SP256': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaders(sbuf1,shdr));
 3005    else test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr))
 3006    end;
 3007    if (upcase(pw_param)='INTERACTIVE') or (upcase(pw_param)='INTERACTIVE_REPORT') then
 3008       begin
 3009       //password is pw string that was already entered in EditPW.Text
 3010       //keyfile name is keyfile_name already entered
 3011       end
 3012    else
 3013       begin
 3014       pw:=password; //pw is got from commandline (not recommended)
 3015       keyfile_name:=keyf_name; //keyfile name is got from command line
 3016       end;
 3017    pw_len:=length(pw);
 3018    if pw_len=0 then internal_error('invalid password length');
 3019    for k:=0 to pw_len-1 do sbuf2[k]:=ord(pw[k+1]);//copy password into an array of byte
 3020    //append header to password's array (sbuf2)
 3021    for k:=0 to 21 do sbuf2[pw_len+k]:=tagbuf[k];
 3022    pw_len:=pw_len+22;
 3023    //append keyfile to password's array (sbuf2)
 3024    if upcase(keyfile_name)<>'NOKEYFILE' then
 3025       test_pea_error('accessing keyfile',use_keyfile(keyfile_name,2048,numread,sbuf2,pw_len));
 3026    //initialize AE
 3027    if (upcase(algo)='TRIATS') or (upcase(algo)='TRITSA') or (upcase(algo)='TRISAT') or
 3028       (upcase(algo)='EAX256') or (upcase(algo)='TF256') or (upcase(algo)='SP256') then init_AE256_control_algo
 3029    else init_AE128_control_algo;
 3030    clean_keying_vars;
 3031    case upcase(algo) of
 3032       'TRIATS','TRITSA','TRISAT': //remove masking of exact archive size, 1..128 byte of random data
 3033       begin
 3034       read_from_chunks ( in_folder,in_name,
 3035                    328,
 3036                    sbuf1,sbuf2,
 3037                    volume_authsize,
 3038                    328,
 3039                    singlevolume);
 3040       sbuf1[0]:=sbuf1[68];
 3041       update_control_algo(sbuf1,1);
 3042       storead:=sbuf1[0];
 3043       if storead>0 then
 3044          for i:=0 to storead-1 do sbuf1[i]:=sbuf1[69+i];
 3045       update_control_algo(sbuf1,storead);
 3046       headersize:=headersize+storead+1;
 3047    end;
 3048    end;
 3049    if (upcase(algo)='TRIATS') or (upcase(algo)='TRITSA') or (upcase(algo)='TRISAT') then
 3050       for i:=0 to 3 do sbuf1[i]:=sbuf1[i+69+storead]
 3051    else
 3052       for i:=0 to 3 do sbuf1[i]:=sbuf1[i+16]; //discard 16 bytes of crypto subheader
 3053    storead:=0;
 3054    end
 3055 //if AE is not used, initialize other control algorithms (and check headers)
 3056 else
 3057    begin
 3058    init_nonAE_control_algo;
 3059    update_control_algo(tagbuf,20);//check the archive and stream headers
 3060    end;
 3061 Form_pea.LabelDecrypt4.Caption:='Using: '+compr+', stream: '+algo+', objects: '+obj_algo+', volume(s): '+volume_algo;
 3062 out_created:=false;
 3063 if upcase(struct_param)='EXTRACT2DIR' then //save objects with shortest path in a dir with archive's name; actually this is the only output method allowed
 3064    begin
 3065    s:=out_file;
 3066    j:=0;
 3067    repeat
 3068      if not(directoryexists(out_path+out_file)) and not(fileexists(out_path+out_file)) then
 3069          try
 3070          forcedirectories(out_path+out_file);
 3071          out_created:=true;
 3072          except
 3073          out_file:=s+'output';
 3074          out_created:=true;
 3075          end
 3076       else
 3077          begin
 3078          j:=j+1;
 3079          out_file:=s+' - '+inttostr(j);
 3080          if j=1000 then //to break recursivity if filename is not valid (ie unsupported character encoding)
 3081             begin
 3082             out_file:=s+'output';
 3083             out_created:=true;
 3084             end;
 3085          end;
 3086       {try //no longer works with Lazarus 0.9.30, exception is not returned
 3087          mkdir(out_path+out_file);
 3088          out_created:=true;
 3089       except
 3090          out_file:=s+' - '+inttostr(j);
 3091          j:=j+1;
 3092       end;}
 3093       until out_created=true;
 3094    setcurrentdir(out_param);
 3095    end;
 3096 Form_pea.LabelDecrypt3.Caption:='Output: '+out_path+out_file+DirectorySeparator;
 3097 //if compression is used, get compression buffer size; since at present revision level a single stream is included in an archive, the stream specific compression buffer size is read as first 4 bytes after the headers area
 3098 if compr<>'PCOMPRESS0' then
 3099    begin
 3100    update_control_algo(sbuf1,4);
 3101    buf_size:=sbuf1[0] + (sbuf1[1] shl 8) + (sbuf1[2] shl 16) + (sbuf1[3] shl 24);
 3102    end;
 3103 // process the data
 3104 uncompsize:=0;
 3105 no_more_files:=false;
 3106 chunks_ok:=true;
 3107 readingstream:=true;
 3108 readingheader:=true;
 3109 readingfns:=false;
 3110 readingtrigger:=false;
 3111 readingfn:=false;
 3112 readingfs:=false;
 3113 readingfage:=false;
 3114 readingfattrib:=false;
 3115 readingcompsize:=false;
 3116 fassigned:=false;
 3117 readingf:=false;
 3118 readingcompblock:=false;
 3119 readingobjauth:=false;
 3120 readingauth:=false;
 3121 end_of_archive:=false;
 3122 addr:=0;
 3123 uncompsize:=0;
 3124 j:=1;
 3125 n_dirs:=0;
 3126 n_input_files:=0;
 3127 out_size:=0;
 3128 wrk_space:=0;
 3129 nobj:=-1;
 3130 init_volume_control_algo;
 3131 while (chunks_ok=true) and (end_of_archive=false) do
 3132    begin
 3133    if singlevolume=false then update_pea_filename(in_name,j,in_file);
 3134    repeat
 3135       if fileexists(in_folder+in_file) then
 3136          begin
 3137          try
 3138       chunks_ok:=true;
 3139       assignfile(f_in,in_folder+in_file);
 3140       filemode:=0;
 3141       reset(f_in);
 3142       if IOResult<>0 then internal_error('IO error opening '+in_folder+in_file);
 3143       srcfilesize(in_folder+in_file,total);
 3144       total:=total-volume_authsize;
 3145       //total:=system.filesize(f_in)-volume_authsize;
 3146       while ((total>0) and (readingheader=true)) do //read and discard archive and stream headers
 3147          begin
 3148          if total>headersize-addr then i:=headersize-addr else i:=total;
 3149          blockread (f_in,sbuf2,i,numread);
 3150          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3151          update_volume_control_algo(sbuf2,numread);
 3152          dec(total,numread);
 3153          inc(wrk_space,numread);
 3154          inc(addr,numread);
 3155          if addr>=headersize then
 3156             begin
 3157             addr:=0;
 3158             readingheader:=false;
 3159             readingfns:=true;
 3160             end;
 3161          end;
 3162       1:
 3163       while ((total>0) and (readingfns=true)) do //read filename size;
 3164          begin
 3165          if total>2-addr then i:=2-addr else i:=total;
 3166          blockread (f_in,sbuf2,i,numread);
 3167          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3168          update_volume_control_algo(sbuf2,numread);
 3169          dec(total,numread);
 3170          inc(wrk_space,numread);
 3171          for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
 3172          inc(addr,numread);
 3173          if addr>=2 then
 3174             begin
 3175             readingfns:=false;
 3176             addr:=0;
 3177             if readingstream=true then
 3178                begin
 3179                init_obj_control_algo;
 3180                update_control_algo(sbuf1,2);
 3181                update_obj_control_algo(sbuf1,2);
 3182                end;
 3183             fns:=sbuf1[0] + (sbuf1[1] shl 8);
 3184             if fns>SBUFSIZE then internal_error('Object name size exceeds '+inttostr(SBUFSIZE));
 3185             {pathnames longer than SBUFSIZE (usually exceeding actual needs,
 3186             SBUFSIZE is originally defined as 32KB), are considered errors}
 3187             if fns=0 then readingtrigger:=true //read a trigger object
 3188             else
 3189                begin
 3190                readingtrigger:=false;
 3191                readingfn:=true;
 3192                inc(nobj,1);
 3193                end;
 3194             end;
 3195          end;
 3196       while ((total>0) and (readingtrigger=true)) do //read 4 byte trigger;
 3197          begin
 3198          if total>4-addr then i:=4-addr else i:=total;
 3199          blockread (f_in,sbuf2,i,numread);
 3200          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3201          update_volume_control_algo(sbuf2,numread);
 3202          dec(total,numread);
 3203          inc(wrk_space,numread);
 3204          for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
 3205          inc(addr,numread);
 3206          if addr>=4 then
 3207             begin
 3208             readingtrigger:=false;
 3209             addr:=0;
 3210             update_control_algo(sbuf1,4);
 3211             if ((sbuf1[0]=69) and (sbuf1[1]=79) and (sbuf1[2]=65) and (sbuf1[3]=0)) then //EOA
 3212                begin
 3213                if authsize<>0 then readingauth:=true;
 3214                end_of_archive:=true;
 3215                end
 3216             else internal_error('Unrecognized trigger object');
 3217             end;
 3218          end;
 3219       while ((total>0) and (readingfn=true)) do //read object name;
 3220          begin
 3221          if total>fns-addr then i:=fns-addr else i:=total;
 3222          blockread (f_in,sbuf2,i,numread);
 3223          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3224          update_volume_control_algo(sbuf2,numread);
 3225          dec(total,numread);
 3226          inc(wrk_space,numread);
 3227          for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
 3228          inc(addr,numread);
 3229          if addr>=fns then
 3230             begin
 3231             readingfn:=false;
 3232             readingfage:=true;
 3233             addr:=0;
 3234             fn:='';
 3235             update_control_algo(sbuf1,fns);
 3236             update_obj_control_algo(sbuf1,fns);
 3237             for k:=0 to fns-1 do fn:=fn+char(sbuf1[k]);
 3238             SetLength(in_files,length(in_files)+1);
 3239             SetLength(status_objects,length(in_files)+1);
 3240             SetLength(fsizes,length(in_files)+1);
 3241             SetLength(ftimes,length(in_files)+1);
 3242             SetLength(fattr,length(in_files)+1);
 3243             SetLength(fattr_dec,length(in_files)+1);
 3244             SetLength(obj_tags,length(in_files)+1);
 3245             SetLength(exp_obj_tags,length(in_files)+1);
 3246             in_files[nobj]:=fn;
 3247             end;
 3248          end;
 3249       while ((total>0) and (readingfage=true)) do //read file date and time of last modification;
 3250          begin
 3251          if total>4-addr then i:=4-addr else i:=total;
 3252          blockread (f_in,sbuf2,i,numread);
 3253          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3254          update_volume_control_algo(sbuf2,numread);
 3255          dec(total,numread);
 3256          inc(wrk_space,numread);
 3257          for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
 3258          inc(addr,numread);
 3259          if addr>=4 then
 3260             begin
 3261             readingfage:=false;
 3262             readingfattrib:=true;
 3263             addr:=0;
 3264             update_control_algo(sbuf1,4);
 3265             update_obj_control_algo(sbuf1,4);
 3266             fage:=sbuf1[0] + (sbuf1[1] shl 8) + (sbuf1[2] shl 16) + (sbuf1[3] shl 24);
 3267             ftimes[nobj]:=fage;
 3268             end;
 3269          end;
 3270       while ((total>0) and (readingfattrib=true)) do //read file attributes;
 3271          begin
 3272          if total>4-addr then i:=4-addr else i:=total;
 3273          blockread (f_in,sbuf2,i,numread);
 3274          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3275          update_volume_control_algo(sbuf2,numread);
 3276          dec(total,numread);
 3277          inc(wrk_space,numread);
 3278          for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
 3279          inc(addr,numread);
 3280          if addr>=4 then
 3281             begin
 3282             readingfattrib:=false;
 3283             addr:=0;
 3284             n_input_files:=n_input_files+1;
 3285             update_control_algo(sbuf1,4);
 3286             update_obj_control_algo(sbuf1,4);
 3287             fattrib:=sbuf1[0] + (sbuf1[1] shl 8) + (sbuf1[2] shl 16) + (sbuf1[3] shl 24);
 3288             fattr[nobj]:=fattrib;
 3289             dword2decodedFileAttributes(fattrib,fattr_dec[nobj]);
 3290             if fassigned=false then
 3291                begin
 3292                //dodirseparators(fn);
 3293                dodirseparators(fn);
 3294                if upcase(struct_param)='EXTRACT2DIR' then
 3295                   begin
 3296                   ansiextract2dir;
 3297                   if (total>0) and (fattrib and faDirectory <> 0) then //object is a dir
 3298                      begin
 3299                      n_dirs:=n_dirs+1;
 3300                      readingobjauth:=true;
 3301                      end;
 3302                   end;
 3303                end;
 3304             end;
 3305          end;
 3306       while ((total>0) and (readingfs=true)) do //read file size;
 3307          begin
 3308          if total>8-addr then i:=8-addr else i:=total;
 3309          blockread (f_in,sbuf2,i,numread);
 3310          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3311          update_volume_control_algo(sbuf2,numread);
 3312          dec(total,numread);
 3313          inc(wrk_space,numread);
 3314          for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
 3315          inc(addr,numread);
 3316          if addr>=8 then
 3317             begin
 3318             readingfs:=false;
 3319             addr:=0;
 3320             update_control_algo(sbuf1,8);
 3321             update_obj_control_algo(sbuf1,8);
 3322             qw0:=sbuf1[0];
 3323             qw1:=sbuf1[1];
 3324             qw2:=sbuf1[2];
 3325             qw3:=sbuf1[3];
 3326             qw4:=sbuf1[4];
 3327             qw5:=sbuf1[5];
 3328             qw6:=sbuf1[6];
 3329             qw7:=sbuf1[7];
 3330             qw0:=qw0;
 3331             qw1:=qw1 *256;
 3332             qw2:=qw2 *256*256;
 3333             qw3:=qw3 *256*256*256;
 3334             qw4:=qw4 *256*256*256*256;
 3335             qw5:=qw5 *256*256*256*256*256;
 3336             qw6:=qw6 *256*256*256*256*256*256;
 3337             qw7:=qw7 *256*256*256*256*256*256*256;
 3338             fs:=qw0+qw1+qw2+qw3+qw4+qw5+qw6+qw7;
 3339             //fs:=sbuf1[0] + (sbuf1[1] shl 8) + (sbuf1[2] shl 16) + (sbuf1[3] shl 24) + (sbuf1[4] shl 32) + (sbuf1[5] shl 40) + (sbuf1[6] shl 48) + (sbuf1[7] shl 56);
 3340             out_size:=out_size+fs;
 3341             fsizes[nobj]:=fs;
 3342             if fs>0 then
 3343                if compr<>'PCOMPRESS0' then readingcompsize:=true
 3344                else readingf:=true
 3345             else //object is an empty file
 3346                begin
 3347                closefile(f_out);
 3348                fassigned:=false;
 3349                readingobjauth:=true;
 3350                end;
 3351             end;
 3352          end;
 3353       if compr<>'PCOMPRESS0' then //use compression
 3354          begin
 3355          while ((total>0) and (readingcompsize=true)) do
 3356             begin
 3357             if total>4-addr then i:=4-addr else i:=total;
 3358             blockread (f_in,sbuf2,i,numread);
 3359             if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3360             update_volume_control_algo(sbuf2,numread);
 3361             dec(total,numread);
 3362             inc(wrk_space,numread);
 3363             for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
 3364             inc(addr,numread);
 3365             if addr>=4 then
 3366                begin
 3367                readingcompsize:=false;
 3368                readingf:=true;
 3369                addr:=0;
 3370                update_control_algo(sbuf1,4);
 3371                update_obj_control_algo(sbuf1,4);
 3372                compsize:=sbuf1[0] + (sbuf1[1] shl 8) + (sbuf1[2] shl 16) + (sbuf1[3] shl 24);
 3373                end;
 3374             end;
 3375          while ((total>0) and (readingf=true)) do
 3376             begin
 3377             while ((total>0) and (addr<compsize+4)) do //read first compsize field for a compressed byte (buffer size was jet read)
 3378                begin
 3379                readingcompblock:=true;
 3380                if total>compsize+4-addr then i:=compsize+4-addr else i:=total;
 3381                blockread (f_in,wbuf2,i,numread);
 3382                if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3383                ci:=0;
 3384                while ci<numread do
 3385                   begin
 3386                   if numread-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=numread-ci;
 3387                   for k:=0 to cj-1 do sbuf1[k]:=wbuf2[ci+k];
 3388                   update_volume_control_algo(sbuf1,cj);
 3389                   inc(ci,cj);
 3390                   end;
 3391                dec(total,numread);
 3392                inc(wrk_space,numread);
 3393                for k:=0 to i-1 do wbuf1[addr+k]:=wbuf2[k];
 3394                inc(addr,numread);
 3395                if addr=compsize+4 then readingcompblock:=false;
 3396                end;
 3397             if readingcompblock=false then //read a compressed block sized compsize and next 4 byte (next block's compressed size, or uncompressed size for last block)
 3398                begin
 3399                addr:=0;
 3400                ci:=0;
 3401                while ci<compsize+4 do
 3402                   begin
 3403                   if compsize+4-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=compsize+4-ci;
 3404                   for k:=0 to cj-1 do sbuf1[k]:=wbuf1[ci+k];
 3405                   update_control_algo(sbuf1,cj);
 3406                   for k:=0 to cj-1 do wbuf1[ci+k]:=sbuf1[k];
 3407                   inc(ci,cj);
 3408                   end;
 3409                if fs>buf_size then k:=buf_size else k:=fs;
 3410                uncompsize:=k;
 3411                if compsize<k then zuncompr.uncompress(@wbuf2[0], uncompsize, wbuf1[0], compsize)
 3412                else wbuf2:=wbuf1;
 3413                ci:=0;
 3414                while ci<uncompsize do
 3415                   begin
 3416                   if uncompsize-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=uncompsize-ci;
 3417                   for k:=0 to cj-1 do sbuf1[k]:=wbuf2[ci+k];
 3418                   update_obj_control_algo(sbuf1,cj);
 3419                   inc(ci,cj);
 3420                   end;
 3421                blockwrite (f_out,wbuf2,uncompsize,numwritten);
 3422                if IOResult<>0 then internal_error('IO error writing data');
 3423                dec(fs,numwritten);
 3424                compsize:=wbuf1[compsize]+(wbuf1[compsize+1] shl 8)+(wbuf1[compsize+2] shl 16)+(wbuf1[compsize+3] shl 24);
 3425                if compsize>WBUFSIZE then internal_error('Decompression error, declared compsize bigger than compression buffer');
 3426                dword2bytebuf(compsize,sbuf1,0);
 3427                update_obj_control_algo(sbuf1,4);
 3428                Form_pea.ProgressBar1.Position:=(wrk_space) div cent_size;
 3429                Application.ProcessMessages;
 3430                end;
 3431             if fs=0 then //end of compressed file, control if uncompsize of last block matches to what expected
 3432                begin
 3433                if compsize<>uncompsize then internal_error('Decompression error, uncompressed size doesn''t match with expected size');
 3434                closefile(f_out);
 3435                fassigned:=false;
 3436                readingf:=false;
 3437                readingobjauth:=true;
 3438                end;
 3439             end;
 3440          end
 3441       else //no compression
 3442          while ((total>0) and (readingf=true)) do
 3443             begin
 3444             if total>SBUFSIZE then i:=SBUFSIZE else i:=total;
 3445             if fs>i then else i:=fs;
 3446             blockread (f_in,sbuf1,i,numread);
 3447             if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3448             update_volume_control_algo(sbuf1,numread);
 3449             dec(total,numread);
 3450             inc(wrk_space,numread);
 3451             dec(fs,numread);
 3452             update_control_algo(sbuf1,numread);
 3453             update_obj_control_algo(sbuf1,numread);
 3454             blockwrite (f_out,sbuf1,numread,numwritten);
 3455             if IOResult<>0 then internal_error('IO error writing data');
 3456             Form_pea.ProgressBar1.Position:=(wrk_space) div cent_size;
 3457             Application.ProcessMessages;
 3458             if fs=0 then
 3459                begin
 3460                closefile(f_out);
 3461                fassigned:=false;
 3462                readingf:=false;
 3463                readingobjauth:=true;
 3464                end;
 3465             end;
 3466       //read object check field
 3467       while ((total>0) and (readingobjauth=true)) do
 3468          begin
 3469          if obj_algo='NOALGO' then
 3470             begin
 3471             readingobjauth:=false;
 3472             readingfns:=true;
 3473             addr:=0;
 3474             if total>0 then goto 1;
 3475             end;
 3476          if total>obj_authsize-addr then i:=obj_authsize-addr else i:=total;
 3477          blockread (f_in,sbuf2,i,numread);
 3478          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3479          update_volume_control_algo(sbuf2,numread);
 3480          dec(total,numread);
 3481          inc(wrk_space,numread);
 3482          for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
 3483          inc(addr,numread);
 3484          if addr>=obj_authsize then
 3485             begin
 3486             update_control_algo(sbuf1,obj_authsize);
 3487             readingobjauth:=false;
 3488             readingfns:=true;
 3489             addr:=0;
 3490             finish_obj_control_algo;
 3491             check_obj;
 3492             if total>0 then goto 1;
 3493             end;
 3494          end;
 3495       //read auth block (if any);
 3496       while (total>0) and (readingauth=true) do
 3497          begin
 3498          if total>authsize-addr then i:=authsize-addr else i:=total;
 3499          blockread (f_in,sbuf2,i,numread);
 3500          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3501          update_volume_control_algo(sbuf2,numread);
 3502          dec(total,numread);
 3503          inc(wrk_space,numread);
 3504          for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
 3505          inc(addr,numread);
 3506          if addr=authsize then
 3507             begin
 3508             finish_control_algo;
 3509             authenticate_stream;
 3510             readingfns:=true;
 3511             addr:=0;
 3512             if total>0 then internal_error('Last volume seem to have wrong size');
 3513             end;
 3514          end;
 3515       //read volume check block (if any);
 3516       if (total=0) then
 3517          begin
 3518          SetLength(status_volumes,length(status_volumes)+1);
 3519          SetLength(volume_tags,length(status_volumes)+1);
 3520          SetLength(exp_volume_tags,length(status_volumes)+1);
 3521          blockread (f_in,tagbuf,volume_authsize,numread);
 3522          if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
 3523          finish_volume_control_algo;
 3524          check_volume;
 3525          dec(total,numread);
 3526          inc(wrk_space,numread);
 3527          init_volume_control_algo;
 3528          end;
 3529       close(f_in);
 3530       if IOResult<>0 then internal_error('IO error closing volume '+inttostr(j));
 3531       j:=j+1;
 3532       except
 3533          try
 3534             setcurrentdir(out_path);
 3535             do_report_unpea;
 3536             save_report('error log','txt',upcase(pw_param),out_path);
 3537          except
 3538          end;
 3539       internal_error('Unexpected error working on volume '+inttostr(j)+'; data is either become non accessible or could be corrupted in a way that not allow the current implementation to extract data from the archive (in that case you should try to obtain a new copy of the archive). Tried to extract available output to: '+out_path+out_file+DirectorySeparator+' and to save the error report in: '+out_path);
 3540       end;
 3541       end
 3542       else check_chunk(in_folder,j,chunks_ok);
 3543    until (chunks_ok=true) or (end_of_archive=true);
 3544    end;
 3545 Form_pea.LabelDecrypt2.Caption:='Input: '+in_name+'.*, '+inttostr(j-1)+' volume(s), '+inttostr(wrk_space)+' B';
 3546 Form_pea.LabelDecrypt3.Caption:='Output: '+out_path+out_file+DirectorySeparator;
 3547 Form_pea.LabelDecrypt6.Caption:='Done '+struct_param+' on archive';
 3548 Form_pea.ProgressBar1.Position:=100;
 3549 setcurrentdir(out_path);
 3550 do_report_unpea;
 3551 timing(ts_start,wrk_space);
 3552 Form_pea.LabelLog1.Visible:=true;
 3553 Form_pea.LabelOpen.Caption:='Explore';
 3554 output:=out_path+out_file;
 3555 Form_pea.LabelOpen.visible:=true;
 3556 Form_pea.ButtonDone1.Visible:=true;
 3557 Form_pea.ButtonPeaExit1.Visible:=false;
 3558 if (upcase(pw_param)='INTERACTIVE_REPORT') or (upcase(pw_param)='BATCH_REPORT') or (upcase(pw_param)='HIDDEN_REPORT') then save_report('Auto log UnPEA','txt',upcase(pw_param),out_path);
 3559 if report_errors =0 then
 3560    begin
 3561    exitcode:=0;
 3562    sleep(500);
 3563    if closepolicy>0 then Form_pea.Close;
 3564    end
 3565 else exitcode:=-2;
 3566 end;
 3567 
 3568 {
 3569 Raw File Split
 3570 Byte split a single input file in volumes of given size
 3571 In an optional separate .check file are saved error checking tags of each volume
 3572 The code is closely related to PEA, it's kept distinct for better readability
 3573 }
 3574 
 3575 procedure rfs;
 3576 var
 3577    out_param,volume_algo,in_qualified_name,pw_param:ansistring;
 3578    ch_size:qword;
 3579    volume_authsize:byte;
 3580 
 3581 procedure parse_rfs_cl;
 3582 begin
 3583 try
 3584    //output
 3585    out_param:=(paramstr(2));
 3586    //control chunk size
 3587    if (upcase(paramstr(3))='ASK') then
 3588       begin
 3589       ch_size:=vol_size;
 3590       volume_algo:=vol_algo;
 3591       end
 3592    else
 3593       begin
 3594       try
 3595          ch_size:=strtoqword(paramstr(3));
 3596          if ch_size=0 then ch_size:=1024*1024*1024*1024*1024; // if chunk size is set to 0 no chunks will be done
 3597       except
 3598          internal_error('"'+paramstr(3)+'" is not a valid chunk size; values allowed are 1..2^64, 0 to don''t split the input');
 3599       end;
 3600       //get volume control algorithm
 3601       volume_algo:=upcase(paramstr(4));
 3602       end;
 3603    if decode_volume_control_algo(volume_algo,volume_authsize)<>0 then
 3604       internal_error('"'+volume_algo+'" is not a valid control algorithm for volume check, please refer to the documentation for supported ones');
 3605    //get operation mode
 3606    pw_param:=upcase(paramstr(5));
 3607    if (pw_param<>'BATCH') and (pw_param<>'HIDDEN') and (pw_param<>'BATCH_REPORT') and (pw_param<>'HIDDEN_REPORT') then
 3608       internal_error('"'+pw_param+'" is not a valid operation mode parameter for RFS, please refer to the documentation');
 3609    //input
 3610    if (paramstr(6))<>'' then
 3611       begin
 3612       in_qualified_name:=(paramstr(6));
 3613       if not fileexists(in_qualified_name) then
 3614          internal_error('"'+in_qualified_name+'" file is not accessible');
 3615       end
 3616    else
 3617       begin
 3618       internal_error('No accessible input object found');
 3619       end;
 3620 except
 3621    internal_error('Received incorrect Command Line. See the documentation for the correct synopsis.');
 3622 end;
 3623 end;
 3624 
 3625 begin
 3626 parse_rfs_cl;
 3627 rfs_procedure(out_param,ch_size,volume_algo,volume_authsize,pw_param,in_qualified_name);
 3628 end;
 3629 
 3630 procedure rfs_lib_procedure ( out_param:ansistring;                             //qualified name for output volumes (without .(volume number) suffix) or AUTONAME
 3631                               ch_size:qword;                                    //size of volumes, 0 for single volume (current implementation up to 2^64 byte of size for volume)
 3632                               volume_algo,                                      //algorithm for volume integrity check
 3633                               in_qualified_name:ansistring;                     //qualified name of input file
 3634                               opmode:ansistring);                               //mode of operation: VISIBLE the form is visible, HIDDEN the form is not visible, MESSAGE the form is not visible, a message is sent as popup at the end of the operation
 3635 var
 3636    pw_param:ansistring;
 3637    volume_authsize:byte;
 3638 begin
 3639 //control chunk size
 3640 if ch_size=0 then ch_size:=1024*1024*1024*1024*1024; // if chunk size is set to 0 no chunks will be done
 3641 //get volume control algorithm
 3642 if decode_volume_control_algo(volume_algo,volume_authsize)<>0 then
 3643    internal_error('"'+volume_algo+'" is not a valid control algorithm for volume check, please refer to the documentation for supported ones');
 3644 //input
 3645 if in_qualified_name='' then
 3646    internal_error('No accessible input object found');
 3647 if not fileexists(in_qualified_name) then
 3648    internal_error('"'+in_qualified_name+'" file is not accessible');
 3649 //get operation mode
 3650 if (upcase(opmode)<>'BATCH') and (upcase(opmode)<>'HIDDEN') and (upcase(opmode)<>'BATCH_REPORT') and (upcase(opmode)<>'HIDDEN_REPORT') then
 3651    internal_error('"'+upcase(opmode)+'" is not a valid operation mode parameter for rfs_lib_procedure, please refer to the documentation');
 3652 pw_param:=upcase(opmode);
 3653 rfs_procedure(out_param,ch_size,volume_algo,volume_authsize,pw_param,in_qualified_name);
 3654 end;
 3655 
 3656 procedure rfs_procedure ( out_param:ansistring;
 3657                           ch_size:qword;
 3658                           volume_algo:ansistring;
 3659                           volume_authsize:byte;
 3660                           pw_param:ansistring;
 3661                           in_qualified_name:ansistring);
 3662 var
 3663    HashContext_volume: THashContext;
 3664    Whirl512Digest_volume: TWhirlDigest;
 3665    SHA512Digest_volume: TSHA512Digest;
 3666    SHA256Digest_volume: TSHA256Digest;
 3667    SHA3_512Digest_volume: TSHA3_512Digest;
 3668    SHA3_256Digest_volume: TSHA3_256Digest;
 3669    SHA1Digest_volume: TSHA1Digest;
 3670    RMD160Digest_volume: TRMD160Digest;
 3671    MD5Digest_volume: TMD5Digest;
 3672    Blake2sContext:blake2s_ctx;
 3673    Blake2sDigest:TBlake2sDigest;
 3674    Blake2bContext:THashContext;
 3675    Blake2bDigest:TBlake2bDigest;
 3676    crc64_volume:TCRC64;
 3677    ts_start:TTimeStamp;
 3678    f_in,f_out,f_check:file of byte;
 3679    sbuf1:array [0..65535] of byte;
 3680    auth_buf:array [0..63] of byte;
 3681    adler_volume,crc32_volume:longint;
 3682    j,ch_number_expected,numread,num_res:dword;
 3683    file_size,total,cent_size,prog_size,in_size,out_size,check_size,exp_size,ch_res:qword;
 3684    out_file,out_path,out_name:ansistring;
 3685 
 3686 procedure clean_variables;
 3687 begin
 3688 j:=0;
 3689 ch_number_expected:=0;
 3690 numread:=0;
 3691 num_res:=0;
 3692 file_size:=0;
 3693 total:=0;
 3694 cent_size:=0;
 3695 prog_size:=0;
 3696 in_size:=0;
 3697 out_size:=0;
 3698 check_size:=0;
 3699 exp_size:=0;
 3700 ch_res:=0;
 3701 end;
 3702 
 3703 procedure init_volume_control_algo;
 3704 begin
 3705 case upcase(volume_algo) of
 3706 'WHIRLPOOL' : Whirl_Init(HashContext_volume);
 3707 'SHA512' : SHA512Init(HashContext_volume);
 3708 'SHA256' : SHA256Init(HashContext_volume);
 3709 'SHA3_512' : SHA3_512Init(HashContext_volume);
 3710 'SHA3_256' : SHA3_256Init(HashContext_volume);
 3711 'SHA1' : SHA1Init(HashContext_volume);
 3712 'BLAKE2S' : Blake2s_Init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen);
 3713 'BLAKE2B' : Blake2b_Init(Blake2bContext,nil,0,BLAKE2B_MaxDigLen);
 3714 'RIPEMD160' : RMD160Init(HashContext_volume);
 3715 'MD5' : MD5Init(HashContext_volume);
 3716 'CRC64' : CRC64Init(crc64_volume);
 3717 'CRC32' : CRC32Init(crc32_volume);
 3718 'ADLER32' : Adler32Init(adler_volume);
 3719 end;
 3720 end;
 3721 
 3722 procedure update_volume_control_algo(buf:array of byte; size:word);
 3723 begin
 3724 case upcase(volume_algo) of
 3725 'WHIRLPOOL' : Whirl_Update(HashContext_volume, @buf, size);
 3726 'SHA512' : SHA512Update(HashContext_volume, @buf, size);
 3727 'SHA256' : SHA256Update(HashContext_volume, @buf, size);
 3728 'SHA3_512' : SHA3_512Update(HashContext_volume, @buf, size);
 3729 'SHA3_256' : SHA3_256Update(HashContext_volume, @buf, size);
 3730 'SHA1' : SHA1Update(HashContext_volume, @buf, size);
 3731 'BLAKE2S' : Blake2s_update(Blake2sContext,@buf,size);
 3732 'BLAKE2B' : Blake2b_update(Blake2bContext,@buf,size);
 3733 'RIPEMD160' : RMD160Update(HashContext_volume, @buf, size);
 3734 'MD5' : MD5Update(HashContext_volume, @buf, size);
 3735 'CRC64' : CRC64Update(crc64_volume, @buf, size);
 3736 'CRC32' : CRC32Update(crc32_volume, @buf, size);
 3737 'ADLER32' : Adler32Update(adler_volume, @buf, size);
 3738 end;
 3739 end;
 3740 
 3741 procedure finish_volume_control_algo;
 3742 begin
 3743 case upcase(volume_algo) of
 3744 'WHIRLPOOL' : Whirl_Final(HashContext_volume,WHIRL512Digest_volume);
 3745 'SHA512' : SHA512Final(HashContext_volume,SHA512Digest_volume);
 3746 'SHA256' : SHA256Final(HashContext_volume,SHA256Digest_volume);
 3747 'SHA3_512' : SHA3_512Final(HashContext_volume,SHA3_512Digest_volume);
 3748 'SHA3_256' : SHA3_256Final(HashContext_volume,SHA3_256Digest_volume);
 3749 'SHA1' : SHA1Final(HashContext_volume,SHA1Digest_volume);
 3750 'BLAKE2S' : blake2s_Final(Blake2sContext,Blake2sDigest);
 3751 'BLAKE2B' : blake2b_Final(Blake2bContext,Blake2bDigest);
 3752 'RIPEMD160' : RMD160Final(HashContext_volume,RMD160Digest_volume);
 3753 'MD5' : MD5Final(HashContext_volume,MD5Digest_volume);
 3754 'CRC64' : CRC64Final(crc64_volume);
 3755 'CRC32' : CRC32Final(crc32_volume);
 3756 'ADLER32' : Adler32Final(adler_volume);
 3757 end;
 3758 end;
 3759 
 3760 procedure write_volume_check;
 3761 var k:dword;
 3762 begin
 3763 if upcase(volume_algo)<>'NOALGO' then
 3764    begin
 3765    case upcase(volume_algo) of
 3766       'WHIRLPOOL' : for k:=0 to volume_authsize-1 do auth_buf[k]:=WHIRL512Digest_volume[k];
 3767       'SHA512' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA512Digest_volume[k];
 3768       'SHA256' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA256Digest_volume[k];
 3769       'SHA3_512' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA3_512Digest_volume[k];
 3770       'SHA3_256' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA3_256Digest_volume[k];
 3771       'SHA1' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA1Digest_volume[k];
 3772       'BLAKE2S' : for k:=0 to volume_authsize-1 do auth_buf[k]:=Blake2sDigest[k];
 3773       'BLAKE2B' : for k:=0 to volume_authsize-1 do auth_buf[k]:=Blake2bDigest[k];
 3774       'RIPEMD160' : for k:=0 to volume_authsize-1 do auth_buf[k]:=RMD160Digest_volume[k];
 3775       'MD5' : for k:=0 to volume_authsize-1 do auth_buf[k]:=MD5Digest_volume[k];
 3776       'CRC64' :
 3777       begin
 3778       dword2bytebuf(crc64_volume.lo32,auth_buf,0);
 3779       dword2bytebuf(crc64_volume.hi32,auth_buf,4);
 3780       end;
 3781       'CRC32' : dword2bytebuf(crc32_volume,auth_buf,0);
 3782       'ADLER32' : dword2bytebuf(adler_volume,auth_buf,0);
 3783       end;
 3784    for k:=0 to volume_authsize-1 do volume_tags[j-1,k]:=auth_buf[k];
 3785    blockwrite (f_check,auth_buf,volume_authsize);
 3786    check_size:=check_size+volume_authsize;
 3787    end;
 3788 end;
 3789 
 3790 procedure write2chunks ( var num_res: dword;                     //amount of data to write
 3791                          var sbuf1: array of byte;               //data buffer
 3792                          var f_out:fileofbyte;                   //output file
 3793                          var out_path,out_name: ansistring;      //name and path for the output;
 3794                          var i: dword;                           //chunk progressive number
 3795                          var ch_size:qword;                      //chunk size
 3796                          var ch_res: qword);                     //residual space in the given chunk
 3797 var k,numwritten:dword;
 3798     addr,buf:qword;
 3799     out_file:ansistring;
 3800 begin
 3801 addr:=0;
 3802 numwritten:=0;
 3803 while num_res>0 do
 3804    begin
 3805    if num_res<=ch_res then
 3806       begin
 3807       blockwrite (f_out,sbuf1,num_res,numwritten);
 3808       if IOResult<>0 then internal_error('IO error writing to volume '+inttostr(i));
 3809       update_volume_control_algo(sbuf1,numwritten);
 3810       num_res:=num_res-numwritten;
 3811       ch_res:=ch_res-numwritten;
 3812       addr:=0;
 3813       end
 3814    else
 3815       begin
 3816       SetLength(volume_tags,length(volume_tags)+1);
 3817       blockwrite (f_out,sbuf1,ch_res,numwritten);
 3818       if IOResult<>0 then internal_error('IO error writing to volume '+inttostr(i));
 3819       update_volume_control_algo(sbuf1,numwritten);
 3820       finish_volume_control_algo;
 3821       write_volume_check;
 3822       if IOResult<>0 then internal_error('IO error writing volume control tag to volume '+inttostr(i));
 3823       close(f_out);
 3824       if IOResult<>0 then internal_error('IO error closing volume '+inttostr(i));
 3825       i:=i+1;
 3826       update_rfs_filename(out_name,i,out_file);
 3827       checkspace(out_path,ch_size);
 3828       assignfile(f_out,out_path+out_file);
 3829       rewrite(f_out); //it will overwrite orphaned files with same name to preserve name coherence
 3830       if IOResult<>0 then internal_error('IO error opening volume '+inttostr(i));
 3831       init_volume_control_algo;
 3832       num_res:=num_res-numwritten;
 3833       if num_res<ch_size then buf:=num_res else buf:=ch_size;
 3834       addr:=addr+numwritten;
 3835       for k:=0 to buf do sbuf1[k]:=sbuf1[addr+k];
 3836       ch_res:=ch_size;
 3837       end;
 3838    end;
 3839 end;
 3840 
 3841 procedure nocompress_file;
 3842 begin
 3843 while ((numread<>0) and (total<file_size)) do
 3844    begin
 3845    blockread (f_in,sbuf1,SBUFSIZE,numread);
 3846    if IOResult<>0 then internal_error('IO error reading from '+in_qualified_name);
 3847    inc(total,numread);
 3848    inc(prog_size,numread);
 3849    num_res:=numread;
 3850    write2chunks ( num_res,
 3851                   sbuf1,
 3852                   f_out,
 3853                   out_path,out_name,
 3854                   j,
 3855                   ch_size,
 3856                   ch_res);
 3857    Form_pea.ProgressBar1.Position:=prog_size div cent_size;
 3858    Application.ProcessMessages;
 3859    end;
 3860 end;
 3861 
 3862 procedure first_gui_output;
 3863 begin
 3864 Form_pea.ProgressBar1.Position:=0;
 3865 Form_pea.LabelEncrypt2.Caption:='Input: '+in_qualified_name;
 3866 Form_pea.LabelEncrypt3.Caption:='Output: '+out_param;
 3867 Form_pea.LabelEncrypt4.Caption:='Integrity check algorithm: '+volume_algo;
 3868 Form_pea.LabelTime1.Caption:='Splitting file in volumes...';
 3869 Form_pea.Panel1.visible:=false;
 3870 Form_pea.LabelE1.Visible:=false;
 3871 end;
 3872 
 3873 procedure evaluate_volumes;
 3874 begin
 3875 ch_number_expected:=(in_size div ch_size)+1;
 3876 if (exp_size mod ch_size)=0 then ch_number_expected:=ch_number_expected-1;
 3877 if ch_number_expected>9999 then
 3878    if MessageDlg('Expected '+inttostr(ch_number_expected)+' volumes. It seems a lot! Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 3879    else halt(-3);
 3880 if ch_size<>1024*1024*1024*1024*1024 then Form_pea.LabelEncrypt5.Caption:='Expected '+inttostr(ch_number_expected)+' volume(s) of '+inttostr(ch_size+volume_authsize)+' B for a total output size of '+inttostr(exp_size)+' B'
 3881 else Form_pea.LabelEncrypt5.Caption:='Expected a single volume of '+inttostr(exp_size)+' B of size';
 3882 end;
 3883 
 3884 procedure evaluate_output;
 3885 begin
 3886 if upcase(out_param) = 'AUTONAME' then out_param:=in_qualified_name;
 3887 out_file:=extractfilename(out_param);
 3888 out_path:=extractfilepath(out_param);
 3889 if out_file='' then out_file:=extractfilename(in_qualified_name); //if no output name is explicitly given, the output name is assumed to be the name of the input file
 3890 if out_path='' then out_path:=extractfilepath(in_qualified_name); //if no output path is explicitly given, the output path is assumed to be the path of the input file
 3891 if out_path='' then out_path:=executable_path;
 3892 if setcurrentdir(out_path)<>true then out_path:=executable_path; //from this point output path is set as current path; if output path is missing or non accessible executable_path (path where the executable is in) is set as output path
 3893 if out_path[length(out_path)]<>DirectorySeparator then out_path:=out_path+DirectorySeparator;
 3894 Form_pea.LabelEncrypt3.Caption:='Output: '+out_path+out_file;
 3895 if exp_size>diskfree(0) then
 3896    if MessageDlg('Output path '+out_path+' seems to not have enough free space, you should continue only if it is a removable support and you have enough removable media. Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 3897    else halt(-3);
 3898 end;
 3899 
 3900 procedure do_report_rfs;
 3901 var
 3902    k,h:dword;
 3903    s:ansistring;
 3904 begin
 3905 Form_report.InputT.Caption:='Input';
 3906 Form_report.OutputT.Caption:='Output';
 3907 Form_report.Caption:='Split file log';
 3908 Form_report.StringGrid1.ColCount:=3;
 3909 Form_report.StringGrid1.Cells[0,0]:='Original object name';
 3910 Form_report.StringGrid1.Cells[1,0]:='Status';
 3911 Form_report.StringGrid1.Cells[2,0]:='Size (B)';
 3912 Form_report.StringGrid1.RowCount:=2;
 3913 Form_report.StringGrid1.Cells[0,1]:=in_qualified_name;
 3914 Form_report.StringGrid1.Cells[1,1]:='OK';
 3915 Form_report.StringGrid1.Cells[2,1]:=inttostr(file_size);
 3916 Form_report.StringGrid1.AutosizeColumns;
 3917 Form_report.StringGrid2.ColCount:=2;
 3918 Form_report.StringGrid2.Cells[0,0]:='Volume';
 3919 Form_report.StringGrid2.Cells[1,0]:=volume_algo;
 3920 Form_report.StringGrid2.RowCount:=j+1;
 3921 for k:=0 to j-1 do
 3922     begin
 3923     Form_report.StringGrid2.Cells[0,k+1]:=inttostr(k+1);
 3924     if upcase(volume_algo)<>'NOALGO' then
 3925        begin
 3926        s:='';
 3927        for h:=0 to volume_authsize-1 do s:=s+hexstr(@volume_tags[k,h],1);
 3928        Form_report.StringGrid2.Cells[1,k+1]:=s;
 3929        end;
 3930     end;
 3931 Form_report.StringGrid2.AutosizeColumns;
 3932 //operation parameters
 3933 Form_report.Label1.Caption:=Form_pea.LabelEncrypt4.Caption;
 3934 //input
 3935 Form_report.Label2.Caption:='Split '+in_qualified_name+'; input '+inttostr(file_size)+' B';
 3936 //output
 3937 Form_report.Label3.Caption:=Form_pea.LabelEncrypt6.Caption;
 3938 //output name
 3939 Form_report.Label4.Caption:=Form_pea.LabelEncrypt3.Caption;
 3940 end;
 3941 
 3942 procedure last_gui_output;
 3943 begin
 3944 Form_pea.ProgressBar1.Position:=100;
 3945 Form_pea.LabelEncrypt3.Caption:='Output: '+out_path+out_name+'.*';
 3946 out_size:=prog_size;
 3947 if ch_size<>1024*1024*1024*1024*1024 then Form_pea.LabelEncrypt6.Caption:=inttostr(j)+' volume(s) of '+inttostr(ch_size)+' B; total output '+inttostr(out_size)+' B'
 3948 else Form_pea.LabelEncrypt6.Caption:='Single volume archive of '+inttostr(out_size)+' B';
 3949 if upcase(volume_algo)<>'NOALGO' then Form_pea.LabelEncrypt6.Caption:=Form_pea.LabelEncrypt6.Caption+' + '+inttostr(check_size)+' B (check tags)';
 3950 do_report_rfs;
 3951 Form_pea.LabelEncrypt5.Caption:=Form_report.Label2.Caption;
 3952 Form_pea.LabelEncrypt4.Visible:=true;
 3953 Form_pea.LabelEncrypt5.Visible:=true;
 3954 Form_pea.LabelEncrypt6.Visible:=true;
 3955 end;
 3956 
 3957 begin
 3958 exitcode:=-1;
 3959 clean_variables;
 3960 if (upcase(pw_param)<>'HIDDEN') and (upcase(pw_param)<>'HIDDEN_REPORT') then Form_pea.Visible:=true else Form_pea.Visible:=false;
 3961 Form_pea.PanelDecrypt1.visible:=false;
 3962 Form_pea.PanelEncrypt1.visible:=true;
 3963 Form_pea.Caption:='Split file';
 3964 ts_start:=datetimetotimestamp(now);
 3965 //give preliminary information on work status to the GUI
 3966 first_gui_output;
 3967 assignfile(f_in,in_qualified_name);
 3968 filemode:=0;
 3969 reset(f_in);
 3970 if IOResult<>0 then internal_error('IO error opening '+in_qualified_name);
 3971 srcfilesize(in_qualified_name,file_size);
 3972 //file_size:=system.filesize(f_in);
 3973 if file_size=0 then internal_error('The file is empty, cannot be split');
 3974 if ch_size>file_size then ch_size:=file_size;
 3975 cent_size:=(file_size div 100)+1; //1% of expected output size, used for progress indication
 3976 //evaluate volumes number;
 3977 //at 9999 objects the program will warn and proceed only after user's permission,
 3978 //however the program has no sort of problem until 999999 chunks (but the host
 3979 //system may!)
 3980 evaluate_volumes;
 3981 //get output path and name;
 3982 //evaluate if the path has enough free space for expected output.
 3983 evaluate_output;
 3984 //check if output path has room for a chunk of given size (mandatory)
 3985 checkspace(out_path,ch_size);
 3986 //start the actual operation routine
 3987 out_name:=out_file;
 3988 assignfile(f_out,out_file+'.001');//current dir was jet set to out_path
 3989 rewrite(f_out);
 3990 if IOResult<>0 then internal_error('IO error creating first output volume');
 3991 if upcase(volume_algo)<>'NOALGO' then
 3992    begin
 3993    assignfile(f_check,out_file+'.check');
 3994    rewrite(f_check);
 3995    if IOResult<>0 then internal_error('IO error creating .check file');
 3996    rfs_create_checkfile_hdr(volume_algo,sbuf1);
 3997    blockwrite(f_check,sbuf1,4);
 3998    if IOResult<>0 then internal_error('IO error writing to .check file');
 3999    check_size:=4;
 4000    init_volume_control_algo;
 4001    end;
 4002 j:=1;
 4003 //1) split file in chunks
 4004 total:=0;
 4005 numread:=1;
 4006 ch_res:=ch_size;
 4007 nocompress_file; //no compression
 4008 //last volume check
 4009 SetLength(volume_tags,length(volume_tags)+1);
 4010 finish_volume_control_algo;
 4011 write_volume_check;
 4012 if IOResult<>0 then internal_error('IO error writing last volume check');
 4013 closefile(f_in);
 4014 if IOResult<>0 then internal_error('IO error closing '+in_qualified_name);
 4015 closefile(f_out);
 4016 if IOResult<>0 then internal_error('IO error closing last output volume');
 4017 if upcase(volume_algo)<>'NOALGO' then
 4018    begin
 4019    closefile(f_check);
 4020    if IOResult<>0 then internal_error('IO error closing .check file');
 4021    end;
 4022 //give final job information to the GUI
 4023 last_gui_output;
 4024 //calculate operation time
 4025 timing(ts_start,out_size);
 4026 //make accessible exit button and link to the detailed job log
 4027 Form_pea.LabelLog1.Visible:=true;
 4028 Form_pea.LabelOpen.Caption:='Explore';
 4029 output:=out_path;
 4030 Form_pea.LabelOpen.visible:=true;
 4031 Form_pea.ButtonDone1.Visible:=true;
 4032 Form_pea.ButtonPeaExit.Visible:=false;
 4033 if (upcase(pw_param)='INTERACTIVE_REPORT') or (upcase(pw_param)='BATCH_REPORT') or (upcase(pw_param)='HIDDEN_REPORT') then save_report('Auto log Raw File Split','txt',upcase(pw_param),out_path);
 4034 exitcode:=0;
 4035 Sleep(500);
 4036 if closepolicy>0 then Form_pea.Close;
 4037 end;
 4038 
 4039 {
 4040 Raw File Join
 4041 Byte join volumes with same name and progressive counter extension in a single
 4042 output file
 4043 Optionally error check each volume with information provided by a separate
 4044 .check file
 4045 The code is closely related to UnPEA, it's kept distinct for better readability
 4046 }
 4047 
 4048 procedure rfj;
 4049 var
 4050    in_qualified_name,out_param,pw_param:ansistring;
 4051 
 4052 procedure parse_rfj_cl;
 4053 begin
 4054 try
 4055    in_qualified_name:=(paramstr(2));
 4056    if not(fileexists(in_qualified_name)) then
 4057       internal_error('"'+in_qualified_name+'" not exist');
 4058    //get operation mode
 4059    pw_param:=upcase(paramstr(3));
 4060    if (pw_param<>'BATCH') and (pw_param<>'HIDDEN') and (pw_param<>'BATCH_REPORT') and (pw_param<>'HIDDEN_REPORT') then
 4061       internal_error('"'+pw_param+'" is not a valid operation mode parameter for RFJ, please refer to the documentation');
 4062    out_param:=(paramstr(4));
 4063 except
 4064    internal_error('Received incorrect Command Line. See the documentation for the correct synopsis.');
 4065 end;
 4066 end;
 4067 
 4068 begin
 4069 parse_rfj_cl;
 4070 rfj_procedure(in_qualified_name,pw_param,out_param);
 4071 end;
 4072 
 4073 procedure rfj_lib_procedure ( in_qualified_name,                                //qualified name of first volume of the split file
 4074                               out_param,                                        //qualified name to give to the output rejoined file (or AUTONAME)
 4075                               opmode:ansistring);                               //mode of operation: VISIBLE the form is visible, HIDDEN the form is not visible, MESSAGE the form is not visible, a message is sent as popup at the end of the operation
 4076 var
 4077    pw_param:ansistring;
 4078 begin
 4079 if not(fileexists(in_qualified_name)) then
 4080    internal_error('"'+in_qualified_name+'" not exist');
 4081 //get operation mode
 4082 if (upcase(opmode)<>'BATCH') and (upcase(opmode)<>'HIDDEN') and (upcase(opmode)<>'BATCH_REPORT') and (upcase(opmode)<>'HIDDEN_REPORT') then
 4083    internal_error('"'+upcase(opmode)+'" is not a valid operation mode parameter for rfj_lib_procedure, please refer to the documentation');
 4084 pw_param:=upcase(opmode);
 4085 rfj_procedure(in_qualified_name,pw_param,out_param);
 4086 end;
 4087 
 4088 procedure rfj_procedure ( in_qualified_name,
 4089                           pw_param,
 4090                           out_param:ansistring);
 4091 var
 4092    HashContext_volume: THashContext;
 4093    Whirl512Digest_volume: TWhirlDigest;
 4094    SHA512Digest_volume: TSHA512Digest;
 4095    SHA256Digest_volume: TSHA256Digest;
 4096    SHA3_512Digest_volume: TSHA3_512Digest;
 4097    SHA3_256Digest_volume: TSHA3_256Digest;
 4098    SHA1Digest_volume: TSHA1Digest;
 4099    RMD160Digest_volume: TRMD160Digest;
 4100    MD5Digest_volume: TMD5Digest;
 4101    Blake2sContext:blake2s_ctx;
 4102    Blake2sDigest:TBlake2sDigest;
 4103    Blake2bContext:THashContext;
 4104    Blake2bDigest:TBlake2bDigest;
 4105    crc64_volume: TCRC64;
 4106    ts_start:TTimeStamp;
 4107    f_in,f_out,f_check:file of byte;
 4108    sbuf1:array [0..65535] of byte;
 4109    tagbuf:array [0..63] of byte;
 4110    volume_authsize:byte;
 4111    adler_volume,crc32_volume:longint;
 4112    i,j,numread,numwritten,n_chunks:dword;
 4113    total,prog_size,wrk_space,exp_space:qword;
 4114    chunks_ok,no_more_files,filenamed:boolean;
 4115    in_file,in_name,in_folder,out_path,out_file,volume_algo:ansistring;
 4116 
 4117 procedure clean_variables;
 4118 begin
 4119 i:=0;
 4120 j:=0;
 4121 numread:=0;
 4122 numwritten:=0;
 4123 n_chunks:=0;
 4124 total:=0;
 4125 prog_size:=0;
 4126 wrk_space:=0;
 4127 exp_space:=0;
 4128 end;
 4129 
 4130 procedure evaluate_file_size(var exp_space:qword; var prog_size:qword); //succeed if all chunks are accessible
 4131 var qw:qword;
 4132 begin
 4133 j:=1;
 4134 no_more_files:=false;
 4135 exp_space:=0;
 4136 while no_more_files=false do
 4137    begin
 4138    update_rfs_filename(in_name,j,in_file);
 4139    if fileexists(in_folder+in_file) then
 4140       begin
 4141       assignfile(f_in,in_folder+in_file);
 4142       filemode:=0;
 4143       reset(f_in);
 4144       srcfilesize(in_folder+in_file,qw);
 4145       exp_space:=exp_space+qw;
 4146       //exp_space:=exp_space+system.filesize(f_in);
 4147       closefile(f_in);
 4148       j:=j+1;
 4149       end
 4150    else no_more_files:=true;
 4151    end;
 4152 n_chunks:=j-1;
 4153 prog_size:=(exp_space div 100)+1;
 4154 Form_pea.LabelDecrypt2.Caption:='Input: '+in_name+'.*, expected '+inttostr(n_chunks)+' volume(s), total '+inttostr(exp_space)+' B';
 4155 end;
 4156 
 4157 procedure evaluate_output;
 4158 var
 4159    k:integer;
 4160    name_ok:boolean;
 4161 begin
 4162 if upcase(out_param) = 'AUTONAME' then out_param:=in_folder+in_name;//the extension was already removed from in_file name
 4163 k:=0;
 4164 name_ok:=false;
 4165 repeat
 4166    if k=0 then
 4167       if fileexists(out_param) or directoryexists(out_param) then inc(k,1)
 4168       else name_ok:=true
 4169    else
 4170       if fileexists(out_param+' - '+inttostr(k)+extractfileext(out_param)) or directoryexists(out_param+' - '+inttostr(k)+extractfileext(out_param)) then inc(k,1)
 4171       else name_ok:=true;
 4172 until name_ok = true;
 4173 if k>0 then out_param:=out_param+' - '+inttostr(k)+extractfileext(out_param);
 4174 out_file:=extractfilename(out_param);
 4175 out_path:=extractfilepath(out_param);
 4176 if out_file='' then out_file:=extractfilename(in_qualified_name); //if no output name is explicitly given, the output name is assumed to be the name of the input file
 4177 if out_path='' then out_path:=extractfilepath(in_qualified_name); //if no output path is explicitly given, the output path is assumed to be the path of the input file
 4178 if out_path='' then out_path:=executable_path;
 4179 if setcurrentdir(out_path)<>true then out_path:=executable_path; //from this point output path is set as current path; if output path is missing or non accessible executable_path (path where the executable is in) is set as output path
 4180 if out_path[length(out_path)]<>DirectorySeparator then out_path:=out_path+DirectorySeparator;
 4181 Form_pea.LabelDecrypt3.Caption:='Input: '+out_path+out_file;
 4182 if exp_space>diskfree(0) then
 4183    if MessageDlg('Output path '+out_path+' seems to not have enough free space. Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
 4184    else halt(-3);
 4185 end;
 4186 
 4187 procedure init_volume_control_algo;
 4188 begin
 4189 case upcase(volume_algo) of
 4190 'WHIRLPOOL' : Whirl_Init(HashContext_volume);
 4191 'SHA512' : SHA512Init(HashContext_volume);
 4192 'SHA256' : SHA256Init(HashContext_volume);
 4193 'SHA3_512' : SHA3_512Init(HashContext_volume);
 4194 'SHA3_256' : SHA3_256Init(HashContext_volume);
 4195 'SHA1' : SHA1Init(HashContext_volume);
 4196 'BLAKE2S' : Blake2s_Init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen);
 4197 'BLAKE2B' : Blake2b_Init(Blake2bContext,nil,0,BLAKE2B_MaxDigLen);
 4198 'RIPEMD160' : RMD160Init(HashContext_volume);
 4199 'MD5' : MD5Init(HashContext_volume);
 4200 'CRC64' : CRC64Init(crc64_volume);
 4201 'CRC32' : CRC32Init(crc32_volume);
 4202 'ADLER32'