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 1.02 20210711 G.Tani Over 2x improved speed of hex preview, now enabled for files up to 64 MB in size
183 Updated files and free space secure delete functions, new ONE parameter to overwrite all bits with 1
184
185 (C) Copyright 2006 Giorgio Tani giorgio.tani.software@gmail.com
186
187 The program is released under GNU LGPL http://www.gnu.org/licenses/lgpl.txt
188
189 This library is free software; you can redistribute it and/or
190 modify it under the terms of the GNU Lesser General Public
191 License as published by the Free Software Foundation; either
192 version 3 of the License, or (at your option) any later version.
193
194 This library is distributed in the hope that it will be useful,
195 but WITHOUT ANY WARRANTY; without even the implied warranty of
196 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
197 Lesser General Public License for more details.
198
199 You should have received a copy of the GNU Lesser General Public
200 License along with this library; if not, write to the Free Software
201 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
202 }
203
204 {$mode objfpc}{$H+}
205 {$INLINE ON}{$UNITPATH ./we}
206
207 interface
208
209 uses
210 {$IFDEF MSWINDOWS}
211 Windows, activex, ShlObj,
212 {$ENDIF}
213 Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls, Process, UTF8Process, Spin,
214 Buttons, ComCtrls, StdCtrls, Menus, strutils, zuncompr, zcompres,
215 hash, adler32, CRC16, CRC24, CRC32, CRC64, ED2K, MD4, MD5, RMD160, SHA1, SHA224,
216 SHA256, SHA3_256, SHA384, SHA3_384, SHA512, SHA3_512, Whirl512, Blake2s, Blake2b,
217 aes_ctr, AES_Type, AES_EAX, fcrypta, FCAES256,
218 tf_eax, fcryptt, fctf256,
219 sp_eax, fcrypts, fcsp256,
220 mem_util, list_utils, img_utils, pea_utils, rfs_utils, ansiutf8_utils, unit_report, types;
221
222 type
223
224 { TForm_pea }
225
226 TForm_pea = class(TForm)
227 Bevel10: TBevel;
228 Bevel11: TBevel;
229 Bevel9: TBevel;
230 ButtonDone1: TBitBtn;
231 ButtonPeaExit1: TBitBtn;
232 ButtonPW1: TBitBtn;
233 ButtonPW2: TBitBtn;
234 ButtonPeaExit: TBitBtn;
235 ButtonRefSize: TButton;
236 ButtonUtilsCancel: TBitBtn;
237 ButtonToolsCancel: TBitBtn;
238 ButtonUtilsOK: TBitBtn;
239 ButtonRFSinteractive: TBitBtn;
240 ButtonRFSinteractive1: TBitBtn;
241 ButtonUtilsReset: TSpeedButton;
242 ComboBox1: TComboBox;
243 ComboBox2: TComboBox;
244 ComboBox3: TComboBox;
245 ComboBoxUnits: TComboBox;
246 ComboBoxUtils: TComboBox;
247 EditConfirm1: TEdit;
248 EditPW1: TEdit;
249 ImageUtils: TImage;
250 Image7: TImage;
251 Image3: TImage;
252 Image4: TImage;
253 Image5: TImage;
254 ImageList1: TImageList;
255 ImageSplit: TImage;
256 Label1: TLabel;
257 Label2: TLabel;
258 LabelConfirm1: TLabel;
259 LabelDecrypt2: TLabel;
260 LabelDecrypt3: TLabel;
261 LabelDecrypt4: TLabel;
262 LabelDecrypt5: TLabel;
263 LabelDecrypt6: TLabel;
264 LabelE1: TLabel;
265 LabelEncrypt2: TLabel;
266 LabelEncrypt3: TLabel;
267 LabelEncrypt4: TLabel;
268 LabelEncrypt5: TLabel;
269 LabelEncrypt6: TLabel;
270 LabelHint1: TLabel;
271 LabelKeyFile1: TLabel;
272 LabelLog1: TBitBtn;
273 LabelOpen: TBitBtn;
274 labelopenfile0: TLabel;
275 labelopenfile2: TLabel;
276 labelopenfile3: TLabel;
277 LabelOut1: TLabel;
278 LabelPS1: TLabel;
279 LabelPW1: TLabel;
280 LabelKeyFileName1: TLabel;
281 LabelTools5: TLabel;
282 LabelUtilsFun: TLabel;
283 LabelSample1: TLabel;
284 LabelSample2: TLabel;
285 LabelTime1: TLabel;
286 LabelTools3: TLabel;
287 LabelTools4: TLabel;
288 LabelTools2: TLabel;
289 LabelUtilsInput: TLabel;
290 ListMemo: TMemo;
291 MainMenu1: TMainMenu;
292 mainmenuhelp: TMenuItem;
293 MenuItem1: TMenuItem;
294 Panelsp1: TPanel;
295 Panelsp0: TPanel;
296 Panelsp2: TPanel;
297 pmupdates: TMenuItem;
298 pmdonations: TMenuItem;
299 pmhelp: TMenuItem;
300 pmrunasadmin: TMenuItem;
301 OpenDialog1: TOpenDialog;
302 OpenDialog2: TOpenDialog;
303 PanelDecrypt1: TPanel;
304 PanelEncrypt1: TPanel;
305 Panel1: TPanel;
306 PanelPW1: TPanel;
307 PanelUtils: TPanel;
308 PanelRFSinteractive: TPanel;
309 PanelTools: TPanel;
310 peautilsmenu: TPopupMenu;
311 ProgressBar1: TProgressBar;
312 Shape2: TShape;
313 ShapeE1: TShape;
314 ShapeE2: TShape;
315 peautilsbtn: TSpeedButton;
316 SpinEdit1: TSpinEdit;
317 Timer1: TTimer;
318 procedure ButtonDone1Click(Sender: TObject);
319 procedure ButtonPeaExitClick(Sender: TObject);
320 procedure ButtonPW1Click(Sender: TObject);
321 procedure ButtonPW2Click(Sender: TObject);
322 procedure ButtonRFSinteractive1Click(Sender: TObject);
323 procedure ButtonRFSinteractiveClick(Sender: TObject);
324 procedure ButtonToolsCancelClick(Sender: TObject);
325 procedure ButtonUtilsCancelClick(Sender: TObject);
326 procedure ButtonUtilsResetClick(Sender: TObject);
327 procedure ButtonUtilsOKClick(Sender: TObject);
328 procedure ComboBox1Change(Sender: TObject);
329 procedure ComboBoxUtilsChange(Sender: TObject);
330 procedure EditPW1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
331 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
332 procedure FormCreate(Sender: TObject);
333 procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
334 procedure FormShow(Sender: TObject);
335 procedure ImageUtilsClick(Sender: TObject);
336 procedure LabelE1Click(Sender: TObject);
337 procedure LabelKeyFile1Click(Sender: TObject);
338 procedure LabelLog1Click(Sender: TObject);
339 procedure LabelOpenClick(Sender: TObject);
340 procedure labelopenfile0Click(Sender: TObject);
341 procedure labelopenfile2Click(Sender: TObject);
342 procedure mainmenuhelpClick(Sender: TObject);
343 procedure pmupdatesClick(Sender: TObject);
344 procedure pmdonationsClick(Sender: TObject);
345 procedure PanelPW1MouseMove(Sender: TObject; Shift: TShiftState; X,
346 Y: Integer);
347 procedure peautilsbtnClick(Sender: TObject);
348 procedure pmhelpClick(Sender: TObject);
349 procedure pmrunasadminClick(Sender: TObject);
350 procedure Timer1Timer(Sender: TObject);
351 private
352 { private declarations }
353 public
354 { public declarations }
355 end;
356
357 Type fileofbyte = file of byte;
358
359 const
360 P_RELEASE = '1.02'; //declares release version for the whole build
361 PEAUTILS_RELEASE = '1.3'; //declares for reference last peautils release
362 PEA_FILEFORMAT_VER = 1;
363 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)
364 SBUFSIZE = 32768;
365 {32KB of size for reading small buffers, used for ciphers and hashes}
366 WBUFSIZE = 1048576;
367 {1MB of size for reading whide buffers, used for compression.
368 Decompression may read arbitrarily sized buffers up to array size used for
369 wide buffers -64KB (left for possible data expansion)}
370 {$IFDEF MSWINDOWS}
371 DEFAULT_THEME = 'ten-embedded';
372 EXEEXT = '.exe';
373 {$ELSE}
374 DEFAULT_THEME = 'ten-embedded';
375 EXEEXT = '';
376 {$ENDIF}
377 WS_EX_LAYERED = $80000;
378 LWA_ALPHA = $2;
379 FIRSTDOM = 'https://peazip.github.io/';
380 SECONDDOM = 'https://peazip.sourceforge.io/';
381
382 var
383 Form_pea: TForm_pea;
384 wbuf1,wbuf2:array[0..1114111] of byte; //>1MB wide buffers (1MB+ 64KB)
385 fun,pw,keyfile_name,output,vol_algo,graphicsfolder,caption_build,delimiter,confpath:ansistring;
386 vol_size:qword;
387 desk_env:byte;
388 interacting,control,details,height_set,toolactioncancelled:boolean;
389 ment,kent,fent,ment_sample: THashContext;
390 mentd: TWhirlDigest;
391 mentd_sample: TSHA256Digest;
392 fingerprint: TSHA512Digest;
393 in_param,in_files,exp_files,status_objects,status_volumes,exp_fattr_dec,fattr_dec:TFoundList;
394 status_files:TFoundListBool;
395 fsizes,exp_fsizes:TFoundListSizes;
396 ftimes,exp_ftimes:TFoundListAges;
397 fattr,exp_fattr:TFoundListAttrib;
398 obj_tags,exp_obj_tags,volume_tags,exp_volume_tags:TFoundListArray64;
399 Bfd,Bmail,Bhd,Bdvd,Binfo,Blog,Bok,Bcancel,Butils,Badmin:TBitmap;
400 fshown:boolean;
401 //theming
402 conf:text;
403 opacity,closepolicy,qscale,qscaleimages,pspacing,pzooming,gridaltcolor:integer;
404 executable_path,persistent_source,color1,color2,color3,color4,color5:string;
405
406 {
407 PEA features can be called using different modes of operation:
408 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)
409 BATCH the form is visible, user's input not requested: if passphrase/keyfile are needed are got from next two parameters of command line
410 HIDDEN the form is not visible, user input not requested (as for BATCH)
411 *_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
412 mode of operation is declared as opmode in *_lib_procedure, then passed to *_procedure as pw_param
413 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
414 }
415
416 //procedure to call pea within another application
417 procedure pea_lib_procedure ( out_param: ansistring; //archive qualified name (without .(volume number).PEA suffix) or AUTONAME
418 ch_size: qword; //size of volumes, 0 for single volume (current implementation up to 2^64 byte of size for volume)
419 compr: ansistring; //compression scheme to use
420 volume_algo:ansistring; //algorithm for volume integrity check
421 obj_algo: ansistring; //algorithm for object integrity check
422 algo:ansistring; //algorithm for stream integrity check
423 password,keyf_name:ansistring; //password and keyfile qualified name (if needed by stream algo)
424 in_param:TFoundList; //array of ansistring containing input qualified names
425 opmode:ansistring); //mode of operation
426
427 procedure pea_procedure ( out_param: ansistring;
428 ch_size: qword;
429 compr: ansistring;
430 compr_level: byte;
431 volume_algo:ansistring;
432 volume_authsize:byte;
433 obj_algo: ansistring;
434 obj_authsize: byte;
435 algo:ansistring;
436 headersize,authsize: byte;
437 pwneeded: boolean;
438 pw_param,password,keyf_name:ansistring;
439 in_param:TFoundList);
440
441 //procedure to call unpea within another application
442 procedure unpea_lib_procedure ( in_qualified_name, //archive qualified name
443 out_param, //dir were extracting the archive (or AUTONAME)
444 date_param, //actually only supported RESETDATE, reset date of extracted files
445 attr_param, //RESETATTR (or SETATTR only on Windows to set object's attributes as on original objects)
446 struct_param, //actually only supported EXTRACT2DIR, create a dir and extract archive in the dir using shortest paths for archived objects
447 password,keyf_name:ansistring; //password and keyfile qualified name (if needed)
448 opmode:ansistring); //mode of operation
449
450 procedure unpea_procedure ( in_qualified_name,
451 out_param,
452 date_param,
453 attr_param,
454 struct_param,
455 pw_param,
456 password,
457 keyf_name:ansistring);
458
459 //procedure to call raw file split within another application
460 procedure rfs_lib_procedure ( out_param:ansistring; //qualified name for output volumes (without .(volume number) suffix) or AUTONAME
461 ch_size:qword; //size of volumes, 0 for single volume (current implementation up to 2^64 byte of size for volume)
462 volume_algo, //algorithm for volume integrity check
463 in_qualified_name:ansistring; //qualified name of input file
464 opmode:ansistring); //mode of operation
465
466 procedure rfs_procedure ( out_param:ansistring;
467 ch_size:qword;
468 volume_algo:ansistring;
469 volume_authsize:byte;
470 pw_param:ansistring;
471 in_qualified_name:ansistring);
472
473 //procedure to call raw file join within another application
474 procedure rfj_lib_procedure ( in_qualified_name, //qualified name of first volume of the split file
475 out_param, //qualified name to give to the output rejoined file (or AUTONAME)
476 opmode:ansistring); //mode of operation
477
478 procedure rfj_procedure ( in_qualified_name,
479 pw_param,
480 out_param:ansistring);
481
482 implementation
483
484 {
485 misc procedures
486 }
487
488 //timing
489 procedure timing(tsin:TTimeStamp; size:qword);
490 var tsout:TTimeStamp;
491 time,speed:qword;
492 begin
493 tsout:=datetimetotimestamp(now);
494 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
495 if time<=0 then time:=100000;
496 speed:=(size * 1000) div time;
497 Form_pea.LabelTime1.Caption:='Processed '+nicenumber(inttostr(size))+' in '+nicetime(inttostr(time))+' @ '+nicenumber(inttostr(speed))+'/s';
498 Form_pea.ButtonDone1.Visible:=true;
499 end;
500
501 //if an error is encountered calling a PEA_utils procedure, show error description then halt, otherwise (error code is 0) continue
502 procedure test_pea_error ( s:ansistring;
503 err:integer);
504 var
505 decoded_err:ansistring;
506 begin
507 if err<>0 then
508 begin
509 decode_pea_error(err,decoded_err);
510 MessageDlg('Error '+s+': '+inttostr(err)+' '+decoded_err, mtError, [mbOK], 0);
511 halt(-3);
512 end;
513 end;
514
515 //when an internal error is encountered, show error description then halt
516 procedure internal_error (s:ansistring);
517 begin
518 MessageDlg(s, mtError, [mbOK], 0);
519 halt(-3);
520 end;
521
522 procedure clean_global_vars;
523 begin
524 SetLength(in_param,0);
525 SetLength(in_files,0);
526 SetLength(exp_files,0);
527 SetLength(status_objects,0);
528 SetLength(status_volumes,0);
529 SetLength(exp_fattr_dec,0);
530 SetLength(fattr_dec,0);
531 SetLength(status_files,0);
532 SetLength(fsizes,0);
533 SetLength(exp_fsizes,0);
534 SetLength(ftimes,0);
535 SetLength(exp_ftimes,0);
536 SetLength(fattr,0);
537 SetLength(exp_fattr,0);
538 SetLength(obj_tags,0);
539 SetLength(exp_obj_tags,0);
540 SetLength(volume_tags,0);
541 SetLength(exp_volume_tags,0);
542 output:='';
543 vol_size:=0;
544 vol_algo:='';
545 end;
546
547 procedure checkspace(outpath:ansistring; chsize:qword);
548 var size_ok:boolean;
549 begin
550 size_ok:=false;
551 repeat
552 if ((chsize>diskfree(0)) and (chsize<>1024*1024*1024*1024*1024)) then
553 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
554 else halt(-3)
555 else size_ok:=true;
556 until size_ok=true;
557 end;
558
559 procedure checkspacepea(outpath:ansistring; chsize,volume_authsize:qword);
560 var size_ok:boolean;
561 begin
562 size_ok:=false;
563 repeat
564 if ((chsize>diskfree(0)) and (chsize<>1024*1024*1024*1024*1024-volume_authsize)) then
565 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
566 else halt(-3)
567 else size_ok:=true;
568 until size_ok=true;
569 end;
570
571 procedure check_chunk ( in_folder:ansistring;
572 j:dword;
573 var chunks_ok:boolean);
574 begin
575 chunks_ok:=false;
576 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
577 else internal_error('Impossible to read requested volume(s). Not found volume '+inttostr(j));
578 end;
579
580 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
581 byte_to_read:dword; //size to be read from chunks
582 var buf: array of byte; //buffer with output data
583 var tmp_buf: array of byte; //buffer used to temporarily store the data to compose in the output buffer
584 volume_tag_size:byte; //size of volume tag, data to be skipped at the end of each volume;
585 maxsize:dword; //max size to read at once
586 singlevolume:boolean);
587 var
588 i,j,k,ind,numread:dword;
589 total:qword;
590 chunks_ok:boolean;
591 in_file:ansistring;
592 f_in:file of byte;
593 begin
594 j:=1;
595 ind:=0;
596 chunks_ok:=true;
597 in_file:=in_name;
598 while ((chunks_ok=true) and (ind<byte_to_read)) do
599 begin
600 if singlevolume=false then update_pea_filename(in_name,j,in_file);
601 repeat
602 if fileexists(in_folder+in_file) then
603 begin
604 chunks_ok:=true;
605 assignfile(f_in,in_folder+in_file);
606 filemode:=0;
607 reset(f_in);
608 if IOResult<>0 then internal_error('IO error opening '+in_folder+in_file);
609 srcfilesize(in_folder+in_file,total);
610 total:=total-volume_tag_size;
611 //total:=system.filesize(f_in)-volume_tag_size;
612 while ((total>0) and (ind<byte_to_read)) do
613 begin
614 if total>maxsize then i:=maxsize else i:=total;
615 blockread (f_in,tmp_buf,i,numread);
616 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
617 dec(total,numread);
618 for k:=0 to numread-1 do buf[ind+k]:=tmp_buf[k];
619 inc(ind,numread);
620 end;
621 close(f_in);
622 if IOResult<>0 then internal_error('IO error closing '+in_folder+in_file);
623 j:=j+1;
624 end
625 else check_chunk(in_folder,j,chunks_ok);
626 until chunks_ok=true;
627 end;
628 end;
629
630 procedure gen_rand(var arr: array of byte);
631 var
632 ment1,kent1,fent1: THashContext;
633 begin
634 ment1:=ment;
635 kent1:=kent;
636 fent1:=fent;
637 generate_keyf (arr,persistent_source,fingerprint,ment1,kent1,fent1);
638 end;
639
640 procedure shl_rand(var arr: array of byte);
641 var
642 randf: file of byte;
643 randarr: TKey2048;
644 i,j: integer;
645 begin
646 try
647 //read current rand seed file
648 assignfile(randf,persistent_source);
649 filemode:=0;
650 reset(randf);
651 blockread(randf,randarr,256,j);
652 closefile(randf);
653 //left shift by one byte the array of the rand seed
654 for i:=0 to 254 do arr[i]:=randarr[i+1];
655 arr[255]:=randarr[0];
656 except
657 end;
658 end;
659
660 {
661 PEA: Pack (archive, compress and split) Encrypt and Authenticate
662 The program accept n objects (files, dirs) as input, merge them into a single
663 archive and give m output chunks of desired size.
664 Number of objects to be archived is actually only memory limited, not format
665 limited (PEA format allow unlimited input objects); each object can be up to 2^64
666 byte in size.
667 PEA file format version 1 revision 0 can create a single stream, optionally
668 encrypted and authenticated, containing all objects to be archived, keyed by
669 passphrase and optionally keyfile (two factor authentication).
670 Metadata associated to archived objects are: qualified name, last modification
671 time, attributes; if more advanced archiving/restoring/backup features are
672 needed it's recommended using asynchronously tar or similar programs more focused
673 on that needs before sending the resulting file to PEA.
674
675 Notes:
676 - W.Ehrhardt's hash and crypto libraries are used for hashes, checksums, ciphers
677 and key scheduling (PBKDF2);
678 - Lazarus paszlib compression libraries were used to build a custom compression
679 scheme (PCOMPESS*);
680 }
681
682 procedure PEA;
683 var
684 out_param,compr,volume_algo,obj_algo,algo,pw_param,password,keyf_name,list_param,listfile_param:ansistring;
685 ch_size:qword;
686 compr_level,volume_authsize,obj_authsize,headersize,authsize:byte;
687 pwneeded:boolean;
688
689
690 procedure parse_pea_cl; //exit at first error with descriptive message, including parameters passed if relevant
691 var i,k:dword;
692 begin
693 i:=0;
694 try
695 out_param:=(paramstr(2));
696 //// control volume size
697 try
698 ch_size:=strtoqword(paramstr(3));
699 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
700 except
701 internal_error('"'+paramstr(3)+'" is not a valid chunk size; values allowed are 1..2^64, 0 to don''t split the input');
702 end;
703 //get compression algorithm
704 compr:=upcase(paramstr(4));
705 if decode_compression_algo(compr,compr_level)<>0 then
706 internal_error('"'+compr+'" is not a valid compression algorithm, please refer to the documentation for supported ones');
707 //get volume control algorithm
708 volume_algo:=upcase(paramstr(5));
709 if decode_volume_control_algo(volume_algo,volume_authsize)<>0 then
710 internal_error('"'+volume_algo+'" is not a valid control algorithm for volume check, please refer to the documentation for supported ones');
711 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)
712 ch_size:=ch_size-volume_authsize;
713 //get object control algorithm
714 obj_algo:=upcase(paramstr(6));
715 if decode_obj_control_algo(obj_algo,obj_authsize)<>0 then
716 internal_error('"'+obj_algo+'" is not a valid control algorithm for object check, please refer to the documentation for supported ones');
717 //get control algorithm
718 algo:=upcase(paramstr(7));
719 if decode_control_algo(algo,headersize,authsize,pwneeded)<>0 then
720 internal_error('"'+algo+'" is not a valid control algorithm, please refer to the documentation for supported ones');
721 //get operation mode
722 inc(i,1);
723 pw_param:=upcase(paramstr(7+i));
724 if pwneeded=true then
725 begin
726 if (pw_param<>'INTERACTIVE') and (pw_param<>'INTERACTIVE_REPORT') then
727 begin
728 inc(i,1);
729 password:=(paramstr(7+i));
730 inc(i,1);
731 keyf_name:=(paramstr(7+i));
732 end
733 else
734 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
735 internal_error('"'+pw_param+'" is not a valid operation mode parameter, please refer to the documentation');
736 end;
737 //get input list (it will be expanded in pea_procedure)
738 list_param:=upcase(paramstr(8+i));
739 if paramstr(8+i)<>'' then
740 if list_param='FROMCL' then //get input files by CL
741 begin
742 for k:=0 to paramcount-9-i do
743 begin
744 SetLength(in_param,k+1);
745 in_param[k]:=(paramstr(k+9+i));
746 end;
747 end
748 else
749 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)
750 begin
751 listfile_param:=(paramstr(9+i));
752 case read_filelist(listfile_param,in_param) of
753 13: internal_error('The list file '+listfile_param+' is empty');
754 14: internal_error('Cannot access the specified list file '+listfile_param);
755 end;
756 end
757 else internal_error('Input method '+list_param+' not allowed')
758 else internal_error('No accessible input object found');
759 except
760 internal_error('Received incorrect Command Line. See the documentation for the correct synopsis.');
761 end;
762 end;
763
764 begin
765 parse_pea_cl;
766 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);
767 end;
768
769 procedure pea_lib_procedure ( out_param: ansistring; //archive qualified name (without .(volume number).PEA suffix) or AUTONAME
770 ch_size: qword; //size of volumes, 0 for single volume (current implementation up to 2^64 byte of size for volume)
771 compr: ansistring; //compression scheme to use
772 volume_algo:ansistring; //algorithm for volume integrity check
773 obj_algo: ansistring; //algorithm for object integrity check
774 algo:ansistring; //algorithm for stream integrity check
775 password,keyf_name:ansistring; //password and keyfile qualified name (if needed by stream algo)
776 in_param:TFoundList; //array of ansistring containing input qualified names
777 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
778 var
779 pw_param:ansistring;
780 compr_level,volume_authsize,obj_authsize,headersize,authsize:byte;
781 pwneeded:boolean;
782 begin
783 //// control volume size
784 if ch_size=0 then ch_size:=1024*1024*1024*1024*1024; // if chunk size is set to 0 no chunks will be done
785 //get compression algorithm
786 if decode_compression_algo(compr,compr_level)<>0 then
787 internal_error('"'+compr+'" is not a valid compression algorithm, please refer to the documentation for supported ones');
788 //get volume control algorithm
789 if decode_volume_control_algo(volume_algo,volume_authsize)<>0 then
790 internal_error('"'+volume_algo+'" is not a valid control algorithm for volume check, please refer to the documentation for supported ones');
791 if ch_size<volume_authsize+1 then ch_size:=volume_authsize+1;
792 ch_size:=ch_size-volume_authsize;
793 //get object control algorithm
794 if decode_obj_control_algo(obj_algo,obj_authsize)<>0 then
795 internal_error('"'+obj_algo+'" is not a valid control algorithm for object check, please refer to the documentation for supported ones');
796 //get control algorithm
797 if decode_control_algo(algo,headersize,authsize,pwneeded)<>0 then
798 internal_error('"'+algo+'" is not a valid control algorithm, please refer to the documentation for supported ones');
799 //input list (will be expanded in pea_procedure) is jet loaded in in_param, TFoundList (array of ansistring)
800 //get operation mode
801 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
802 internal_error('"'+upcase(opmode)+'" is not a valid operation mode parameter, please refer to the documentation');
803 if (upcase(opmode)='INTERACTIVE') or (upcase(opmode)='INTERACTIVE_REPORT') then
804 internal_error('INTERACTIVE* modes are not allowed calling pea_lib_procedure, use BATCH* or HIDDEN* modes');
805 pw_param:=upcase(opmode);
806 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);
807 end;
808
809 procedure pea_procedure ( out_param: ansistring;
810 ch_size: qword;
811 compr: ansistring;
812 compr_level: byte;
813 volume_algo:ansistring;
814 volume_authsize:byte;
815 obj_algo: ansistring;
816 obj_authsize: byte;
817 algo:ansistring;
818 headersize,authsize: byte;
819 pwneeded: boolean;
820 pw_param,password,keyf_name:ansistring;
821 in_param:TFoundList);
822 var
823 hdr : TFCAHdr;
824 fhdr : TFCFHdr;
825 shdr : TFCSHdr;
826 hdr256 : TFCA256Hdr;
827 fhdr256 : TFCF256Hdr;
828 shdr256 : TFCS256Hdr;
829 cxe : TAES_EAXContext;
830 cxf : Ttf_EAXContext;
831 cxs : Tsp_EAXContext;
832 cxh : TFCA_HMAC_Context;
833 randarr: TKey2048;
834 auth,auth2,auth3 : array [0..15] of byte; //valid type conversion for TFCA_AuthBlock and TFCA256_AuthBlock
835 Blake2sContext,Blake2sContext_obj,Blake2sContext_volume:blake2s_ctx;
836 Blake2sDigest,Blake2sDigest_obj,Blake2sDigest_volume:TBlake2sDigest;
837 Blake2bDigest,Blake2bDigest_obj,Blake2bDigest_volume:TBlake2bDigest;
838 HashContext,HashContext_obj,HashContext_volume: THashContext;
839 Whirl512Digest,Whirl512Digest_obj,Whirl512Digest_volume: TWhirlDigest;
840 SHA512Digest,SHA512Digest_obj,SHA512Digest_volume: TSHA512Digest;
841 SHA256Digest,SHA256Digest_obj,SHA256Digest_volume: TSHA256Digest;
842 SHA3_512Digest,SHA3_512Digest_obj,SHA3_512Digest_volume: TSHA3_512Digest;
843 SHA3_256Digest,SHA3_256Digest_obj,SHA3_256Digest_volume: TSHA3_256Digest;
844 SHA1Digest,SHA1Digest_obj,SHA1Digest_volume: TSHA1Digest;
845 RMD160Digest,RMD160Digest_obj,RMD160Digest_volume: TRMD160Digest;
846 MD5Digest,MD5Digest_obj,MD5Digest_volume: TMD5Digest;
847 crc64,crc64_obj,crc64_volume:TCRC64;
848 ts_start:TTimeStamp;
849 r: TSearchRec;
850 f_in,f_out:file of byte;
851 sbuf1,sbuf2:array [0..65535] of byte;
852 auth_buf:array [0..63] of byte;
853 filename_size,pw_len:word;
854 err,adler,crc32,adler_obj,crc32_obj,adler_volume,crc32_volume:longint;
855 i,j,k,addr,n_skipped,n_input_files,n_dirs,obj_ok,ch_number_expected,numread,compsize,compsize_d,num_res:dword;
856 n_exp,file_size,total,cent_size,prog_size,prog_compsize,in_size,out_size,exp_size,ch_res:qword;
857 in_qualified_name,out_file,out_path,out_name,s:ansistring;
858 ansi_qualified_name:ansistring;
859 inskipped:boolean;
860 label 1;
861
862 procedure clean_variables;
863 begin
864 i:=0;
865 j:=0;
866 k:=0;
867 addr:=0;
868 n_skipped:=0;
869 n_input_files:=0;
870 n_dirs:=0;
871 obj_ok:=0;
872 ch_number_expected:=0;
873 numread:=0;
874 compsize:=0;
875 compsize_d:=0;
876 num_res:=0;
877 n_exp:=0;
878 file_size:=0;
879 total:=0;
880 cent_size:=0;
881 prog_size:=0;
882 prog_compsize:=0;
883 in_size:=0;
884 out_size:=0;
885 exp_size:=0;
886 ch_res:=0;
887 clean_global_vars;
888 end;
889
890 procedure expand_inputlist;
891 var i,k:dword;
892 fh_overhead:qword;
893 begin
894 addr:=0;
895 n_skipped:=0;
896 in_size:=0;
897 fh_overhead:=0;
898 for i:=0 to length(in_param)-1 do
899 begin
900 if filegetattr(in_param[i]) > 0 then
901 if filegetattr(in_param[i]) and faDirectory <>0 then //Object is a dir
902 begin
903 expand(in_param[i],exp_files,exp_fsizes,exp_ftimes,exp_fattr,exp_fattr_dec,n_exp);
904 SetLength(in_files,length(in_files)+n_exp);
905 SetLength(status_files,length(status_files)+n_exp);
906 SetLength(fsizes,length(fsizes)+n_exp);
907 SetLength(ftimes,length(ftimes)+n_exp);
908 SetLength(fattr,length(fattr)+n_exp);
909 SetLength(fattr_dec,length(fattr_dec)+n_exp);
910 if in_param[i][length(in_param[i])]<>DirectorySeparator then in_param[i]:=in_param[i]+DirectorySeparator;
911 for k:=0 to n_exp-1 do
912 begin
913 in_files[addr+k]:=exp_files[k];
914 status_files[addr+k]:=true;
915 fsizes[addr+k]:=exp_fsizes[k];
916 in_size:=in_size+exp_fsizes[k];
917 ftimes[addr+k]:=exp_ftimes[k];
918 fattr[addr+k]:=exp_fattr[k];
919 if (exp_fattr[k] and faDirectory)=0 then fh_overhead:=fh_overhead+length(exp_files[k])+18
920 else fh_overhead:=fh_overhead+length(exp_files[k])+10;
921 fattr_dec[addr+k]:=exp_fattr_dec[k];
922 end;
923 addr:=addr+n_exp;
924 end
925 else //Object is a file
926 begin
927 expand(in_param[i],exp_files,exp_fsizes,exp_ftimes,exp_fattr,exp_fattr_dec,n_exp);
928 SetLength(in_files,length(in_files)+1);
929 SetLength(status_files,length(status_files)+1);
930 SetLength(fsizes,length(fsizes)+1);
931 SetLength(ftimes,length(ftimes)+1);
932 SetLength(fattr,length(fattr)+1);
933 SetLength(fattr_dec,length(fattr_dec)+1);
934 in_files[addr]:=in_param[i];
935 status_files[addr]:=true;
936 fsizes[addr]:=exp_fsizes[0];
937 fh_overhead:=fh_overhead+length(exp_files[0])+18;
938 in_size:=in_size+exp_fsizes[0];
939 ftimes[addr]:=exp_ftimes[0];
940 fattr[addr]:=exp_fattr[0];
941 fattr_dec[addr]:=exp_fattr_dec[0];
942 addr:=addr+1;
943 end
944 else //Object not accessible
945 begin
946 SetLength(in_files,length(in_files)+1);
947 SetLength(status_files,length(status_files)+1);
948 SetLength(fsizes,length(fsizes)+1);
949 SetLength(ftimes,length(ftimes)+1);
950 SetLength(fattr,length(fattr)+1);
951 SetLength(fattr_dec,length(fattr_dec)+1);
952 in_files[addr]:=in_param[i];
953 status_files[addr]:=false;
954 inc(n_skipped,1);
955 addr:=addr+1;
956 end;
957 end;
958 n_input_files:=addr;
959 exp_size:=in_size+headersize+authsize+6+fh_overhead;
960 if n_skipped=n_input_files then internal_error('No valid input found');
961 end;
962
963 //clean keying-related variables
964 procedure clean_keying_vars;
965 var
966 k:integer;
967 begin
968 for k:=0 to SBUFSIZE do sbuf2[k]:=0;
969 pw:='';
970 password:='';
971 keyfile_name:='';
972 keyf_name:='';
973 pw_len:=0;
974 k:=0;
975 end;
976
977 procedure init_obj_control_algo;
978 begin
979 case upcase(obj_algo) of
980 'WHIRLPOOL' : Whirl_Init(HashContext_obj);
981 'SHA512' : SHA512Init(HashContext_obj);
982 'SHA256' : SHA256Init(HashContext_obj);
983 'SHA3_512' : SHA3_512Init(HashContext_obj);
984 'SHA3_256' : SHA3_256Init(HashContext_obj);
985 'SHA1' : SHA1Init(HashContext_obj);
986 'BLAKE2S' : Blake2s_Init(Blake2sContext_obj,nil,0,BLAKE2S_MaxDigLen);
987 'BLAKE2B' : Blake2b_Init(HashContext_obj,nil,0,BLAKE2B_MaxDigLen);
988 'RIPEMD160' : RMD160Init(HashContext_obj);
989 'MD5' : MD5Init(HashContext_obj);
990 'CRC64' : CRC64Init(crc64_obj);
991 'CRC32' : CRC32Init(crc32_obj);
992 'ADLER32' : Adler32Init(adler_obj);
993 end;
994 end;
995
996 procedure init_volume_control_algo;
997 begin
998 case upcase(volume_algo) of
999 'WHIRLPOOL' : Whirl_Init(HashContext_volume);
1000 'SHA512' : SHA512Init(HashContext_volume);
1001 'SHA256' : SHA256Init(HashContext_volume);
1002 'SHA3_512' : SHA3_512Init(HashContext_volume);
1003 'SHA3_256' : SHA3_256Init(HashContext_volume);
1004 'SHA1' : SHA1Init(HashContext_volume);
1005 'BLAKE2S' : Blake2s_Init(Blake2sContext_volume,nil,0,BLAKE2S_MaxDigLen);
1006 'BLAKE2B' : Blake2b_Init(HashContext_volume,nil,0,BLAKE2B_MaxDigLen);
1007 'RIPEMD160' : RMD160Init(HashContext_volume);
1008 'MD5' : MD5Init(HashContext_volume);
1009 'CRC64' : CRC64Init(crc64_volume);
1010 'CRC32' : CRC32Init(crc32_volume);
1011 'ADLER32' : Adler32Init(adler_volume);
1012 end;
1013 end;
1014
1015 procedure update_control_algo(var buf:array of byte; size:word);
1016 var k:integer;
1017 begin
1018 case upcase(algo) of
1019 'TRIATS':
1020 begin
1021 if FCA_EAX256_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1022 if FCF_EAX256_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1023 if FCS_EAX256_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1024 end;
1025 'TRITSA':
1026 begin
1027 if FCF_EAX256_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1028 if FCS_EAX256_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1029 if FCA_EAX256_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1030 end;
1031 'TRISAT':
1032 begin
1033 if FCS_EAX256_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1034 if FCA_EAX256_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1035 if FCF_EAX256_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1036 end;
1037 'EAX256' : if FCA_EAX256_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1038 'TF256' : if FCF_EAX256_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1039 'SP256' : if FCS_EAX256_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1040 'EAX' : if FCA_EAX_encrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1041 'TF' : if FCf_EAX_encrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1042 'SP' : if FCs_EAX_encrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1043 'HMAC' : if FCA_HMAC_encrypt(cxh, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
1044 'WHIRLPOOL' : Whirl_Update(HashContext, @buf, size);
1045 'SHA512' : SHA512Update(HashContext, @buf, size);
1046 'SHA256' : SHA256Update(HashContext, @buf, size);
1047 'SHA3_512' : SHA3_512Update(HashContext, @buf, size);
1048 'SHA3_256' : SHA3_256Update(HashContext, @buf, size);
1049 'SHA1' : SHA1Update(HashContext, @buf, size);
1050 'BLAKE2S' : Blake2s_update(Blake2sContext,@buf,size);
1051 'BLAKE2B' : Blake2b_update(HashContext,@buf,size);
1052 'RIPEMD160' : RMD160Update(HashContext, @buf, size);
1053 'MD5' : MD5Update(HashContext, @buf, size);
1054 'CRC64' : CRC64Update(crc64, @buf, size);
1055 'CRC32' : CRC32Update(crc32, @buf, size);
1056 'ADLER32' : Adler32Update(adler, @buf, size);
1057 end;
1058 end;
1059
1060 procedure update_obj_control_algo(buf:array of byte; size:word);
1061 begin
1062 case upcase(obj_algo) of
1063 'WHIRLPOOL' : Whirl_Update(HashContext_obj, @buf, size);
1064 'SHA512' : SHA512Update(HashContext_obj, @buf, size);
1065 'SHA256' : SHA256Update(HashContext_obj, @buf, size);
1066 'SHA3_512' : SHA3_512Update(HashContext_obj, @buf, size);
1067 'SHA3_256' : SHA3_256Update(HashContext_obj, @buf, size);
1068 'SHA1' : SHA1Update(HashContext_obj, @buf, size);
1069 'BLAKE2S' : Blake2s_update(Blake2sContext_obj,@buf,size);
1070 'BLAKE2B' : Blake2b_update(HashContext_obj,@buf,size);
1071 'RIPEMD160' : RMD160Update(HashContext_obj, @buf, size);
1072 'MD5' : MD5Update(HashContext_obj, @buf, size);
1073 'CRC64' : CRC64Update(crc64_obj, @buf, size);
1074 'CRC32' : CRC32Update(crc32_obj, @buf, size);
1075 'ADLER32' : Adler32Update(adler_obj, @buf, size);
1076 end;
1077 end;
1078
1079 procedure update_volume_control_algo(buf:array of byte; size:word);
1080 begin
1081 case upcase(volume_algo) of
1082 'WHIRLPOOL' : Whirl_Update(HashContext_volume, @buf, size);
1083 'SHA512' : SHA512Update(HashContext_volume, @buf, size);
1084 'SHA256' : SHA256Update(HashContext_volume, @buf, size);
1085 'SHA3_512' : SHA3_512Update(HashContext_volume, @buf, size);
1086 'SHA3_256' : SHA3_256Update(HashContext_volume, @buf, size);
1087 'SHA1' : SHA1Update(HashContext_volume, @buf, size);
1088 'BLAKE2S' : Blake2s_update(Blake2sContext_volume,@buf,size);
1089 'BLAKE2B' : Blake2b_update(HashContext_volume,@buf,size);
1090 'RIPEMD160' : RMD160Update(HashContext_volume, @buf, size);
1091 'MD5' : MD5Update(HashContext_volume, @buf, size);
1092 'CRC64' : CRC64Update(crc64_volume, @buf, size);
1093 'CRC32' : CRC32Update(crc32_volume, @buf, size);
1094 'ADLER32' : Adler32Update(adler_volume, @buf, size);
1095 end;
1096 end;
1097
1098 procedure finish_control_algo;
1099 begin
1100 case upcase(algo) of
1101 'TRIATS':
1102 begin
1103 FCA_EAX256_final(cxe, auth);
1104 FCF_EAX256_final(cxf, auth2);
1105 FCS_EAX256_final(cxs, auth3);
1106 end;
1107 'TRITSA':
1108 begin
1109 FCF_EAX256_final(cxf, auth);
1110 FCS_EAX256_final(cxs, auth2);
1111 FCA_EAX256_final(cxe, auth3);
1112 end;
1113 'TRISAT':
1114 begin
1115 FCS_EAX256_final(cxs, auth);
1116 FCA_EAX256_final(cxe, auth2);
1117 FCF_EAX256_final(cxf, auth3);
1118 end;
1119 'EAX256' : FCA_EAX256_final(cxe, auth);
1120 'TF256' : FCF_EAX256_final(cxf, auth);
1121 'SP256' : FCS_EAX256_final(cxs, auth);
1122 'EAX' : FCA_EAX_final(cxe, auth);
1123 'TF' : FCf_EAX_final(cxf, auth);
1124 'SP' : FCs_EAX_final(cxs, auth);
1125 'HMAC' : FCA_HMAC_final(cxh, auth);
1126 'WHIRLPOOL' : Whirl_Final(HashContext,WHIRL512Digest);
1127 'SHA512' : SHA512Final(HashContext,SHA512Digest);
1128 'SHA256' : SHA256Final(HashContext,SHA256Digest);
1129 'SHA3_512' : SHA3_512Final(HashContext,SHA3_512Digest);
1130 'SHA3_256' : SHA3_256Final(HashContext,SHA3_256Digest);
1131 'SHA1' : SHA1Final(HashContext,SHA1Digest);
1132 'BLAKE2S' : blake2s_Final(Blake2sContext,Blake2sDigest);
1133 'BLAKE2B' : blake2b_Final(HashContext,Blake2bDigest);
1134 'RIPEMD160' : RMD160Final(HashContext,RMD160Digest);
1135 'MD5' : MD5Final(HashContext,MD5Digest);
1136 'CRC64' : CRC64Final(crc64);
1137 'CRC32' : CRC32Final(crc32);
1138 'ADLER32' : Adler32Final(adler);
1139 end;
1140 end;
1141
1142 procedure finish_obj_control_algo;
1143 begin
1144 case upcase(obj_algo) of
1145 'WHIRLPOOL' : Whirl_Final(HashContext_obj,WHIRL512Digest_obj);
1146 'SHA512' : SHA512Final(HashContext_obj,SHA512Digest_obj);
1147 'SHA256' : SHA256Final(HashContext_obj,SHA256Digest_obj);
1148 'SHA3_512' : SHA3_512Final(HashContext_obj,SHA3_512Digest_obj);
1149 'SHA3_256' : SHA3_256Final(HashContext_obj,SHA3_256Digest_obj);
1150 'SHA1' : SHA1Final(HashContext_obj,SHA1Digest_obj);
1151 'BLAKE2S' : blake2s_Final(Blake2sContext_obj,Blake2sDigest_obj);
1152 'BLAKE2B' : blake2b_Final(HashContext_obj,Blake2bDigest_obj);
1153 'RIPEMD160' : RMD160Final(HashContext_obj,RMD160Digest_obj);
1154 'MD5' : MD5Final(HashContext_obj,MD5Digest_obj);
1155 'CRC64' : CRC64Final(crc64_obj);
1156 'CRC32' : CRC32Final(crc32_obj);
1157 'ADLER32' : Adler32Final(adler_obj);
1158 end;
1159 end;
1160
1161 procedure finish_volume_control_algo;
1162 begin
1163 case upcase(volume_algo) of
1164 'WHIRLPOOL' : Whirl_Final(HashContext_volume,WHIRL512Digest_volume);
1165 'SHA512' : SHA512Final(HashContext_volume,SHA512Digest_volume);
1166 'SHA256' : SHA256Final(HashContext_volume,SHA256Digest_volume);
1167 'SHA3_512' : SHA3_512Final(HashContext_volume,SHA3_512Digest_volume);
1168 'SHA3_256' : SHA3_256Final(HashContext_volume,SHA3_256Digest_volume);
1169 'SHA1' : SHA1Final(HashContext_volume,SHA1Digest_volume);
1170 'BLAKE2S' : blake2s_Final(Blake2sContext_volume,Blake2sDigest_volume);
1171 'BLAKE2B' : blake2b_Final(HashContext_volume,Blake2bDigest_volume);
1172 'RIPEMD160' : RMD160Final(HashContext_volume,RMD160Digest_volume);
1173 'MD5' : MD5Final(HashContext_volume,MD5Digest_volume);
1174 'CRC64' : CRC64Final(crc64_volume);
1175 'CRC32' : CRC32Final(crc32_volume);
1176 'ADLER32' : Adler32Final(adler_volume);
1177 end;
1178 end;
1179
1180 procedure write_volume_check;
1181 var k:dword;
1182 begin
1183 if upcase(volume_algo)<>'NOALGO' then
1184 begin
1185 case upcase(volume_algo) of
1186 'WHIRLPOOL' : for k:=0 to volume_authsize-1 do auth_buf[k]:=WHIRL512Digest_volume[k];
1187 'SHA512' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA512Digest_volume[k];
1188 'SHA256' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA256Digest_volume[k];
1189 'SHA3_512' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA3_512Digest_volume[k];
1190 'SHA3_256' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA3_256Digest_volume[k];
1191 'SHA1' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA1Digest_volume[k];
1192 'BLAKE2S' : for k:=0 to volume_authsize-1 do auth_buf[k]:=Blake2sDigest_volume[k];
1193 'BLAKE2B' : for k:=0 to volume_authsize-1 do auth_buf[k]:=Blake2bDigest_volume[k];
1194 'RIPEMD160' : for k:=0 to volume_authsize-1 do auth_buf[k]:=RMD160Digest_volume[k];
1195 'MD5' : for k:=0 to volume_authsize-1 do auth_buf[k]:=MD5Digest_volume[k];
1196 'CRC64' :
1197 begin
1198 dword2bytebuf(crc64_volume.lo32,auth_buf,0);
1199 dword2bytebuf(crc64_volume.hi32,auth_buf,4);
1200 end;
1201 'CRC32' : dword2bytebuf(crc32_volume,auth_buf,0);
1202 'ADLER32' : dword2bytebuf(adler_volume,auth_buf,0);
1203 end;
1204 for k:=0 to volume_authsize-1 do volume_tags[j-1,k]:=auth_buf[k];
1205 blockwrite (f_out,auth_buf,volume_authsize);
1206 prog_compsize:=prog_compsize+volume_authsize;
1207 prog_size:=prog_size+volume_authsize;
1208 end;
1209 end;
1210
1211 procedure write2chunks ( var num_res: dword; //amount of data to write
1212 var buf_data: array of byte; //data buffer
1213 var f_out: fileofbyte; //output file
1214 var out_path,out_name: ansistring; //name and path for the output;
1215 var i: dword; //chunk progressive number
1216 var ch_size:qword; //chunk size
1217 var ch_res: qword); //residual space in the given chunk
1218 var ci,cj,k,numwritten:dword;
1219 addr,buf:qword;
1220 out_file:ansistring;
1221 begin
1222 addr:=0;
1223 numwritten:=0;
1224 while num_res>0 do
1225 begin
1226 if num_res<=ch_res then
1227 begin
1228 blockwrite (f_out,buf_data,num_res,numwritten);
1229 if IOResult<>0 then internal_error('IO error writing to volume '+inttostr(i));
1230 ci:=0;
1231 while ci<numwritten do
1232 begin
1233 if numwritten-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=numwritten-ci;
1234 for k:=0 to cj-1 do sbuf1[k]:=buf_data[ci+k];
1235 update_volume_control_algo(sbuf1,cj);
1236 inc(ci,cj);
1237 end;
1238 num_res:=num_res-numwritten;
1239 ch_res:=ch_res-numwritten;
1240 addr:=0;
1241 end
1242 else
1243 begin
1244 SetLength(volume_tags,length(volume_tags)+1);
1245 blockwrite (f_out,buf_data,ch_res,numwritten);
1246 if IOResult<>0 then internal_error('IO error writing to volume '+inttostr(i));
1247 ci:=0;
1248 while ci<numwritten do
1249 begin
1250 if numwritten-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=numwritten-ci;
1251 for k:=0 to cj-1 do sbuf1[k]:=buf_data[ci+k];
1252 update_volume_control_algo(sbuf1,cj);
1253 inc(ci,cj);
1254 end;
1255 finish_volume_control_algo;
1256 write_volume_check;
1257 if IOResult<>0 then internal_error('IO error writing volume control tag to volume '+inttostr(i));
1258 close(f_out);
1259 if IOResult<>0 then internal_error('IO error closing volume '+inttostr(i));
1260 i:=i+1;
1261 update_pea_filename(out_name,i,out_file);
1262 checkspacepea(out_path,ch_size,volume_authsize);
1263 assignfile(f_out,out_path+out_file);
1264 rewrite(f_out); //it will overwrite orphaned files with same name to preserve name coherence
1265 if IOResult<>0 then internal_error('IO error opening volume '+inttostr(i));
1266 init_volume_control_algo;
1267 num_res:=num_res-numwritten;
1268 if num_res<ch_size then buf:=num_res else buf:=ch_size;
1269 addr:=addr+numwritten;
1270 for k:=0 to buf do buf_data[k]:=buf_data[addr+k];
1271 ch_res:=ch_size;
1272 end;
1273 end;
1274 end;
1275
1276 procedure init_control_algo;
1277 var
1278 i:integer;
1279 sbufx,tsbuf2:array [0..65535] of byte;
1280 tpw_len,verw:Word;
1281 begin
1282 case upcase(algo) of
1283 'TRIATS','TRITSA','TRISAT':
1284 begin
1285 for i:=0 to pw_len-1 do tsbuf2[i]:=sbuf2[i]; tpw_len:=pw_len;
1286 case upcase(algo) of
1287 '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));
1288 '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));
1289 '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));
1290 end;
1291 prog_size:=prog_size+num_res;
1292 prog_compsize:=prog_compsize+num_res;
1293 write2chunks ( num_res,
1294 sbuf1,
1295 f_out,
1296 out_path,out_name,
1297 j,
1298 ch_size,
1299 ch_res);
1300 for i:=0 to tpw_len-1 do sbuf2[i]:=tsbuf2[i]; pw_len:=tpw_len;
1301 for i:=0 to tpw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len+i) xor ord(upcase(algo[length(algo)-1]));
1302 case upcase(algo) of
1303 '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));
1304 '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));
1305 '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));
1306 end;
1307 prog_size:=prog_size+num_res;
1308 prog_compsize:=prog_compsize+num_res;
1309 write2chunks ( num_res,
1310 sbuf1,
1311 f_out,
1312 out_path,out_name,
1313 j,
1314 ch_size,
1315 ch_res);
1316 for i:=0 to tpw_len-1 do sbuf2[i]:=tsbuf2[i]; pw_len:=tpw_len;
1317 for i:=0 to tpw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len xor i) xor ord(upcase(algo[length(algo)]));
1318 case upcase(algo) of
1319 '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));
1320 '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));
1321 '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));
1322 end;
1323 for i:=0 to tpw_len-1 do tsbuf2[i]:=0; tpw_len:=0;
1324 verw:=hdr256.PW_Ver xor fhdr256.PW_Ver xor shdr256.PW_Ver;
1325 word2bytebuf(verw,sbuf1,14);
1326 verw:=0;
1327 end;
1328 '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));
1329 '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));
1330 '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));
1331 '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));
1332 '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));
1333 '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));
1334 '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));
1335 'WHIRLPOOL' : Whirl_Init(HashContext);
1336 'SHA512' : SHA512Init(HashContext);
1337 'SHA256' : SHA256Init(HashContext);
1338 'SHA3_512' : SHA3_512Init(HashContext);
1339 'SHA3_256' : SHA3_256Init(HashContext);
1340 'SHA1' : SHA1Init(HashContext);
1341 'BLAKE2S' : Blake2s_Init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen);
1342 'BLAKE2B' : Blake2b_Init(HashContext,nil,0,BLAKE2B_MaxDigLen);
1343 'RIPEMD160' : RMD160Init(HashContext);
1344 'MD5' : MD5Init(HashContext);
1345 'CRC64' : CRC64Init(crc64);
1346 'CRC32' : CRC32Init(crc32);
1347 'ADLER32' : Adler32Init(adler);
1348 end;
1349 end;
1350
1351 procedure compress_file;
1352 {
1353 PCOMPRESS1..3 is a deflate-based scheme of compression that allows decompression
1354 of single blocks without need of decompressing preceding blocks:
1355 that slightly degrade compression compared to classical schemes but allow fast
1356 access to arbitrary sectors knowing position in input data (feature not used in
1357 this application)
1358 }
1359 var ci,cj,k:dword;
1360 begin
1361 //file data area
1362 while ((numread<>0) and (total<file_size)) do
1363 begin
1364 blockread (f_in,wbuf1,WBUFSIZE,numread);
1365 inc(total,numread);
1366 inc(prog_size,numread);
1367 compsize:=numread+65536;
1368 {leave some room for expansion in compsize (64kb), however expanded blocks
1369 will be substituted by original blocks and compressed size will be set equal
1370 to input size, triggering decompression routine to not decompress but rather
1371 use the block as is (speeding up a bit operations on files that doesn't
1372 compress well or at all in case of user's misuse)}
1373 err:=zcompres.compress2(@wbuf2[0], compsize, wbuf1[0], numread, compr_level);
1374 if (err<>0) or (compsize>=numread) then
1375 begin
1376 wbuf2:=wbuf1;
1377 compsize:=numread;
1378 end;
1379 compsize_d:=compsize;
1380 //check of uncompressed size and data in the order it will be written
1381 dword2bytebuf(compsize,sbuf1,0);
1382 update_obj_control_algo(sbuf1,4);
1383 ci:=0;
1384 while ci<numread do
1385 begin
1386 if numread-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=numread-ci;
1387 for k:=0 to cj-1 do sbuf1[k]:=wbuf1[ci+k];
1388 update_obj_control_algo(sbuf1,cj);
1389 inc(ci,cj);
1390 end;
1391 //compressed block size field, dword
1392 dword2bytebuf(compsize,wbuf1,0);
1393 //compressed block data field, variable sized
1394 for k:=0 to compsize_d-1 do wbuf1[k+4]:=wbuf2[k];
1395 ci:=0;
1396 while ci<compsize_d+4 do
1397 begin
1398 if compsize_d+4-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=compsize_d+4-ci;
1399 for k:=0 to cj-1 do sbuf1[k]:=wbuf1[ci+k];
1400 update_control_algo(sbuf1,cj);
1401 for k:=0 to cj-1 do wbuf1[ci+k]:=sbuf1[k];
1402 inc(ci,cj);
1403 end;
1404 num_res:=compsize_d+4;
1405 prog_compsize:=prog_compsize+num_res;
1406 write2chunks ( num_res,
1407 wbuf1,
1408 f_out,
1409 out_path,out_name,
1410 j,
1411 ch_size,
1412 ch_res);
1413 Form_pea.ProgressBar1.Position:=prog_size div cent_size;
1414 Application.ProcessMessages;
1415 end;
1416 // uncompressed size of last buffer field (since it can not match the buffer size), dword
1417 dword2bytebuf(numread,sbuf1,0);
1418 update_obj_control_algo(sbuf1,4);
1419 update_control_algo(sbuf1,4);
1420 num_res:=4;
1421 prog_compsize:=prog_compsize+4;
1422 write2chunks ( num_res,
1423 sbuf1,
1424 f_out,
1425 out_path,out_name,
1426 j,
1427 ch_size,
1428 ch_res);
1429 end;
1430
1431 procedure nocompress_file;
1432 begin
1433 while ((numread<>0) and (total<file_size)) do
1434 begin
1435 blockread (f_in,sbuf1,SBUFSIZE,numread);
1436 inc(total,numread);
1437 inc(prog_size,numread);
1438 update_obj_control_algo(sbuf1,numread);
1439 update_control_algo(sbuf1,numread);
1440 num_res:=numread;
1441 write2chunks ( num_res,
1442 sbuf1,
1443 f_out,
1444 out_path,out_name,
1445 j,
1446 ch_size,
1447 ch_res);
1448 Form_pea.ProgressBar1.Position:=prog_size div cent_size;
1449 Application.ProcessMessages;
1450 end;
1451 end;
1452
1453 procedure write_eos; //unused in PEA file format 1.0
1454 //write a trigger object that declare the end of the stream
1455 begin
1456 trigger_eos(sbuf1);
1457 update_control_algo(sbuf1,6);
1458 num_res:=6;
1459 prog_size:=prog_size+6;
1460 prog_compsize:=prog_compsize+6;
1461 write2chunks ( num_res,
1462 sbuf1,
1463 f_out,
1464 out_path,out_name,
1465 j,
1466 ch_size,
1467 ch_res);
1468 end;
1469
1470 procedure write_eoa;
1471 //write a trigger object that declare the end of the archive (instead of EOS in the last stream of the archive)
1472 begin
1473 trigger_eoa(sbuf1);
1474 update_control_algo(sbuf1,6);
1475 num_res:=6;
1476 prog_size:=prog_size+6;
1477 prog_compsize:=prog_compsize+6;
1478 write2chunks ( num_res,
1479 sbuf1,
1480 f_out,
1481 out_path,out_name,
1482 j,
1483 ch_size,
1484 ch_res);
1485 end;
1486
1487 procedure write_auth;
1488 var
1489 k:dword;
1490 ct384:THashContext;
1491 dg384:TSHA3_384Digest;
1492 begin
1493 finish_control_algo;
1494 case upcase(algo) of
1495 'TRIATS','TRITSA','TRISAT':
1496 begin
1497 for k:=0 to 15 do sbuf1[k]:=auth[k];
1498 for k:=16 to 31 do sbuf1[k]:=auth2[k-16];
1499 for k:=32 to 47 do sbuf1[k]:=auth3[k-32];
1500 SHA3_384Init(ct384);
1501 SHA3_384Update(ct384, @sbuf1, 48);
1502 SHA3_384Final(ct384, dg384);
1503 for k:=0 to 47 do sbuf1[k]:=dg384[k];
1504 end;
1505 'EAX256','TF256','SP256','EAX','TF','SP','HMAC': for k:=0 to authsize-1 do sbuf1[k]:=auth[k];
1506 'WHIRLPOOL' : for k:=0 to authsize-1 do sbuf1[k]:=WHIRL512Digest[k];
1507 'SHA512' : for k:=0 to authsize-1 do sbuf1[k]:=SHA512Digest[k];
1508 'SHA256' : for k:=0 to authsize-1 do sbuf1[k]:=SHA256Digest[k];
1509 'SHA3_512' : for k:=0 to authsize-1 do sbuf1[k]:=SHA3_512Digest[k];
1510 'SHA3_256' : for k:=0 to authsize-1 do sbuf1[k]:=SHA3_256Digest[k];
1511 'SHA1' : for k:=0 to authsize-1 do sbuf1[k]:=SHA1Digest[k];
1512 'BLAKE2S' : for k:=0 to authsize-1 do sbuf1[k]:=Blake2sDigest[k];
1513 'BLAKE2B' : for k:=0 to authsize-1 do sbuf1[k]:=Blake2bDigest[k];
1514 'RIPEMD160' : for k:=0 to authsize-1 do sbuf1[k]:=RMD160Digest[k];
1515 'MD5' : for k:=0 to authsize-1 do sbuf1[k]:=MD5Digest[k];
1516 'CRC64' :
1517 begin
1518 dword2bytebuf(crc64.lo32,sbuf1,0);
1519 dword2bytebuf(crc64.hi32,sbuf1,4);
1520 end;
1521 'CRC32' : dword2bytebuf(crc32,sbuf1,0);
1522 'ADLER32' : dword2bytebuf(adler,sbuf1,0);
1523 end;
1524 s:='';
1525 num_res:=authsize;
1526 prog_size:=prog_size+num_res;
1527 prog_compsize:=prog_compsize+num_res;
1528 write2chunks ( num_res,
1529 sbuf1,
1530 f_out,
1531 out_path,out_name,
1532 j,
1533 ch_size,
1534 ch_res);
1535 end;
1536
1537 procedure write_obj_check;
1538 var k:dword;
1539 begin
1540 if upcase(obj_algo)<>'NOALGO' then
1541 begin
1542 case upcase(obj_algo) of
1543 'WHIRLPOOL' : for k:=0 to obj_authsize-1 do sbuf1[k]:=WHIRL512Digest_obj[k];
1544 'SHA512' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA512Digest_obj[k];
1545 'SHA256' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA256Digest_obj[k];
1546 'SHA3_512' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA3_512Digest_obj[k];
1547 'SHA3_256' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA3_256Digest_obj[k];
1548 'SHA1' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA1Digest_obj[k];
1549 'BLAKE2S' : for k:=0 to obj_authsize-1 do sbuf1[k]:=Blake2sDigest_obj[k];
1550 'BLAKE2B' : for k:=0 to obj_authsize-1 do sbuf1[k]:=Blake2bDigest_obj[k];
1551 'RIPEMD160' : for k:=0 to obj_authsize-1 do sbuf1[k]:=RMD160Digest_obj[k];
1552 'MD5' : for k:=0 to obj_authsize-1 do sbuf1[k]:=MD5Digest_obj[k];
1553 'CRC64' :
1554 begin
1555 dword2bytebuf(crc64_obj.lo32,sbuf1,0);
1556 dword2bytebuf(crc64_obj.hi32,sbuf1,4);
1557 end;
1558 'CRC32' : dword2bytebuf(crc32_obj,sbuf1,0);
1559 'ADLER32' : dword2bytebuf(adler_obj,sbuf1,0);
1560 end;
1561 for k:=0 to obj_authsize-1 do obj_tags[i,k]:=sbuf1[k];
1562 update_control_algo(sbuf1,obj_authsize);
1563 num_res:=obj_authsize;
1564 prog_size:=prog_size+num_res;
1565 prog_compsize:=prog_compsize+num_res;
1566 write2chunks ( num_res,
1567 sbuf1,
1568 f_out,
1569 out_path,out_name,
1570 j,
1571 ch_size,
1572 ch_res);
1573 end;
1574 end;
1575
1576 procedure first_gui_output;
1577 var i,k:integer;
1578 begin
1579 Form_pea.ProgressBar1.Position:=0;
1580 Form_pea.LabelEncrypt2.Caption:='Input: ';
1581 if length(in_param)>4 then k:=4 else k:=length(in_param);
1582 for i:=0 to k-1 do Form_pea.LabelEncrypt2.Caption:=Form_pea.LabelEncrypt2.Caption+in_param[i]+', ';
1583 if length(in_param)>4 then Form_pea.LabelEncrypt2.Caption:=Form_pea.LabelEncrypt2.Caption+' ...';
1584 Form_pea.LabelEncrypt3.Caption:='Output: '+out_param+'.*';
1585 Form_pea.LabelEncrypt4.Caption:='Using: '+compr+'; stream: '+algo+', object(s): '+obj_algo+', volume(s): '+volume_algo;
1586 Form_pea.LabelTime1.Caption:='Creating archive...';
1587 Form_pea.Panel1.visible:=true;
1588 Form_pea.LabelE1.Visible:=true;
1589 end;
1590
1591 procedure evaluate_volumes;
1592 begin
1593 if exp_size>0 then
1594 begin
1595 ch_number_expected:=(exp_size div ch_size)+1;
1596 if (exp_size mod ch_size)=0 then ch_number_expected:=ch_number_expected-1;
1597 end
1598 else ch_number_expected:=0;
1599 if ch_number_expected>9999 then
1600 if (upcase(compr)='PCOMPRESS0') then
1601 if MessageDlg('Expected '+inttostr(ch_number_expected)+' volumes. It seems a lot! Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
1602 else halt(-3)
1603 else
1604 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
1605 else halt(-3);
1606 if ch_number_expected>0 then
1607 if (upcase(compr)<>'PCOMPRESS0') then
1608 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'
1609 else Form_pea.LabelEncrypt5.Caption:='Expected a single volume archive, output size may vary due to the compressibility of the input'
1610 else
1611 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'
1612 else Form_pea.LabelEncrypt5.Caption:='Expected a single volume archive of '+inttostr(exp_size)+' B of size'
1613 else Form_pea.LabelEncrypt5.Caption:='Unknown number of volumes expected';
1614 end;
1615
1616 procedure evaluate_output;
1617 begin
1618 if upcase(out_param) = 'AUTONAME' then out_param:=in_param[0];
1619 out_file:=extractfilename(out_param);
1620 out_path:=extractfilepath(out_param);
1621 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
1622 if out_path='' then out_path:=executable_path;
1623 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
1624 if out_path[length(out_path)]<>DirectorySeparator then out_path:=out_path+DirectorySeparator;
1625 Form_pea.LabelEncrypt3.Caption:='Output: '+out_path+out_file+'.*';
1626 if exp_size>diskfree(0) then
1627 if (upcase(compr)='PCOMPRESS0') then
1628 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
1629 else halt(-3)
1630 else
1631 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
1632 else halt(-3);
1633 end;
1634
1635 procedure do_report_PEA;
1636 var
1637 h,k:dword;
1638 s:ansistring;
1639 begin
1640 Form_report.InputT.Caption:='Input';
1641 Form_report.OutputT.Caption:='Output';
1642 Form_report.Caption:='Log PEA';
1643 Form_report.StringGrid1.ColCount:=7;
1644 Form_report.StringGrid1.Cells[0,0]:='Original object name';
1645 Form_report.StringGrid1.Cells[1,0]:='Status';
1646 Form_report.StringGrid1.Cells[2,0]:='Size (B)';
1647 Form_report.StringGrid1.Cells[3,0]:='Age';
1648 Form_report.StringGrid1.Cells[4,0]:='Attrib';
1649 Form_report.StringGrid1.Cells[5,0]:='Attrib n.';
1650 Form_report.StringGrid1.Cells[6,0]:=obj_algo;
1651 Form_report.StringGrid1.RowCount:=n_input_files+1;
1652 obj_ok:=0;
1653 for k:=0 to n_input_files-1 do
1654 begin
1655 Form_report.StringGrid1.Cells[0,k+1]:=in_files[k];
1656 if status_files[k]=true then Form_report.StringGrid1.Cells[1,k+1]:='Archived'
1657 else
1658 begin
1659 inskipped:=true;
1660 Form_report.StringGrid1.Cells[1,k+1]:='Skipped';
1661 end;
1662 if status_files[k]=true then
1663 begin
1664 Form_report.StringGrid1.Cells[2,k+1]:=inttostr(fsizes[k]);
1665 if ftimes[k]<>0 then Form_report.StringGrid1.Cells[3,k+1]:=datetimetostr(filedatetodatetime(ftimes[k]));
1666 Form_report.StringGrid1.Cells[4,k+1]:=fattr_dec[k];
1667 Form_report.StringGrid1.Cells[5,k+1]:=inttostr(fattr[k]);
1668 if upcase(obj_algo)<>'NOALGO' then
1669 begin
1670 s:='';
1671 for h:=0 to obj_authsize-1 do s:=s+hexstr(@obj_tags[k,h],1);
1672 Form_report.StringGrid1.Cells[6,k+1]:=s;
1673 end;
1674 inc(obj_ok,1);
1675 end;
1676 end;
1677 Form_report.StringGrid1.AutosizeColumns;
1678 Form_report.StringGrid2.ColCount:=2;
1679 Form_report.StringGrid2.Cells[0,0]:='Volume';
1680 Form_report.StringGrid2.Cells[1,0]:=volume_algo;
1681 Form_report.StringGrid2.RowCount:=j+1;
1682 for k:=0 to j-1 do
1683 begin
1684 update_pea_filename(out_path+out_name,k+1,s);
1685 Form_report.StringGrid2.Cells[0,k+1]:=s;
1686 if upcase(volume_algo)<>'NOALGO' then
1687 begin
1688 s:='';
1689 for h:=0 to volume_authsize-1 do s:=s+hexstr(@volume_tags[k,h],1);
1690 Form_report.StringGrid2.Cells[1,k+1]:=s;
1691 end;
1692 end;
1693 Form_report.StringGrid2.AutosizeColumns;
1694 //operation parameters
1695 Form_report.Label1.Caption:=Form_pea.LabelEncrypt4.Caption;
1696 //input
1697 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';
1698 //output
1699 Form_report.Label3.Caption:=Form_pea.LabelEncrypt6.Caption;
1700 //output name
1701 Form_report.Label4.Caption:=Form_pea.LabelEncrypt3.Caption;
1702 end;
1703
1704 procedure last_gui_output;
1705 begin
1706 Form_pea.ProgressBar1.Position:=100;
1707 Form_pea.LabelEncrypt3.Caption:='Output: '+out_path+out_name+'.*; tag: '+s;
1708 if compr<>'PCOMPRESS0' then out_size:=prog_compsize
1709 else out_size:=prog_size;
1710 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'
1711 else Form_pea.LabelEncrypt6.Caption:='Single volume, '+inttostr(out_size)+' B';
1712 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';
1713 do_report_PEA;
1714 Form_pea.LabelEncrypt5.Caption:=Form_report.Label2.Caption;
1715 Form_pea.LabelOut1.Caption:=inttostr((out_size * 100) div (in_size+1))+'% of input size';
1716 if ((out_size * 200) div (in_size+1))<16 then Form_pea.ShapeE2.Width:=16
1717 else
1718 if ((out_size * 200) div (in_size+1))>300 then Form_pea.ShapeE2.Width:=300
1719 else Form_pea.ShapeE2.Width:=(out_size * 200) div (in_size+1);
1720 end;
1721
1722 begin
1723 exitcode:=-1;
1724 clean_variables;
1725 inskipped:=false;
1726 get_fingerprint (fingerprint,false);
1727 if (upcase(pw_param)<>'HIDDEN') and (upcase(pw_param)<>'HIDDEN_REPORT') then Form_pea.Visible:=true else Form_pea.Visible:=false;
1728 Form_pea.Caption:='Pea';
1729 Form_pea.PanelDecrypt1.visible:=false;
1730 Form_pea.PanelEncrypt1.visible:=true;
1731 ts_start:=datetimetotimestamp(now);
1732 i:=0;
1733 //give preliminary information on work status to the GUI
1734 first_gui_output;
1735 {
1736 expand the list of input objects and evaluate input and expected uncompressed
1737 output size (taking overheads in account):
1738 if the object is a file add file name to the list;
1739 if the object is a dir, recursively add the content to the list (any object in
1740 the dir and all subdir will be added to the list; if you want only file sin the
1741 root dir to be added to the list, add them as files, don't add the dir);
1742 if the object is not found mark it as skipped in the status list, otherwise mark
1743 it as ok (the different lists indexes must remain sincronized)
1744 }
1745 expand_inputlist;
1746 cent_size:=(exp_size div 100)+1; //1% of expected output size, used for progress indication
1747 {
1748 evaluate volumes number;
1749 at 9999 objects the program will warn and proceed only after user's permission,
1750 however the program has no sort of problem until 999999 chunks (but the host
1751 system may!)
1752 }
1753 evaluate_volumes;
1754 {
1755 get output path and name;
1756 evaluate if the path has enough free space for expected output.
1757 }
1758 evaluate_output;
1759 //check if output path has room for a chunk of given size (mandatory)
1760 checkspacepea(out_path,ch_size,volume_authsize);
1761 {
1762 start the actual operation routine
1763 1) generate the archive header;
1764 2a) generate the stream header (current implementation allow only a stream for archive)
1765 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);
1766 2c) if compression is used write compressed buffer's size
1767 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
1768 4) generate End Of Archive trigger followed by the appropriate control tag
1769 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)
1770 }
1771 //1) generate archive header
1772 out_name:=out_file;
1773 if ch_size=1024*1024*1024*1024*1024-volume_authsize then
1774 assignfile(f_out,out_file+'.pea')
1775 else
1776 assignfile(f_out,out_file+'.000001.pea');//current dir was jet set to out_path
1777 rewrite(f_out);
1778 if IOResult<>0 then internal_error('IO error opening first volume');
1779 SetLength(volume_tags,length(volume_tags)+1);
1780 init_volume_control_algo;
1781 test_pea_error('creating archive header',pea_archive_hdr(volume_algo,sbuf1,num_res));
1782 j:=1;
1783 ch_res:=ch_size;
1784 prog_size:=num_res;
1785 prog_compsize:=num_res;
1786 write2chunks ( num_res,
1787 sbuf1,
1788 f_out,
1789 out_path,out_name,
1790 j,
1791 ch_size,
1792 ch_res);
1793 for i:=0 to 9 do auth_buf[i]:=sbuf1[i];
1794 //2a) generate stream header
1795 test_pea_error('creating stream header',pea_stream_hdr(compr,algo,obj_algo,sbuf1,num_res));
1796 prog_size:=prog_size+num_res;
1797 prog_compsize:=prog_compsize+num_res;
1798 write2chunks ( num_res,
1799 sbuf1,
1800 f_out,
1801 out_path,out_name,
1802 j,
1803 ch_size,
1804 ch_res);
1805 for i:=0 to 9 do auth_buf[i+10]:=sbuf1[i];
1806 // 2b) init stream control algorithm, generate crypto subheader if needed
1807 if pwneeded=true then
1808 begin
1809 //get password
1810 if (upcase(pw_param)='INTERACTIVE') or (upcase(pw_param)='INTERACTIVE_REPORT') then
1811 begin
1812 //password is pw string that was already entered in EditPW.Text
1813 //keyfile name is keyfile_name already entered
1814 end
1815 else
1816 begin
1817 pw:=password; //pw is got from commandline (not recommended)
1818 keyfile_name:=keyf_name; //keyfile name is got from command line
1819 end;
1820 pw_len:=length(pw);
1821 if pw_len=0 then internal_error('invalid password length');
1822 for k:=0 to pw_len-1 do sbuf2[k]:=ord(pw[k+1]);//copy password into an array of byte
1823 //append headers to password's array (sbuf2)
1824 for i:=0 to 1 do auth_buf[i+20]:=sbuf1[i];
1825 for k:=0 to 21 do sbuf2[pw_len+k]:=auth_buf[k];
1826 pw_len:=pw_len+22;
1827 //append keyfile to password's array (sbuf2)
1828 if upcase(keyfile_name)<>'NOKEYFILE' then
1829 test_pea_error('accessing keyfile',use_keyfile(keyfile_name,2048,numread,sbuf2,pw_len));
1830 end;
1831 init_control_algo;
1832 clean_keying_vars;
1833 prog_size:=prog_size+num_res;
1834 prog_compsize:=prog_compsize+num_res;
1835 write2chunks ( num_res,
1836 sbuf1,
1837 f_out,
1838 out_path,out_name,
1839 j,
1840 ch_size,
1841 ch_res);
1842 case upcase(algo) of
1843 'TRIATS','TRITSA','TRISAT': //mask exact archive size extending header 1..128 byte with random data (encrypted)
1844 begin
1845 gen_rand(randarr);
1846 randarr[0]:=randarr[0] div 2;
1847 for i:=0 to 127 do sbuf1[i]:=randarr[i];
1848 update_control_algo(sbuf1,randarr[0]+1);
1849 num_res:=randarr[0]+1;
1850 prog_size:=prog_size+num_res;
1851 prog_compsize:=prog_compsize+num_res;
1852 write2chunks ( num_res,
1853 sbuf1,
1854 f_out,
1855 out_path,out_name,
1856 j,
1857 ch_size,
1858 ch_res);
1859 for i:=0 to 255 do randarr[i]:=0;
1860 end;
1861 end;
1862 if pwneeded=false then update_control_algo(auth_buf,20); //check the archive and stream headers
1863 // 2c) buffer size field (data to compress at once), dword, stream specific
1864 if upcase(compr)<>'PCOMPRESS0' then
1865 begin
1866 dword2bytebuf(WBUFSIZE,sbuf1,0);
1867 update_control_algo(sbuf1,4);
1868 num_res:=4;
1869 prog_compsize:=prog_compsize+num_res;
1870 write2chunks ( num_res,
1871 sbuf1,
1872 f_out,
1873 out_path,out_name,
1874 j,
1875 ch_size,
1876 ch_res);
1877 end;
1878 //3) for each object: if the object is accessible add it to the archive
1879 n_dirs:=0;
1880 for i:=0 to n_input_files-1 do
1881 begin
1882 SetLength(obj_tags,length(obj_tags)+1);
1883 if status_files[i]=false then goto 1; //the object, during creation of the list, was not accessible
1884 in_qualified_name:=in_files[i];
1885 addr:=i;
1886 k:=check_in(f_in,in_qualified_name,status_files,i);
1887 if k<>0 then
1888 begin
1889 inc(n_skipped,1);
1890 goto 1; //the object is actually not accessible
1891 end;
1892 init_obj_control_algo;
1893 //2 byte (word) sized field for size of the input object qualified name, if = 0 then the object is a trigger
1894 ansi_qualified_name:=utf8toansi(in_qualified_name);
1895 filename_size:=length(ansi_qualified_name);//(in_files[i]);
1896 word2bytebuf(filename_size,sbuf1,0);
1897 //variable sized field for input object qualified name
1898 for k:=0 to filename_size-1 do sbuf1[k+2]:=ord(ansi_qualified_name[k+1]);
1899 //4 byte (dword) sized field for input object last modification time
1900 if filegetattr(in_files[i]) and faDirectory = 0 then k:=fileage(in_qualified_name)
1901 else
1902 begin
1903 if findfirst(in_files[i]+'.',faDirectory,r) = 0 then k:=r.Time
1904 else k:=datetimetofiledate(now); //should not happen
1905 FindClose(r);
1906 end;
1907 dword2bytebuf(k,sbuf1,filename_size+2);
1908 //4 byte (dword) sized field for input object attributes
1909 k:=filegetattr(in_qualified_name);
1910 dword2bytebuf(k,sbuf1,filename_size+6);
1911 if filegetattr(in_qualified_name) and faDirectory <>0 then //the object is a directory
1912 begin
1913 update_obj_control_algo(sbuf1,filename_size+10);
1914 update_control_algo(sbuf1,filename_size+10);
1915 num_res:=filename_size+10;
1916 prog_size:=prog_size+num_res;
1917 prog_compsize:=prog_compsize+num_res;
1918 inc(n_dirs,1);
1919 write2chunks ( num_res,
1920 sbuf1,
1921 f_out,
1922 out_path,out_name,
1923 j,
1924 ch_size,
1925 ch_res);
1926 finish_obj_control_algo;
1927 write_obj_check;
1928 end
1929 else //the object is a file
1930 begin
1931 //8 byte (qword) sized field for input file size
1932 srcfilesize(in_qualified_name,file_size);
1933 //file_size:=system.filesize(f_in);
1934 qword2bytebuf(file_size,sbuf1,filename_size+10);
1935 update_obj_control_algo(sbuf1,filename_size+18);
1936 update_control_algo(sbuf1,filename_size+18);
1937 num_res:=filename_size+18;
1938 prog_size:=prog_size+num_res;
1939 prog_compsize:=prog_compsize+num_res;
1940 write2chunks ( num_res,
1941 sbuf1,
1942 f_out,
1943 out_path,out_name,
1944 j,
1945 ch_size,
1946 ch_res);
1947 if file_size>0 then //non empty file
1948 begin
1949 ////// for each file: 3) mangle and write file data
1950 total:=0;
1951 numread:=1;
1952 if upcase(compr)<>'PCOMPRESS0' then compress_file
1953 else nocompress_file; //no compression
1954 closefile(f_in);
1955 end;
1956 finish_obj_control_algo;
1957 write_obj_check;
1958 end;
1959 1:
1960 end;
1961 //4) close stream: write trigger of end of archive (since PEA1.0 files contain a single stream) and write authentication tag (if applicable)
1962 write_eoa;
1963 if upcase(algo)<>'NOALGO' then write_auth
1964 else s:='no control tag';
1965 //5) generate last volume control tag
1966 SetLength(volume_tags,length(volume_tags)+1);
1967 finish_volume_control_algo;
1968 write_volume_check;
1969 closefile(f_out);
1970 if IOResult<>0 then internal_error('IO error closing last volume');
1971 //give final job information to the GUI
1972 last_gui_output;
1973 //calculate operation time
1974 timing(ts_start,in_size);
1975 //make accessible exit button and link to the detailed job log
1976 Form_pea.LabelLog1.Visible:=true;
1977 Form_pea.LabelOpen.Caption:='Explore';
1978 output:=out_path;
1979 Form_pea.LabelOpen.visible:=true;
1980 Form_pea.ButtonDone1.Visible:=true;
1981 Form_pea.ButtonPeaExit.Visible:=false;
1982 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);
1983 if inskipped=true then exitcode:=-2 else exitcode:=0;
1984 Sleep(500);
1985 if closepolicy>0 then Form_pea.Close; //error conditions are intercepted before and handled with internal_error procedure
1986 end;
1987
1988 {
1989 UnPEA
1990 Decrypt, authenticate, join, decompress, extract PEA format archives
1991
1992 Error management:
1993 - errors in objects, stream or volumes are checked by strong functions and
1994 reported in job log, that can be saved, at the end of the job a popup message
1995 will warn that such errors were encountered;
1996 - errors that prevent the application to work make the application quit with a
1997 descriptive message, if the error is of unknown nature application will
1998 autosave a job log allowing further analysis.
1999
2000 Known issues:
2001 - FPC's set object attributes works only on Windows, set object date seem not
2002 actually working (both are currently not supported on *x);
2003 }
2004
2005 procedure unpea;
2006 var
2007 in_qualified_name,out_param,date_param,attr_param,struct_param,pw_param,password,keyf_name:ansistring;
2008 i:integer;
2009
2010 procedure parse_unpea_cl;
2011 begin
2012 i:=0;
2013 try
2014 in_qualified_name:=(paramstr(2));
2015 if not(fileexists(in_qualified_name)) then
2016 internal_error('"'+in_qualified_name+'" not exist');
2017 out_param:=(paramstr(3));
2018 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
2019 if date_param<>'RESETDATE' then //(date_param<>'SETDATE') or
2020 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');
2021 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
2022 if not ((attr_param='SETATTR') or (attr_param='RESETATTR')) then
2023 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');
2024 struct_param:=upcase(paramstr(6)); //EXTRACT2DIR: make a dir with output object with shortest possible path derived from input structures
2025 if struct_param<>'EXTRACT2DIR' then
2026 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');
2027 //get operation mode
2028 pw_param:=upcase(paramstr(7));
2029 if (pw_param<>'INTERACTIVE') and (pw_param<>'INTERACTIVE_REPORT') then
2030 begin
2031 inc(i,1);
2032 password:=(paramstr(7+i));
2033 inc(i,1);
2034 keyf_name:=(paramstr(7+i));
2035 end
2036 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
2037 internal_error('"'+pw_param+'" is not a valid operation mode parameter, please refer to the documentation');
2038 except
2039 internal_error('Received incorrect Command Line. See the documentation for the correct synopsis.');
2040 end;
2041 end;
2042
2043 begin
2044 parse_unpea_cl; //parse and validate command line
2045 unpea_procedure(in_qualified_name,out_param,date_param,attr_param,struct_param,pw_param,password,keyf_name);
2046 end;
2047
2048 procedure unpea_lib_procedure ( in_qualified_name, //archive qualified name
2049 out_param, //dir were extracting the archive (or AUTONAME)
2050 date_param, //actually only supported RESETDATE, reset date of extracted files
2051 attr_param, //RESETATTR (or SETATTR only on Windows to set object's attributes as on original objects)
2052 struct_param, //actually only supported EXTRACT2DIR, create a dir and extract archive in the dir using shortest paths for archived objects
2053 password,keyf_name:ansistring; //password and keyfile qualified name (if needed)
2054 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
2055 var
2056 pw_param:ansistring;
2057 begin
2058 if not(fileexists(in_qualified_name)) then
2059 internal_error('"'+in_qualified_name+'" not exist');
2060 //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
2061 if date_param<>'RESETDATE' then //(date_param<>'SETDATE') or
2062 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');
2063 //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
2064 if not ((attr_param='SETATTR') or (attr_param='RESETATTR')) then
2065 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');
2066 //EXTRACT2DIR: make a dir with output object with shortest possible path derived from input structures
2067 if struct_param<>'EXTRACT2DIR' then
2068 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');
2069 //get operation mode
2070 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
2071 internal_error('"'+upcase(opmode)+'" is not a valid operation mode, please refer to the documentation');
2072 if (upcase(opmode)='INTERACTIVE') or (upcase(opmode)='INTERACTIVE_REPORT') then
2073 internal_error('INTERACTIVE* modes are not allowed calling unpea_lib_procedure, use BATCH* or HIDDEN* modes');
2074 pw_param:=upcase(opmode);
2075 unpea_procedure(in_qualified_name,out_param,date_param,attr_param,struct_param,pw_param,password,keyf_name);
2076 end;
2077
2078 procedure unpea_procedure ( in_qualified_name,
2079 out_param,
2080 date_param,
2081 attr_param,
2082 struct_param,
2083 pw_param,
2084 password,
2085 keyf_name:ansistring);
2086 var
2087 hdr,hdrd : TFCAHdr;
2088 fhdr,fhdrd : TFCFHdr;
2089 shdr,shdrd : TFCSHdr;
2090 hdr256,hdrd256 : TFCA256Hdr;
2091 fhdr256,fhdrd256 : TFCF256Hdr;
2092 shdr256,shdrd256 : TFCS256Hdr;
2093 cxe : TAES_EAXContext;
2094 cxf : Ttf_EAXContext;
2095 cxs : Tsp_EAXContext;
2096 cxh : TFCA_HMAC_Context;
2097 auth,auth2,auth3 : array [0..15] of byte;//TFCA_AuthBlock;
2098 HashContext,HashContext_obj,HashContext_volume: THashContext;
2099 Blake2sContext,Blake2sContext_obj,Blake2sContext_volume:blake2s_ctx;
2100 Blake2sDigest,Blake2sDigest_obj,Blake2sDigest_volume:TBlake2sDigest;
2101 Blake2bDigest,Blake2bDigest_obj,Blake2bDigest_volume:TBlake2bDigest;
2102 Whirl512Digest,Whirl512Digest_obj,Whirl512Digest_volume: TWhirlDigest;
2103 SHA512Digest,SHA512Digest_obj,SHA512Digest_volume: TSHA512Digest;
2104 SHA256Digest,SHA256Digest_obj,SHA256Digest_volume: TSHA256Digest;
2105 SHA3_512Digest,SHA3_512Digest_obj,SHA3_512Digest_volume: TSHA3_512Digest;
2106 SHA3_256Digest,SHA3_256Digest_obj,SHA3_256Digest_volume: TSHA3_256Digest;
2107 SHA1Digest,SHA1Digest_obj,SHA1Digest_volume: TSHA1Digest;
2108 RMD160Digest,RMD160Digest_obj,RMD160Digest_volume: TRMD160Digest;
2109 MD5Digest,MD5Digest_obj,MD5Digest_volume: TMD5Digest;
2110 crc64,crc64_obj,crc64_volume:TCRC64;
2111 ts_start:TTimeStamp;
2112 f_in,f_out:file of byte;
2113 sbuf1,sbuf2:array [0..65535] of byte;
2114 tagbuf,exp_auth:array [0..63] of byte;
2115 compr_level,headersize,authsize,obj_authsize,volume_authsize,archive_datetimeencoding,storead:byte;
2116 pw_len,fns:word;
2117 adler,crc32,adler_obj,crc32_obj,adler_volume,crc32_volume:longint;
2118 i,j,ci,cj,h,k,numread,numwritten,n_chunks,n_dirs,n_input_files,compsize,uncompsize,addr,fage,fattrib,buf_size:dword;
2119 total,wrk_space,exp_space,cent_size,fs,out_size,qw0,qw1,qw2,qw3,qw4,qw5,qw6,qw7:qword;
2120 nobj:int64;
2121 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;
2122 subroot,basedir,s,in_file,in_name,in_folder,out_path,out_file,algo,obj_algo,volume_algo,compr,fn:ansistring;
2123 label 1;
2124
2125 procedure clean_variables;
2126 begin
2127 i:=0;
2128 j:=0;
2129 h:=0;
2130 k:=0;
2131 numread:=0;
2132 numwritten:=0;
2133 n_chunks:=0;
2134 n_dirs:=0;
2135 n_input_files:=0;
2136 compsize:=0;
2137 uncompsize:=0;
2138 addr:=0;
2139 fage:=0;
2140 fattrib:=0;
2141 total:=0;
2142 cent_size:=0;
2143 wrk_space:=0;
2144 exp_space:=0;
2145 fs:=0;
2146 nobj:=0;
2147 out_size:=0;
2148 clean_global_vars;
2149 end;
2150
2151 procedure evaluate_archive_size(var exp_space:qword; var cent_size:qword); //succeed if all chunks are accessible
2152 var qw:qword;
2153 begin
2154 j:=1;
2155 no_more_files:=false;
2156 exp_space:=0;
2157 while no_more_files=false do
2158 begin
2159 if singlevolume=false then update_pea_filename(in_name,j,in_file)
2160 else no_more_files:=true;
2161 if fileexists(in_folder+in_file) then
2162 begin
2163 assignfile(f_in,in_folder+in_file);
2164 filemode:=0;
2165 reset(f_in);
2166 srcfilesize(in_folder+in_file,qw);
2167 exp_space:=exp_space+qw;
2168 //exp_space:=exp_space+system.filesize(f_in);
2169 closefile(f_in);
2170 j:=j+1;
2171 end
2172 else no_more_files:=true;
2173 end;
2174 n_chunks:=j-1;
2175 cent_size:=(exp_space div 100)+1;
2176 Form_pea.LabelDecrypt2.Caption:='Input: '+in_name+'.*, expected '+inttostr(n_chunks)+' volume(s), total '+inttostr(exp_space)+' B';
2177 end;
2178
2179 procedure evaluate_output;
2180 begin
2181 if upcase(out_param) = 'AUTONAME' then out_param:=in_folder+in_name;
2182 out_file:=extractfilename(out_param);
2183 out_path:=extractfilepath(out_param);
2184 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
2185 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
2186 if out_path='' then out_path:=executable_path;
2187 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
2188 if out_path[length(out_path)]<>DirectorySeparator then out_path:=out_path+DirectorySeparator;
2189 Form_pea.LabelDecrypt3.Caption:='Output: '+out_path+out_file+DirectorySeparator;
2190 if exp_space>diskfree(0) then
2191 if (upcase(compr)='PCOMPRESS0') then
2192 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
2193 else halt(-3)
2194 else
2195 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
2196 else halt(-3);
2197 end;
2198
2199 procedure ansiextract2dir;
2200 var
2201 afn,fnpath,fnname,aout_path,aout_file:ansistring;
2202 begin
2203 afn:=fn;
2204 aout_path:=utf8toansi(out_path);
2205 aout_file:=utf8toansi(out_file);
2206 if afn[length(afn)]=DirectorySeparator then
2207 begin
2208 ansiextractdirname(afn,fnpath,fnname);
2209 if subroot='' then
2210 begin
2211 subroot:=fnpath;
2212 basedir:=afn;
2213 end;
2214 if ansicontainsstr(fnpath,basedir) then
2215 begin
2216 s:=copy(fnpath,length(subroot)+1,length(fnpath)-length(subroot)-1);
2217 end
2218 else
2219 begin
2220 subroot:=fnpath;
2221 basedir:=afn;
2222 s:='';
2223 end;
2224 try
2225 if s<>'' then mkdir(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname)
2226 else mkdir(aout_path+aout_file+directoryseparator+fnname);
2227 except
2228 if IOResult<>0 then internal_error('IO error creating dir '+ansitoutf8(fnname));
2229 end;
2230 {$IFDEF MSWINDOWS}
2231 if attr_param='SETATTR' then filesetattr(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname,fattrib);
2232 filesetdate(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname,fage);
2233 {$ENDIF}
2234 readingfns:=true;
2235 end
2236 else
2237 begin
2238 fnname:=extractfilename(afn);
2239 fnpath:=extractfilepath(afn);
2240 if subroot='' then
2241 begin
2242 subroot:=fnpath;
2243 s:='';
2244 end
2245 else s:=copy(fnpath,length(subroot)+1,length(fnpath)-length(subroot)-1);
2246 if setcurrentdir(aout_path+aout_file+directoryseparator+s)<>true then s:='';
2247 h:=0;
2248 filenamed:=false;
2249 repeat
2250 if h=0 then
2251 if fileexists(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname) then inc(h,1)
2252 else filenamed:=true
2253 else
2254 if fileexists(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname+' - '+inttostr(h)+extractfileext(afn)) then inc(h,1)
2255 else filenamed:=true;
2256 until filenamed = true;
2257 if h>0 then fnname:=fnname+' - '+inttostr(h)+extractfileext(afn);
2258 assignfile(f_out,aout_path+aout_file+directoryseparator+s+directoryseparator+fnname);
2259 setcurrentdir(aout_path+aout_file);
2260 rewrite(f_out);
2261 if IOResult<>0 then internal_error('IO error creating '+ansitoutf8(fnname));
2262 {$IFDEF MSWINDOWS}
2263 if attr_param='SETATTR' then filesetattr(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname,fattrib);
2264 //filesetdate(aout_path+aout_file+directoryseparator+s+directoryseparator+fnname,fage); fails
2265 {$ENDIF}
2266 readingfs:=true;
2267 fassigned:=true;
2268 end;
2269 end;
2270
2271 procedure init_AE256_control_algo;
2272 var
2273 i:integer;
2274 tsbuf2:array [0..65535] of byte;
2275 verw:word;
2276 begin
2277 case upcase(algo) of
2278 'TRIATS':
2279 begin
2280 for i:=0 to pw_len-1 do tsbuf2[i]:=sbuf2[i];
2281 hdr256.FCAsig:=hdr.FCAsig;
2282 hdr256.Flags:=hdr.Flags;
2283 hdr256.Salt:=hdr.Salt;
2284 hdr256.PW_Ver:=hdr.PW_Ver;
2285 hdrd256:=hdr256;
2286 if FCA_EAX256_initP(cxe, @sbuf2, pw_len, hdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2287 fhdr256.FCfsig:=fhdr.FCfsig;
2288 fhdr256.Flags:=fhdr.Flags;
2289 fhdr256.Salt:=fhdr.Salt;
2290 fhdr256.PW_Ver:=fhdr.PW_Ver;
2291 fhdrd256:=fhdr256;
2292 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i] xor (pw_len+i) xor ord(upcase(algo[length(algo)-1]));
2293 if FCf_EAX256_initP(cxf, @sbuf2, pw_len, fhdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2294 shdr256.FCssig:=shdr.FCssig;
2295 shdr256.Flags:=shdr.Flags;
2296 shdr256.Salt:=shdr.Salt;
2297 shdr256.PW_Ver:=shdr.PW_Ver;
2298 shdrd256:=shdr256;
2299 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i];
2300 for i:=0 to pw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len xor i) xor ord(upcase(algo[length(algo)]));
2301 if FCs_EAX256_initP(cxs, @sbuf2, pw_len, shdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2302 verw:=hdrd256.PW_Ver xor fhdrd256.PW_Ver xor shdrd256.PW_Ver;
2303 if shdr256.PW_ver<>verw then internal_error('Wrong password or keyfile');
2304 for i:=0 to pw_len-1 do tsbuf2[i]:=0;
2305 verw:=0;
2306 end;
2307 'TRITSA':
2308 begin
2309 for i:=0 to pw_len-1 do tsbuf2[i]:=sbuf2[i];
2310 fhdr256.FCfsig:=fhdr.FCfsig;
2311 fhdr256.Flags:=fhdr.Flags;
2312 fhdr256.Salt:=fhdr.Salt;
2313 fhdr256.PW_Ver:=fhdr.PW_Ver;
2314 fhdrd256:=fhdr256;
2315 if FCf_EAX256_initP(cxf, @sbuf2, pw_len, fhdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2316 shdr256.FCssig:=shdr.FCssig;
2317 shdr256.Flags:=shdr.Flags;
2318 shdr256.Salt:=shdr.Salt;
2319 shdr256.PW_Ver:=shdr.PW_Ver;
2320 shdrd256:=shdr256;
2321 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i] xor (pw_len+i) xor ord(upcase(algo[length(algo)-1]));
2322 if FCs_EAX256_initP(cxs, @sbuf2, pw_len, shdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2323 hdr256.FCAsig:=hdr.FCAsig;
2324 hdr256.Flags:=hdr.Flags;
2325 hdr256.Salt:=hdr.Salt;
2326 hdr256.PW_Ver:=hdr.PW_Ver;
2327 hdrd256:=hdr256;
2328 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i];
2329 for i:=0 to pw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len xor i) xor ord(upcase(algo[length(algo)]));
2330 if FCA_EAX256_initP(cxe, @sbuf2, pw_len, hdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2331 verw:=hdrd256.PW_Ver xor fhdrd256.PW_Ver xor shdrd256.PW_Ver;
2332 if hdr256.PW_ver<>verw then internal_error('Wrong password or keyfile');
2333 for i:=0 to pw_len-1 do tsbuf2[i]:=0;
2334 verw:=0;
2335 end;
2336 'TRISAT':
2337 begin
2338 for i:=0 to pw_len-1 do tsbuf2[i]:=sbuf2[i];
2339 shdr256.FCssig:=shdr.FCssig;
2340 shdr256.Flags:=shdr.Flags;
2341 shdr256.Salt:=shdr.Salt;
2342 shdr256.PW_Ver:=shdr.PW_Ver;
2343 shdrd256:=shdr256;
2344 if FCs_EAX256_initP(cxs, @sbuf2, pw_len, shdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2345 hdr256.FCAsig:=hdr.FCAsig;
2346 hdr256.Flags:=hdr.Flags;
2347 hdr256.Salt:=hdr.Salt;
2348 hdr256.PW_Ver:=hdr.PW_Ver;
2349 hdrd256:=hdr256;
2350 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i] xor (pw_len+i) xor ord(upcase(algo[length(algo)-1]));
2351 if FCA_EAX256_initP(cxe, @sbuf2, pw_len, hdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2352 fhdr256.FCfsig:=fhdr.FCfsig;
2353 fhdr256.Flags:=fhdr.Flags;
2354 fhdr256.Salt:=fhdr.Salt;
2355 fhdr256.PW_Ver:=fhdr.PW_Ver;
2356 fhdrd256:=fhdr256;
2357 for i:=0 to pw_len-1 do sbuf2[i]:=tsbuf2[i];
2358 for i:=0 to pw_len-1 do sbuf2[i]:=sbuf2[i] xor (pw_len xor i) xor ord(upcase(algo[length(algo)]));
2359 if FCf_EAX256_initP(cxf, @sbuf2, pw_len, fhdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2360 verw:=hdrd256.PW_Ver xor fhdrd256.PW_Ver xor shdrd256.PW_Ver;
2361 if fhdr256.PW_ver<>verw then internal_error('Wrong password or keyfile');
2362 for i:=0 to pw_len-1 do tsbuf2[i]:=0;
2363 verw:=0;
2364 end;
2365 'EAX256':
2366 begin
2367 hdr256.FCAsig:=hdr.FCAsig;
2368 hdr256.Flags:=hdr.Flags;
2369 hdr256.Salt:=hdr.Salt;
2370 hdr256.PW_Ver:=hdr.PW_Ver;
2371 hdrd256:=hdr256;
2372 if FCA_EAX256_init(cxe, @sbuf2, pw_len, hdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2373 if hdr256.PW_ver<>hdrd256.PW_ver then internal_error('eax Wrong password or keyfile');
2374 end;
2375 'TF256':
2376 begin
2377 fhdr256.FCfsig:=fhdr.FCfsig;
2378 fhdr256.Flags:=fhdr.Flags;
2379 fhdr256.Salt:=fhdr.Salt;
2380 fhdr256.PW_Ver:=fhdr.PW_Ver;
2381 fhdrd256:=fhdr256;
2382 if FCf_EAX256_init(cxf, @sbuf2, pw_len, fhdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2383 if fhdr256.PW_ver<>fhdrd256.PW_ver then internal_error('Wrong password or keyfile');
2384 end;
2385 'SP256':
2386 begin
2387 shdr256.FCssig:=shdr.FCssig;
2388 shdr256.Flags:=shdr.Flags;
2389 shdr256.Salt:=shdr.Salt;
2390 shdr256.PW_Ver:=shdr.PW_Ver;
2391 shdrd256:=shdr256;
2392 if FCs_EAX256_init(cxs, @sbuf2, pw_len, shdrd256)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2393 if shdr256.PW_ver<>shdrd256.PW_ver then internal_error('Wrong password or keyfile');
2394 end;
2395 end;
2396 end;
2397
2398 procedure init_AE128_control_algo;
2399 begin
2400 case upcase(algo) of
2401 'TF':
2402 begin
2403 fhdrd:=fhdr;
2404 if FCf_EAX_init(cxf, @sbuf2, pw_len, fhdrd)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2405 if fhdr.PW_ver<>fhdrd.PW_ver then internal_error('Wrong password or keyfile');
2406 end;
2407 'SP':
2408 begin
2409 shdrd:=shdr;
2410 if FCs_EAX_init(cxs, @sbuf2, pw_len, shdrd)<>0 then internal_error('Stream control algorithm: error in '+algo+' init');
2411 if shdr.PW_ver<>shdrd.PW_ver then internal_error('Wrong password or keyfile');
2412 end;
2413 else
2414 begin
2415 hdrd:=hdr;
2416 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');
2417 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');
2418 if hdr.PW_ver<>hdrd.PW_ver then internal_error('Wrong password or keyfile');
2419 end;
2420 end;
2421 end;
2422
2423 procedure init_nonAE_control_algo;
2424 begin
2425 case upcase(algo) of
2426 'WHIRLPOOL' : Whirl_Init(HashContext);
2427 'SHA512' : SHA512Init(HashContext);
2428 'SHA256' : SHA256Init(HashContext);
2429 'SHA3_512' : SHA3_512Init(HashContext);
2430 'SHA3_256' : SHA3_256Init(HashContext);
2431 'SHA1' : SHA1Init(HashContext);
2432 'BLAKE2S' : Blake2s_Init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen);
2433 'BLAKE2B' : Blake2b_Init(HashContext,nil,0,BLAKE2B_MaxDigLen);
2434 'RIPEMD160' : RMD160Init(HashContext);
2435 'MD5' : MD5Init(HashContext);
2436 'CRC64' : CRC64Init(crc64);
2437 'CRC32' : CRC32Init(crc32);
2438 'ADLER32' : Adler32Init(adler);
2439 end;
2440 end;
2441
2442 procedure init_obj_control_algo;
2443 begin
2444 case upcase(obj_algo) of
2445 'WHIRLPOOL' : Whirl_Init(HashContext_obj);
2446 'SHA512' : SHA512Init(HashContext_obj);
2447 'SHA256' : SHA256Init(HashContext_obj);
2448 'SHA3_512' : SHA3_512Init(HashContext_obj);
2449 'SHA3_256' : SHA3_256Init(HashContext_obj);
2450 'SHA1' : SHA1Init(HashContext_obj);
2451 'BLAKE2S' : Blake2s_Init(Blake2sContext_obj,nil,0,BLAKE2S_MaxDigLen);
2452 'BLAKE2B' : Blake2b_Init(HashContext_obj,nil,0,BLAKE2B_MaxDigLen);
2453 'RIPEMD160' : RMD160Init(HashContext_obj);
2454 'MD5' : MD5Init(HashContext_obj);
2455 'CRC64' : CRC64Init(crc64_obj);
2456 'CRC32' : CRC32Init(crc32_obj);
2457 'ADLER32' : Adler32Init(adler_obj);
2458 end;
2459 end;
2460
2461 procedure init_volume_control_algo;
2462 begin
2463 case upcase(volume_algo) of
2464 'WHIRLPOOL' : Whirl_Init(HashContext_volume);
2465 'SHA512' : SHA512Init(HashContext_volume);
2466 'SHA256' : SHA256Init(HashContext_volume);
2467 'SHA3_512' : SHA3_512Init(HashContext_volume);
2468 'SHA3_256' : SHA3_256Init(HashContext_volume);
2469 'SHA1' : SHA1Init(HashContext_volume);
2470 'BLAKE2S' : Blake2s_Init(Blake2sContext_volume,nil,0,BLAKE2S_MaxDigLen);
2471 'BLAKE2B' : Blake2b_Init(HashContext_volume,nil,0,BLAKE2B_MaxDigLen);
2472 'RIPEMD160' : RMD160Init(HashContext_volume);
2473 'MD5' : MD5Init(HashContext_volume);
2474 'CRC64' : CRC64Init(crc64_volume);
2475 'CRC32' : CRC32Init(crc32_volume);
2476 'ADLER32' : Adler32Init(adler_volume);
2477 end;
2478 end;
2479
2480 procedure update_control_algo(var buf:array of byte; size:word);
2481 var k:integer;
2482 begin
2483 case upcase(algo) of
2484 'TRIATS':
2485 begin
2486 if FCS_EAX256_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2487 if FCF_EAX256_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2488 if FCA_EAX256_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2489 end;
2490 'TRITSA':
2491 begin
2492 if FCA_EAX256_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2493 if FCS_EAX256_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2494 if FCF_EAX256_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2495 end;
2496 'TRISAT':
2497 begin
2498 if FCF_EAX256_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2499 if FCA_EAX256_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2500 if FCS_EAX256_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2501 end;
2502 'EAX256' : if FCA_EAX256_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2503 'TF256' : if FCF_EAX256_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2504 'SP256' : if FCS_EAX256_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2505 'EAX' : if FCA_EAX_decrypt(cxe, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2506 'TF' : if FCf_EAX_decrypt(cxf, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2507 'SP' : if FCs_EAX_decrypt(cxs, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2508 'HMAC' : if FCA_HMAC_decrypt(cxh, buf, size)<>0 then internal_error('Stream control algorithm: error in '+algo+' update');
2509 'WHIRLPOOL' : Whirl_Update(HashContext, @buf, size);
2510 'SHA512' : SHA512Update(HashContext, @buf, size);
2511 'SHA256' : SHA256Update(HashContext, @buf, size);
2512 'SHA3_512' : SHA3_512Update(HashContext, @buf, size);
2513 'SHA3_256' : SHA3_256Update(HashContext, @buf, size);
2514 'SHA1' : SHA1Update(HashContext, @buf, size);
2515 'BLAKE2S' : Blake2s_update(Blake2sContext,@buf,size);
2516 'BLAKE2B' : Blake2b_update(HashContext,@buf,size);
2517 'RIPEMD160' : RMD160Update(HashContext, @buf, size);
2518 'MD5' : MD5Update(HashContext, @buf, size);
2519 'CRC64' : CRC64Update(crc64, @buf, size);
2520 'CRC32' : CRC32Update(crc32, @buf, size);
2521 'ADLER32' : Adler32Update(adler, @buf, size);
2522 end;
2523 end;
2524
2525 procedure update_obj_control_algo(buf:array of byte; size:word);
2526 begin
2527 case upcase(obj_algo) of
2528 'WHIRLPOOL' : Whirl_Update(HashContext_obj, @buf, size);
2529 'SHA512' : SHA512Update(HashContext_obj, @buf, size);
2530 'SHA256' : SHA256Update(HashContext_obj, @buf, size);
2531 'SHA3_512' : SHA3_512Update(HashContext_obj, @buf, size);
2532 'SHA3_256' : SHA3_256Update(HashContext_obj, @buf, size);
2533 'SHA1' : SHA1Update(HashContext_obj, @buf, size);
2534 'BLAKE2S' : Blake2s_update(Blake2sContext_obj,@buf,size);
2535 'BLAKE2B' : Blake2b_update(HashContext_obj,@buf,size);
2536 'RIPEMD160' : RMD160Update(HashContext_obj, @buf, size);
2537 'MD5' : MD5Update(HashContext_obj, @buf, size);
2538 'CRC64' : CRC64Update(crc64_obj, @buf, size);
2539 'CRC32' : CRC32Update(crc32_obj, @buf, size);
2540 'ADLER32' : Adler32Update(adler_obj, @buf, size);
2541 end;
2542 end;
2543
2544 procedure update_volume_control_algo(buf:array of byte; size:word);
2545 begin
2546 case upcase(volume_algo) of
2547 'WHIRLPOOL' : Whirl_Update(HashContext_volume, @buf, size);
2548 'SHA512' : SHA512Update(HashContext_volume, @buf, size);
2549 'SHA256' : SHA256Update(HashContext_volume, @buf, size);
2550 'SHA3_512' : SHA3_512Update(HashContext_volume, @buf, size);
2551 'SHA3_256' : SHA3_256Update(HashContext_volume, @buf, size);
2552 'SHA1' : SHA1Update(HashContext_volume, @buf, size);
2553 'BLAKE2S' : Blake2s_update(Blake2sContext_volume,@buf,size);
2554 'BLAKE2B' : Blake2b_update(HashContext_volume,@buf,size);
2555 'RIPEMD160' : RMD160Update(HashContext_volume, @buf, size);
2556 'MD5' : MD5Update(HashContext_volume, @buf, size);
2557 'CRC64' : CRC64Update(crc64_volume, @buf, size);
2558 'CRC32' : CRC32Update(crc32_volume, @buf, size);
2559 'ADLER32' : Adler32Update(adler_volume, @buf, size);
2560 end;
2561 end;
2562
2563 procedure finish_control_algo;
2564 begin
2565 case upcase(algo) of
2566 'TRIATS':
2567 begin
2568 FCA_EAX256_final(cxe, auth);
2569 FCF_EAX256_final(cxf, auth2);
2570 FCS_EAX256_final(cxs, auth3);
2571 end;
2572 'TRITSA':
2573 begin
2574 FCF_EAX256_final(cxf, auth);
2575 FCS_EAX256_final(cxs, auth2);
2576 FCA_EAX256_final(cxe, auth3);
2577 end;
2578 'TRISAT':
2579 begin
2580 FCS_EAX256_final(cxs, auth);
2581 FCA_EAX256_final(cxe, auth2);
2582 FCF_EAX256_final(cxf, auth3);
2583 end;
2584 'EAX256' : FCA_EAX256_final(cxe, auth);
2585 'TF256' : FCf_EAX256_final(cxf, auth);
2586 'SP256' : FCs_EAX256_final(cxs, auth);
2587 'EAX' : FCA_EAX_final(cxe, auth);
2588 'TF' : FCf_EAX_final(cxf, auth);
2589 'SP' : FCs_EAX_final(cxs, auth);
2590 'HMAC' : FCA_HMAC_final(cxh, auth);
2591 'WHIRLPOOL' : Whirl_Final(HashContext,WHIRL512Digest);
2592 'SHA512' : SHA512Final(HashContext,SHA512Digest);
2593 'SHA256' : SHA256Final(HashContext,SHA256Digest);
2594 'SHA3_512' : SHA3_512Final(HashContext,SHA3_512Digest);
2595 'SHA3_256' : SHA3_256Final(HashContext,SHA3_256Digest);
2596 'SHA1' : SHA1Final(HashContext,SHA1Digest);
2597 'BLAKE2S' : blake2s_Final(Blake2sContext,Blake2sDigest);
2598 'BLAKE2B' : blake2b_Final(HashContext,Blake2bDigest);
2599 'RIPEMD160' : RMD160Final(HashContext,RMD160Digest);
2600 'MD5' : MD5Final(HashContext,MD5Digest);
2601 'CRC64' : CRC64Final(crc64);
2602 'CRC32' : CRC32Final(crc32);
2603 'ADLER32' : Adler32Final(adler);
2604 end;
2605 end;
2606
2607 procedure finish_obj_control_algo;
2608 begin
2609 case upcase(obj_algo) of
2610 'WHIRLPOOL' : Whirl_Final(HashContext_obj,WHIRL512Digest_obj);
2611 'SHA512' : SHA512Final(HashContext_obj,SHA512Digest_obj);
2612 'SHA256' : SHA256Final(HashContext_obj,SHA256Digest_obj);
2613 'SHA3_512' : SHA3_512Final(HashContext_obj,SHA3_512Digest_obj);
2614 'SHA3_256' : SHA3_256Final(HashContext_obj,SHA3_256Digest_obj);
2615 'SHA1' : SHA1Final(HashContext_obj,SHA1Digest_obj);
2616 'BLAKE2S' : blake2s_Final(Blake2sContext_obj,Blake2sDigest_obj);
2617 'BLAKE2B' : blake2b_Final(HashContext_obj,Blake2bDigest_obj);
2618 'RIPEMD160' : RMD160Final(HashContext_obj,RMD160Digest_obj);
2619 'MD5' : MD5Final(HashContext_obj,MD5Digest_obj);
2620 'CRC64' : CRC64Final(crc64_obj);
2621 'CRC32' : CRC32Final(crc32_obj);
2622 'ADLER32' : Adler32Final(adler_obj);
2623 end;
2624 end;
2625
2626 procedure finish_volume_control_algo;
2627 begin
2628 case upcase(volume_algo) of
2629 'WHIRLPOOL' : Whirl_Final(HashContext_volume,WHIRL512Digest_volume);
2630 'SHA512' : SHA512Final(HashContext_volume,SHA512Digest_volume);
2631 'SHA256' : SHA256Final(HashContext_volume,SHA256Digest_volume);
2632 'SHA3_512' : SHA3_512Final(HashContext_volume,SHA3_512Digest_volume);
2633 'SHA3_256' : SHA3_256Final(HashContext_volume,SHA3_256Digest_volume);
2634 'SHA1' : SHA1Final(HashContext_volume,SHA1Digest_volume);
2635 'BLAKE2S' : blake2s_Final(Blake2sContext_volume,Blake2sDigest_volume);
2636 'BLAKE2B' : blake2b_Final(HashContext_volume,Blake2bDigest_volume);
2637 'RIPEMD160' : RMD160Final(HashContext_volume,RMD160Digest_volume);
2638 'MD5' : MD5Final(HashContext_volume,MD5Digest_volume);
2639 'CRC64' : CRC64Final(crc64_volume);
2640 'CRC32' : CRC32Final(crc32_volume);
2641 'ADLER32' : Adler32Final(adler_volume);
2642 end;
2643 end;
2644
2645 procedure authenticate_stream;
2646 var
2647 k:dword;
2648 tag_match:boolean;
2649 ct384:THashContext;
2650 dg384:TSHA3_384Digest;
2651 begin
2652 if upcase(algo)<>'NOALGO' then
2653 begin
2654 for k:=0 to authsize-1 do exp_auth[k]:=sbuf1[k];
2655 case upcase(algo) of
2656 'TRIATS','TRITSA','TRISAT':
2657 begin
2658 for k:=0 to authsize-1 do sbuf1[k]:=auth[k];
2659 for k:=16 to 31 do sbuf1[k]:=auth2[k-16];
2660 for k:=32 to 47 do sbuf1[k]:=auth3[k-32];
2661 SHA3_384Init(ct384);
2662 SHA3_384Update(ct384, @sbuf1, 48);
2663 SHA3_384Final(ct384, dg384);
2664 for k:=0 to 47 do sbuf1[k]:=dg384[k];
2665 end;
2666 'EAX256','TF256','SP256','EAX','TF','SP','HMAC' : for k:=0 to authsize-1 do sbuf1[k]:=auth[k];
2667 'WHIRLPOOL' : for k:=0 to authsize-1 do sbuf1[k]:=WHIRL512Digest[k];
2668 'SHA512' : for k:=0 to authsize-1 do sbuf1[k]:=SHA512Digest[k];
2669 'SHA256' : for k:=0 to authsize-1 do sbuf1[k]:=SHA256Digest[k];
2670 'SHA3_512' : for k:=0 to authsize-1 do sbuf1[k]:=SHA3_512Digest[k];
2671 'SHA3_256' : for k:=0 to authsize-1 do sbuf1[k]:=SHA3_256Digest[k];
2672 'SHA1' : for k:=0 to authsize-1 do sbuf1[k]:=SHA1Digest[k];
2673 'BLAKE2S' : for k:=0 to authsize-1 do sbuf1[k]:=Blake2sDigest[k];
2674 'BLAKE2B' : for k:=0 to authsize-1 do sbuf1[k]:=Blake2bDigest[k];
2675 'RIPEMD160' : for k:=0 to authsize-1 do sbuf1[k]:=RMD160Digest[k];
2676 'MD5' : for k:=0 to authsize-1 do sbuf1[k]:=MD5Digest[k];
2677 'CRC64' :
2678 begin
2679 dword2bytebuf(crc64.lo32,sbuf1,0);
2680 dword2bytebuf(crc64.hi32,sbuf1,4);
2681 end;
2682 'CRC32' : dword2bytebuf(crc32,sbuf1,0);
2683 'ADLER32' : dword2bytebuf(adler,sbuf1,0);
2684 end;
2685 tag_match:=true;
2686 for k:=0 to authsize-1 do if sbuf1[k]<>exp_auth[k] then
2687 begin
2688 tag_match:=false;
2689 break;
2690 end;
2691 if tag_match=false then
2692 begin
2693 Form_pea.LabelDecrypt5.Caption:='The archive''s stream of data seem corrupted or tampered! You should not trust the stream''s content!';
2694 stream_error:=true;
2695 end
2696 else
2697 begin
2698 s:='';
2699 for k:=0 to authsize-1 do s:=s+hexstr(@sbuf1[k],1);
2700 if (upcase(algo)='TRIATS') or (upcase(algo)='TRITSA') or (upcase(algo)='TRISAT') or
2701 (upcase(algo)='EAX256') or (upcase(algo)='TF256') or (upcase(algo)='SP256') or
2702 (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
2703 else Form_pea.LabelDecrypt5.Caption:='Archive''s stream correctly verified';
2704 end;
2705 end;
2706 end;
2707
2708 procedure check_obj;
2709 var
2710 k:dword;
2711 tag_match:boolean;
2712 begin
2713 if upcase(obj_algo)<>'NOALGO' then
2714 begin
2715 for k:=0 to obj_authsize-1 do exp_obj_tags[nobj,k]:=sbuf1[k];
2716 case upcase(obj_algo) of
2717 'WHIRLPOOL' : for k:=0 to obj_authsize-1 do sbuf1[k]:=WHIRL512Digest_obj[k];
2718 'SHA512' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA512Digest_obj[k];
2719 'SHA256' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA256Digest_obj[k];
2720 'SHA3_512' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA3_512Digest_obj[k];
2721 'SHA3_256' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA3_256Digest_obj[k];
2722 'SHA1' : for k:=0 to obj_authsize-1 do sbuf1[k]:=SHA1Digest_obj[k];
2723 'BLAKE2S' : for k:=0 to obj_authsize-1 do sbuf1[k]:=Blake2sDigest_obj[k];
2724 'BLAKE2B' : for k:=0 to obj_authsize-1 do sbuf1[k]:=Blake2bDigest_obj[k];
2725 'RIPEMD160' : for k:=0 to obj_authsize-1 do sbuf1[k]:=RMD160Digest_obj[k];
2726 'MD5' : for k:=0 to obj_authsize-1 do sbuf1[k]:=MD5Digest_obj[k];
2727 'CRC64' :
2728 begin
2729 dword2bytebuf(crc64_obj.lo32,sbuf1,0);
2730 dword2bytebuf(crc64_obj.hi32,sbuf1,4);
2731 end;
2732 'CRC32' : dword2bytebuf(crc32_obj,sbuf1,0);
2733 'ADLER32' : dword2bytebuf(adler_obj,sbuf1,0);
2734 end;
2735 for k:=0 to obj_authsize-1 do obj_tags[nobj,k]:=sbuf1[k];
2736 tag_match:=true;
2737 for k:=0 to obj_authsize-1 do if obj_tags[nobj,k]<>exp_obj_tags[nobj,k] then
2738 begin
2739 tag_match:=false;
2740 break;
2741 end;
2742 if tag_match=true then status_objects[nobj]:='Object is OK'
2743 else
2744 begin
2745 status_objects[nobj]:='Wrong tag!';
2746 obj_error:=true;
2747 end;
2748 end;
2749 end;
2750
2751 procedure check_volume;
2752 var
2753 k:dword;
2754 tag_match:boolean;
2755 begin
2756 if upcase(volume_algo)<>'NOALGO' then
2757 begin
2758 for k:=0 to volume_authsize-1 do exp_volume_tags[j-1,k]:=tagbuf[k];
2759 case upcase(volume_algo) of
2760 'WHIRLPOOL' : for k:=0 to volume_authsize-1 do tagbuf[k]:=WHIRL512Digest_volume[k];
2761 'SHA512' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA512Digest_volume[k];
2762 'SHA256' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA256Digest_volume[k];
2763 'SHA3_512' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA3_512Digest_volume[k];
2764 'SHA3_256' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA3_256Digest_volume[k];
2765 'SHA1' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA1Digest_volume[k];
2766 'BLAKE2S' : for k:=0 to volume_authsize-1 do tagbuf[k]:=Blake2sDigest_volume[k];
2767 'BLAKE2B' : for k:=0 to volume_authsize-1 do tagbuf[k]:=Blake2bDigest_volume[k];
2768 'RIPEMD160' : for k:=0 to volume_authsize-1 do tagbuf[k]:=RMD160Digest_volume[k];
2769 'MD5' : for k:=0 to volume_authsize-1 do tagbuf[k]:=MD5Digest_volume[k];
2770 'CRC64' :
2771 begin
2772 dword2bytebuf(crc64_volume.lo32,tagbuf,0);
2773 dword2bytebuf(crc64_volume.hi32,tagbuf,4);
2774 end;
2775 'CRC32' : dword2bytebuf(crc32_volume,tagbuf,0);
2776 'ADLER32' : dword2bytebuf(adler_volume,tagbuf,0);
2777 end;
2778 for k:=0 to volume_authsize-1 do volume_tags[j-1,k]:=tagbuf[k];
2779 tag_match:=true;
2780 for k:=0 to volume_authsize-1 do if volume_tags[j-1,k]<>exp_volume_tags[j-1,k] then
2781 begin
2782 tag_match:=false;
2783 break;
2784 end;
2785 if tag_match=true then status_volumes[j-1]:='Volume is OK'
2786 else
2787 begin
2788 status_volumes[j-1]:='Wrong tag!';
2789 volume_error:=true;
2790 end;
2791 end;
2792 end;
2793
2794 procedure do_report_unPEA;
2795 var
2796 h,k,obj_ok:dword;
2797 s:ansistring;
2798 system_datetimeencoding:byte;
2799 begin
2800 get_system_datetimeencoding(system_datetimeencoding);
2801 Form_report.InputT.Caption:='Objects';
2802 Form_report.OutputT.Caption:='Volumes';
2803 Form_report.Caption:='Log UnPEA';
2804 Form_report.StringGrid1.ColCount:=8;
2805 Form_report.StringGrid1.Cells[0,0]:='Original object name';
2806 Form_report.StringGrid1.Cells[1,0]:='Status';
2807 Form_report.StringGrid1.Cells[2,0]:='Size (B)';
2808 Form_report.StringGrid1.Cells[3,0]:='Age';
2809 Form_report.StringGrid1.Cells[4,0]:='Attrib';
2810 Form_report.StringGrid1.Cells[5,0]:='Attrib n.';
2811 Form_report.StringGrid1.Cells[6,0]:='calculated ('+obj_algo+')';
2812 Form_report.StringGrid1.Cells[7,0]:='found';
2813 Form_report.StringGrid1.RowCount:=nobj+2;
2814 obj_ok:=0;
2815 for k:=0 to nobj do
2816 begin
2817 Form_report.StringGrid1.Cells[0,k+1]:=ansitoutf8(in_files[k]);
2818 Form_report.StringGrid1.Cells[1,k+1]:=status_objects[k];
2819 Form_report.StringGrid1.Cells[2,k+1]:=inttostr(fsizes[k]);
2820 if system_datetimeencoding=archive_datetimeencoding then
2821 begin
2822 try
2823 if ftimes[k]<>0 then Form_report.StringGrid1.Cells[3,k+1]:=datetimetostr(filedatetodatetime(ftimes[k]));
2824 except
2825 Form_report.StringGrid1.Cells[3,k+1]:='Non valid DateTime';
2826 end;
2827 end
2828 else Form_report.StringGrid1.Cells[3,k+1]:='DateTime conversion not available';
2829 Form_report.StringGrid1.Cells[4,k+1]:=fattr_dec[k];
2830 Form_report.StringGrid1.Cells[5,k+1]:=inttostr(fattr[k]);
2831 if upcase(obj_algo)<>'NOALGO' then
2832 begin
2833 s:='';
2834 for h:=0 to obj_authsize-1 do s:=s+hexstr(@obj_tags[k,h],1);
2835 Form_report.StringGrid1.Cells[6,k+1]:=s;
2836 s:='';
2837 for h:=0 to obj_authsize-1 do s:=s+hexstr(@exp_obj_tags[k,h],1);
2838 Form_report.StringGrid1.Cells[7,k+1]:=s;
2839 end;
2840 inc(obj_ok,1);
2841 end;
2842 Form_report.StringGrid1.AutosizeColumns;
2843 Form_report.StringGrid2.ColCount:=4;
2844 Form_report.StringGrid2.Cells[0,0]:='Volume';
2845 Form_report.StringGrid2.Cells[1,0]:='Status';
2846 Form_report.StringGrid2.Cells[2,0]:='calculated ('+volume_algo+')';
2847 Form_report.StringGrid2.Cells[3,0]:='found';
2848 Form_report.StringGrid2.RowCount:=j;
2849 for k:=0 to j-2 do
2850 begin
2851 if singlevolume=false then update_pea_filename((in_name),k+1,s)
2852 else s:=(in_name);
2853 Form_report.StringGrid2.Cells[0,k+1]:=s;
2854 if upcase(volume_algo)<>'NOALGO' then
2855 begin
2856 Form_report.StringGrid2.Cells[1,k+1]:=status_volumes[k];
2857 s:='';
2858 for h:=0 to volume_authsize-1 do s:=s+hexstr(@volume_tags[k,h],1);
2859 Form_report.StringGrid2.Cells[2,k+1]:=s;
2860 s:='';
2861 for h:=0 to volume_authsize-1 do s:=s+hexstr(@exp_volume_tags[k,h],1);
2862 Form_report.StringGrid2.Cells[3,k+1]:=s;
2863 end;
2864 end;
2865 Form_report.StringGrid2.AutosizeColumns;
2866 Form_report.Label1.Caption:=in_folder+in_name+'.* -> '+out_path+out_file+DirectorySeparator;
2867 Form_report.Label2.Caption:=Form_pea.LabelDecrypt4.Caption;
2868 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';
2869 Form_report.Label4.Caption:=Form_pea.LabelDecrypt5.Caption+' '+Form_pea.LabelDecrypt6.Caption
2870 end;
2871
2872 //clean keying-related variables
2873 procedure clean_keying_vars;
2874 var
2875 k:integer;
2876 begin
2877 for k:=0 to pw_len-1 do sbuf2[k]:=0;
2878 pw:='';
2879 password:='';
2880 keyfile_name:='';
2881 keyf_name:='';
2882 pw_len:=0;
2883 k:=0;
2884 end;
2885
2886 function report_errors:integer;
2887 var
2888 s:ansistring;
2889 begin
2890 result:=0;
2891 if (stream_error=false) and (obj_error=false) and (volume_error=false) then exit;
2892 result:=-1;
2893 s:='Error(s) found in: ';
2894 if stream_error=true then s:=s+'stream; ';
2895 if obj_error=true then s:=s+'object(s); ';
2896 if volume_error=true then s:=s+'volume(s); ';
2897 s:=s+'please check job log!';
2898 MessageDlg(s, mtError, [mbOK], 0);
2899 end;
2900
2901 begin
2902 exitcode:=-1;
2903 clean_variables;
2904 if (upcase(pw_param)<>'HIDDEN') and (upcase(pw_param)<>'HIDDEN_REPORT') then Form_pea.Visible:=true else Form_pea.Visible:=false;
2905 Form_pea.PanelDecrypt1.visible:=true;
2906 Form_pea.PanelEncrypt1.visible:=false;
2907 Form_pea.Caption:='UnPea';
2908 ts_start:=datetimetotimestamp(now);
2909 stream_error:=false;
2910 obj_error:=false;
2911 volume_error:=false;
2912 Form_pea.ProgressBar1.Position:=0;
2913 Form_pea.LabelDecrypt2.Caption:='Input: '+in_qualified_name;
2914 Form_pea.LabelDecrypt3.Caption:='Output: '+out_param;
2915 Form_pea.LabelTime1.Caption:='Opening archive...';
2916 in_folder:=extractfilepath(in_qualified_name);
2917 if in_folder='' then in_folder:=executable_path;
2918 in_file:=extractfilename(in_qualified_name);
2919 if upcase(copy(in_qualified_name,length(in_qualified_name)-10,11))<>'.000001.PEA' then
2920 begin
2921 singlevolume:=true;
2922 end
2923 else
2924 begin
2925 singlevolume:=false;
2926 delete(in_file,length(in_file)-10,11);
2927 end;
2928 in_name:=in_file;
2929 //try to evaluate archive size (succeed if all chunks are accessible)
2930 evaluate_archive_size(exp_space,cent_size);
2931 //check output name and path
2932 evaluate_output;
2933 //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)
2934 setcurrentdir(extractfilepath(out_param));
2935 if exp_space>diskfree(0) then
2936 if MessageDlg('Output path '+extractfilepath(out_param)+' seems to not have enough free space. Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
2937 else halt(-3);
2938 {blockread 10 byte archive header; since volume tag size is unknown to UnPEA,
2939 PEA set first volume size mandatory at least 10 byte (plus volume tag) in order
2940 to make UnPEA able to blockread the archive header and calculate the volume tag
2941 size}
2942 assignfile(f_in,in_qualified_name);
2943 filemode:=0;
2944 reset(f_in);
2945 blockread (f_in,sbuf1,10,numread);
2946 if IOResult<>0 then internal_error('IO error reading from '+in_qualified_name);
2947 close(f_in);
2948 test_pea_error('parsing archive header',pea_parse_archive_header(sbuf1,volume_algo,archive_datetimeencoding));
2949 decode_volume_control_algo (volume_algo,volume_authsize);
2950 //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)
2951 read_from_chunks ( in_folder,in_name,
2952 40,
2953 sbuf1,sbuf2,
2954 volume_authsize,
2955 40,
2956 singlevolume);
2957 for i:=0 to 22 do tagbuf[i]:=sbuf1[i]; //write plaintext header
2958 for i:=0 to 29 do sbuf1[i]:=sbuf1[i+10]; //discard 10 byte of archive header
2959 test_pea_error('parsing stream header',pea_parse_stream_header(sbuf1, compr, compr_level, algo, obj_algo));
2960 decode_control_algo ( algo,
2961 headersize,
2962 authsize,
2963 pwneeded);
2964 if compr<>'PCOMPRESS0' then headersize:=headersize+14//stream header size + 10 (archive header size) + 4 (compression buffer field size, if compression is used)
2965 else headersize:=headersize+10;
2966 decode_obj_control_algo (obj_algo,obj_authsize);
2967 for i:=0 to 19 do sbuf1[i]:=sbuf1[i+10]; //discard 10 bytes of stream header
2968 if pwneeded=true then //initialize AE (appending headers to password)
2969 begin
2970 //read AE header
2971 case upcase(algo) of
2972 'TRIATS','TRITSA','TRISAT':
2973 begin
2974 case upcase(algo) of
2975 'TRIATS': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr));
2976 'TRITSA': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaderf(sbuf1,fhdr));
2977 'TRISAT': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaders(sbuf1,shdr));
2978 end;
2979 read_from_chunks ( in_folder,in_name,
2980 56,
2981 sbuf1,sbuf2,
2982 volume_authsize,
2983 56,
2984 singlevolume);
2985 for i:=0 to 15 do sbuf1[i]:=sbuf1[i+36];
2986 case upcase(algo) of
2987 'TRIATS': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaderf(sbuf1,fhdr));
2988 'TRITSA': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaders(sbuf1,shdr));
2989 'TRISAT': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr));
2990 end;
2991 read_from_chunks ( in_folder,in_name,
2992 72,
2993 sbuf1,sbuf2,
2994 volume_authsize,
2995 72,
2996 singlevolume);
2997 for i:=0 to 15 do sbuf1[i]:=sbuf1[i+52];
2998 case upcase(algo) of
2999 'TRIATS': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaders(sbuf1,shdr));
3000 'TRITSA': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr));
3001 'TRISAT': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaderf(sbuf1,fhdr));
3002 end;
3003 end;
3004 'EAX','EAX256': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr));
3005 'TF','TF256': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaderf(sbuf1,fhdr));
3006 'SP','SP256': test_pea_error('parsing crypto subheader',pea_parse_crypto_subheaders(sbuf1,shdr));
3007 else test_pea_error('parsing crypto subheader',pea_parse_crypto_subheader(sbuf1,hdr))
3008 end;
3009 if (upcase(pw_param)='INTERACTIVE') or (upcase(pw_param)='INTERACTIVE_REPORT') then
3010 begin
3011 //password is pw string that was already entered in EditPW.Text
3012 //keyfile name is keyfile_name already entered
3013 end
3014 else
3015 begin
3016 pw:=password; //pw is got from commandline (not recommended)
3017 keyfile_name:=keyf_name; //keyfile name is got from command line
3018 end;
3019 pw_len:=length(pw);
3020 if pw_len=0 then internal_error('invalid password length');
3021 for k:=0 to pw_len-1 do sbuf2[k]:=ord(pw[k+1]);//copy password into an array of byte
3022 //append header to password's array (sbuf2)
3023 for k:=0 to 21 do sbuf2[pw_len+k]:=tagbuf[k];
3024 pw_len:=pw_len+22;
3025 //append keyfile to password's array (sbuf2)
3026 if upcase(keyfile_name)<>'NOKEYFILE' then
3027 test_pea_error('accessing keyfile',use_keyfile(keyfile_name,2048,numread,sbuf2,pw_len));
3028 //initialize AE
3029 if (upcase(algo)='TRIATS') or (upcase(algo)='TRITSA') or (upcase(algo)='TRISAT') or
3030 (upcase(algo)='EAX256') or (upcase(algo)='TF256') or (upcase(algo)='SP256') then init_AE256_control_algo
3031 else init_AE128_control_algo;
3032 clean_keying_vars;
3033 case upcase(algo) of
3034 'TRIATS','TRITSA','TRISAT': //remove masking of exact archive size, 1..128 byte of random data
3035 begin
3036 read_from_chunks ( in_folder,in_name,
3037 328,
3038 sbuf1,sbuf2,
3039 volume_authsize,
3040 328,
3041 singlevolume);
3042 sbuf1[0]:=sbuf1[68];
3043 update_control_algo(sbuf1,1);
3044 storead:=sbuf1[0];
3045 if storead>0 then
3046 for i:=0 to storead-1 do sbuf1[i]:=sbuf1[69+i];
3047 update_control_algo(sbuf1,storead);
3048 headersize:=headersize+storead+1;
3049 end;
3050 end;
3051 if (upcase(algo)='TRIATS') or (upcase(algo)='TRITSA') or (upcase(algo)='TRISAT') then
3052 for i:=0 to 3 do sbuf1[i]:=sbuf1[i+69+storead]
3053 else
3054 for i:=0 to 3 do sbuf1[i]:=sbuf1[i+16]; //discard 16 bytes of crypto subheader
3055 storead:=0;
3056 end
3057 //if AE is not used, initialize other control algorithms (and check headers)
3058 else
3059 begin
3060 init_nonAE_control_algo;
3061 update_control_algo(tagbuf,20);//check the archive and stream headers
3062 end;
3063 Form_pea.LabelDecrypt4.Caption:='Using: '+compr+', stream: '+algo+', objects: '+obj_algo+', volume(s): '+volume_algo;
3064 out_created:=false;
3065 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
3066 begin
3067 s:=out_file;
3068 j:=0;
3069 repeat
3070 if not(directoryexists(out_path+out_file)) and not(fileexists(out_path+out_file)) then
3071 try
3072 forcedirectories(out_path+out_file);
3073 out_created:=true;
3074 except
3075 out_file:=s+'output';
3076 out_created:=true;
3077 end
3078 else
3079 begin
3080 j:=j+1;
3081 out_file:=s+' - '+inttostr(j);
3082 if j=1000 then //to break recursivity if filename is not valid (ie unsupported character encoding)
3083 begin
3084 out_file:=s+'output';
3085 out_created:=true;
3086 end;
3087 end;
3088 {try //no longer works with Lazarus 0.9.30, exception is not returned
3089 mkdir(out_path+out_file);
3090 out_created:=true;
3091 except
3092 out_file:=s+' - '+inttostr(j);
3093 j:=j+1;
3094 end;}
3095 until out_created=true;
3096 setcurrentdir(out_param);
3097 end;
3098 Form_pea.LabelDecrypt3.Caption:='Output: '+out_path+out_file+DirectorySeparator;
3099 //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
3100 if compr<>'PCOMPRESS0' then
3101 begin
3102 update_control_algo(sbuf1,4);
3103 buf_size:=sbuf1[0] + (sbuf1[1] shl 8) + (sbuf1[2] shl 16) + (sbuf1[3] shl 24);
3104 end;
3105 // process the data
3106 uncompsize:=0;
3107 no_more_files:=false;
3108 chunks_ok:=true;
3109 readingstream:=true;
3110 readingheader:=true;
3111 readingfns:=false;
3112 readingtrigger:=false;
3113 readingfn:=false;
3114 readingfs:=false;
3115 readingfage:=false;
3116 readingfattrib:=false;
3117 readingcompsize:=false;
3118 fassigned:=false;
3119 readingf:=false;
3120 readingcompblock:=false;
3121 readingobjauth:=false;
3122 readingauth:=false;
3123 end_of_archive:=false;
3124 addr:=0;
3125 uncompsize:=0;
3126 j:=1;
3127 n_dirs:=0;
3128 n_input_files:=0;
3129 out_size:=0;
3130 wrk_space:=0;
3131 nobj:=-1;
3132 init_volume_control_algo;
3133 while (chunks_ok=true) and (end_of_archive=false) do
3134 begin
3135 if singlevolume=false then update_pea_filename(in_name,j,in_file);
3136 repeat
3137 if fileexists(in_folder+in_file) then
3138 begin
3139 try
3140 chunks_ok:=true;
3141 assignfile(f_in,in_folder+in_file);
3142 filemode:=0;
3143 reset(f_in);
3144 if IOResult<>0 then internal_error('IO error opening '+in_folder+in_file);
3145 srcfilesize(in_folder+in_file,total);
3146 total:=total-volume_authsize;
3147 //total:=system.filesize(f_in)-volume_authsize;
3148 while ((total>0) and (readingheader=true)) do //read and discard archive and stream headers
3149 begin
3150 if total>headersize-addr then i:=headersize-addr else i:=total;
3151 blockread (f_in,sbuf2,i,numread);
3152 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3153 update_volume_control_algo(sbuf2,numread);
3154 dec(total,numread);
3155 inc(wrk_space,numread);
3156 inc(addr,numread);
3157 if addr>=headersize then
3158 begin
3159 addr:=0;
3160 readingheader:=false;
3161 readingfns:=true;
3162 end;
3163 end;
3164 1:
3165 while ((total>0) and (readingfns=true)) do //read filename size;
3166 begin
3167 if total>2-addr then i:=2-addr else i:=total;
3168 blockread (f_in,sbuf2,i,numread);
3169 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3170 update_volume_control_algo(sbuf2,numread);
3171 dec(total,numread);
3172 inc(wrk_space,numread);
3173 for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
3174 inc(addr,numread);
3175 if addr>=2 then
3176 begin
3177 readingfns:=false;
3178 addr:=0;
3179 if readingstream=true then
3180 begin
3181 init_obj_control_algo;
3182 update_control_algo(sbuf1,2);
3183 update_obj_control_algo(sbuf1,2);
3184 end;
3185 fns:=sbuf1[0] + (sbuf1[1] shl 8);
3186 if fns>SBUFSIZE then internal_error('Object name size exceeds '+inttostr(SBUFSIZE));
3187 {pathnames longer than SBUFSIZE (usually exceeding actual needs,
3188 SBUFSIZE is originally defined as 32KB), are considered errors}
3189 if fns=0 then readingtrigger:=true //read a trigger object
3190 else
3191 begin
3192 readingtrigger:=false;
3193 readingfn:=true;
3194 inc(nobj,1);
3195 end;
3196 end;
3197 end;
3198 while ((total>0) and (readingtrigger=true)) do //read 4 byte trigger;
3199 begin
3200 if total>4-addr then i:=4-addr else i:=total;
3201 blockread (f_in,sbuf2,i,numread);
3202 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3203 update_volume_control_algo(sbuf2,numread);
3204 dec(total,numread);
3205 inc(wrk_space,numread);
3206 for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
3207 inc(addr,numread);
3208 if addr>=4 then
3209 begin
3210 readingtrigger:=false;
3211 addr:=0;
3212 update_control_algo(sbuf1,4);
3213 if ((sbuf1[0]=69) and (sbuf1[1]=79) and (sbuf1[2]=65) and (sbuf1[3]=0)) then //EOA
3214 begin
3215 if authsize<>0 then readingauth:=true;
3216 end_of_archive:=true;
3217 end
3218 else internal_error('Unrecognized trigger object');
3219 end;
3220 end;
3221 while ((total>0) and (readingfn=true)) do //read object name;
3222 begin
3223 if total>fns-addr then i:=fns-addr else i:=total;
3224 blockread (f_in,sbuf2,i,numread);
3225 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3226 update_volume_control_algo(sbuf2,numread);
3227 dec(total,numread);
3228 inc(wrk_space,numread);
3229 for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
3230 inc(addr,numread);
3231 if addr>=fns then
3232 begin
3233 readingfn:=false;
3234 readingfage:=true;
3235 addr:=0;
3236 fn:='';
3237 update_control_algo(sbuf1,fns);
3238 update_obj_control_algo(sbuf1,fns);
3239 for k:=0 to fns-1 do fn:=fn+char(sbuf1[k]);
3240 SetLength(in_files,length(in_files)+1);
3241 SetLength(status_objects,length(in_files)+1);
3242 SetLength(fsizes,length(in_files)+1);
3243 SetLength(ftimes,length(in_files)+1);
3244 SetLength(fattr,length(in_files)+1);
3245 SetLength(fattr_dec,length(in_files)+1);
3246 SetLength(obj_tags,length(in_files)+1);
3247 SetLength(exp_obj_tags,length(in_files)+1);
3248 in_files[nobj]:=fn;
3249 end;
3250 end;
3251 while ((total>0) and (readingfage=true)) do //read file date and time of last modification;
3252 begin
3253 if total>4-addr then i:=4-addr else i:=total;
3254 blockread (f_in,sbuf2,i,numread);
3255 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3256 update_volume_control_algo(sbuf2,numread);
3257 dec(total,numread);
3258 inc(wrk_space,numread);
3259 for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
3260 inc(addr,numread);
3261 if addr>=4 then
3262 begin
3263 readingfage:=false;
3264 readingfattrib:=true;
3265 addr:=0;
3266 update_control_algo(sbuf1,4);
3267 update_obj_control_algo(sbuf1,4);
3268 fage:=sbuf1[0] + (sbuf1[1] shl 8) + (sbuf1[2] shl 16) + (sbuf1[3] shl 24);
3269 ftimes[nobj]:=fage;
3270 end;
3271 end;
3272 while ((total>0) and (readingfattrib=true)) do //read file attributes;
3273 begin
3274 if total>4-addr then i:=4-addr else i:=total;
3275 blockread (f_in,sbuf2,i,numread);
3276 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3277 update_volume_control_algo(sbuf2,numread);
3278 dec(total,numread);
3279 inc(wrk_space,numread);
3280 for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
3281 inc(addr,numread);
3282 if addr>=4 then
3283 begin
3284 readingfattrib:=false;
3285 addr:=0;
3286 n_input_files:=n_input_files+1;
3287 update_control_algo(sbuf1,4);
3288 update_obj_control_algo(sbuf1,4);
3289 fattrib:=sbuf1[0] + (sbuf1[1] shl 8) + (sbuf1[2] shl 16) + (sbuf1[3] shl 24);
3290 fattr[nobj]:=fattrib;
3291 dword2decodedFileAttributes(fattrib,fattr_dec[nobj]);
3292 if fassigned=false then
3293 begin
3294 //dodirseparators(fn);
3295 dodirseparators(fn);
3296 if upcase(struct_param)='EXTRACT2DIR' then
3297 begin
3298 ansiextract2dir;
3299 if (total>0) and (fattrib and faDirectory <> 0) then //object is a dir
3300 begin
3301 n_dirs:=n_dirs+1;
3302 readingobjauth:=true;
3303 end;
3304 end;
3305 end;
3306 end;
3307 end;
3308 while ((total>0) and (readingfs=true)) do //read file size;
3309 begin
3310 if total>8-addr then i:=8-addr else i:=total;
3311 blockread (f_in,sbuf2,i,numread);
3312 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3313 update_volume_control_algo(sbuf2,numread);
3314 dec(total,numread);
3315 inc(wrk_space,numread);
3316 for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
3317 inc(addr,numread);
3318 if addr>=8 then
3319 begin
3320 readingfs:=false;
3321 addr:=0;
3322 update_control_algo(sbuf1,8);
3323 update_obj_control_algo(sbuf1,8);
3324 qw0:=sbuf1[0];
3325 qw1:=sbuf1[1];
3326 qw2:=sbuf1[2];
3327 qw3:=sbuf1[3];
3328 qw4:=sbuf1[4];
3329 qw5:=sbuf1[5];
3330 qw6:=sbuf1[6];
3331 qw7:=sbuf1[7];
3332 qw0:=qw0;
3333 qw1:=qw1 *256;
3334 qw2:=qw2 *256*256;
3335 qw3:=qw3 *256*256*256;
3336 qw4:=qw4 *256*256*256*256;
3337 qw5:=qw5 *256*256*256*256*256;
3338 qw6:=qw6 *256*256*256*256*256*256;
3339 qw7:=qw7 *256*256*256*256*256*256*256;
3340 fs:=qw0+qw1+qw2+qw3+qw4+qw5+qw6+qw7;
3341 //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);
3342 out_size:=out_size+fs;
3343 fsizes[nobj]:=fs;
3344 if fs>0 then
3345 if compr<>'PCOMPRESS0' then readingcompsize:=true
3346 else readingf:=true
3347 else //object is an empty file
3348 begin
3349 closefile(f_out);
3350 fassigned:=false;
3351 readingobjauth:=true;
3352 end;
3353 end;
3354 end;
3355 if compr<>'PCOMPRESS0' then //use compression
3356 begin
3357 while ((total>0) and (readingcompsize=true)) do
3358 begin
3359 if total>4-addr then i:=4-addr else i:=total;
3360 blockread (f_in,sbuf2,i,numread);
3361 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3362 update_volume_control_algo(sbuf2,numread);
3363 dec(total,numread);
3364 inc(wrk_space,numread);
3365 for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
3366 inc(addr,numread);
3367 if addr>=4 then
3368 begin
3369 readingcompsize:=false;
3370 readingf:=true;
3371 addr:=0;
3372 update_control_algo(sbuf1,4);
3373 update_obj_control_algo(sbuf1,4);
3374 compsize:=sbuf1[0] + (sbuf1[1] shl 8) + (sbuf1[2] shl 16) + (sbuf1[3] shl 24);
3375 end;
3376 end;
3377 while ((total>0) and (readingf=true)) do
3378 begin
3379 while ((total>0) and (addr<compsize+4)) do //read first compsize field for a compressed byte (buffer size was jet read)
3380 begin
3381 readingcompblock:=true;
3382 if total>compsize+4-addr then i:=compsize+4-addr else i:=total;
3383 blockread (f_in,wbuf2,i,numread);
3384 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3385 ci:=0;
3386 while ci<numread do
3387 begin
3388 if numread-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=numread-ci;
3389 for k:=0 to cj-1 do sbuf1[k]:=wbuf2[ci+k];
3390 update_volume_control_algo(sbuf1,cj);
3391 inc(ci,cj);
3392 end;
3393 dec(total,numread);
3394 inc(wrk_space,numread);
3395 for k:=0 to i-1 do wbuf1[addr+k]:=wbuf2[k];
3396 inc(addr,numread);
3397 if addr=compsize+4 then readingcompblock:=false;
3398 end;
3399 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)
3400 begin
3401 addr:=0;
3402 ci:=0;
3403 while ci<compsize+4 do
3404 begin
3405 if compsize+4-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=compsize+4-ci;
3406 for k:=0 to cj-1 do sbuf1[k]:=wbuf1[ci+k];
3407 update_control_algo(sbuf1,cj);
3408 for k:=0 to cj-1 do wbuf1[ci+k]:=sbuf1[k];
3409 inc(ci,cj);
3410 end;
3411 if fs>buf_size then k:=buf_size else k:=fs;
3412 uncompsize:=k;
3413 if compsize<k then zuncompr.uncompress(@wbuf2[0], uncompsize, wbuf1[0], compsize)
3414 else wbuf2:=wbuf1;
3415 ci:=0;
3416 while ci<uncompsize do
3417 begin
3418 if uncompsize-ci > SBUFSIZE then cj:=SBUFSIZE else cj:=uncompsize-ci;
3419 for k:=0 to cj-1 do sbuf1[k]:=wbuf2[ci+k];
3420 update_obj_control_algo(sbuf1,cj);
3421 inc(ci,cj);
3422 end;
3423 blockwrite (f_out,wbuf2,uncompsize,numwritten);
3424 if IOResult<>0 then internal_error('IO error writing data');
3425 dec(fs,numwritten);
3426 compsize:=wbuf1[compsize]+(wbuf1[compsize+1] shl 8)+(wbuf1[compsize+2] shl 16)+(wbuf1[compsize+3] shl 24);
3427 if compsize>WBUFSIZE then internal_error('Decompression error, declared compsize bigger than compression buffer');
3428 dword2bytebuf(compsize,sbuf1,0);
3429 update_obj_control_algo(sbuf1,4);
3430 Form_pea.ProgressBar1.Position:=(wrk_space) div cent_size;
3431 Application.ProcessMessages;
3432 end;
3433 if fs=0 then //end of compressed file, control if uncompsize of last block matches to what expected
3434 begin
3435 if compsize<>uncompsize then internal_error('Decompression error, uncompressed size doesn''t match with expected size');
3436 closefile(f_out);
3437 fassigned:=false;
3438 readingf:=false;
3439 readingobjauth:=true;
3440 end;
3441 end;
3442 end
3443 else //no compression
3444 while ((total>0) and (readingf=true)) do
3445 begin
3446 if total>SBUFSIZE then i:=SBUFSIZE else i:=total;
3447 if fs>i then else i:=fs;
3448 blockread (f_in,sbuf1,i,numread);
3449 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3450 update_volume_control_algo(sbuf1,numread);
3451 dec(total,numread);
3452 inc(wrk_space,numread);
3453 dec(fs,numread);
3454 update_control_algo(sbuf1,numread);
3455 update_obj_control_algo(sbuf1,numread);
3456 blockwrite (f_out,sbuf1,numread,numwritten);
3457 if IOResult<>0 then internal_error('IO error writing data');
3458 Form_pea.ProgressBar1.Position:=(wrk_space) div cent_size;
3459 Application.ProcessMessages;
3460 if fs=0 then
3461 begin
3462 closefile(f_out);
3463 fassigned:=false;
3464 readingf:=false;
3465 readingobjauth:=true;
3466 end;
3467 end;
3468 //read object check field
3469 while ((total>0) and (readingobjauth=true)) do
3470 begin
3471 if obj_algo='NOALGO' then
3472 begin
3473 readingobjauth:=false;
3474 readingfns:=true;
3475 addr:=0;
3476 if total>0 then goto 1;
3477 end;
3478 if total>obj_authsize-addr then i:=obj_authsize-addr else i:=total;
3479 blockread (f_in,sbuf2,i,numread);
3480 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3481 update_volume_control_algo(sbuf2,numread);
3482 dec(total,numread);
3483 inc(wrk_space,numread);
3484 for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
3485 inc(addr,numread);
3486 if addr>=obj_authsize then
3487 begin
3488 update_control_algo(sbuf1,obj_authsize);
3489 readingobjauth:=false;
3490 readingfns:=true;
3491 addr:=0;
3492 finish_obj_control_algo;
3493 check_obj;
3494 if total>0 then goto 1;
3495 end;
3496 end;
3497 //read auth block (if any);
3498 while (total>0) and (readingauth=true) do
3499 begin
3500 if total>authsize-addr then i:=authsize-addr else i:=total;
3501 blockread (f_in,sbuf2,i,numread);
3502 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3503 update_volume_control_algo(sbuf2,numread);
3504 dec(total,numread);
3505 inc(wrk_space,numread);
3506 for k:=0 to numread-1 do sbuf1[addr+k]:=sbuf2[k];
3507 inc(addr,numread);
3508 if addr=authsize then
3509 begin
3510 finish_control_algo;
3511 authenticate_stream;
3512 readingfns:=true;
3513 addr:=0;
3514 if total>0 then internal_error('Last volume seem to have wrong size');
3515 end;
3516 end;
3517 //read volume check block (if any);
3518 if (total=0) then
3519 begin
3520 SetLength(status_volumes,length(status_volumes)+1);
3521 SetLength(volume_tags,length(status_volumes)+1);
3522 SetLength(exp_volume_tags,length(status_volumes)+1);
3523 blockread (f_in,tagbuf,volume_authsize,numread);
3524 if IOResult<>0 then internal_error('IO error reading from '+in_folder+in_file);
3525 finish_volume_control_algo;
3526 check_volume;
3527 dec(total,numread);
3528 inc(wrk_space,numread);
3529 init_volume_control_algo;
3530 end;
3531 close(f_in);
3532 if IOResult<>0 then internal_error('IO error closing volume '+inttostr(j));
3533 j:=j+1;
3534 except
3535 try
3536 setcurrentdir(out_path);
3537 do_report_unpea;
3538 save_report('error log','txt',upcase(pw_param),out_path);
3539 except
3540 end;
3541 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);
3542 end;
3543 end
3544 else check_chunk(in_folder,j,chunks_ok);
3545 until (chunks_ok=true) or (end_of_archive=true);
3546 end;
3547 Form_pea.LabelDecrypt2.Caption:='Input: '+in_name+'.*, '+inttostr(j-1)+' volume(s), '+inttostr(wrk_space)+' B';
3548 Form_pea.LabelDecrypt3.Caption:='Output: '+out_path+out_file+DirectorySeparator;
3549 Form_pea.LabelDecrypt6.Caption:='Done '+struct_param+' on archive';
3550 Form_pea.ProgressBar1.Position:=100;
3551 setcurrentdir(out_path);
3552 do_report_unpea;
3553 timing(ts_start,wrk_space);
3554 Form_pea.LabelLog1.Visible:=true;
3555 Form_pea.LabelOpen.Caption:='Explore';
3556 output:=out_path+out_file;
3557 Form_pea.LabelOpen.visible:=true;
3558 Form_pea.ButtonDone1.Visible:=true;
3559 Form_pea.ButtonPeaExit1.Visible:=false;
3560 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);
3561 if report_errors =0 then
3562 begin
3563 exitcode:=0;
3564 sleep(500);
3565 if closepolicy>0 then Form_pea.Close;
3566 end
3567 else exitcode:=-2;
3568 end;
3569
3570 {
3571 Raw File Split
3572 Byte split a single input file in volumes of given size
3573 In an optional separate .check file are saved error checking tags of each volume
3574 The code is closely related to PEA, it's kept distinct for better readability
3575 }
3576
3577 procedure rfs;
3578 var
3579 out_param,volume_algo,in_qualified_name,pw_param:ansistring;
3580 ch_size:qword;
3581 volume_authsize:byte;
3582
3583 procedure parse_rfs_cl;
3584 begin
3585 try
3586 //output
3587 out_param:=(paramstr(2));
3588 //control chunk size
3589 if (upcase(paramstr(3))='ASK') then
3590 begin
3591 ch_size:=vol_size;
3592 volume_algo:=vol_algo;
3593 end
3594 else
3595 begin
3596 try
3597 ch_size:=strtoqword(paramstr(3));
3598 if ch_size=0 then ch_size:=1024*1024*1024*1024*1024; // if chunk size is set to 0 no chunks will be done
3599 except
3600 internal_error('"'+paramstr(3)+'" is not a valid chunk size; values allowed are 1..2^64, 0 to don''t split the input');
3601 end;
3602 //get volume control algorithm
3603 volume_algo:=upcase(paramstr(4));
3604 end;
3605 if decode_volume_control_algo(volume_algo,volume_authsize)<>0 then
3606 internal_error('"'+volume_algo+'" is not a valid control algorithm for volume check, please refer to the documentation for supported ones');
3607 //get operation mode
3608 pw_param:=upcase(paramstr(5));
3609 if (pw_param<>'BATCH') and (pw_param<>'HIDDEN') and (pw_param<>'BATCH_REPORT') and (pw_param<>'HIDDEN_REPORT') then
3610 internal_error('"'+pw_param+'" is not a valid operation mode parameter for RFS, please refer to the documentation');
3611 //input
3612 if (paramstr(6))<>'' then
3613 begin
3614 in_qualified_name:=(paramstr(6));
3615 if not fileexists(in_qualified_name) then
3616 internal_error('"'+in_qualified_name+'" file is not accessible');
3617 end
3618 else
3619 begin
3620 internal_error('No accessible input object found');
3621 end;
3622 except
3623 internal_error('Received incorrect Command Line. See the documentation for the correct synopsis.');
3624 end;
3625 end;
3626
3627 begin
3628 parse_rfs_cl;
3629 rfs_procedure(out_param,ch_size,volume_algo,volume_authsize,pw_param,in_qualified_name);
3630 end;
3631
3632 procedure rfs_lib_procedure ( out_param:ansistring; //qualified name for output volumes (without .(volume number) suffix) or AUTONAME
3633 ch_size:qword; //size of volumes, 0 for single volume (current implementation up to 2^64 byte of size for volume)
3634 volume_algo, //algorithm for volume integrity check
3635 in_qualified_name:ansistring; //qualified name of input file
3636 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
3637 var
3638 pw_param:ansistring;
3639 volume_authsize:byte;
3640 begin
3641 //control chunk size
3642 if ch_size=0 then ch_size:=1024*1024*1024*1024*1024; // if chunk size is set to 0 no chunks will be done
3643 //get volume control algorithm
3644 if decode_volume_control_algo(volume_algo,volume_authsize)<>0 then
3645 internal_error('"'+volume_algo+'" is not a valid control algorithm for volume check, please refer to the documentation for supported ones');
3646 //input
3647 if in_qualified_name='' then
3648 internal_error('No accessible input object found');
3649 if not fileexists(in_qualified_name) then
3650 internal_error('"'+in_qualified_name+'" file is not accessible');
3651 //get operation mode
3652 if (upcase(opmode)<>'BATCH') and (upcase(opmode)<>'HIDDEN') and (upcase(opmode)<>'BATCH_REPORT') and (upcase(opmode)<>'HIDDEN_REPORT') then
3653 internal_error('"'+upcase(opmode)+'" is not a valid operation mode parameter for rfs_lib_procedure, please refer to the documentation');
3654 pw_param:=upcase(opmode);
3655 rfs_procedure(out_param,ch_size,volume_algo,volume_authsize,pw_param,in_qualified_name);
3656 end;
3657
3658 procedure rfs_procedure ( out_param:ansistring;
3659 ch_size:qword;
3660 volume_algo:ansistring;
3661 volume_authsize:byte;
3662 pw_param:ansistring;
3663 in_qualified_name:ansistring);
3664 var
3665 HashContext_volume: THashContext;
3666 Whirl512Digest_volume: TWhirlDigest;
3667 SHA512Digest_volume: TSHA512Digest;
3668 SHA256Digest_volume: TSHA256Digest;
3669 SHA3_512Digest_volume: TSHA3_512Digest;
3670 SHA3_256Digest_volume: TSHA3_256Digest;
3671 SHA1Digest_volume: TSHA1Digest;
3672 RMD160Digest_volume: TRMD160Digest;
3673 MD5Digest_volume: TMD5Digest;
3674 Blake2sContext:blake2s_ctx;
3675 Blake2sDigest:TBlake2sDigest;
3676 Blake2bContext:THashContext;
3677 Blake2bDigest:TBlake2bDigest;
3678 crc64_volume:TCRC64;
3679 ts_start:TTimeStamp;
3680 f_in,f_out,f_check:file of byte;
3681 sbuf1:array [0..65535] of byte;
3682 auth_buf:array [0..63] of byte;
3683 adler_volume,crc32_volume:longint;
3684 j,ch_number_expected,numread,num_res:dword;
3685 file_size,total,cent_size,prog_size,in_size,out_size,check_size,exp_size,ch_res:qword;
3686 out_file,out_path,out_name:ansistring;
3687
3688 procedure clean_variables;
3689 begin
3690 j:=0;
3691 ch_number_expected:=0;
3692 numread:=0;
3693 num_res:=0;
3694 file_size:=0;
3695 total:=0;
3696 cent_size:=0;
3697 prog_size:=0;
3698 in_size:=0;
3699 out_size:=0;
3700 check_size:=0;
3701 exp_size:=0;
3702 ch_res:=0;
3703 end;
3704
3705 procedure init_volume_control_algo;
3706 begin
3707 case upcase(volume_algo) of
3708 'WHIRLPOOL' : Whirl_Init(HashContext_volume);
3709 'SHA512' : SHA512Init(HashContext_volume);
3710 'SHA256' : SHA256Init(HashContext_volume);
3711 'SHA3_512' : SHA3_512Init(HashContext_volume);
3712 'SHA3_256' : SHA3_256Init(HashContext_volume);
3713 'SHA1' : SHA1Init(HashContext_volume);
3714 'BLAKE2S' : Blake2s_Init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen);
3715 'BLAKE2B' : Blake2b_Init(Blake2bContext,nil,0,BLAKE2B_MaxDigLen);
3716 'RIPEMD160' : RMD160Init(HashContext_volume);
3717 'MD5' : MD5Init(HashContext_volume);
3718 'CRC64' : CRC64Init(crc64_volume);
3719 'CRC32' : CRC32Init(crc32_volume);
3720 'ADLER32' : Adler32Init(adler_volume);
3721 end;
3722 end;
3723
3724 procedure update_volume_control_algo(buf:array of byte; size:word);
3725 begin
3726 case upcase(volume_algo) of
3727 'WHIRLPOOL' : Whirl_Update(HashContext_volume, @buf, size);
3728 'SHA512' : SHA512Update(HashContext_volume, @buf, size);
3729 'SHA256' : SHA256Update(HashContext_volume, @buf, size);
3730 'SHA3_512' : SHA3_512Update(HashContext_volume, @buf, size);
3731 'SHA3_256' : SHA3_256Update(HashContext_volume, @buf, size);
3732 'SHA1' : SHA1Update(HashContext_volume, @buf, size);
3733 'BLAKE2S' : Blake2s_update(Blake2sContext,@buf,size);
3734 'BLAKE2B' : Blake2b_update(Blake2bContext,@buf,size);
3735 'RIPEMD160' : RMD160Update(HashContext_volume, @buf, size);
3736 'MD5' : MD5Update(HashContext_volume, @buf, size);
3737 'CRC64' : CRC64Update(crc64_volume, @buf, size);
3738 'CRC32' : CRC32Update(crc32_volume, @buf, size);
3739 'ADLER32' : Adler32Update(adler_volume, @buf, size);
3740 end;
3741 end;
3742
3743 procedure finish_volume_control_algo;
3744 begin
3745 case upcase(volume_algo) of
3746 'WHIRLPOOL' : Whirl_Final(HashContext_volume,WHIRL512Digest_volume);
3747 'SHA512' : SHA512Final(HashContext_volume,SHA512Digest_volume);
3748 'SHA256' : SHA256Final(HashContext_volume,SHA256Digest_volume);
3749 'SHA3_512' : SHA3_512Final(HashContext_volume,SHA3_512Digest_volume);
3750 'SHA3_256' : SHA3_256Final(HashContext_volume,SHA3_256Digest_volume);
3751 'SHA1' : SHA1Final(HashContext_volume,SHA1Digest_volume);
3752 'BLAKE2S' : blake2s_Final(Blake2sContext,Blake2sDigest);
3753 'BLAKE2B' : blake2b_Final(Blake2bContext,Blake2bDigest);
3754 'RIPEMD160' : RMD160Final(HashContext_volume,RMD160Digest_volume);
3755 'MD5' : MD5Final(HashContext_volume,MD5Digest_volume);
3756 'CRC64' : CRC64Final(crc64_volume);
3757 'CRC32' : CRC32Final(crc32_volume);
3758 'ADLER32' : Adler32Final(adler_volume);
3759 end;
3760 end;
3761
3762 procedure write_volume_check;
3763 var k:dword;
3764 begin
3765 if upcase(volume_algo)<>'NOALGO' then
3766 begin
3767 case upcase(volume_algo) of
3768 'WHIRLPOOL' : for k:=0 to volume_authsize-1 do auth_buf[k]:=WHIRL512Digest_volume[k];
3769 'SHA512' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA512Digest_volume[k];
3770 'SHA256' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA256Digest_volume[k];
3771 'SHA3_512' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA3_512Digest_volume[k];
3772 'SHA3_256' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA3_256Digest_volume[k];
3773 'SHA1' : for k:=0 to volume_authsize-1 do auth_buf[k]:=SHA1Digest_volume[k];
3774 'BLAKE2S' : for k:=0 to volume_authsize-1 do auth_buf[k]:=Blake2sDigest[k];
3775 'BLAKE2B' : for k:=0 to volume_authsize-1 do auth_buf[k]:=Blake2bDigest[k];
3776 'RIPEMD160' : for k:=0 to volume_authsize-1 do auth_buf[k]:=RMD160Digest_volume[k];
3777 'MD5' : for k:=0 to volume_authsize-1 do auth_buf[k]:=MD5Digest_volume[k];
3778 'CRC64' :
3779 begin
3780 dword2bytebuf(crc64_volume.lo32,auth_buf,0);
3781 dword2bytebuf(crc64_volume.hi32,auth_buf,4);
3782 end;
3783 'CRC32' : dword2bytebuf(crc32_volume,auth_buf,0);
3784 'ADLER32' : dword2bytebuf(adler_volume,auth_buf,0);
3785 end;
3786 for k:=0 to volume_authsize-1 do volume_tags[j-1,k]:=auth_buf[k];
3787 blockwrite (f_check,auth_buf,volume_authsize);
3788 check_size:=check_size+volume_authsize;
3789 end;
3790 end;
3791
3792 procedure write2chunks ( var num_res: dword; //amount of data to write
3793 var sbuf1: array of byte; //data buffer
3794 var f_out:fileofbyte; //output file
3795 var out_path,out_name: ansistring; //name and path for the output;
3796 var i: dword; //chunk progressive number
3797 var ch_size:qword; //chunk size
3798 var ch_res: qword); //residual space in the given chunk
3799 var k,numwritten:dword;
3800 addr,buf:qword;
3801 out_file:ansistring;
3802 begin
3803 addr:=0;
3804 numwritten:=0;
3805 while num_res>0 do
3806 begin
3807 if num_res<=ch_res then
3808 begin
3809 blockwrite (f_out,sbuf1,num_res,numwritten);
3810 if IOResult<>0 then internal_error('IO error writing to volume '+inttostr(i));
3811 update_volume_control_algo(sbuf1,numwritten);
3812 num_res:=num_res-numwritten;
3813 ch_res:=ch_res-numwritten;
3814 addr:=0;
3815 end
3816 else
3817 begin
3818 SetLength(volume_tags,length(volume_tags)+1);
3819 blockwrite (f_out,sbuf1,ch_res,numwritten);
3820 if IOResult<>0 then internal_error('IO error writing to volume '+inttostr(i));
3821 update_volume_control_algo(sbuf1,numwritten);
3822 finish_volume_control_algo;
3823 write_volume_check;
3824 if IOResult<>0 then internal_error('IO error writing volume control tag to volume '+inttostr(i));
3825 close(f_out);
3826 if IOResult<>0 then internal_error('IO error closing volume '+inttostr(i));
3827 i:=i+1;
3828 update_rfs_filename(out_name,i,out_file);
3829 checkspace(out_path,ch_size);
3830 assignfile(f_out,out_path+out_file);
3831 rewrite(f_out); //it will overwrite orphaned files with same name to preserve name coherence
3832 if IOResult<>0 then internal_error('IO error opening volume '+inttostr(i));
3833 init_volume_control_algo;
3834 num_res:=num_res-numwritten;
3835 if num_res<ch_size then buf:=num_res else buf:=ch_size;
3836 addr:=addr+numwritten;
3837 for k:=0 to buf do sbuf1[k]:=sbuf1[addr+k];
3838 ch_res:=ch_size;
3839 end;
3840 end;
3841 end;
3842
3843 procedure nocompress_file;
3844 begin
3845 while ((numread<>0) and (total<file_size)) do
3846 begin
3847 blockread (f_in,sbuf1,SBUFSIZE,numread);
3848 if IOResult<>0 then internal_error('IO error reading from '+in_qualified_name);
3849 inc(total,numread);
3850 inc(prog_size,numread);
3851 num_res:=numread;
3852 write2chunks ( num_res,
3853 sbuf1,
3854 f_out,
3855 out_path,out_name,
3856 j,
3857 ch_size,
3858 ch_res);
3859 Form_pea.ProgressBar1.Position:=prog_size div cent_size;
3860 Application.ProcessMessages;
3861 end;
3862 end;
3863
3864 procedure first_gui_output;
3865 begin
3866 Form_pea.ProgressBar1.Position:=0;
3867 Form_pea.LabelEncrypt2.Caption:='Input: '+in_qualified_name;
3868 Form_pea.LabelEncrypt3.Caption:='Output: '+out_param;
3869 Form_pea.LabelEncrypt4.Caption:='Integrity check algorithm: '+volume_algo;
3870 Form_pea.LabelTime1.Caption:='Splitting file in volumes...';
3871 Form_pea.Panel1.visible:=false;
3872 Form_pea.LabelE1.Visible:=false;
3873 end;
3874
3875 procedure evaluate_volumes;
3876 begin
3877 ch_number_expected:=(in_size div ch_size)+1;
3878 if (exp_size mod ch_size)=0 then ch_number_expected:=ch_number_expected-1;
3879 if ch_number_expected>9999 then
3880 if MessageDlg('Expected '+inttostr(ch_number_expected)+' volumes. It seems a lot! Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
3881 else halt(-3);
3882 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'
3883 else Form_pea.LabelEncrypt5.Caption:='Expected a single volume of '+inttostr(exp_size)+' B of size';
3884 end;
3885
3886 procedure evaluate_output;
3887 begin
3888 if upcase(out_param) = 'AUTONAME' then out_param:=in_qualified_name;
3889 out_file:=extractfilename(out_param);
3890 out_path:=extractfilepath(out_param);
3891 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
3892 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
3893 if out_path='' then out_path:=executable_path;
3894 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
3895 if out_path[length(out_path)]<>DirectorySeparator then out_path:=out_path+DirectorySeparator;
3896 Form_pea.LabelEncrypt3.Caption:='Output: '+out_path+out_file;
3897 if exp_size>diskfree(0) then
3898 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
3899 else halt(-3);
3900 end;
3901
3902 procedure do_report_rfs;
3903 var
3904 k,h:dword;
3905 s:ansistring;
3906 begin
3907 Form_report.InputT.Caption:='Input';
3908 Form_report.OutputT.Caption:='Output';
3909 Form_report.Caption:='Split file log';
3910 Form_report.StringGrid1.ColCount:=3;
3911 Form_report.StringGrid1.Cells[0,0]:='Original object name';
3912 Form_report.StringGrid1.Cells[1,0]:='Status';
3913 Form_report.StringGrid1.Cells[2,0]:='Size (B)';
3914 Form_report.StringGrid1.RowCount:=2;
3915 Form_report.StringGrid1.Cells[0,1]:=in_qualified_name;
3916 Form_report.StringGrid1.Cells[1,1]:='OK';
3917 Form_report.StringGrid1.Cells[2,1]:=inttostr(file_size);
3918 Form_report.StringGrid1.AutosizeColumns;
3919 Form_report.StringGrid2.ColCount:=2;
3920 Form_report.StringGrid2.Cells[0,0]:='Volume';
3921 Form_report.StringGrid2.Cells[1,0]:=volume_algo;
3922 Form_report.StringGrid2.RowCount:=j+1;
3923 for k:=0 to j-1 do
3924 begin
3925 Form_report.StringGrid2.Cells[0,k+1]:=inttostr(k+1);
3926 if upcase(volume_algo)<>'NOALGO' then
3927 begin
3928 s:='';
3929 for h:=0 to volume_authsize-1 do s:=s+hexstr(@volume_tags[k,h],1);
3930 Form_report.StringGrid2.Cells[1,k+1]:=s;
3931 end;
3932 end;
3933 Form_report.StringGrid2.AutosizeColumns;
3934 //operation parameters
3935 Form_report.Label1.Caption:=Form_pea.LabelEncrypt4.Caption;
3936 //input
3937 Form_report.Label2.Caption:='Split '+in_qualified_name+'; input '+inttostr(file_size)+' B';
3938 //output
3939 Form_report.Label3.Caption:=Form_pea.LabelEncrypt6.Caption;
3940 //output name
3941 Form_report.Label4.Caption:=Form_pea.LabelEncrypt3.Caption;
3942 end;
3943
3944 procedure last_gui_output;
3945 begin
3946 Form_pea.ProgressBar1.Position:=100;
3947 Form_pea.LabelEncrypt3.Caption:='Output: '+out_path+out_name+'.*';
3948 out_size:=prog_size;
3949 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'
3950 else Form_pea.LabelEncrypt6.Caption:='Single volume archive of '+inttostr(out_size)+' B';
3951 if upcase(volume_algo)<>'NOALGO' then Form_pea.LabelEncrypt6.Caption:=Form_pea.LabelEncrypt6.Caption+' + '+inttostr(check_size)+' B (check tags)';
3952 do_report_rfs;
3953 Form_pea.LabelEncrypt5.Caption:=Form_report.Label2.Caption;
3954 Form_pea.LabelEncrypt4.Visible:=true;
3955 Form_pea.LabelEncrypt5.Visible:=true;
3956 Form_pea.LabelEncrypt6.Visible:=true;
3957 end;
3958
3959 begin
3960 exitcode:=-1;
3961 clean_variables;
3962 if (upcase(pw_param)<>'HIDDEN') and (upcase(pw_param)<>'HIDDEN_REPORT') then Form_pea.Visible:=true else Form_pea.Visible:=false;
3963 Form_pea.PanelDecrypt1.visible:=false;
3964 Form_pea.PanelEncrypt1.visible:=true;
3965 Form_pea.Caption:='Split file';
3966 ts_start:=datetimetotimestamp(now);
3967 //give preliminary information on work status to the GUI
3968 first_gui_output;
3969 assignfile(f_in,in_qualified_name);
3970 filemode:=0;
3971 reset(f_in);
3972 if IOResult<>0 then internal_error('IO error opening '+in_qualified_name);
3973 srcfilesize(in_qualified_name,file_size);
3974 //file_size:=system.filesize(f_in);
3975 if file_size=0 then internal_error('The file is empty, cannot be split');
3976 if ch_size>file_size then ch_size:=file_size;
3977 cent_size:=(file_size div 100)+1; //1% of expected output size, used for progress indication
3978 //evaluate volumes number;
3979 //at 9999 objects the program will warn and proceed only after user's permission,
3980 //however the program has no sort of problem until 999999 chunks (but the host
3981 //system may!)
3982 evaluate_volumes;
3983 //get output path and name;
3984 //evaluate if the path has enough free space for expected output.
3985 evaluate_output;
3986 //check if output path has room for a chunk of given size (mandatory)
3987 checkspace(out_path,ch_size);
3988 //start the actual operation routine
3989 out_name:=out_file;
3990 assignfile(f_out,out_file+'.001');//current dir was jet set to out_path
3991 rewrite(f_out);
3992 if IOResult<>0 then internal_error('IO error creating first output volume');
3993 if upcase(volume_algo)<>'NOALGO' then
3994 begin
3995 assignfile(f_check,out_file+'.check');
3996 rewrite(f_check);
3997 if IOResult<>0 then internal_error('IO error creating .check file');
3998 rfs_create_checkfile_hdr(volume_algo,sbuf1);
3999 blockwrite(f_check,sbuf1,4);
4000 if IOResult<>0 then internal_error('IO error writing to .check file');
4001 check_size:=4;
4002 init_volume_control_algo;
4003 end;
4004 j:=1;
4005 //1) split file in chunks
4006 total:=0;
4007 numread:=1;
4008 ch_res:=ch_size;
4009 nocompress_file; //no compression
4010 //last volume check
4011 SetLength(volume_tags,length(volume_tags)+1);
4012 finish_volume_control_algo;
4013 write_volume_check;
4014 if IOResult<>0 then internal_error('IO error writing last volume check');
4015 closefile(f_in);
4016 if IOResult<>0 then internal_error('IO error closing '+in_qualified_name);
4017 closefile(f_out);
4018 if IOResult<>0 then internal_error('IO error closing last output volume');
4019 if upcase(volume_algo)<>'NOALGO' then
4020 begin
4021 closefile(f_check);
4022 if IOResult<>0 then internal_error('IO error closing .check file');
4023 end;
4024 //give final job information to the GUI
4025 last_gui_output;
4026 //calculate operation time
4027 timing(ts_start,out_size);
4028 //make accessible exit button and link to the detailed job log
4029 Form_pea.LabelLog1.Visible:=true;
4030 Form_pea.LabelOpen.Caption:='Explore';
4031 output:=out_path;
4032 Form_pea.LabelOpen.visible:=true;
4033 Form_pea.ButtonDone1.Visible:=true;
4034 Form_pea.ButtonPeaExit.Visible:=false;
4035 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);
4036 exitcode:=0;
4037 Sleep(500);
4038 if closepolicy>0 then Form_pea.Close;
4039 end;
4040
4041 {
4042 Raw File Join
4043 Byte join volumes with same name and progressive counter extension in a single
4044 output file
4045 Optionally error check each volume with information provided by a separate
4046 .check file
4047 The code is closely related to UnPEA, it's kept distinct for better readability
4048 }
4049
4050 procedure rfj;
4051 var
4052 in_qualified_name,out_param,pw_param:ansistring;
4053
4054 procedure parse_rfj_cl;
4055 begin
4056 try
4057 in_qualified_name:=(paramstr(2));
4058 if not(fileexists(in_qualified_name)) then
4059 internal_error('"'+in_qualified_name+'" not exist');
4060 //get operation mode
4061 pw_param:=upcase(paramstr(3));
4062 if (pw_param<>'BATCH') and (pw_param<>'HIDDEN') and (pw_param<>'BATCH_REPORT') and (pw_param<>'HIDDEN_REPORT') then
4063 internal_error('"'+pw_param+'" is not a valid operation mode parameter for RFJ, please refer to the documentation');
4064 out_param:=(paramstr(4));
4065 except
4066 internal_error('Received incorrect Command Line. See the documentation for the correct synopsis.');
4067 end;
4068 end;
4069
4070 begin
4071 parse_rfj_cl;
4072 rfj_procedure(in_qualified_name,pw_param,out_param);
4073 end;
4074
4075 procedure rfj_lib_procedure ( in_qualified_name, //qualified name of first volume of the split file
4076 out_param, //qualified name to give to the output rejoined file (or AUTONAME)
4077 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
4078 var
4079 pw_param:ansistring;
4080 begin
4081 if not(fileexists(in_qualified_name)) then
4082 internal_error('"'+in_qualified_name+'" not exist');
4083 //get operation mode
4084 if (upcase(opmode)<>'BATCH') and (upcase(opmode)<>'HIDDEN') and (upcase(opmode)<>'BATCH_REPORT') and (upcase(opmode)<>'HIDDEN_REPORT') then
4085 internal_error('"'+upcase(opmode)+'" is not a valid operation mode parameter for rfj_lib_procedure, please refer to the documentation');
4086 pw_param:=upcase(opmode);
4087 rfj_procedure(in_qualified_name,pw_param,out_param);
4088 end;
4089
4090 procedure rfj_procedure ( in_qualified_name,
4091 pw_param,
4092 out_param:ansistring);
4093 var
4094 HashContext_volume: THashContext;
4095 Whirl512Digest_volume: TWhirlDigest;
4096 SHA512Digest_volume: TSHA512Digest;
4097 SHA256Digest_volume: TSHA256Digest;
4098 SHA3_512Digest_volume: TSHA3_512Digest;
4099 SHA3_256Digest_volume: TSHA3_256Digest;
4100 SHA1Digest_volume: TSHA1Digest;
4101 RMD160Digest_volume: TRMD160Digest;
4102 MD5Digest_volume: TMD5Digest;
4103 Blake2sContext:blake2s_ctx;
4104 Blake2sDigest:TBlake2sDigest;
4105 Blake2bContext:THashContext;
4106 Blake2bDigest:TBlake2bDigest;
4107 crc64_volume: TCRC64;
4108 ts_start:TTimeStamp;
4109 f_in,f_out,f_check:file of byte;
4110 sbuf1:array [0..65535] of byte;
4111 tagbuf:array [0..63] of byte;
4112 volume_authsize:byte;
4113 adler_volume,crc32_volume:longint;
4114 i,j,numread,numwritten,n_chunks:dword;
4115 total,prog_size,wrk_space,exp_space:qword;
4116 chunks_ok,no_more_files,filenamed:boolean;
4117 in_file,in_name,in_folder,out_path,out_file,volume_algo:ansistring;
4118
4119 procedure clean_variables;
4120 begin
4121 i:=0;
4122 j:=0;
4123 numread:=0;
4124 numwritten:=0;
4125 n_chunks:=0;
4126 total:=0;
4127 prog_size:=0;
4128 wrk_space:=0;
4129 exp_space:=0;
4130 end;
4131
4132 procedure evaluate_file_size(var exp_space:qword; var prog_size:qword); //succeed if all chunks are accessible
4133 var qw:qword;
4134 begin
4135 j:=1;
4136 no_more_files:=false;
4137 exp_space:=0;
4138 while no_more_files=false do
4139 begin
4140 update_rfs_filename(in_name,j,in_file);
4141 if fileexists(in_folder+in_file) then
4142 begin
4143 assignfile(f_in,in_folder+in_file);
4144 filemode:=0;
4145 reset(f_in);
4146 srcfilesize(in_folder+in_file,qw);
4147 exp_space:=exp_space+qw;
4148 //exp_space:=exp_space+system.filesize(f_in);
4149 closefile(f_in);
4150 j:=j+1;
4151 end
4152 else no_more_files:=true;
4153 end;
4154 n_chunks:=j-1;
4155 prog_size:=(exp_space div 100)+1;
4156 Form_pea.LabelDecrypt2.Caption:='Input: '+in_name+'.*, expected '+inttostr(n_chunks)+' volume(s), total '+inttostr(exp_space)+' B';
4157 end;
4158
4159 procedure evaluate_output;
4160 var
4161 k:integer;
4162 name_ok:boolean;
4163 begin
4164 if upcase(out_param) = 'AUTONAME' then out_param:=in_folder+in_name;//the extension was already removed from in_file name
4165 k:=0;
4166 name_ok:=false;
4167 repeat
4168 if k=0 then
4169 if fileexists(out_param) or directoryexists(out_param) then inc(k,1)
4170 else name_ok:=true
4171 else
4172 if fileexists(out_param+' - '+inttostr(k)+extractfileext(out_param)) or directoryexists(out_param+' - '+inttostr(k)+extractfileext(out_param)) then inc(k,1)
4173 else name_ok:=true;
4174 until name_ok = true;
4175 if k>0 then out_param:=out_param+' - '+inttostr(k)+extractfileext(out_param);
4176 out_file:=extractfilename(out_param);
4177 out_path:=extractfilepath(out_param);
4178 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
4179 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
4180 if out_path='' then out_path:=executable_path;
4181 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
4182 if out_path[length(out_path)]<>DirectorySeparator then out_path:=out_path+DirectorySeparator;
4183 Form_pea.LabelDecrypt3.Caption:='Input: '+out_path+out_file;
4184 if exp_space>diskfree(0) then
4185 if MessageDlg('Output path '+out_path+' seems to not have enough free space. Continue anyway?',mtWarning,[mbYes, mbNo],0)=6 then
4186 else halt(-3);
4187 end;
4188
4189 procedure init_volume_control_algo;
4190 begin
4191 case upcase(volume_algo) of
4192 'WHIRLPOOL' : Whirl_Init(HashContext_volume);
4193 'SHA512' : SHA512Init(HashContext_volume);
4194 'SHA256' : SHA256Init(HashContext_volume);
4195 'SHA3_512' : SHA3_512Init(HashContext_volume);
4196 'SHA3_256' : SHA3_256Init(HashContext_volume);
4197 'SHA1' : SHA1Init(HashContext_volume);
4198 'BLAKE2S' : Blake2s_Init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen);
4199 'BLAKE2B' : Blake2b_Init(Blake2bContext,nil,0,BLAKE2B_MaxDigLen);
4200 'RIPEMD160' : RMD160Init(HashContext_volume);
4201 'MD5' : MD5Init(HashContext_volume);
4202 'CRC64' : CRC64Init(crc64_volume);
4203 'CRC32' : CRC32Init(crc32_volume);
4204 'ADLER32' : Adler32Init(adler_volume);
4205 end;
4206 end;
4207
4208 procedure update_volume_control_algo(buf:array of byte; size:word);
4209 begin
4210 case upcase(volume_algo) of
4211 'WHIRLPOOL' : Whirl_Update(HashContext_volume, @buf, size);
4212 'SHA512' : SHA512Update(HashContext_volume, @buf, size);
4213 'SHA256' : SHA256Update(HashContext_volume, @buf, size);
4214 'SHA3_512' : SHA3_512Update(HashContext_volume, @buf, size);
4215 'SHA3_256' : SHA3_256Update(HashContext_volume, @buf, size);
4216 'SHA1' : SHA1Update(HashContext_volume, @buf, size);
4217 'BLAKE2S' : Blake2s_update(Blake2sContext,@buf,size);
4218 'BLAKE2B' : Blake2b_update(Blake2bContext,@buf,size);
4219 'RIPEMD160' : RMD160Update(HashContext_volume, @buf, size);
4220 'MD5' : MD5Update(HashContext_volume, @buf, size);
4221 'CRC64' : CRC64Update(crc64_volume, @buf, size);
4222 'CRC32' : CRC32Update(crc32_volume, @buf, size);
4223 'ADLER32' : Adler32Update(adler_volume, @buf, size);
4224 end;
4225 end;
4226
4227 procedure finish_volume_control_algo;
4228 begin
4229 case upcase(volume_algo) of
4230 'WHIRLPOOL' : Whirl_Final(HashContext_volume,WHIRL512Digest_volume);
4231 'SHA512' : SHA512Final(HashContext_volume,SHA512Digest_volume);
4232 'SHA256' : SHA256Final(HashContext_volume,SHA256Digest_volume);
4233 'SHA3_512' : SHA3_512Final(HashContext_volume,SHA3_512Digest_volume);
4234 'SHA3_256' : SHA3_256Final(HashContext_volume,SHA3_256Digest_volume);
4235 'SHA1' : SHA1Final(HashContext_volume,SHA1Digest_volume);
4236 'BLAKE2S' : blake2s_Final(Blake2sContext,Blake2sDigest);
4237 'BLAKE2B' : blake2b_Final(Blake2bContext,Blake2bDigest);
4238 'RIPEMD160' : RMD160Final(HashContext_volume,RMD160Digest_volume);
4239 'MD5' : MD5Final(HashContext_volume,MD5Digest_volume);
4240 'CRC64' : CRC64Final(crc64_volume);
4241 'CRC32' : CRC32Final(crc32_volume);
4242 'ADLER32' : Adler32Final(adler_volume);
4243 end;
4244 end;
4245
4246 procedure check_volume;
4247 var
4248 k:dword;
4249 tag_match:boolean;
4250 begin
4251 if upcase(volume_algo)<>'NOALGO' then
4252 begin
4253 for k:=0 to volume_authsize-1 do exp_volume_tags[j-1,k]:=tagbuf[k];
4254 case upcase(volume_algo) of
4255 'WHIRLPOOL' : for k:=0 to volume_authsize-1 do tagbuf[k]:=WHIRL512Digest_volume[k];
4256 'SHA512' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA512Digest_volume[k];
4257 'SHA256' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA256Digest_volume[k];
4258 'SHA3_512' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA3_512Digest_volume[k];
4259 'SHA3_256' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA3_256Digest_volume[k];
4260 'BLAKE2S' : for k:=0 to volume_authsize-1 do tagbuf[k]:=Blake2sDigest[k];
4261 'BLAKE2B' : for k:=0 to volume_authsize-1 do tagbuf[k]:=Blake2bDigest[k];
4262 'SHA1' : for k:=0 to volume_authsize-1 do tagbuf[k]:=SHA1Digest_volume[k];
4263 'RIPEMD160' : for k:=0 to volume_authsize-1 do tagbuf[k]:=RMD160Digest_volume[k];
4264 'MD5' : for k:=0 to volume_authsize-1 do tagbuf[k]:=MD5Digest_volume[k];
4265 'CRC64' :
4266 begin
4267 dword2bytebuf(crc64_volume.lo32,tagbuf,0);
4268 dword2bytebuf(crc64_volume.hi32,tagbuf,4);
4269 end;
4270 'CRC32' : dword2bytebuf(crc32_volume,tagbuf,0);
4271 'ADLER32' : dword2bytebuf(adler_volume,tagbuf,0);
4272 end;
4273 for k:=0 to volume_authsize-1 do volume_tags[j-1,k]:=tagbuf[k];
4274 tag_match:=true;
4275 for k:=0 to volume_authsize-1 do if volume_tags[j-1,k]<>exp_volume_tags[j-1,k] then
4276 begin
4277 tag_match:=false;
4278 break;
4279 end;
4280 if tag_match=true then status_volumes[j-1]:='Volume is OK'
4281 else status_volumes[j-1]:='Wrong tag!';
4282 end;
4283 end;
4284
4285 procedure do_report_rfj;
4286 var
4287 h,k:dword;
4288 s:ansistring;
4289 begin
4290 Form_report.InputT.Caption:='File';
4291 Form_report.OutputT.Caption:='Volumes';
4292 Form_report.Caption:='Log Raw File Join';
4293 Form_report.StringGrid1.ColCount:=2;
4294 Form_report.StringGrid1.Cells[0,0]:='File name';
4295 Form_report.StringGrid1.Cells[1,0]:='Size (B)';
4296 Form_report.StringGrid1.RowCount:=2;
4297 Form_report.StringGrid1.Cells[0,1]:=out_param;
4298 Form_report.StringGrid1.Cells[1,1]:=inttostr(exp_space);
4299 Form_report.StringGrid1.AutosizeColumns;
4300 Form_report.StringGrid2.ColCount:=4;
4301 Form_report.StringGrid2.Cells[0,0]:='Volume';
4302 Form_report.StringGrid2.Cells[1,0]:='Status';
4303 Form_report.StringGrid2.Cells[2,0]:='calculated ('+volume_algo+')';
4304 Form_report.StringGrid2.Cells[3,0]:='found';
4305 if j>1 then Form_report.StringGrid2.RowCount:=j
4306 else exit;
4307 for k:=0 to j-2 do
4308 begin
4309 Form_report.StringGrid2.Cells[0,k+1]:=inttostr(k+1);
4310 if upcase(volume_algo)<>'NOALGO' then
4311 begin
4312 Form_report.StringGrid2.Cells[1,k+1]:=status_volumes[k];
4313 s:='';
4314 for h:=0 to volume_authsize-1 do s:=s+hexstr(@volume_tags[k,h],1);
4315 Form_report.StringGrid2.Cells[2,k+1]:=s;
4316 s:='';
4317 for h:=0 to volume_authsize-1 do s:=s+hexstr(@exp_volume_tags[k,h],1);
4318 Form_report.StringGrid2.Cells[3,k+1]:=s;
4319 end;
4320 end;
4321 Form_report.StringGrid2.AutosizeColumns;
4322 Form_report.Label1.Caption:=in_qualified_name+' -> '+out_param;
4323 Form_report.Label2.Caption:=Form_pea.LabelDecrypt4.Caption;
4324 Form_report.Label3.Caption:='Total output '+inttostr(wrk_space)+' B';
4325 Form_report.Label4.Caption:='Joined '+inttostr(j-1)+' volume(s)';
4326 end;
4327
4328 begin
4329 exitcode:=-1;
4330 clean_variables;
4331 if (upcase(pw_param)<>'HIDDEN') and (upcase(pw_param)<>'HIDDEN_REPORT') then Form_pea.Visible:=true else Form_pea.Visible:=false;
4332 Form_pea.PanelDecrypt1.visible:=true;
4333 Form_pea.PanelEncrypt1.visible:=false;
4334 Form_pea.Caption:='File join';
4335 ts_start:=datetimetotimestamp(now);
4336 Form_pea.ProgressBar1.Position:=0;
4337 Form_pea.LabelDecrypt2.Caption:='Input: '+in_qualified_name;
4338 if extractfileext(in_qualified_name)<>'.001' then
4339 begin
4340 MessageDlg('Please select the file with .001 extension to start joining file parts', mtWarning, [mbOK], 0);
4341 exit;
4342 end;
4343 Form_pea.LabelDecrypt3.Caption:='Output: '+out_param;
4344 Form_pea.LabelTime1.Caption:='Joining volumes...';
4345 in_folder:=extractfilepath(in_qualified_name);
4346 in_file:=extractfilename(in_qualified_name);
4347 delete(in_file,length(in_file)-3,4);
4348 in_name:=in_file;
4349 //try to evaluate archive size (succeed if all chunks are accessible)
4350 evaluate_file_size(exp_space,prog_size);
4351 //evaluate output name and if output path has enough free space
4352 evaluate_output;
4353 // process the data
4354 chunks_ok:=true;
4355 wrk_space:=0;
4356 Form_pea.ProgressBar1.Position:=5;
4357 j:=0;
4358 filenamed:=false;
4359 repeat //avoid to overwrite files
4360 if j=0 then
4361 if fileexists(out_path+out_file) or directoryexists(out_path+out_file) then inc(j,1)
4362 else filenamed:=true
4363 else
4364 if fileexists(out_path+out_file+' - '+inttostr(j)+extractfileext(out_file)) or directoryexists(out_path+out_file+' - '+inttostr(j)+extractfileext(out_file)) then inc(j,1)
4365 else filenamed:=true;
4366 until filenamed = true;
4367 if j>0 then out_file:=out_file+' - '+inttostr(j)+extractfileext(out_file);
4368 assignfile(f_out,out_path+out_file);
4369 rewrite(f_out);
4370 if IOResult<>0 then internal_error('IO error creating output file '+out_path+out_file);
4371 Form_pea.LabelDecrypt3.Caption:='Output: '+out_path+out_file;
4372 j:=1;
4373 try
4374 assignfile(f_check,in_folder+in_name+'.check');
4375 filemode:=0;
4376 reset(f_check);
4377 if IOResult<>0 then internal_error('IO error opening check file '+in_folder+in_name+'.check');
4378 blockread (f_check,sbuf1,4,numread);
4379 if IOResult<>0 then internal_error('IO error reading from check file '+in_folder+in_name+'.check');
4380 if rfs_parse_archive_header (sbuf1,volume_algo)<>0 then volume_algo:='NOALGO';
4381 except
4382 volume_algo:='NOALGO';
4383 end;
4384 decode_rfs_volume_control_algo (volume_algo, volume_authsize);
4385 Form_pea.LabelDecrypt4.Caption:='Integrity check algorithm: '+volume_algo;
4386 {
4387 Since in raw split files there is no extra information about file termination,
4388 the program will assume that the user had copied ALL needed volumes into the same
4389 path
4390 }
4391 while chunks_ok=true do
4392 begin
4393 update_rfs_filename(in_name,j,in_file);
4394 if fileexists(in_folder+in_file) then
4395 begin
4396 init_volume_control_algo;
4397 chunks_ok:=true;
4398 assignfile(f_in,in_folder+in_file);
4399 filemode:=0;
4400 reset(f_in);
4401 if IOResult<>0 then internal_error('IO error opening input file '+in_folder+in_file);
4402 srcfilesize(in_folder+in_file,total);
4403 //total:=system.filesize(f_in);
4404 while (total>0) do
4405 begin
4406 if total>SBUFSIZE then i:=SBUFSIZE else i:=total;
4407 blockread (f_in,sbuf1,i,numread);
4408 if IOResult<>0 then internal_error('IO error reading from input file '+in_folder+in_file);
4409 update_volume_control_algo(sbuf1,numread);
4410 dec(total,numread);
4411 inc(wrk_space,numread);
4412 blockwrite (f_out,sbuf1,numread,numwritten);
4413 if IOResult<>0 then internal_error('IO error writing to output file '+out_path+out_file);
4414 end;
4415 close(f_in);
4416 if IOResult<>0 then internal_error('IO error closing input file '+in_folder+in_file);
4417 //check volume
4418 SetLength(status_volumes,length(status_volumes)+1);
4419 SetLength(volume_tags,length(status_volumes)+1);
4420 SetLength(exp_volume_tags,length(status_volumes)+1);
4421 if upcase(volume_algo)<>'NOALGO' then blockread (f_check,tagbuf,volume_authsize,numread);
4422 finish_volume_control_algo;
4423 check_volume;
4424 j:=j+1;
4425 Form_pea.ProgressBar1.Position:=wrk_space div prog_size;
4426 Application.ProcessMessages;
4427 end
4428 else chunks_ok:=false;
4429 end;
4430 close(f_out);
4431 if IOResult<>0 then internal_error('IO error closing output file '+out_path+out_file);
4432 if upcase(volume_algo)<>'NOALGO' then
4433 begin
4434 closefile(f_check);
4435 if IOResult<>0 then internal_error('IO error closing check file '+in_folder+in_name+'.check');
4436 end;
4437 Form_pea.LabelDecrypt2.Caption:='Input: '+in_name+'.*, got '+inttostr(j-1)+' volume(s), total '+inttostr(wrk_space)+' B';
4438 Form_pea.LabelDecrypt3.Caption:='Output: '+out_path+out_file;
4439 Form_pea.LabelDecrypt5.Caption:='Volumes merged succesfully';
4440 Form_pea.ProgressBar1.Position:=100;
4441 setcurrentdir(extractfilepath(out_param));
4442 do_report_rfj;
4443 timing(ts_start,wrk_space);
4444 Form_pea.LabelOpen.Caption:='Open';
4445 output:=out_path+out_file;
4446 Form_pea.LabelOpen.visible:=true;
4447 Form_pea.LabelLog1.Visible:=true;
4448 Form_pea.ButtonDone1.Visible:=true;
4449 Form_pea.ButtonPeaExit1.Visible:=false;
4450 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 Join','txt',upcase(pw_param),out_path);
4451 exitcode:=0;
4452 Sleep(500);
4453 if closepolicy>0 then Form_pea.Close;
4454 end;
4455
4456 //procedure to wipe files and folders
4457 procedure wipe ( level: ansistring);
4458 //NONE: delete (quick delete: no overwrite, not sent to recycle bin)
4459 //QUICK: alias for NONE
4460 //RECYCLE: move to recycle bin (Windows only)
4461 //ZERO: overwrite with zero, flush, delete
4462 //ONE: overwrite with one, flush, delete
4463 //VERY_FAST: overwrite with random data, flush, delete
4464 //FAST: 2 * overwrite with random data, flush, delete
4465 //MEDIUM: zero delete, one delete, random data overwrite, flush, mask file size <4KB, 3 * (rename, flush), delete
4466 //SLOW: zero delete, one delete, 2 * (random data overwrite, flush), mask file size <4KB*2, 4 * (rename, flush), delete
4467 //VERY_SLOW: zero delete, one delete, 3 * (random data overwrite, flush), mask file size <4KB*3, 5 * (rename, flush), delete
4468 var
4469 f:file of byte;
4470 exp_files:TFoundList;
4471 exp_dirs:TFoundList;
4472 exp_fsizes:TFoundListSizes;
4473 exp_ftimes:TFoundListAges;
4474 exp_fattr:TFoundListAttrib;
4475 exp_fattr_dec:TFoundList;
4476 nfound,size,total,ntotalexp,tsize,etsize,nfiles,ndirs,ctsize,speed,numread:qword;
4477 i,j,k,errors,dfiles,ddirs,nlevel,nleveli,rc,attr,time,numwritten:integer;
4478 buf:array[0..65535]of byte;
4479 aes_ctx:TAESContext;
4480 aes_iv:array[0..15]of byte;
4481 randomstring,randomstring2,oldrandomstring,in_param,s,end2caption:ansistring;
4482 sr:TSearchRec;
4483 tsin,tsout:TTimestamp;
4484
4485 procedure canceldelete;
4486 begin
4487 Form_pea.LabelTools4.Caption:='Operation cancelled by user';
4488 Application.ProcessMessages;
4489 if errors=0 then
4490 begin
4491 Sleep(1500);
4492 if closepolicy>0 then Form_pea.Close;
4493 end;
4494 end;
4495
4496 procedure wipefixed(b:byte);
4497 begin
4498 assignfile(f,(exp_files[k]));
4499 rewrite(f);
4500 total:=0;
4501 FillByte(buf,sizeof(buf),b);
4502 repeat
4503 if size-total>65536 then numread:=65536
4504 else numread:=size-total;
4505 blockwrite(f,buf,numread,numwritten);
4506 etsize:=etsize+numread;
4507 Form_pea.ProgressBar1.Position:=(100*etsize) div tsize;
4508 tsout:=datetimetotimestamp(now);
4509 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
4510 Form_pea.LabelTools5.Caption:=nicetime(inttostr(time))+' elapsed';
4511 Application.ProcessMessages;
4512 if toolactioncancelled=true then
4513 begin
4514 closefile(f);
4515 try udeletefile(exp_files[k]); except end;
4516 canceldelete;
4517 exit;
4518 end;
4519 inc(total,numwritten);
4520 until (total>=size);
4521 closefile(f);//causes flush;
4522 end;
4523
4524 {$IFDEF MSWINDOWS}
recyclefile_fromnamenull4525 function recyclefile_fromname(fname:ansistring):integer;
4526 var
4527 FStruct: TSHFileOpStruct;
4528 fnamearr: array[0..255] of char;
4529 begin
isnull4530 //file already checked when the function is called
4531 fillchar(fnamearr,sizeof(fnamearr),0) ;
4532 StrPcopy(fnamearr,expandfilename(fname)+#0#0) ;
4533 FStruct.hwnd:=0;
4534 FStruct.wFunc:=FO_DELETE;
4535 FStruct.pFrom:=fnamearr;
4536 FStruct.pTo:=nil;
4537 FStruct.fFlags:= FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
4538 FStruct.fAnyOperationsAborted := false;
4539 FStruct.hNameMappings := nil;
4540 Result:=ShFileOperation(FStruct);
4541 end;
4542 {$ENDIF}
4543
4544 begin
4545 exitcode:=-1;
4546 tsin:=datetimetotimestamp(now);
4547 Form_pea.PanelPW1.height:=2;
4548 Form_pea.ButtonToolsCancel.visible:=true;
4549 Form_pea.ButtonToolsCancel.hint:='Cancel will stop deletion but will not recover already deleted elements';
4550 Form_report.Notebook1.PageIndex:=0;
4551 Form_report.StringGrid1.RowCount:=1;
4552 level:=upcase(level);
4553 if (level='NONE') or (level='QUICK') or (level='RECYCLE') or (level='HEADER') then
4554 Form_report.Caption:='Delete'
4555 else
4556 Form_report.Caption:='Secure delete';
4557 Form_pea.Caption:=Form_report.Caption;
4558 Form_pea.LabelTools2.Caption:=Form_report.Caption+' ('+level+'), '+inttostr(paramcount-2)+' element(s)';
4559 Form_pea.ProgressBar1.Position:=0;
4560 Form_pea.PanelTools.Cursor:=crHourGlass;
4561 errors:=0;
4562 dfiles:=0;
4563 ddirs:=0;
4564 ntotalexp:=paramcount-2;
4565 case level of
4566 'NONE' : nlevel:=0;
4567 'QUICK' : nlevel:=0;
4568 'RECYCLE' : nlevel:=0;
4569 'HEADER' : nlevel:=1;
4570 'ZERO' : nlevel:=1;
4571 'ONE' : nlevel:=1;
4572 'VERY_FAST' : nlevel:=1;
4573 'FAST' : nlevel:=2;
4574 'MEDIUM' : nlevel:=3;
4575 'SLOW' : nlevel:=4;
4576 else nlevel:=5;
4577 end;
4578 nleveli:=nlevel;
4579 tsize:=0;
4580 etsize:=0;
4581 ctsize:=0;
4582 for j:=3 to paramcount do
4583 begin
4584 if filegetattr((paramstr(j))) and faDirectory = 0 then
4585 srcfilesize((paramstr(j)),ctsize)
4586 else
4587 rcountsize((paramstr(j))+directoryseparator,'*',faAnyFile,true,nfiles,ndirs,ctsize);
4588 tsize:=tsize+ctsize;
4589 end;
4590 Form_pea.LabelTools2.Caption:=Form_pea.LabelTools2.Caption+', '+nicenumber(inttostr(tsize));
4591 end2caption:=Form_pea.LabelTools2.Caption;
4592 Application.ProcessMessages;
4593 tsize:=(tsize*nlevel) + paramcount;
4594 randomize;
4595 for j:=3 to paramcount do
4596 begin
4597 if Form_pea.ProgressBar1.Position>=100 then Form_pea.ProgressBar1.Position:=99;
4598 tsout:=datetimetotimestamp(now);
4599 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
4600 Form_pea.LabelTools4.Caption:=nicetime(inttostr(time))+' elapsed';
4601 Application.ProcessMessages;
4602 try
4603 if level='RECYCLE' then //recycle (Windows)
4604 begin
4605 {$IFDEF MSWINDOWS}
4606 in_param:=escapefilename(paramstr(j),desk_env);
4607 findfirst(in_param, faAnyFile, sr);
4608 s := StrPas(sr.FindData.cAlternateFileName);
4609 if s='' then s:= extractfilename(in_param);
4610 s := extractfilepath(in_param) + s;
4611 FindClose(sr);
4612 recyclefile_fromname(s);
4613 {$ENDIF}
4614 end
4615 else
4616 begin
4617 expand((paramstr(j)),exp_files,exp_fsizes,exp_ftimes,exp_fattr,exp_fattr_dec,nfound);
4618 if nfound=0 then nfound:=1;
4619 SetLength(exp_dirs,0);
4620 ntotalexp:=ntotalexp+nfound-1;
4621 for k:=0 to nfound-1 do
4622 begin
4623 if filegetattr(exp_files[k]) and faDirectory = 0 then //file
4624 begin
4625 rc:=Form_report.StringGrid1.RowCount+1;
4626 Form_report.StringGrid1.RowCount:=rc;
4627 if nlevel>0 then Form_pea.LabelTools2.Caption:=end2caption+', '+nicenumber(inttostr(etsize div nlevel))+' deleted'
4628 else Form_pea.LabelTools2.Caption:=end2caption+', '+nicenumber(inttostr(etsize))+' deleted';
4629 Form_pea.LabelTools3.Caption:='Processing item '+inttostr(rc-1)+' of '+inttostr(ntotalexp);
4630 try
4631 {$IFDEF MSWINDOWS}
4632 upredeletefile(exp_files[k]);
4633 {$ENDIF}
4634 assignfile(f,exp_files[k]);
4635 filemode:=0;
4636 reset(f);
4637 srcfilesize(exp_files[k],size);
4638 closefile(f);
4639 Form_pea.LabelTools3.Caption:=Form_pea.LabelTools3.Caption+', '+nicenumber(inttostr(size))+' file';
4640 setcurrentdir(extractfilepath((exp_files[k])));
4641 if toolactioncancelled=true then
4642 begin
4643 canceldelete;
4644 exit;
4645 end;
4646 case level of
4647 'NONE': udeletefile(exp_files[k]);//quick delete
4648 'QUICK': udeletefile(exp_files[k]);//quick delete (alias)
4649 'ZERO': //overwrite with zero
4650 begin
4651 wipefixed(0);
4652 udeletefile(exp_files[k]);
4653 end;
4654 'ONE': //overwrite with one
4655 begin
4656 wipefixed(255);
4657 udeletefile(exp_files[k]);
4658 end;
4659 else // secure delete (and header quick delete)
4660 begin
4661 get_fingerprint(fingerprint,false);
4662 //init encryption
4663 for i:=0 to 31 do fingerprint[i]:=fingerprint[i];
4664 for i:=0 to 15 do aes_iv[i]:=fingerprint[i]+random(256);
4665 AES_CTR_Init(fingerprint, 256, aes_iv, aes_ctx);
4666 if nlevel>2 then
4667 begin
4668 nleveli:=nlevel-2;
4669 wipefixed(0);
4670 sleep(random(250));
4671 wipefixed(255);
4672 sleep(random(250));
4673 end;
4674 for i:=1 to nleveli do //overwrite nlevel times with random data (AES256 CTR init once by system fingerprint)
4675 begin
4676 assignfile(f,exp_files[k]);
4677 rewrite(f);
4678 total:=0;
4679 repeat
4680 if size-total>65536 then numread:=65536
4681 else numread:=size-total;
4682 AES_CTR_Encrypt(@buf, @buf, numread, aes_ctx);
4683 blockwrite(f,buf,numread,numwritten);
4684 etsize:=etsize+numread;
4685 Form_pea.ProgressBar1.Position:=(100*etsize) div tsize;
4686 tsout:=datetimetotimestamp(now);
4687 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
4688 Form_pea.LabelTools4.Caption:=nicetime(inttostr(time))+' elapsed';
4689 Application.ProcessMessages;
4690 if toolactioncancelled=true then
4691 begin
4692 closefile(f);
4693 try udeletefile(exp_files[k]); except end;
4694 canceldelete;
4695 exit;
4696 end;
4697 inc(total,numwritten);
4698 if level='HEADER' then begin etsize:=etsize+size-numread; break; end;//overwrite only file header up to 64KB
4699 until (total>=size);
4700 closefile(f);//causes flush;
4701 if nleveli>1 then sleep(random(250));
4702 end;
4703 if nlevel>2 then
4704 begin
4705 numread:=1+random(4096*i);//replace file with random sized block 1B-(4KB*i) to mask original size
4706 AES_CTR_Encrypt(@buf, @buf, numread, aes_ctx);
4707 assignfile(f,(exp_files[k]));
4708 rewrite(f);
4709 blockwrite(f,buf,numread,numwritten);
4710 closefile(f);
4711 randomstring:=(exp_files[k]);
4712 for i:=1 to nleveli do //rename
4713 begin
4714 oldrandomstring:=randomstring;
4715 assignfile(f,randomstring);
4716 randomstring:=extractfilepath(randomstring)+inttostr(random(maxint))+'.tmp';
4717 renamefile(oldrandomstring,randomstring);
4718 end;
4719 udeletefile(randomstring);
4720 end
4721 else udeletefile(exp_files[k]);
4722 end;
4723 end;
4724 Form_report.StringGrid1.Cells[0,rc-1]:=exp_files[k];
4725 Form_report.StringGrid1.Cells[1,rc-1]:='file successfully deleted';
4726 dfiles:=dfiles+1;
4727 except
4728 try closefile(f); except end;
4729 Form_report.StringGrid1.Cells[0,rc-1]:=exp_files[k];
4730 Form_report.StringGrid1.Cells[1,rc-1]:='<ERROR: FILE NOT DELETED (not writeable/accessible/found)>';
4731 errors:=errors+1;
4732 end;
4733 end
4734 else
4735 begin
4736 if not(fileexists(exp_files[k])) and not(directoryexists(exp_files[k])) then //not found
4737 begin
4738 rc:=Form_report.StringGrid1.RowCount+1;
4739 Form_report.StringGrid1.RowCount:=rc;
4740 Form_report.StringGrid1.Cells[0,rc-1]:=exp_files[k];
4741 Form_report.StringGrid1.Cells[1,rc-1]:='OBJECT NOT FOUND';
4742 errors:=errors+1;
4743 end
4744 else
4745 begin
4746 SetLength(exp_dirs,length(exp_dirs)+1);
4747 exp_dirs[length(exp_dirs)-1]:=exp_files[k];
4748 end;
4749 end;
4750 end;
4751 setcurrentdir(executable_path);
4752 if length(exp_dirs)>0 then
4753 for k:=(length(exp_dirs)-1) downto 0 do
4754 begin
4755 rc:=Form_report.StringGrid1.RowCount+1;
4756 Form_report.StringGrid1.RowCount:=rc;
4757 Form_pea.LabelTools3.Caption:='Processing item '+inttostr(rc-1)+' of '+inttostr(ntotalexp)+', directory';
4758 Application.ProcessMessages;
4759 try
4760 randomstring:=(exp_dirs[k]);
4761 for i:=1 to nlevel do //rename
4762 begin
4763 if randomstring[length(randomstring)]=directoryseparator then setlength(randomstring,length(randomstring)-1);
4764 randomstring2:=extractfilepath(randomstring)+inttostr(random(maxint));
4765 renamefile(randomstring,randomstring2);
4766 randomstring:=randomstring2;
4767 end;
4768 removedir(randomstring);
4769 Form_report.StringGrid1.Cells[0,rc-1]:=exp_dirs[k];
4770 Form_report.StringGrid1.Cells[1,rc-1]:='directory successfully deleted';
4771 ddirs:=ddirs+1;
4772 except
4773 Form_report.StringGrid1.Cells[0,rc-1]:=exp_dirs[k];
4774 Form_report.StringGrid1.Cells[1,rc-1]:='DIRECTORY NOT DELETED (not writeable/accessible/found)';
4775 errors:=errors+1;
4776 end;
4777 end;
4778 end;
4779 except
4780 rc:=Form_report.StringGrid1.RowCount+1;
4781 Form_report.StringGrid1.RowCount:=rc;
4782 Form_report.StringGrid1.Cells[0,Form_report.StringGrid1.RowCount-1]:=(paramstr(j));
4783 Form_report.StringGrid1.Cells[1,Form_report.StringGrid1.RowCount-1]:='OBJECT NOT DELETED';
4784 errors:=errors+1;
4785 end;
4786 end;
4787 Form_pea.ButtonToolsCancel.visible:=false;
4788 Form_pea.ProgressBar1.Position:=100;
4789 Form_pea.PanelTools.Cursor:=crDefault;
4790 Form_report.StringGrid1.Cells[0,0]:='File';
4791 Form_report.StringGrid1.Cells[1,0]:='Result';
4792 Form_report.StringGrid1.AutosizeColumns;
4793 Form_pea.LabelTools2.Caption:=end2caption;
4794 if level='RECYCLE' then
4795 Form_pea.LabelTools3.Caption:=''
4796 else
4797 Form_pea.LabelTools3.Caption:='Processed '+inttostr(dfiles)+' files, '+inttostr(ddirs)+' directories, '+inttostr(errors)+' errors';
4798 tsout:=datetimetotimestamp(now);
4799 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
4800 if time>0 then
4801 begin
4802 speed:=(tsize * 1000) div time;
4803 Form_pea.LabelTools4.Caption:=nicetime(inttostr(time))+' total time @ '+nicenumber(inttostr(speed))+'/s';
4804 end
4805 else Form_pea.LabelTools4.Caption:='';
4806 Form_report.Label1.Caption:=Form_pea.LabelTools2.Caption;
4807 Form_report.Label2.Caption:=Form_pea.LabelTools3.Caption;
4808 Form_report.Label3.Caption:=Form_pea.LabelTools4.Caption;
4809 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
4810 Form_pea.ButtonDone1.Visible:=true;
4811 Form_pea.LabelOpen.Visible:=true;
4812 Form_pea.LabelOpen.Enabled:=false;
4813 Form_pea.LabelLog1.Visible:=true;
4814 Application.ProcessMessages;
4815 if errors=0 then
4816 begin
4817 exitcode:=0;
4818 Sleep(1500);
4819 if closepolicy>0 then Form_pea.Close;
4820 end
4821 else exitcode:=-2;
4822 end;
4823
4824 //procedure to wipe/sanitize free space: write files smaller than 2GB then delete
4825 procedure sanitize ( level: ansistring);
4826 //ZERO: overwrite free space with zero, flush
4827 //ONE: overwrite free space with one, flush
4828 //VERY_FAST: 1 * (random data overwrite filling free space, flush, delete work files)
4829 //FAST: 2 * (random data overwrite filling free space, flush, delete work files)
4830 //MEDIUM: zero delete, one delete, 1 * (random data overwrite filling free space, flush, delete work files)
4831 //SLOW: zero delete, one delete, 2 * (random data overwrite filling free space, flush, delete work files)
4832 //VERY_SLOW: zero delete, one delete, 3* (random data overwrite filling free space, flush, delete work files)
4833
4834 var
4835 f:file of byte;
4836 total,gtotal,maxs:qword;
4837 n,i,j,numread,numwritten,nlevel,nleveli,rc,drivenumber,time:integer;
4838 buf:array[0..65535]of byte;
4839 aes_ctx:TAESContext;
4840 aes_iv:array[0..15]of byte;
4841 wrkfile,wrkdir,wrktitle,fstype,sdrive,wincomspec,winver,majmin:ansistring;
4842 bufVolumeName, bufFSName: array[0..255] of Char;
4843 sn,mc,flags:dword;
4844 sizefree,sizetotal,rfree,speed:qword;
4845 tok:boolean;
4846 tsin,tsout:TTimestamp;
4847
4848 procedure recoverfreespace(n:integer);
4849 var m:integer;
4850 begin
4851 try
4852 for m:=1 to n do udeletefile(wrkdir+directoryseparator+inttostr(m));
4853 except
4854 sleep(500);
4855 try
4856 for m:=1 to n do udeletefile(wrkdir+directoryseparator+inttostr(m));
4857 except
4858 MessageDlg('Cannot delete temporary work files, please manually delete '+wrkdir+directoryseparator+' to recover free space', mtWarning, [mbOK], 0);
4859 end;
4860 end;
4861 end;
4862
4863 procedure cancelsanitize(n:integer);
4864 begin
4865 Form_pea.LabelTools4.Caption:=nicetime(inttostr(time))+' operation cancelled by user, recovering free space from '+wrkdir+' ...';
4866 Application.ProcessMessages;
4867 recoverfreespace(n);
4868 removedir(wrkdir);
4869 sleep(1500);
4870 halt(-4);
4871 end;
4872
4873 procedure sanitizefixed(b:byte;j:integer);
4874 begin
4875 FillByte(buf,sizeof(buf),b);
4876 tok:=false;
4877 gtotal:=0;
4878 n:=0;
4879 repeat
4880 total:=0;
4881 n:=n+1;
4882 wrkfile:=wrkdir+directoryseparator+inttostr(n);
4883 assignfile(f,wrkfile);
4884 rewrite(f);
4885 try
4886 repeat
4887 if maxs-total>65536 then numread:=65536
4888 else numread:=maxs-total;
4889 rfree:=diskfree(drivenumber);
4890 Form_pea.ProgressBar1.Position:=100-((rfree*100) div sizefree);
4891 Form_pea.LabelTools3.Caption:=nicenumber(inttostr(sizefree))+' free, '+nicenumber(inttostr(rfree))+' remaining';
4892 tsout:=datetimetotimestamp(now);
4893 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
4894 Form_pea.LabelTools4.Caption:=nicetime(inttostr(time))+' elapsed';
4895 Application.ProcessMessages;
4896 if toolactioncancelled=true then begin closefile(f); cancelsanitize(n); exit; end;
4897 if rfree<=65536 then tok:=true
4898 else
4899 begin
4900 blockwrite(f,buf,numread,numwritten);
4901 inc(total,numwritten);
4902 end;
4903 until (tok=true) or (total>=maxs);
4904 finally
4905 closefile(f);//causes flush;
4906 inc(gtotal,total);
4907 end;
4908 until tok=true;
4909 recoverfreespace(n);
4910 Form_pea.LabelTools2.Caption:='Done drive '+(paramstr(3))+', '+nicenumber(inttostr(sizetotal))+', pass '+inttostr(j)+' of '+inttostr(nlevel);
4911 end;
4912
4913 begin
4914 exitcode:=-1;
4915 {$IFDEF MSWINDOWS}
4916 Form_pea.ButtonToolsCancel.visible:=true;
4917 Form_pea.PanelPW1.height:=2;
4918 Form_report.Notebook1.PageIndex:=0;
4919 Form_report.StringGrid1.RowCount:=1;
4920 level:=upcase(level);
4921 case level of
4922 'ZERO' : wrktitle:='Zero delete free space';
4923 'ONE' : wrktitle:='One delete free space';
4924 else wrktitle:='Secure delete free space ('+level+')';
4925 end;
4926 Form_report.Caption:=wrktitle;
4927 Form_pea.Caption:=wrktitle;
4928 Form_pea.ProgressBar1.Position:=0;
4929 Form_pea.PanelTools.Cursor:=crHourGlass;
4930 case level of
4931 'ZERO' : nlevel:=1;
4932 'ONE' : nlevel:=1;
4933 'VERY_FAST' : nlevel:=1;
4934 'FAST' : nlevel:=2;
4935 'MEDIUM' : nlevel:=3;
4936 'SLOW' : nlevel:=4;
4937 else nlevel:=5;
4938 end;
4939 nleveli:=nlevel;
4940 randomize;
4941 Form_report.StringGrid1.RowCount:=1;
4942 Application.ProcessMessages;
4943 drivenumber:=ord(upcase(paramstr(3)[1]))-64;
4944 if drivenumber>2 then sizefree:=diskfree(drivenumber);
4945 if drivenumber>2 then sizetotal:=DiskSize(drivenumber);
4946 maxs:=2*1024*1024*1024-1;//2GiB-1B
4947 wrkdir:=paramstr(3)+directoryseparator+'.ptmp';
4948 forcedirectories(wrkdir);
4949
4950 tsin:=datetimetotimestamp(now);
4951
4952 getwinenvadv(wincomspec,winver,majmin);
4953 if (winver='nt6+') or (winver='nt5') then
4954 begin
4955 sdrive:=extractfiledrive((paramstr(3)))+'\';
4956 GetVolumeInformation(Pchar(sdrive),
4957 @bufVolumeName, sizeof(bufVolumeName),
4958 @sn, mc, flags,
4959 @bufFSName, sizeof(bufFSName));
4960 fstype:=bufFSName;
4961 end
4962 else fstype:='';
4963
4964 if fstype<>'' then
4965 Form_pea.LabelTools2.Caption:='Processing drive '+(paramstr(3))+' ('+fstype+'), '+nicenumber(inttostr(sizetotal))
4966 else
4967 Form_pea.LabelTools2.Caption:='Processing drive '+(paramstr(3))+', '+nicenumber(inttostr(sizetotal));
4968 Application.ProcessMessages;
4969 case level of
4970 'ZERO': //overwrite with zero
4971 sanitizefixed(0,1);
4972 'ONE': //overwrite with one
4973 sanitizefixed(255,1);
4974 else // secure delete
4975 begin
4976 get_fingerprint(fingerprint,false);
4977 //init encryption
4978 for i:=0 to 31 do fingerprint[i]:=fingerprint[i];
4979 for i:=0 to 15 do aes_iv[i]:=fingerprint[i]+random(256);
4980 AES_CTR_Init(fingerprint, 256, aes_iv, aes_ctx);
4981 //overwrite nlevel times with random data (AES256 CTR init once by system fingerprint)
4982 if nlevel>2 then
4983 begin
4984 nleveli:=nleveli-2;
4985 sanitizefixed(0,1);
4986 sanitizefixed(255,2);
4987 end;
4988 for j:=1 to nleveli do
4989 begin
4990
4991 if fstype<>'' then
4992 Form_pea.LabelTools2.Caption:='Processing drive '+(paramstr(3))+' ('+fstype+'), '+nicenumber(inttostr(sizetotal))+', pass '+inttostr(j+nlevel-nleveli)+' of '+inttostr(nlevel)
4993 else
4994 Form_pea.LabelTools2.Caption:='Processing drive '+(paramstr(3))+', '+nicenumber(inttostr(sizetotal))+', pass '+inttostr(j+nlevel-nleveli)+' of '+inttostr(nlevel);
4995 Application.ProcessMessages;
4996
4997 tok:=false;
4998 gtotal:=0;
4999 n:=0;
5000 repeat
5001 total:=0;
5002 n:=n+1;
5003 wrkfile:=wrkdir+directoryseparator+inttostr(n);
5004 assignfile(f,wrkfile);
5005 rewrite(f);
5006 try
5007 repeat
5008 if maxs-total>65536 then numread:=65536
5009 else numread:=maxs-total;
5010 rfree:=diskfree(drivenumber);
5011 Form_pea.ProgressBar1.Position:=100-((rfree*100) div sizefree);
5012 Form_pea.LabelTools3.Caption:=nicenumber(inttostr(sizefree))+' free, '+nicenumber(inttostr(rfree))+' remaining';
5013 tsout:=datetimetotimestamp(now);
5014 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
5015 Form_pea.LabelTools4.Caption:=nicetime(inttostr(time))+' elapsed';
5016 Application.ProcessMessages;
5017 if toolactioncancelled=true then begin closefile(f); cancelsanitize(n); exit; end;
5018 if rfree<=65536 then tok:=true
5019 else
5020 begin
5021 AES_CTR_Encrypt(@buf, @buf, numread, aes_ctx);
5022 blockwrite(f,buf,numread,numwritten);
5023 inc(total,numwritten);
5024 end;
5025 until (tok=true) or (total>=maxs);
5026 finally
5027 closefile(f);//causes flush;
5028 inc(gtotal,total);
5029 end;
5030 until tok=true;
5031 recoverfreespace(n);
5032 Form_pea.LabelTools2.Caption:='Done drive '+(paramstr(3))+', '+nicenumber(inttostr(sizetotal))+', pass '+inttostr(j+nlevel-nleveli)+' of '+inttostr(nlevel);
5033 end;
5034 end;
5035 end;
5036 Form_pea.ButtonToolsCancel.visible:=false;
5037 removedir(wrkdir);
5038 Form_pea.ProgressBar1.Position:=100;
5039 Form_pea.PanelTools.Cursor:=crDefault;
5040 Form_report.StringGrid1.Cells[0,0]:='File';
5041 Form_report.StringGrid1.Cells[1,0]:='Result';
5042 Form_report.StringGrid1.AutosizeColumns;
5043 rfree:=diskfree(drivenumber);
5044 Form_pea.LabelTools3.Caption:=nicenumber(inttostr(sizefree))+' free when task started, '+nicenumber(inttostr(rfree))+' currently free, temporary work dir '+wrkdir;
5045 tsout:=datetimetotimestamp(now);
5046 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
5047 if time>0 then
5048 begin
5049 speed:=(sizefree * 1000) div time;
5050 Form_pea.LabelTools4.Caption:=nicetime(inttostr(time))+' total time @ '+nicenumber(inttostr(speed))+'/s';
5051 end
5052 else Form_pea.LabelTools4.Caption:='';
5053 Form_report.Label1.Caption:=wrktitle;
5054 Form_report.Label2.Caption:=Form_pea.LabelTools2.Caption;
5055 Form_report.Label3.Caption:=Form_pea.LabelTools3.Caption;
5056 Form_report.Label4.Caption:=Form_pea.LabelTools4.Caption;
5057 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
5058 Form_pea.ButtonDone1.Visible:=true;
5059 Form_pea.LabelOpen.Visible:=true;
5060 Form_pea.LabelOpen.Enabled:=false;
5061 Form_pea.LabelLog1.Visible:=true;
5062 Application.ProcessMessages;
5063 {if errors=0 then
5064 begin
5065 Sleep(500);
5066 if closepolicy>0 then Form_pea.Close;
5067 end;}
5068 {$ENDIF}
5069 exitcode:=0;
5070 end;
5071
5072 //procedure to compare files
5073 procedure compare;
5074 var
5075 fa,fb:file of byte;
5076 sfile:ansistring;
5077 sizea,sizeb,sizemin,total:qword;
5078 i,d,x,numreada,numreadb,numreadmin,continue:integer;
5079 bufa,bufb:array[0..65535]of byte;
5080 stoppedcomparison:boolean;
5081 begin
5082 exitcode:=-1;
5083 Form_pea.PanelPW1.height:=2;
5084 Form_report.visible:=true;
5085 Form_report.Notebook1.PageIndex:=0;
5086 Form_report.StringGrid1.RowCount:=1;
5087 Form_report.Caption:='Compare';
5088 Form_pea.Caption:='Byte to byte compare';
5089 Form_pea.LabelTools2.Caption:='Comparing files...';
5090 Form_pea.LabelTools3.Caption:='First file: '+(paramstr(2));
5091 sfile:=paramstr(3);
5092 if sfile='' then
5093 if Form_pea.OpenDialog2.Execute then
5094 if Form_pea.OpenDialog2.FileName<>'' then sfile:=Form_pea.OpenDialog2.FileName
5095 else exit;
5096 Form_pea.LabelTools4.Caption:='Second file: '+(sfile);
5097 Form_pea.ProgressBar1.Position:=0;
5098 Form_report.StringGrid1.RowCount:=2;
5099 Form_report.StringGrid1.Cells[0,0]:='Test';
5100 Form_report.StringGrid1.Cells[1,0]:='Result';
5101 continue:=0;
5102 total:=0;
5103 d:=0;
5104 try
5105 assignfile(fa,(paramstr(2)));
5106 filemode:=0;
5107 reset(fa);
5108 srcfilesize((paramstr(2)),sizea);
5109 if sizea=0 then begin internal_error('The file is empty, cannot be compared'); exit; end;
5110 setcurrentdir(extractfilepath((paramstr(2))));
5111 assignfile(fb,sfile);
5112 filemode:=0;
5113 reset(fb);
5114 srcfilesize(sfile,sizeb);
5115 //sizeb:=system.filesize(fb);
5116 if sizea=0 then total:=2;
5117 if sizeb=0 then total:=2;
5118 except
5119 total:=1;
5120 end;
5121 if total<>0 then
5122 begin
5123 Form_report.StringGrid1.RowCount:=Form_report.StringGrid1.RowCount+1;
5124 Form_report.StringGrid1.Cells[0,1]:='Error';
5125 Form_report.StringGrid1.Cells[1,1]:='Cannot compare files';
5126 if paramstr(2)=sfile then
5127 Form_pea.LabelTools2.Caption:='Cannot compare a file with itself!'
5128 else
5129 begin
5130 Form_pea.LabelTools2.Caption:='Cannot compare files';
5131 if total=2 then
5132 begin
5133 if sizea=0 then Form_pea.LabelTools2.Caption:=Form_pea.LabelTools2.Caption+' first file is empty';
5134 if sizeb=0 then Form_pea.LabelTools2.Caption:=Form_pea.LabelTools2.Caption+' second file is empty';
5135 end
5136 else
5137 Form_pea.LabelTools2.Caption:=Form_pea.LabelTools2.Caption+' (i.e. not accessible, not files etc)';
5138 end;
5139 Form_pea.ProgressBar1.Position:=100;
5140 Form_report.StringGrid1.AutosizeColumns;
5141 Form_report.Label1.Caption:=Form_pea.Caption;
5142 Form_report.Label2.Caption:=Form_pea.LabelTools2.Caption;
5143 Form_report.Label3.Caption:=Form_pea.LabelTools3.Caption;
5144 Form_report.Label4.Caption:=Form_pea.LabelTools4.Caption;
5145 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
5146 Form_pea.ButtonDone1.Visible:=true;
5147 Form_pea.LabelOpen.Visible:=true;
5148 Form_pea.LabelOpen.Enabled:=false;
5149 Form_pea.LabelLog1.Visible:=true;
5150 exit;
5151 end;
5152 if sizeb<sizea then sizemin:=sizeb
5153 else sizemin:=sizea;
5154 if sizea=sizeb then
5155 begin
5156 Form_report.StringGrid1.Cells[0,1]:='Size comparison';
5157 Form_report.StringGrid1.Cells[1,1]:='Files have same size: '+inttostr(sizea)+' B';
5158 x:=1;
5159 end
5160 else
5161 begin
5162 Form_report.StringGrid1.Cells[0,1]:='Size comparison';
5163 Form_report.StringGrid1.Cells[1,1]:='Files have different sizes';
5164 Form_report.StringGrid1.RowCount:=Form_report.StringGrid1.RowCount+3;
5165 Form_report.StringGrid1.Cells[0,2]:='- First file';
5166 Form_report.StringGrid1.Cells[1,2]:=inttostr(sizea)+' B';
5167 Form_report.StringGrid1.Cells[0,3]:='- Second file';
5168 Form_report.StringGrid1.Cells[1,3]:=inttostr(sizeb)+' B';
5169 Form_report.StringGrid1.Cells[0,4]:='- Size difference';
5170 if sizea>sizeb then Form_report.StringGrid1.Cells[1,4]:=inttostr(sizea-sizeb)+' B'
5171 else Form_report.StringGrid1.Cells[1,4]:=inttostr(sizeb-sizea)+' B';
5172 x:=4;
5173 end;
5174 Form_report.Label1.Caption:=Form_pea.Caption;
5175 Form_report.Label2.Caption:=Form_pea.LabelTools2.Caption;
5176 Form_report.Label3.Caption:=Form_pea.LabelTools3.Caption+' ('+inttostr(sizea)+' B)';
5177 Form_report.Label4.Caption:=Form_pea.LabelTools4.Caption+' ('+inttostr(sizeb)+' B)';
5178 Form_pea.Visible:=false;
5179 stoppedcomparison:=false;
5180 Form_report.StringGrid1.BeginUpdate;
5181 repeat
5182 blockread (fa,bufa,65536,numreada);
5183 blockread (fb,bufb,65536,numreadb);
5184 if numreadb<numreada then numreadmin:=numreadb
5185 else numreadmin:=numreada;
5186 for i:=0 to (numreadmin - 1) do
5187 begin
5188 if bufa[i]=bufb[i] then
5189 else
5190 begin
5191 d:=d+1;
5192 Form_report.StringGrid1.RowCount:=Form_report.StringGrid1.RowCount+1;
5193 Form_report.StringGrid1.Cells[0,d+x]:='Offset '+system.hexstr(((filepos(fa)-numreada+i)div 16)*16,8);
5194 Form_report.StringGrid1.Cells[1,d+x]:='Byte '+inttostr(filepos(fa)-numreada+i+1)+' is different: Hex '+hexstr(@bufa[i],1)+' vs '+hexstr(@bufb[i],1)+'; Dec '+inttostr(bufa[i])+' vs '+inttostr(bufb[i]);
5195 if ((d>=100) and (continue=0)) then
5196 begin
5197 continue:=1;
5198 if MessageDlg('More than 100 different bytes, continue anyway?',mtConfirmation,[mbYes, mbNo],0)=6 then continue:=1
5199 else
5200 begin
5201 Form_report.StringGrid1.Cells[0,d+x]:='Comparison terminated by user';
5202 Form_report.StringGrid1.Cells[1,d+x]:='More than 100 different bytes';
5203 stoppedcomparison:=true;
5204 break;
5205 end;
5206 end;
5207 if (d>=10000) then
5208 begin
5209 Form_report.StringGrid1.Cells[0,d+x]:='Comparison automatically terminated';
5210 Form_report.StringGrid1.Cells[1,d+x]:='More than 10000 different bytes';
5211 stoppedcomparison:=true;
5212 break;
5213 end;
5214 end;
5215 end;
5216 inc(total,numreadmin);
5217 Form_pea.ProgressBar1.Position:=(total*100) div sizemin;
5218 Application.ProcessMessages;
5219 until ((numreada=0) or (numreadb=0) or (stoppedcomparison=true));
5220 Form_report.StringGrid1.EndUpdate;
5221 closefile(fa);
5222 closefile(fb);
5223 Form_report.StringGrid1.RowCount:=Form_report.StringGrid1.RowCount+1;
5224 Form_report.StringGrid1.Cells[0,Form_report.StringGrid1.RowCount-1]:='Byte comparison';
5225 if d=0 then
5226 if sizea=sizeb then
5227 begin
5228 Form_pea.Caption:='Files are identical';
5229 Form_pea.LabelTools2.Caption:='Same size, no different byte';
5230 Form_report.StringGrid1.Cells[1,Form_report.StringGrid1.RowCount-1]:='No different byte';
5231 end
5232 else
5233 begin
5234 Form_pea.Caption:='Files are different';
5235 Form_pea.LabelTools2.Caption:='Different size, no different byte in the shortest file ('+inttostr(sizemin)+' B)';
5236 Form_report.StringGrid1.Cells[1,Form_report.StringGrid1.RowCount-1]:='No different byte in the shortest file ('+inttostr(sizemin)+' B)';
5237 end
5238 else
5239 if sizea=sizeb then
5240 begin
5241 Form_pea.Caption:='Files are different';
5242 Form_pea.LabelTools2.Caption:='Same size, '+inttostr(d)+' different byte(s)';
5243 Form_report.StringGrid1.Cells[1,Form_report.StringGrid1.RowCount-1]:=inttostr(d)+' different byte(s)';
5244 end
5245 else
5246 begin
5247 Form_pea.Caption:='Files are different';
5248 Form_pea.LabelTools2.Caption:='Different size, '+inttostr(d)+' different byte(s) in the shortest file ('+inttostr(sizemin)+' B)';
5249 Form_report.StringGrid1.Cells[1,Form_report.StringGrid1.RowCount-1]:=inttostr(d)+' different byte(s) in the shortest file ('+inttostr(sizemin)+' B)';
5250 end;
5251 Form_pea.ProgressBar1.Position:=100;
5252 Form_report.StringGrid1.AutosizeColumns;
5253 Form_report.Label1.Caption:=Form_pea.Caption;
5254 Form_report.Label2.Caption:=Form_pea.LabelTools2.Caption;
5255 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
5256 Form_pea.ButtonDone1.Visible:=true;
5257 Form_pea.LabelOpen.Visible:=true;
5258 Form_pea.LabelOpen.Enabled:=false;
5259 Form_pea.LabelLog1.Visible:=true;
5260 exitcode:=0;
5261 end;
5262
5263 //procedure to checksum/hash files
5264 procedure check; //ALL: all algorithms, otherwise specify the algorithm to use followed by "on" which marks the input parameters
5265 var
5266 sbuf:array [1..32767] of byte;
5267 i,j,n,t,td,te,k,dmax,dmin,x,icount,iver,rc,dup,icol:integer;
5268 f_size,nfiles,ntfiles,ndirs,ctsize,etsize,tsize,nfound,ntotalexp,time,speed,compest,compsize:qword;
5269 smax,smin:int64;
5270 exp_files:TFoundList;
5271 exp_fsizes:TFoundListSizes;
5272 exp_ftimes:TFoundListAges;
5273 exp_fattr:TFoundListAttrib;
5274 exp_fattr_dec:TFoundList;
5275 tsin,tsout:TTimestamp;
5276 mode,dummystr,oper,moded,sdig:ansistring;
5277 dummyansistr:ansistring;
5278 pgpsig:TPGPDigest;
5279 Adler:longint;
5280 CRC16:word;
5281 CRC24:longint;
5282 CRC32:longint;
5283 CRC64:TCRC64;
5284 ED2KContext:TED2KContext;
5285 ED2KRes:TED2KResult;
5286 MD4Context:THashContext;
5287 MD4Digest:TMD4Digest;
5288 MD5Context:THashContext;
5289 MD5Digest:TMD5Digest;
5290 Blake2sContext:blake2s_ctx;
5291 Blake2sDigest:TBlake2sDigest;
5292 Blake2bContext:THashContext;
5293 Blake2bDigest:TBlake2bDigest;
5294 RMD160Context:THashContext;
5295 RMD160Digest:TRMD160Digest;
5296 SHA1Context:THashContext;
5297 SHA1Digest:TSHA1Digest;
5298 SHA224Context:THashContext;
5299 SHA224Digest:TSHA224Digest;
5300 SHA256Context:THashContext;
5301 SHA256Digest:TSHA256Digest;
5302 SHA3_256Context:THashContext;
5303 SHA3_256Digest:TSHA3_256Digest;
5304 SHA384Context:THashContext;
5305 SHA384Digest:TSHA384Digest;
5306 SHA512Context:THashContext;
5307 SHA512Digest:TSHA512Digest;
5308 SHA3_512Context:THashContext;
5309 SHA3_512Digest:TSHA3_512Digest;
5310 WhirlContext:THashContext;
5311 WhirlDigest:TWhirlDigest;
5312 Adler32_on,CRC16_on,CRC24_on,CRC32_on,CRC64_on,ED2K_on,MD4_on,MD5_on,RIPEMD160_on,
5313 SHA1_on,SHA224_on,SHA256_on,SHA384_on,SHA512_on,WHIRLPOOL_on,SHA3_256_on,SHA3_512_on,
5314 Blake2s_on,Blake2b_on:boolean;
5315 f:file of byte;
5316
5317 procedure cancelcheck;
5318 begin
5319 Form_pea.LabelTools4.Caption:='Operation cancelled by user, terminating...';
5320 Application.ProcessMessages;
5321 sleep(1500);
5322 halt(-4);
5323 end;
5324
5325 begin
5326 exitcode:=-1;
5327 tsin:=datetimetotimestamp(now);
5328 Form_pea.PanelPW1.height:=2;
5329 Form_pea.ButtonToolsCancel.visible:=true;
5330 Form_report.Notebook1.PageIndex:=0;
5331 Form_pea.LabelTools2.Caption:='Checking file(s)...';
5332 Form_pea.ProgressBar1.Position:=0;
5333 Form_report.InputT.Caption:='Input';
5334 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
5335 Form_report.StringGrid1.ColCount:=31;
5336 Form_report.StringGrid1.Cells[0,0]:='File path and name';
5337 Form_report.StringGrid1.Cells[1,0]:='Name';
5338 Form_report.StringGrid1.Cells[2,0]:='Type';
5339 Form_report.StringGrid1.Cells[3,0]:='Size';
5340 Form_report.StringGrid1.Cells[4,0]:='Bytes';
5341 Form_report.StringGrid1.Cells[5,0]:='Modified';
5342 Form_report.StringGrid1.Cells[6,0]:='Attributes';
5343 Form_report.StringGrid1.Cells[7,0]:='Copies';
5344 Form_report.StringGrid1.Cells[8,0]:='Adler32';
5345 Form_report.StringGrid1.Cells[9,0]:='CRC16';
5346 Form_report.StringGrid1.Cells[10,0]:='CRC24';
5347 Form_report.StringGrid1.Cells[11,0]:='CRC32';
5348 Form_report.StringGrid1.Cells[12,0]:='CRC64';
5349 Form_report.StringGrid1.Cells[13,0]:='eDonkey';
5350 Form_report.StringGrid1.Cells[14,0]:='MD4';
5351 Form_report.StringGrid1.Cells[15,0]:='MD5';
5352 Form_report.StringGrid1.Cells[16,0]:='RIPEMD160';
5353 Form_report.StringGrid1.Cells[17,0]:='SHA1';
5354 //Form_report.StringGrid1.Cells[18,0]:='SHA224';
5355 Form_report.StringGrid1.Cells[18,0]:='BLAKE2S';
5356 Form_report.StringGrid1.Cells[19,0]:='SHA256';
5357 Form_report.StringGrid1.Cells[20,0]:='SHA3_256';
5358 //Form_report.StringGrid1.Cells[21,0]:='SHA384';
5359 Form_report.StringGrid1.Cells[21,0]:='BLAKE2B';
5360 Form_report.StringGrid1.Cells[22,0]:='SHA512';
5361 Form_report.StringGrid1.Cells[23,0]:='SHA3_512';
5362 Form_report.StringGrid1.Cells[24,0]:='Whirlpool';
5363 Form_report.StringGrid1.Cells[25,0]:='(Encoded size)';
5364 Form_report.StringGrid1.Cells[26,0]:='File header';
5365 Form_report.StringGrid1.Cells[27,0]:='End of file';
5366 Form_report.StringGrid1.Cells[28,0]:='Directory content';
5367 Form_report.StringGrid1.Cells[29,0]:='% size';
5368 Form_report.StringGrid1.Cells[30,0]:='(Encoded % size)';
5369 //read output mode HEX or BASE64
5370 if upcase(paramstr(2))='HEX' then mode:='HEX'
5371 else
5372 if upcase(paramstr(2))='LSBHEX' then mode:='LSBHEX'
5373 else
5374 if upcase(paramstr(2))='BASE64' then mode:='BASE64'
5375 else
5376 begin
5377 MessageDlg('Mode '+paramstr(2)+' is not valid, use HEX to see output coded as hexadecimal, LSBHEX for LSB hexadecimal or BASE64 for output coded in BASE64', mtError, [mbOK], 0);
5378 halt(-3);
5379 end;
5380 //read algorithms to be used
5381 j:=3;
5382 Adler32_on:=false;
5383 CRC16_on:=false;
5384 CRC24_on:=false;
5385 CRC32_on:=false;
5386 CRC64_on:=false;
5387 ED2K_on:=false;
5388 MD4_on:=false;
5389 MD5_on:=false;
5390 RIPEMD160_on:=false;
5391 Blake2s_on:=false;
5392 Blake2b_on:=false;
5393 SHA1_on:=false;
5394 SHA224_on:=false;
5395 SHA256_on:=false;
5396 SHA3_256_on:=false;
5397 SHA384_on:=false;
5398 SHA512_on:=false;
5399 SHA3_512_on:=false;
5400 WHIRLPOOL_on:=false;
5401 oper:='CRCHASH';
5402 moded:=mode;
5403 repeat
5404 case upcase(paramstr(j)) of
5405 'ADLER32': Adler32_on:=true;
5406 'CRC16': CRC16_on:=true;
5407 'CRC24': CRC24_on:=true;
5408 'CRC32': CRC32_on:=true;
5409 'CRC64': CRC64_on:=true;
5410 'ED2K': ED2K_on:=true;
5411 'MD4': MD4_on:=true;
5412 'MD5': MD5_on:=true;
5413 'RIPEMD160': RIPEMD160_on:=true;
5414 'SHA1': SHA1_on:=true;
5415 'BLAKE2S': Blake2s_on:=true;//'SHA224': SHA224_on:=true;
5416 'SHA256': SHA256_on:=true;
5417 'SHA3_256': SHA3_256_on:=true;
5418 'BLAKE2B': Blake2b_on:=true;//'SHA384': SHA384_on:=true;
5419 'SHA512': SHA512_on:=true;
5420 'SHA3_512': SHA3_512_on:=true;
5421 'WHIRLPOOL': WHIRLPOOL_on:=true;
5422 'ALL':
5423 begin
5424 Adler32_on:=true;
5425 CRC16_on:=true;
5426 CRC24_on:=true;
5427 CRC32_on:=true;
5428 CRC64_on:=true;
5429 ED2K_on:=true;
5430 MD4_on:=true;
5431 MD5_on:=true;
5432 RIPEMD160_on:=true;
5433 SHA1_on:=true;
5434 Blake2s_on:=true;//SHA224_on:=true;
5435 SHA256_on:=true;
5436 SHA3_256_on:=true;
5437 Blake2b_on:=true;//SHA384_on:=true;
5438 SHA512_on:=true;
5439 SHA3_512_on:=true;
5440 WHIRLPOOL_on:=true;
5441 end;
5442 'PREVIEW': begin oper:='PREVIEW'; moded:=oper; end;//no algorithm, only file metadata and header/eof samples
5443 'LIST': begin oper:='LIST'; moded:=oper; end;//no algorithm, only file metadata, will not assign files (faster)
5444 end;
5445 j:=j+1;
5446 until ((upcase(paramstr(j-1))='ON') or (j>paramcount));
5447 if j=4 then
5448 begin
5449 MessageDlg('No algorithm received', mtError, [mbOK], 0);
5450 halt(-3);
5451 end;
5452 if j>paramcount then
5453 begin
5454 MessageDlg('No input file received', mtError, [mbOK], 0);
5455 halt(-3);
5456 end;
5457 if oper='CRCHASH' then Form_pea.Caption:='Checksum and hash'
5458 else Form_pea.Caption:='Analyze';
5459 if (oper='CRCHASH') and (mode<>'BASE64') then Form_report.LabelCase.visible:=true;
5460 Form_report.Caption:=Form_pea.Caption;
5461 //get input size
5462 tsize:=0;
5463 etsize:=0;
5464 ctsize:=0;
5465 nfiles:=0;
5466 ntfiles:=0;
5467 Form_pea.LabelTools2.Caption:='Checking ('+moded+') '+inttostr(paramcount-j+1)+' element(s), counting total items and size...';
5468 Application.ProcessMessages;
5469 for i:=j to paramcount do
5470 begin
5471 if filegetattr((paramstr(i))) and faDirectory = 0 then
5472 begin
5473 srcfilesize((paramstr(i)),ctsize);
5474 ntfiles:=ntfiles+1;
5475 end
5476 else
5477 begin
5478 rcountsize((paramstr(i))+directoryseparator,'*',faAnyFile,true,nfiles,ndirs,ctsize);
5479 ntfiles:=ntfiles+nfiles;
5480 end;
5481 tsize:=tsize+ctsize;
5482 end;
5483 //perform checks
5484 t:=0;
5485 te:=0;
5486 td:=0;
5487 ntotalexp:=0;
5488 compest:=0;
5489 compsize:=0;
5490 dmax:=-1;
5491 dmin:=-1;
5492 smax:=-1;
5493 smin:=-1;
5494 for i:=j to paramcount do
5495 begin
5496 if i=j then setcurrentdir(extractfilepath((paramstr(i)))); //set path same as the first input file (for saving the report in)
5497 expand((paramstr(i)),exp_files,exp_fsizes,exp_ftimes,exp_fattr,exp_fattr_dec,nfound);
5498 if nfound=0 then nfound:=1;
5499 ntotalexp:=ntotalexp+nfound;
5500 if oper='CRCHASH' then
5501 if ntotalexp>1 then Form_report.StringGrid1.Rowcount:=ntotalexp+2
5502 else Form_report.StringGrid1.Rowcount:=ntotalexp+1
5503 else Form_report.StringGrid1.Rowcount:=ntotalexp+1;
5504 for k:=0 to nfound-1 do
5505 if filegetattr(exp_files[k]) and faDirectory = 0 then
5506 begin
5507 filemode:=0;
5508 t:=t+1;
5509 try
5510 if oper<>'LIST' then
5511 begin
5512 assignfile(f,(exp_files[k]));
5513 filemode:=0;
5514 reset(f);
5515 end;
5516 srcfilesize((exp_files[k]),f_size);
5517 Form_report.StringGrid1.Cells[0,t]:=(exp_files[k]);
5518 Form_report.StringGrid1.Cells[1,t]:=extractfilename((exp_files[k]));
5519 Form_report.StringGrid1.Cells[2,t]:=extractfileext((exp_files[k]));
5520 Form_report.StringGrid1.Cells[3,t]:=nicenumber(inttostr(f_size));
5521 Form_report.StringGrid1.Cells[4,t]:=inttostr(f_size);
5522 Form_report.StringGrid1.Cells[5,t]:=FormatDateTime('yyyy-mm-dd hh:mm:ss', filedatetodatetime(exp_ftimes[k]));
5523 Form_report.StringGrid1.Cells[6,t]:=exp_fattr_dec[k];
5524 Form_report.StringGrid1.Cells[25,t]:=inttostr(length(inttostr(length(Form_report.StringGrid1.Cells[4,t]))))+inttostr(length(Form_report.StringGrid1.Cells[4,t]))+Form_report.StringGrid1.Cells[4,t];
5525 if tsize>0 then Form_report.StringGrid1.Cells[29,t]:=inttostr((100*f_size) div tsize)+'%';
5526 if tsize>0 then Form_report.StringGrid1.Cells[30,t]:=inttostr(length(Form_report.StringGrid1.Cells[27,t]))+Form_report.StringGrid1.Cells[27,t];
5527 compest:=testpcomp(exp_files[k]);
5528 compsize:=compsize+(f_size*compest);
5529 if smax=-1 then smax:=exp_fsizes[k];
5530 if smin=-1 then smin:=exp_fsizes[k];
5531 if dmax=-1 then dmax:=exp_ftimes[k];
5532 if dmin=-1 then dmin:=exp_ftimes[k];
5533 if f_size>smax then smax:=f_size;
5534 if f_size<smin then smin:=f_size;
5535 try
5536 if exp_ftimes[k]>dmax then dmax:=exp_ftimes[k];
5537 if exp_ftimes[k]<dmin then dmin:=exp_ftimes[k];
5538 except end;
5539 {if f_size=0 then
5540 begin
5541 if oper<>'LIST' then
5542 begin closefile(f); end;
5543 continue;
5544 end;}
5545 Form_pea.LabelTools2.Caption:='Checking ('+moded+') '+inttostr(paramcount-j+1)+' element(s), '+nicenumber(inttostr(tsize))+', '+nicenumber(inttostr(etsize))+' checked';
5546 Form_pea.LabelTools3.Caption:='Processing item '+inttostr(t)+' of '+inttostr(ntfiles)+', '+nicenumber(inttostr(f_size))+' file';
5547 Application.ProcessMessages;
5548 except
5549 Form_report.StringGrid1.Cells[0,t]:=(exp_files[k]);
5550 Form_report.StringGrid1.Cells[1,t]:=extractfilename((exp_files[k]));
5551 Form_report.StringGrid1.Cells[2,t]:=extractfileext((exp_files[k]));
5552 Form_report.StringGrid1.Cells[3,t]:='ERROR';
5553 te:=te+1;
5554 continue;
5555 end;
5556 if oper<>'LIST' then
5557 begin
5558 if RIPEMD160_on then RMD160Init(RMD160Context);
5559 if SHA1_on then SHA1Init(SHA1Context);
5560 if SHA256_on then SHA256Init(SHA256Context);
5561 if SHA3_256_on then SHA3_256Init(SHA3_256Context);
5562 if Blake2s_on then Blake2s_Init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen); //if SHA224_on then SHA224Init(SHA224Context);
5563 if Blake2b_on then Blake2b_Init(Blake2bContext,nil,0,BLAKE2B_MaxDigLen); //if SHA384_on then SHA384Init(SHA384Context);
5564 if SHA512_on then SHA512Init(SHA512Context);
5565 if SHA3_512_on then SHA3_512Init(SHA3_512Context);
5566 if Whirlpool_on then Whirl_Init(WhirlContext);
5567 if ED2K_on then ED2K_Init(ED2KContext);
5568 if MD4_on then MD4Init(MD4Context);
5569 if MD5_on then MD5Init(MD5Context);
5570 if CRC16_on then CRC16Init(CRC16);
5571 if CRC24_on then CRC24Init(CRC24);
5572 if CRC32_on then CRC32Init(CRC32);
5573 if Adler32_on then Adler32Init(adler);
5574 if CRC64_on then CRC64Init(CRC64);
5575 repeat
5576 blockread(f,sbuf,sizeof(sbuf),n);
5577 if n<>0 then
5578 begin
5579 if Adler32_on then Adler32Update(adler,@sbuf,n);
5580 if CRC16_on then CRC16Update(CRC16,@sbuf,n);
5581 if CRC24_on then CRC24Update(CRC24,@sbuf,n);
5582 if CRC32_on then CRC32Update(CRC32,@sbuf,n);
5583 if CRC64_on then CRC64Update(CRC64,@sbuf,n);
5584 if ED2K_on then ED2K_Update(ED2KContext,@sbuf,n);
5585 if MD4_on then MD4Update(MD4Context,@sbuf,n);
5586 if MD5_on then MD5Update(MD5Context,@sbuf,n);
5587 if RIPEMD160_on then RMD160Update(RMD160Context,@sbuf,n);
5588 if SHA1_on then SHA1Update(SHA1Context,@sbuf,n);
5589 if Blake2s_on then Blake2s_update(Blake2sContext,@sbuf,n);//if SHA224_on then SHA224Update(SHA224Context,@sbuf,n);
5590 if SHA256_on then SHA256Update(SHA256Context,@sbuf,n);
5591 if SHA3_256_on then SHA3_256Update(SHA3_256Context,@sbuf,n);
5592 if Blake2b_on then Blake2b_update(Blake2bContext,@sbuf,n);//if SHA384_on then SHA384Update(SHA384Context,@sbuf,n);
5593 if SHA512_on then SHA512Update(SHA512Context,@sbuf,n);
5594 if SHA3_512_on then SHA3_512Update(SHA3_512Context,@sbuf,n);
5595 if Whirlpool_on then Whirl_Update(WhirlContext,@sbuf,n);
5596 etsize:=etsize+n;
5597 Form_pea.ProgressBar1.Position:=(100*etsize) div (tsize+paramcount);
5598 tsout:=datetimetotimestamp(now);
5599 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
5600 Form_pea.LabelTools5.Caption:=nicetime(inttostr(time))+' elapsed';
5601 if toolactioncancelled=true then begin closefile(f); cancelcheck; exit; end;
5602 Application.ProcessMessages;
5603 end;
5604 until n<>sizeof(sbuf);
5605 seek(f,0);
5606 blockread(f,sbuf,32,n);
5607 if n<>0 then
5608 begin
5609 dummystr:='';
5610 SetString(dummystr, PChar(@sbuf[1]), n);
5611 Form_report.StringGrid1.Cells[26,t]:=utf8encode(dummystr);
5612 end;
5613 if f_size>=32 then seek(f,f_size-32) else seek(f,0);
5614 blockread(f,sbuf,32,n);
5615 if n<>0 then
5616 begin
5617 dummystr:='';
5618 SetString(dummystr, PChar(@sbuf[1]), n);
5619 Form_report.StringGrid1.Cells[27,t]:=utf8encode(dummystr);
5620 end;
5621 close(f);
5622 if Adler32_on then Adler32Final(adler);
5623 if CRC16_on then CRC16Final(CRC16);
5624 if CRC24_on then CRC24Final(CRC24); Long2PGP(CRC24, pgpsig);
5625 if CRC32_on then CRC32Final(CRC32);
5626 if CRC64_on then CRC64Final(CRC64);
5627 if ED2K_on then ED2K_Final(ED2KContext,ED2KRes);
5628 if MD4_on then MD4Final(MD4Context,MD4Digest);
5629 if MD5_on then MD5Final(MD5Context,MD5Digest);
5630 if RIPEMD160_on then RMD160Final(RMD160Context,RMD160Digest);
5631 if SHA1_on then SHA1Final(SHA1Context,SHA1Digest);
5632 if Blake2s_on then blake2s_Final(Blake2sContext,Blake2sDigest);//if SHA224_on then SHA224Final(SHA224Context,SHA224Digest);
5633 if SHA256_on then SHA256Final(SHA256Context,SHA256Digest);
5634 if SHA3_256_on then SHA3_256Final(SHA3_256Context,SHA3_256Digest);
5635 if Blake2b_on then blake2b_Final(Blake2bContext,Blake2bDigest);//if SHA384_on then SHA384Final(SHA384Context,SHA384Digest);
5636 if SHA512_on then SHA512Final(SHA512Context,SHA512Digest);
5637 if SHA3_512_on then SHA3_512Final(SHA3_512Context,SHA3_512Digest);
5638 if Whirlpool_on then Whirl_Final(WhirlContext,WhirlDigest);
5639 if ((mode='HEX') or (mode='LSBHEX')) then
5640 begin
5641 if mode ='HEX' then
5642 begin
5643 if CRC16_on then CRC16 := swap(CRC16);
5644 if CRC24_on then Form_report.StringGrid1.Cells[10,t]:=hexstr(@pgpsig,sizeof(pgpsig));
5645 CRC32 := (CRC32 shr 24) or ((CRC32 shr 8) and $FF00) or ((CRC32 shl 8) and $FF0000) or (CRC32 shl 24);
5646 Adler := (Adler shr 24) or ((Adler shr 8) and $FF00) or ((Adler shl 8) and $FF0000) or (Adler shl 24);
5647 end
5648 else
5649 begin
5650 if CRC24_on then Form_report.StringGrid1.Cells[10,t]:=hexstr(@CRC24,sizeof(CRC24));
5651 end;
5652 if Adler32_on then Form_report.StringGrid1.Cells[8,t]:=upcase(hexstr(@adler,sizeof(Adler)));
5653 if CRC16_on then Form_report.StringGrid1.Cells[9,t]:=upcase(hexstr(@CRC16,sizeof(CRC16)));
5654 if CRC32_on then Form_report.StringGrid1.Cells[11,t]:=upcase(hexstr(@CRC32,sizeof(CRC32)));
5655 if CRC64_on then Form_report.StringGrid1.Cells[12,t]:=upcase(hexstr(@CRC64,sizeof(CRC64)));
5656 if ED2K_on then
5657 begin
5658 Form_report.StringGrid1.Cells[13,t]:=upcase(hexstr(@ED2KRes.eDonkey, sizeof(ED2KRes.eDonkey)));
5659 if ED2KRes.differ then Form_report.StringGrid1.Cells[13,t]:=Form_report.StringGrid1.Cells[13,t]+' / eMule: '+upcase(hexstr(@ED2KRes.eMule, sizeof(ED2KRes.eMule)));
5660 end;
5661 if MD4_on then Form_report.StringGrid1.Cells[14,t]:=upcase(hexstr(@MD4Digest,sizeof(MD4Digest)));
5662 if MD5_on then Form_report.StringGrid1.Cells[15,t]:=upcase(hexstr(@MD5Digest,sizeof(MD5Digest)));
5663 if RIPEMD160_on then Form_report.StringGrid1.Cells[16,t]:=upcase(hexstr(@RMD160Digest,sizeof(RMD160Digest)));
5664 if SHA1_on then Form_report.StringGrid1.Cells[17,t]:=upcase(hexstr(@SHA1Digest,sizeof(SHA1Digest)));
5665 if Blake2s_on then Form_report.StringGrid1.Cells[18,t]:=upcase(hexstr(@Blake2sDigest,sizeof(Blake2sDigest)));//if SHA224_on then Form_report.StringGrid1.Cells[18,t]:=upcase(hexstr(@SHA224Digest,sizeof(SHA224Digest)));
5666 if SHA256_on then Form_report.StringGrid1.Cells[19,t]:=upcase(hexstr(@SHA256Digest,sizeof(SHA256Digest)));
5667 if SHA3_256_on then Form_report.StringGrid1.Cells[20,t]:=upcase(hexstr(@SHA3_256Digest,sizeof(SHA3_256Digest)));
5668 if Blake2b_on then Form_report.StringGrid1.Cells[21,t]:=upcase(hexstr(@Blake2bDigest,sizeof(Blake2bDigest)));//if SHA384_on then Form_report.StringGrid1.Cells[21,t]:=upcase(hexstr(@SHA384Digest,sizeof(SHA384Digest)));
5669 if SHA512_on then Form_report.StringGrid1.Cells[22,t]:=upcase(hexstr(@SHA512Digest,sizeof(SHA512Digest)));
5670 if SHA3_512_on then Form_report.StringGrid1.Cells[23,t]:=upcase(hexstr(@SHA3_512Digest,sizeof(SHA3_512Digest)));
5671 if Whirlpool_on then Form_report.StringGrid1.Cells[24,t]:=upcase(hexstr(@WhirlDigest,sizeof(WhirlDigest)));
5672 end
5673 else
5674 begin
5675 if Adler32_on then Form_report.StringGrid1.Cells[8,t]:=base64str(@adler,sizeof(Adler));
5676 if CRC16_on then Form_report.StringGrid1.Cells[9,t]:=base64str(@CRC16,sizeof(CRC16));
5677 if CRC24_on then Form_report.StringGrid1.Cells[10,t]:=base64str(@pgpsig,sizeof(CRC24));
5678 if CRC32_on then Form_report.StringGrid1.Cells[11,t]:=base64str(@CRC32,sizeof(CRC32));
5679 if CRC64_on then Form_report.StringGrid1.Cells[12,t]:=base64str(@CRC64,sizeof(CRC64));
5680 if ED2K_on then
5681 begin
5682 Form_report.StringGrid1.Cells[13,t]:=base64str(@ED2KRes.eDonkey, sizeof(ED2KRes.eDonkey));
5683 if ED2KRes.differ then Form_report.StringGrid1.Cells[13,t]:=Form_report.StringGrid1.Cells[13,t]+' / eMule: '+base64str(@ED2KRes.eMule, sizeof(ED2KRes.eMule));
5684 end;
5685 if MD4_on then Form_report.StringGrid1.Cells[14,t]:=base64str(@MD4Digest,sizeof(MD4Digest));
5686 if MD5_on then Form_report.StringGrid1.Cells[15,t]:=base64str(@MD5Digest,sizeof(MD5Digest));
5687 if RIPEMD160_on then Form_report.StringGrid1.Cells[16,t]:=base64str(@RMD160Digest,sizeof(RMD160Digest));
5688 if SHA1_on then Form_report.StringGrid1.Cells[17,t]:=base64str(@SHA1Digest,sizeof(SHA1Digest));
5689 if Blake2s_on then Form_report.StringGrid1.Cells[18,t]:=base64str(@Blake2sDigest,sizeof(Blake2sDigest)); //if SHA224_on then Form_report.StringGrid1.Cells[18,t]:=base64str(@SHA224Digest,sizeof(SHA224Digest));
5690 if SHA256_on then Form_report.StringGrid1.Cells[19,t]:=base64str(@SHA256Digest,sizeof(SHA256Digest));
5691 if SHA3_256_on then Form_report.StringGrid1.Cells[20,t]:=base64str(@SHA3_256Digest,sizeof(SHA3_256Digest));
5692 if Blake2b_on then Form_report.StringGrid1.Cells[21,t]:=base64str(@Blake2bDigest,sizeof(Blake2bDigest)); //if SHA384_on then Form_report.StringGrid1.Cells[21,t]:=base64str(@SHA384Digest,sizeof(SHA384Digest));
5693 if SHA512_on then Form_report.StringGrid1.Cells[22,t]:=base64str(@SHA512Digest,sizeof(SHA512Digest));
5694 if SHA3_512_on then Form_report.StringGrid1.Cells[23,t]:=base64str(@SHA3_512Digest,sizeof(SHA3_512Digest));
5695 if Whirlpool_on then Form_report.StringGrid1.Cells[24,t]:=base64str(@WhirlDigest,sizeof(WhirlDigest));
5696 end;
5697 end
5698 else //list operation, do not assign file
5699 begin
5700 etsize:=etsize+f_size;
5701 Form_pea.ProgressBar1.Position:=(100*etsize) div (tsize+paramcount);
5702 tsout:=datetimetotimestamp(now);
5703 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
5704 Form_pea.LabelTools5.Caption:=nicetime(inttostr(time))+' elapsed';
5705 if toolactioncancelled=true then begin cancelcheck; exit; end;
5706 end;
5707 if etsize>0 then Form_pea.LabelTools4.Caption:='Potential compression '+inttostr((etsize*100 - compsize) div etsize)+'%';
5708 end
5709 else//directory
5710 begin
5711 t:=t+1;
5712 td:=td+1;
5713 dummystr:=copy((exp_files[k]),0,length((exp_files[k]))-1);
5714 Form_report.StringGrid1.Cells[0,t]:=(exp_files[k]);
5715 Form_report.StringGrid1.Cells[1,t]:=extractfilename(dummystr);
5716 Form_report.StringGrid1.Cells[2,t]:=' [folder]';
5717 Form_report.StringGrid1.Cells[3,t]:='';
5718 Form_report.StringGrid1.Cells[4,t]:='';
5719 Form_report.StringGrid1.Cells[5,t]:=FormatDateTime('yyyy-mm-dd hh:mm:ss', filedatetodatetime(exp_ftimes[k]));
5720 Form_report.StringGrid1.Cells[6,t]:=exp_fattr_dec[k];
5721 ctsize:=0;
5722 nfiles:=0;
5723 ndirs:=0;
5724 rcountsize((exp_files[k]),'*',faAnyFile,true,nfiles,ndirs,ctsize);
5725 Form_report.StringGrid1.Cells[28,t]:='('+inttostr(ctsize)+' B) '+(inttostr(ndirs-1))+' dir(s), '+(inttostr(nfiles))+' file(s), '+nicenumber(inttostr(ctsize));
5726 if tsize>0 then Form_report.StringGrid1.Cells[29,t]:=inttostr((100*ctsize) div tsize)+'%';
5727 if tsize>0 then Form_report.StringGrid1.Cells[30,t]:=inttostr(length(Form_report.StringGrid1.Cells[27,t]))+Form_report.StringGrid1.Cells[27,t];
5728 end;
5729 end;
5730 Form_report.StringGrid1.AutosizeColumns;
5731 if Adler32_on then
5732 if (t-td-te)>1 then
5733 begin
5734 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5735 Adler32Init(Adler);
5736 for i:=1 to t do
5737 begin
5738 sdig:=Form_report.StringGrid1.Cells[8,i];
5739 if sdig<>'' then
5740 begin
5741 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5742 Adler32Update(Adler,@sbuf,sizeof(sdig));
5743 end;
5744 end;
5745 Adler32Final(Adler);
5746 case mode of
5747 'HEX':
5748 begin
5749 Adler := (Adler shr 24) or ((Adler shr 8) and $FF00) or ((Adler shl 8) and $FF0000) or (Adler shl 24);
5750 Form_report.StringGrid1.Cells[8,t+1]:=upcase(hexstr(@Adler,sizeof(Adler)));
5751 end;
5752 'LSBHEX': Form_report.StringGrid1.Cells[8,t+1]:=upcase(hexstr(@Adler,sizeof(Adler)));
5753 'BASE64':Form_report.StringGrid1.Cells[8,t+1]:=base64str(@Adler,sizeof(Adler));
5754 end;
5755 end
5756 else
5757 else Form_report.StringGrid1.ColWidths[8]:=0;
5758 if CRC16_on then
5759 if (t-td-te)>1 then
5760 begin
5761 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5762 CRC16Init(CRC16);
5763 for i:=1 to t do
5764 begin
5765 sdig:=Form_report.StringGrid1.Cells[9,i];
5766 if sdig<>'' then
5767 begin
5768 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5769 CRC16Update(CRC16,@sbuf,sizeof(sdig));
5770 end;
5771 end;
5772 CRC16Final(CRC16);
5773 case mode of
5774 'HEX':
5775 begin
5776 CRC16 := swap(CRC16);
5777 Form_report.StringGrid1.Cells[9,t+1]:=upcase(hexstr(@CRC16,sizeof(CRC16)));
5778 end;
5779 'LSBHEX': Form_report.StringGrid1.Cells[9,t+1]:=upcase(hexstr(@CRC16,sizeof(CRC16)));
5780 'BASE64':Form_report.StringGrid1.Cells[9,t+1]:=base64str(@CRC16,sizeof(CRC16));
5781 end;
5782 end
5783 else
5784 else Form_report.StringGrid1.ColWidths[9]:=0;
5785 if CRC24_on then
5786 if (t-td-te)>1 then
5787 begin
5788 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5789 CRC24Init(CRC24);
5790 for i:=1 to t do
5791 begin
5792 sdig:=Form_report.StringGrid1.Cells[10,i];
5793 if sdig<>'' then
5794 begin
5795 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5796 CRC24Update(CRC24,@sbuf,sizeof(sdig));
5797 end;
5798 end;
5799 CRC24Final(CRC24);
5800 Long2PGP(CRC24, pgpsig);
5801 case mode of
5802 'HEX':
5803 begin
5804 Form_report.StringGrid1.Cells[10,t+1]:=hexstr(@pgpsig,sizeof(pgpsig));
5805 Form_report.StringGrid1.Cells[10,t+1]:=upcase(hexstr(@CRC24,sizeof(CRC24)));
5806 end;
5807 'LSBHEX': Form_report.StringGrid1.Cells[10,t+1]:=hexstr(@CRC24,sizeof(CRC24));
5808 'BASE64': Form_report.StringGrid1.Cells[10,t+1]:=base64str(@pgpsig,sizeof(CRC24))
5809 end;
5810 end
5811 else
5812 else Form_report.StringGrid1.ColWidths[10]:=0;
5813 if CRC32_on then
5814 if (t-td-te)>1 then
5815 begin
5816 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5817 CRC32Init(CRC32);
5818 for i:=1 to t do
5819 begin
5820 sdig:=Form_report.StringGrid1.Cells[11,i];
5821 if sdig<>'' then
5822 begin
5823 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5824 CRC32Update(CRC32,@sbuf,sizeof(sdig));
5825 end;
5826 end;
5827 CRC32Final(CRC32);
5828 case mode of
5829 'HEX':
5830 begin
5831 CRC32 := (CRC32 shr 24) or ((CRC32 shr 8) and $FF00) or ((CRC32 shl 8) and $FF0000) or (CRC32 shl 24);
5832 Form_report.StringGrid1.Cells[11,t+1]:=upcase(hexstr(@CRC32,sizeof(CRC32)));
5833 end;
5834 'LSBHEX': Form_report.StringGrid1.Cells[11,t+1]:=upcase(hexstr(@CRC32,sizeof(CRC32)));
5835 'BASE64':Form_report.StringGrid1.Cells[11,t+1]:=base64str(@CRC32,sizeof(CRC32));
5836 end;
5837 end
5838 else
5839 else Form_report.StringGrid1.ColWidths[11]:=0;
5840 if CRC64_on then
5841 if (t-td-te)>1 then
5842 begin
5843 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5844 CRC64Init(CRC64);
5845 for i:=1 to t do
5846 begin
5847 sdig:=Form_report.StringGrid1.Cells[12,i];
5848 if sdig<>'' then
5849 begin
5850 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5851 CRC64Update(CRC64,@sbuf,sizeof(sdig));
5852 end;
5853 end;
5854 CRC64Final(CRC64);
5855 case mode of
5856 'HEX','LSBHEX': Form_report.StringGrid1.Cells[12,t+1]:=upcase(hexstr(@CRC64,sizeof(CRC64)));
5857 'BASE64':Form_report.StringGrid1.Cells[12,t+1]:=base64str(@CRC64,sizeof(CRC64));
5858 end;
5859 end
5860 else
5861 else Form_report.StringGrid1.ColWidths[12]:=0;
5862 if ED2K_on then
5863 if (t-td-te)>1 then
5864 begin
5865 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5866 ED2K_Init(ED2KContext);
5867 for i:=1 to t do
5868 begin
5869 sdig:=Form_report.StringGrid1.Cells[13,i];
5870 if sdig<>'' then
5871 begin
5872 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5873 ED2K_Update(ED2KContext,@sbuf,sizeof(sdig));
5874 end;
5875 end;
5876 ED2K_Final(ED2KContext,ED2KRes);
5877 case mode of
5878 'HEX','LSBHEX':
5879 begin
5880 Form_report.StringGrid1.Cells[13,t+1]:=upcase(hexstr(@ED2KRes.eDonkey, sizeof(ED2KRes.eDonkey)));
5881 if ED2KRes.differ then Form_report.StringGrid1.Cells[13,t+1]:=Form_report.StringGrid1.Cells[13,t+1]+' / eMule: '+upcase(hexstr(@ED2KRes.eMule, sizeof(ED2KRes.eMule)));
5882 end;
5883 'BASE64':
5884 begin
5885 Form_report.StringGrid1.Cells[13,t+1]:=base64str(@ED2KRes.eDonkey, sizeof(ED2KRes.eDonkey));
5886 if ED2KRes.differ then Form_report.StringGrid1.Cells[13,t+1]:=Form_report.StringGrid1.Cells[13,t+1]+' / eMule: '+base64str(@ED2KRes.eMule, sizeof(ED2KRes.eMule));
5887 end;
5888 end;
5889 end
5890 else
5891 else Form_report.StringGrid1.ColWidths[13]:=0;
5892 if MD4_on then
5893 if (t-td-te)>1 then
5894 begin
5895 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5896 MD4Init(MD4Context);
5897 for i:=1 to t do
5898 begin
5899 sdig:=Form_report.StringGrid1.Cells[14,i];
5900 if sdig<>'' then
5901 begin
5902 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5903 MD4Update(MD4Context,@sbuf,sizeof(sdig));
5904 end;
5905 end;
5906 MD4Final(MD4Context,MD4Digest);
5907 case mode of
5908 'HEX','LSBHEX': Form_report.StringGrid1.Cells[14,t+1]:=upcase(hexstr(@MD4Digest,sizeof(MD4Digest)));
5909 'BASE64':Form_report.StringGrid1.Cells[14,t+1]:=base64str(@MD4Digest,sizeof(MD4Digest));
5910 end;
5911 end
5912 else
5913 else Form_report.StringGrid1.ColWidths[14]:=0;
5914 if MD5_on then
5915 if (t-td-te)>1 then
5916 begin
5917 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5918 MD5Init(MD5Context);
5919 for i:=1 to t do
5920 begin
5921 sdig:=Form_report.StringGrid1.Cells[15,i];
5922 if sdig<>'' then
5923 begin
5924 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5925 MD5Update(MD5Context,@sbuf,sizeof(sdig));
5926 end;
5927 end;
5928 MD5Final(MD5Context,MD5Digest);
5929 case mode of
5930 'HEX','LSBHEX': Form_report.StringGrid1.Cells[15,t+1]:=upcase(hexstr(@MD5Digest,sizeof(MD5Digest)));
5931 'BASE64':Form_report.StringGrid1.Cells[15,t+1]:=base64str(@MD5Digest,sizeof(MD5Digest));
5932 end;
5933 end
5934 else
5935 else Form_report.StringGrid1.ColWidths[15]:=0;
5936 if RIPEMD160_on then
5937 if (t-td-te)>1 then
5938 begin
5939 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5940 RMD160Init(RMD160Context);
5941 for i:=1 to t do
5942 begin
5943 sdig:=Form_report.StringGrid1.Cells[16,i];
5944 if sdig<>'' then
5945 begin
5946 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5947 RMD160Update(RMD160Context,@sbuf,sizeof(sdig));
5948 end;
5949 end;
5950 RMD160Final(RMD160Context,RMD160Digest);
5951 case mode of
5952 'HEX','LSBHEX': Form_report.StringGrid1.Cells[16,t+1]:=upcase(hexstr(@RMD160Digest,sizeof(RMD160Digest)));
5953 'BASE64':Form_report.StringGrid1.Cells[16,t+1]:=base64str(@RMD160Digest,sizeof(RMD160Digest));
5954 end;
5955 end
5956 else
5957 else Form_report.StringGrid1.ColWidths[16]:=0;
5958 if SHA1_on then
5959 if (t-td-te)>1 then
5960 begin
5961 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5962 SHA1Init(SHA1Context);
5963 for i:=1 to t do
5964 begin
5965 sdig:=Form_report.StringGrid1.Cells[17,i];
5966 if sdig<>'' then
5967 begin
5968 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5969 SHA1Update(SHA1Context,@sbuf,sizeof(sdig));
5970 end;
5971 end;
5972 SHA1Final(SHA1Context,SHA1Digest);
5973 case mode of
5974 'HEX','LSBHEX': Form_report.StringGrid1.Cells[17,t+1]:=upcase(hexstr(@SHA1Digest,sizeof(SHA1Digest)));
5975 'BASE64':Form_report.StringGrid1.Cells[17,t+1]:=base64str(@SHA1Digest,sizeof(SHA1Digest));
5976 end;
5977 end
5978 else
5979 else Form_report.StringGrid1.ColWidths[17]:=0;
5980 if Blake2s_on then
5981 if (t-td-te)>1 then
5982 begin
5983 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
5984 Blake2s_init(Blake2sContext,nil,0,BLAKE2S_MaxDigLen);
5985 for i:=1 to t do
5986 begin
5987 sdig:=Form_report.StringGrid1.Cells[18,i];
5988 if sdig<>'' then
5989 begin
5990 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
5991 blake2s_update(Blake2sContext,@sbuf,sizeof(sdig));
5992 end;
5993 end;
5994 blake2s_Final(Blake2sContext,Blake2sDigest);
5995 case mode of
5996 'HEX','LSBHEX': Form_report.StringGrid1.Cells[18,t+1]:=upcase(hexstr(@Blake2sDigest,sizeof(Blake2sDigest)));
5997 'BASE64':Form_report.StringGrid1.Cells[18,t+1]:=base64str(@Blake2sDigest,sizeof(Blake2sDigest));
5998 end;
5999 end
6000 else
6001 else Form_report.StringGrid1.ColWidths[18]:=0;
6002 {if SHA224_on then
6003 if (t-td-te)>1 then
6004 begin
6005 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
6006 SHA224Init(SHA224Context);
6007 for i:=1 to t do
6008 begin
6009 sdig:=Form_report.StringGrid1.Cells[18,i];
6010 if sdig<>'' then
6011 begin
6012 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
6013 SHA224Update(SHA224Context,@sbuf,sizeof(sdig));
6014 end;
6015 end;
6016 SHA224Final(SHA224Context,SHA224Digest);
6017 case mode of
6018 'HEX','LSBHEX': Form_report.StringGrid1.Cells[18,t+1]:=upcase(hexstr(@SHA224Digest,sizeof(SHA224Digest)));
6019 'BASE64':Form_report.StringGrid1.Cells[18,t+1]:=base64str(@SHA224Digest,sizeof(SHA224Digest));
6020 end;
6021 end
6022 else
6023 else Form_report.StringGrid1.ColWidths[18]:=0;}
6024 if SHA256_on then
6025 if (t-td-te)>1 then
6026 begin
6027 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
6028 SHA256Init(SHA256Context);
6029 for i:=1 to t do
6030 begin
6031 sdig:=Form_report.StringGrid1.Cells[19,i];
6032 if sdig<>'' then
6033 begin
6034 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
6035 SHA256Update(SHA256Context,@sbuf,sizeof(sdig));
6036 end;
6037 end;
6038 SHA256Final(SHA256Context,SHA256Digest);
6039 case mode of
6040 'HEX','LSBHEX': Form_report.StringGrid1.Cells[19,t+1]:=upcase(hexstr(@SHA256Digest,sizeof(SHA256Digest)));
6041 'BASE64':Form_report.StringGrid1.Cells[19,t+1]:=base64str(@SHA256Digest,sizeof(SHA256Digest));
6042 end;
6043 end
6044 else
6045 else Form_report.StringGrid1.ColWidths[19]:=0;
6046 if SHA3_256_on then
6047 if (t-td-te)>1 then
6048 begin
6049 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
6050 SHA3_256Init(SHA3_256Context);
6051 for i:=1 to t do
6052 begin
6053 sdig:=Form_report.StringGrid1.Cells[20,i];
6054 if sdig<>'' then
6055 begin
6056 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
6057 SHA3_256Update(SHA3_256Context,@sbuf,sizeof(sdig));
6058 end;
6059 end;
6060 SHA3_256Final(SHA3_256Context,SHA3_256Digest);
6061 case mode of
6062 'HEX','LSBHEX': Form_report.StringGrid1.Cells[20,t+1]:=upcase(hexstr(@SHA3_256Digest,sizeof(SHA3_256Digest)));
6063 'BASE64':Form_report.StringGrid1.Cells[20,t+1]:=base64str(@SHA3_256Digest,sizeof(SHA3_256Digest));
6064 end;
6065 end
6066 else
6067 else Form_report.StringGrid1.ColWidths[20]:=0;
6068 if Blake2b_on then
6069 if (t-td-te)>1 then
6070 begin
6071 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
6072 Blake2b_init(Blake2bContext,nil,0,BLAKE2B_MaxDigLen);
6073 for i:=1 to t do
6074 begin
6075 sdig:=Form_report.StringGrid1.Cells[21,i];
6076 if sdig<>'' then
6077 begin
6078 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
6079 blake2b_update(Blake2bContext,@sbuf,sizeof(sdig));
6080 end;
6081 end;
6082 blake2b_Final(Blake2bContext,Blake2bDigest);
6083 case mode of
6084 'HEX','LSBHEX': Form_report.StringGrid1.Cells[21,t+1]:=upcase(hexstr(@Blake2bDigest,sizeof(Blake2bDigest)));
6085 'BASE64':Form_report.StringGrid1.Cells[21,t+1]:=base64str(@Blake2bDigest,sizeof(Blake2bDigest));
6086 end;
6087 end
6088 else
6089 else Form_report.StringGrid1.ColWidths[21]:=0;
6090 {if SHA384_on then
6091 if (t-td-te)>1 then
6092 begin
6093 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
6094 SHA384Init(SHA384Context);
6095 for i:=1 to t do
6096 begin
6097 sdig:=Form_report.StringGrid1.Cells[21,i];
6098 if sdig<>'' then
6099 begin
6100 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
6101 SHA384Update(SHA384Context,@sbuf,sizeof(sdig));
6102 end;
6103 end;
6104 SHA384Final(SHA384Context,SHA384Digest);
6105 case mode of
6106 'HEX','LSBHEX': Form_report.StringGrid1.Cells[21,t+1]:=upcase(hexstr(@SHA384Digest,sizeof(SHA384Digest)));
6107 'BASE64':Form_report.StringGrid1.Cells[21,t+1]:=base64str(@SHA384Digest,sizeof(SHA384Digest));
6108 end;
6109 end
6110 else
6111 else Form_report.StringGrid1.ColWidths[21]:=0;}
6112 if SHA512_on then
6113 if (t-td-te)>1 then
6114 begin
6115 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
6116 SHA512Init(SHA512Context);
6117 for i:=1 to t do
6118 begin
6119 sdig:=Form_report.StringGrid1.Cells[22,i];
6120 if sdig<>'' then
6121 begin
6122 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
6123 SHA512Update(SHA512Context,@sbuf,sizeof(sdig));
6124 end;
6125 end;
6126 SHA512Final(SHA512Context,SHA512Digest);
6127 case mode of
6128 'HEX','LSBHEX': Form_report.StringGrid1.Cells[22,t+1]:=upcase(hexstr(@SHA512Digest,sizeof(SHA512Digest)));
6129 'BASE64':Form_report.StringGrid1.Cells[22,t+1]:=base64str(@SHA512Digest,sizeof(SHA512Digest));
6130 end;
6131 end
6132 else
6133 else Form_report.StringGrid1.ColWidths[22]:=0;
6134 if SHA3_512_on then
6135 if (t-td-te)>1 then
6136 begin
6137 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
6138 SHA3_512Init(SHA3_512Context);
6139 for i:=1 to t do
6140 begin
6141 sdig:=Form_report.StringGrid1.Cells[23,i];
6142 if sdig<>'' then
6143 begin
6144 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
6145 SHA3_512Update(SHA3_512Context,@sbuf,sizeof(sdig));
6146 end;
6147 end;
6148 SHA3_512Final(SHA3_512Context,SHA3_512Digest);
6149 case mode of
6150 'HEX','LSBHEX': Form_report.StringGrid1.Cells[23,t+1]:=upcase(hexstr(@SHA3_512Digest,sizeof(SHA3_512Digest)));
6151 'BASE64':Form_report.StringGrid1.Cells[23,t+1]:=base64str(@SHA3_512Digest,sizeof(SHA3_512Digest));
6152 end;
6153 end
6154 else
6155 else Form_report.StringGrid1.ColWidths[23]:=0;
6156 if Whirlpool_on then
6157 if (t-td-te)>1 then
6158 begin
6159 Form_report.StringGrid1.Cells[0,t+1]:='* Digest *';
6160 Whirl_Init(WhirlContext);
6161 for i:=1 to t do
6162 begin
6163 sdig:=Form_report.StringGrid1.Cells[24,i];
6164 if sdig<>'' then
6165 begin
6166 for j:=1 to sizeof(sdig) do sbuf[j]:=byte(sdig[j]);
6167 Whirl_Update(WhirlContext,@sbuf,sizeof(sdig));
6168 end;
6169 end;
6170 Whirl_Final(WhirlContext,WhirlDigest);
6171 case mode of
6172 'HEX','LSBHEX': Form_report.StringGrid1.Cells[24,t+1]:=upcase(hexstr(@WhirlDigest,sizeof(WhirlDigest)));
6173 'BASE64':Form_report.StringGrid1.Cells[24,t+1]:=base64str(@WhirlDigest,sizeof(WhirlDigest));
6174 end;
6175 end
6176 else
6177 else Form_report.StringGrid1.ColWidths[24]:=0;
6178 Form_report.StringGrid1.ColWidths[25]:=0;
6179 if oper='LIST' then
6180 begin
6181 Form_report.StringGrid1.ColWidths[26]:=0;
6182 Form_report.StringGrid1.ColWidths[27]:=0;
6183 end;
6184 Form_report.StringGrid1.ColWidths[30]:=0;
6185 if Form_report.StringGrid1.ColWidths[0]>320 then Form_report.StringGrid1.ColWidths[0]:=320;
6186 if Form_report.StringGrid1.ColWidths[1]>200 then Form_report.StringGrid1.ColWidths[1]:=200;
6187 ///check duplicates
6188 icol:=0;
6189 for icount:=8 to 23 do
6190 if Form_report.StringGrid1.ColWidths[icount]<>0 then icol:=icount;
6191 if icol<>0 then
6192 begin
6193 Form_pea.ProgressBar1.Position:=95;
6194 rc:=Form_report.StringGrid1.RowCount-1;
6195 if rc>1 then rc:=rc-1;//digest
6196 Form_pea.LabelTools2.Caption:='Checking for duplicates in '+inttostr(rc)+' items';
6197 Form_pea.LabelTools3.Caption:='This passage may take some time';
6198 Application.ProcessMessages;
6199 for icount:=1 to rc do
6200 begin
6201 dup:=0;
6202 if (Form_report.StringGrid1.Cells[2,icount]<>' [folder]') and (Form_report.StringGrid1.Cells[4,icount]<>'0') then
6203 begin
6204 for iver:=1 to rc do
6205 if Form_report.StringGrid1.Cells[icol,iver]<>Form_report.StringGrid1.Cells[icol,icount] then else dup:=dup+1;
6206 Form_report.StringGrid1.Cells[7,icount]:=inttostr(dup);
6207 end
6208 else Form_report.StringGrid1.Cells[7,icount]:='-';
6209 if icount>1024 then
6210 if (icount and 127) = 0 then
6211 begin
6212 Form_pea.LabelTools2.Caption:='Checking for duplicates of '+Form_report.StringGrid1.Cells[1,icount];
6213 Form_pea.LabelTools3.Caption:='Item '+inttostr(icount)+' of '+inttostr(rc);
6214 Application.ProcessMessages;
6215 end;
6216 end;
6217 end
6218 else Form_report.StringGrid1.ColWidths[7]:=0;
6219 ///
6220 Form_report.StringGrid1.PopupMenu:=Form_report.PopupMenu1;
6221 Form_pea.ButtonToolsCancel.visible:=false;
6222 Form_pea.ProgressBar1.Position:=100;
6223 Form_pea.LabelTools2.Caption:='Checked ('+moded+') '+inttostr(paramcount-j+1)+' element(s), '+nicenumber(inttostr(tsize))+' ['+inttostr(tsize)+' B]';
6224 Form_pea.LabelTools3.Caption:='Processed '+inttostr(t)+' of '+inttostr(ntotalexp)+' items: '+inttostr(t-td-te)+' files, '+inttostr(td)+' directories, '+inttostr(te)+' errors';
6225 if t>1 then Form_pea.LabelTools4.Caption:=
6226 'Larger '+nicenumber(inttostr(smax))+' smaller '+nicenumber(inttostr(smin))+
6227 ', newer '+FormatDateTime('yyyy-mm-dd hh:mm:ss', filedatetodatetime(dmax))+
6228 ' older '+FormatDateTime('yyyy-mm-dd hh:mm:ss', filedatetodatetime(dmin))
6229 else Form_pea.LabelTools4.Caption:='Size '+nicenumber(inttostr(smax))+', date '+FormatDateTime('yyyy-mm-dd hh:mm:ss', filedatetodatetime(dmax));
6230 if etsize>0 then Form_pea.LabelTools4.Caption:=Form_pea.LabelTools4.Caption+', potential compression '+inttostr((etsize*100 - compsize) div etsize)+'%';
6231 tsout:=datetimetotimestamp(now);
6232 time:=((tsout.date-tsin.date)*24*60*60*1000)+tsout.time-tsin.time;
6233 if time>0 then
6234 begin
6235 speed:=(tsize * 1000) div time;
6236 Form_pea.LabelTools5.Caption:=nicetime(inttostr(time))+' total time @ '+nicenumber(inttostr(speed))+'/s';
6237 end
6238 else Form_pea.LabelTools5.Caption:='';
6239 Form_report.Label1.Caption:=Form_pea.LabelTools2.Caption;
6240 Form_report.Label2.Caption:=Form_pea.LabelTools3.Caption;
6241 Form_report.Label3.Caption:=Form_pea.LabelTools4.Caption;
6242 Form_report.Label4.Caption:=Form_pea.LabelTools5.Caption;
6243 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
6244 Form_pea.ButtonDone1.Visible:=true;
6245 Form_pea.LabelOpen.Visible:=true;
6246 Form_pea.LabelOpen.Enabled:=false;
6247 Form_pea.LabelLog1.Visible:=true;
6248 Form_report.Visible:=true;
6249 Form_pea.Visible:=false;
6250 exitcode:=0;
6251 end;
6252
6253 //procedure to display environment variables strings
6254 procedure envstr;
6255 var
6256 i:integer;
6257 begin
6258 exitcode:=-1;
6259 Form_pea.PanelPW1.height:=2;
6260 Form_report.Notebook1.PageIndex:=0;
6261 Form_report.Caption:='Environment variables';
6262 Form_pea.Caption:='Environment variables';
6263 Form_pea.LabelTools2.Caption:='';
6264 Form_pea.ProgressBar1.Position:=0;
6265 Form_report.InputT.Caption:='Environment variables';
6266 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
6267 Form_report.StringGrid1.ColCount:=2;
6268 Form_report.StringGrid1.Cells[0,0]:='N';
6269 Form_report.StringGrid1.Cells[1,0]:='Variable';
6270 Form_report.StringGrid1.Rowcount:=GetEnvironmentVariableCount+2;
6271 for i:=0 to GetEnvironmentVariableCount do
6272 begin
6273 Form_report.StringGrid1.Cells[0,i+1]:=inttostr(i);
6274 Form_report.StringGrid1.Cells[1,i+1]:=GetEnvironmentString(i);
6275 end;
6276 Form_report.StringGrid1.AutosizeColumns;
6277 Form_pea.ProgressBar1.Position:=100;
6278 Form_report.Label1.Caption:=Form_pea.Caption;
6279 Form_report.Label2.Caption:=Form_pea.LabelTools2.Caption;
6280 Form_report.Label3.Caption:=Form_pea.LabelTools3.Caption;
6281 Form_report.Label4.Caption:=Form_pea.LabelTools4.Caption;
6282 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
6283 Form_pea.ButtonDone1.Visible:=true;
6284 Form_pea.LabelOpen.Visible:=true;
6285 Form_pea.LabelOpen.Enabled:=false;
6286 Form_pea.LabelLog1.Visible:=true;
6287 Form_report.Visible:=true;
6288 Form_pea.Visible:=false;
6289 exitcode:=0;
6290 end;
6291
6292 procedure listfiles; //list files: mode INFO gives detailed information, LIST plain list
6293 var
6294 s,mode:ansistring;
6295 h,k,i:integer;
6296 exp_files:TFoundList;
6297 exp_fsizes:TFoundListSizes;
6298 exp_ftimes:TFoundListAges;
6299 exp_fattr:TFoundListAttrib;
6300 exp_fattr_dec:TFoundList;
6301 nfound,nsize,smax,smin,compsize:qword;
6302 dmax,dmin,compest:integer;
6303 begin
6304 exitcode:=-1;
6305 mode:=(paramstr(2));
6306 s:=(paramstr(3));
6307 Form_pea.Caption:=mode;
6308 Form_pea.LabelTools2.Caption:='Listing '+s+' may take some time, please wait...';
6309 Form_pea.ProgressBar1.Position:=5;
6310 Application.ProcessMessages;
6311 expand(s,exp_files,exp_fsizes,exp_ftimes,exp_fattr,exp_fattr_dec,nfound);
6312 Form_pea.ProgressBar1.Position:=50;
6313 Application.ProcessMessages;
6314 nsize:=0;
6315 compsize:=0;
6316 compest:=0;
6317 dmax:=exp_ftimes[0];
6318 dmin:=exp_ftimes[0];
6319 smax:=exp_fsizes[0];
6320 smin:=exp_fsizes[0];
6321 if nfound=0 then nfound:=1;
6322 Form_pea.LabelTools3.Caption:='Found: '+inttostr(nfound);
6323 Form_pea.ProgressBar1.Position:=60;
6324 Application.ProcessMessages;
6325 if upcase(mode)='INFO' then
6326 for i:=0 to nfound-1 do
6327 begin
6328 nsize:=nsize+exp_fsizes[i];
6329 compest:=testpcomp(exp_files[i]);
6330 compsize:=compsize+(exp_fsizes[i]*compest);
6331 if exp_fsizes[i]>smax then smax:=exp_fsizes[i];
6332 if exp_fsizes[i]<smin then smin:=exp_fsizes[i];
6333 try
6334 if exp_ftimes[i]>dmax then dmax:=exp_ftimes[i];
6335 if exp_ftimes[i]<dmin then dmin:=exp_ftimes[i];
6336 except end;
6337 end;
6338 Form_pea.LabelTools4.Caption:='Total size: '+inttostr(nsize)+' B';
6339 Form_pea.ProgressBar1.Position:=70;
6340 Application.ProcessMessages;
6341 Form_report.InputT.Caption:='Input';
6342 if upcase(mode)='INFO' then Form_report.Caption:='Info'
6343 else Form_report.Caption:='List';
6344 Form_report.StringGrid1.ColCount:=4;
6345 Form_report.StringGrid1.Cells[0,0]:='Name';
6346 Form_report.StringGrid1.Cells[1,0]:='Size (B)';
6347 Form_report.StringGrid1.Cells[2,0]:='Date/time';
6348 Form_report.StringGrid1.Cells[3,0]:='Attributes';
6349 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
6350 Form_report.StringGrid1.RowCount:=nfound+1;
6351 for k:=0 to nfound-1 do
6352 begin
6353 Form_report.StringGrid1.Cells[0,k+1]:=exp_files[k];
6354 Form_report.StringGrid1.Cells[1,k+1]:=inttostr(exp_fsizes[k]);
6355 try Form_report.StringGrid1.Cells[2,k+1]:=datetimetostr(filedatetodatetime(exp_ftimes[k])); except Form_report.StringGrid1.Cells[2,k+1]:='unknown'; end;
6356 Form_report.StringGrid1.Cells[3,k+1]:=exp_fattr_dec[k];
6357 end;
6358 Form_pea.ProgressBar1.Position:=100;
6359 Application.ProcessMessages;
6360 Form_report.StringGrid1.AutosizeColumns;
6361 Form_report.Label1.Caption:=s;
6362 Form_report.Label2.Caption:='';
6363 Form_report.Label3.Caption:='';
6364 Form_report.Label4.Caption:='';
6365 if upcase(mode)='INFO' then
6366 begin
6367 try Form_report.Label2.Caption:='Found: '+inttostr(nfound)+' objects (newer: '+datetimetostr(filedatetodatetime(dmax))+', older: '+datetimetostr(filedatetodatetime(dmin))+')'; except Form_report.Label2.Caption:='Found: '+inttostr(nfound)+' objects'; end;
6368 Form_report.Label3.Caption:='Total size: '+nicenumber(inttostr(nsize))+' (larger: '+nicenumber(inttostr(smax))+', smaller: '+nicenumber(inttostr(smin))+');';
6369 if nsize<>0 then Form_report.Label3.Caption:=Form_report.Label3.Caption+' potential compression: '+inttostr((nsize*100 - compsize) div nsize)+'%';//+nicenumber(inttostr(compsize div 100))+' ('+inttostr(compsize div nsize)+'%)';
6370 end;
6371 Form_report.Visible:=true;
6372 Form_pea.Visible:=false;
6373 exitcode:=0;
6374 end;
6375
6376 //hex preview: slow, limited to 64 MB
6377 procedure hexpreview;
6378 var
6379 hexs,hexs1,astr,offs,s:ansistring;
6380 fa:file of byte;
6381 sizea,total:qword;
6382 i,x,y,numreada,nrows,prows,noffs,wrbytes:integer;
6383 bufa:array[0..65535]of byte;
6384 bufhex:array[0..15,0..4095]of byte;
6385 begin
6386 exitcode:=-1;
6387 if directoryexists(paramstr(2)) then
6388 begin
6389 Form_pea.LabelTools2.Caption:=paramstr(2)+' is a directory, cannot be previewed';
6390 exit;
6391 end;
6392 Form_report.StringGrid1.BeginUpdate;
6393 Form_pea.PanelPW1.height:=2;
6394 Form_report.Notebook1.PageIndex:=0;
6395 Form_report.Caption:='Hex preview';
6396 Form_pea.Caption:='Hex preview';
6397 Form_pea.LabelTools2.Caption:=(paramstr(2));
6398 Form_pea.LabelTools3.Caption:='';
6399 Form_pea.LabelTools4.Caption:='';
6400 Form_pea.ProgressBar1.Position:=0;
6401 Form_report.StringGrid1.RowCount:=1;
6402 Form_report.StringGrid1.ColCount:=3;
6403 Form_report.StringGrid1.Cells[0,0]:='Offset';
6404 Form_report.StringGrid1.Cells[1,0]:='Hex';
6405 Form_report.StringGrid1.Cells[2,0]:='Possible UTF8';
6406 Form_report.StringGrid1.Font.Name:='Courier';
6407 Form_report.StringGrid1.Font.Size:=10;
6408 Form_report.StringGrid1.ColWidths[0]:=96;
6409 Form_report.StringGrid1.ColWidths[1]:=460;
6410 Form_report.StringGrid1.ColWidths[2]:=180;
6411 sizea:=0;
6412 try
6413 assignfile(fa,(paramstr(2)));
6414 filemode:=0;
6415 reset(fa);
6416 srcfilesize((paramstr(2)),sizea);
6417 if sizea=0 then begin internal_error('The file is empty, cannot be previewed'); exit; end;
6418 setcurrentdir(extractfilepath((paramstr(2))));
6419 except
6420 MessageDlg((paramstr(2))+' is not accessible (or not a file)', mtError, [mbOK], 0);
6421 halt(-3);
6422 exit;
6423 end;
6424 if sizea>64*1024*1024 then
6425 begin
6426 MessageDlg('Hex preview is currently limited to small files, up to 64 MB', mtWarning, [mbOK], 0);
6427 exit;
6428 end;
6429 Form_pea.LabelTools3.Caption:='Size '+nicenumber(inttostr(sizea))+' ('+inttostr(sizea)+' B)';
6430 Form_report.StringGrid1.RowCount:=(sizea div 16) +2;
6431 total:=0;
6432 prows:=1;
6433 wrbytes:=0;
6434 repeat
6435 numreada:=0;
6436 blockread (fa,bufa,65536,numreada);
6437 i:=0;
6438 y:=0;
6439 repeat
6440 for x:=0 to 15 do
6441 begin
6442 bufhex[x,y]:=bufa[i];
6443 i:=i+1;
6444 if i=numreada then break;
6445 end;
6446 y:=y+1;
6447 until i>=numreada;
6448 nrows:=y;
6449 i:=0;
6450 for y:=0 to nrows-1 do
6451 begin
6452 noffs:=y+prows-1;
6453 offs:=inttohex(noffs*16,8);
6454 Form_report.StringGrid1.Cells[0,y+prows]:=offs;
6455 astr:='';
6456 for x:=0 to 15 do
6457 begin
6458 i:=i+1;
6459 if i=numreada then break;
6460 end;
6461 astr:=chr(bufhex[0,y])+chr(bufhex[1,y])+chr(bufhex[2,y])+chr(bufhex[3,y])+chr(bufhex[4,y])+chr(bufhex[5,y])+chr(bufhex[6,y])+chr(bufhex[7,y])+
6462 chr(bufhex[8,y])+chr(bufhex[9,y])+chr(bufhex[10,y])+chr(bufhex[11,y])+chr(bufhex[12,y])+chr(bufhex[13,y])+chr(bufhex[14,y])+chr(bufhex[15,y]);
6463 SetLength(astr, x+1);
6464 hexs:='';
6465 hexs1:='';
6466 SetLength(hexs, Length(astr)*2);
6467 BinToHex(@astr[1], @hexs[1], Length(astr));
6468 hexs1:=hexs[1]+hexs[2]+' '+hexs[3]+hexs[4]+' '+hexs[5]+hexs[6]+' '+hexs[7]+hexs[8]+' '+
6469 hexs[9]+hexs[10]+' '+hexs[11]+hexs[12]+' '+hexs[13]+hexs[14]+' '+hexs[15]+hexs[16]+' '+
6470 hexs[17]+hexs[18]+' '+hexs[19]+hexs[20]+' '+hexs[21]+hexs[22]+' '+hexs[23]+hexs[24]+' '+
6471 hexs[25]+hexs[26]+' '+hexs[27]+hexs[28]+' '+hexs[29]+hexs[30]+' '+hexs[31]+hexs[32];
6472 //setlength(hexs,length(hexs)-1);
6473 wrbytes:=wrbytes+16;
6474 Form_report.StringGrid1.Cells[1,y+prows]:=hexs1;
6475 Form_report.StringGrid1.Cells[2,y+prows]:=ansitoutf8(astr);
6476 end;
6477 ///
6478 inc(total,numreada);
6479 prows:=prows+nrows;
6480 Form_pea.ProgressBar1.Position:=(total*100) div sizea;
6481 Application.ProcessMessages;
6482 until (numreada=0) or (total>=sizea);
6483 //Form_report.StringGrid1.AutosizeColumns;
6484 Form_report.StringGrid1.EndUpdate;
6485 closefile(fa);
6486 Form_pea.Visible:=false;
6487 Form_report.visible:=true;
6488 Form_pea.ProgressBar1.Position:=100;
6489 Form_report.Label1.Caption:=Form_pea.Caption;
6490 Form_report.Label2.Caption:=Form_pea.LabelTools2.Caption;
6491 Form_report.Label3.Caption:=Form_pea.LabelTools3.Caption;
6492 Form_report.Label4.Caption:='';
6493 {$IFDEF MSWINDOWS}Form_report.OutputT.TabVisible:=false;{$ENDIF}Form_report.Notebook1.ShowTabs:=false;
6494 Form_pea.ButtonDone1.Visible:=true;
6495 Form_pea.LabelOpen.Visible:=true;
6496 Form_pea.LabelOpen.Enabled:=false;
6497 Form_pea.LabelLog1.Visible:=true;
6498 exitcode:=0;
6499 end;
6500
6501 {
6502 GUI procedures
6503 }
6504
6505 procedure parse_action;
6506 begin
6507 case upcase(paramstr(1))of
6508 'PEA' : pea;
6509 'UNPEA' : unpea;
6510 'RFS' : rfs;
6511 'RFJ' : rfj;
6512 'WIPE' : wipe(paramstr(2));
6513 'SANITIZE' : sanitize(paramstr(2));
6514 'COMPARE' : compare;
6515 'CHECK' : check;
6516 'ENVSTR' : envstr;
6517 'LIST' : listfiles;
6518 'HEXPREVIEW' : hexpreview;
6519 else internal_error('Incorrect request for Pea, the action "'+paramstr(1)+'" is not supported');
6520 end;
6521 end;
6522
6523 procedure call_pea;
6524 begin
6525 Form_pea.PanelRFSinteractive.visible:=false;
6526 Form_pea.PanelTools.visible:=false;
6527 Form_pea.Panel1.Visible:=true;
6528 Form_pea.LabelE1.Visible:=true;
6529 if (upcase(paramstr(7))='TRIATS') or (upcase(paramstr(7))='TRITSA') or (upcase(paramstr(7))='TRISAT') or
6530 (upcase(paramstr(7))='EAX256') or (upcase(paramstr(7))='TF256') or (upcase(paramstr(7))='SP256') or
6531 (upcase(paramstr(7))='EAX') or (upcase(paramstr(7))='TF') or (upcase(paramstr(7))='SP') or (upcase(paramstr(7))='HMAC') then
6532 if (upcase(paramstr(8))='INTERACTIVE') or (upcase(paramstr(8))='INTERACTIVE_REPORT') then
6533 begin
6534 Form_pea.Visible:=true;
6535 Form_pea.PanelDecrypt1.visible:=false;
6536 Form_pea.PanelEncrypt1.visible:=true;
6537 Form_pea.PanelPW1.Visible:=true;
6538 Whirl_Init(ment); //only for PEA called as executable (otherwise passphrase/keyfile is passed from main executable): improve seed generation trough mouse movements sampling while entering passwphrase/keyfile
6539 Form_pea.LabelConfirm1.Visible:=true;
6540 Form_pea.EditConfirm1.Visible:=true;
6541 Form_pea.LabelHint1.Visible:=true;
6542 Form_pea.LabelSample1.Visible:=true;
6543 Form_pea.LabelSample2.Visible:=true;
6544 Form_pea.Image5.Visible:=true;
6545 exit;
6546 end;
6547 interacting:=false;
6548 end;
6549
6550 procedure call_unpea;
6551 var
6552 f_in:file of byte;
6553 in_folder,in_file,in_name,in_qualified_name,compr,algo,obj_algo,volume_algo:ansistring;
6554 buf,tmp_buf:array [0..19] of byte;
6555 pwneeded,singlevolume:boolean;
6556 compr_level,headersize,authsize,volume_authsize,archive_datetimeencoding:byte;
6557 i,numread:integer;
6558 begin
6559 Form_pea.PanelRFSinteractive.visible:=false;
6560 Form_pea.PanelTools.visible:=false;
6561 //parse archive to see if password is needed
6562 in_qualified_name:=(paramstr(2));
6563 if not(fileexists(in_qualified_name)) then internal_error('"'+in_qualified_name+'" not exists');
6564 in_folder:=extractfilepath(in_qualified_name);
6565 in_file:=extractfilename(in_qualified_name);
6566 if upcase(copy(in_qualified_name,length(in_qualified_name)-10,11))<>'.000001.PEA' then
6567 begin
6568 singlevolume:=true;
6569 end
6570 else
6571 begin
6572 singlevolume:=false;
6573 delete(in_file,length(in_file)-10,11);
6574 end;
6575 in_name:=in_file;
6576 {blockread 10 byte archive header; since volume tag size is unknown to UnPEA,
6577 PEA set first volume size mandatory at least 10 byte (plus volume tag) in order
6578 to make UnPEA able to blockread the archive header and calculate the volume tag
6579 size}
6580 assignfile(f_in,in_qualified_name);
6581 filemode:=0;
6582 reset(f_in);
6583 blockread (f_in,buf,10,numread);
6584 if IOResult<>0 then internal_error('IO error reading from '+in_qualified_name);
6585 close(f_in);
6586 test_pea_error('parsing archive header',pea_parse_archive_header(buf,volume_algo,archive_datetimeencoding));
6587 decode_volume_control_algo (volume_algo,volume_authsize);
6588 read_from_chunks ( in_folder,in_name,
6589 20,
6590 buf,tmp_buf,
6591 volume_authsize,
6592 20,
6593 singlevolume);
6594 for i:=0 to 9 do buf[i]:=buf[i+10];
6595 pea_parse_stream_header(buf, compr, compr_level, algo, obj_algo);
6596 decode_control_algo ( algo,
6597 headersize,
6598 authsize,
6599 pwneeded);
6600 //if password is needed, open the password panel
6601 if pwneeded=true then
6602 if (upcase(paramstr(7))='INTERACTIVE') or (upcase(paramstr(7))='INTERACTIVE_REPORT') then
6603 begin
6604 Form_pea.Visible:=true;
6605 Form_pea.PanelDecrypt1.visible:=true;
6606 Form_pea.PanelEncrypt1.visible:=false;
6607 Form_pea.PanelPW1.Visible:=true;
6608 exit;
6609 end;
6610 interacting:=false;
6611 end;
6612
6613 procedure call_rfs;
6614 begin
6615 Form_pea.Visible:=true;
6616 Form_pea.PanelRFSinteractive.visible:=false;
6617 Form_pea.PanelTools.visible:=false;
6618 if upcase(paramstr(3))='ASK' then
6619 begin
6620 Form_pea.PanelRFSinteractive.visible:=true;
6621 Form_pea.Caption:='Split file';
6622 exit;
6623 end;
6624 interacting:=false;
6625 end;
6626
6627 procedure call_rfj;
6628 begin
6629 Form_pea.Visible:=true;
6630 Form_pea.PanelRFSinteractive.visible:=false;
6631 Form_pea.PanelTools.visible:=false;
6632 interacting:=false;
6633 end;
6634
6635 procedure call_wipe;
6636 begin
6637 Form_pea.Visible:=true;
6638 Form_pea.PanelRFSinteractive.visible:=false;
6639 Form_pea.PanelTools.visible:=true;
6640 interacting:=false;
6641 end;
6642
6643 procedure call_sanitize;
6644 begin
6645 Form_pea.Visible:=true;
6646 Form_pea.PanelRFSinteractive.visible:=false;
6647 Form_pea.PanelTools.visible:=true;
6648 interacting:=false;
6649 end;
6650
6651 procedure call_compare;
6652 begin
6653 Form_pea.Visible:=true;
6654 Form_pea.PanelRFSinteractive.visible:=false;
6655 Form_pea.PanelTools.visible:=true;
6656 interacting:=false;
6657 end;
6658
6659 procedure call_check;
6660 begin
6661 Form_pea.Visible:=true;
6662 Form_pea.PanelRFSinteractive.visible:=false;
6663 Form_pea.PanelTools.visible:=true;
6664 interacting:=false;
6665 end;
6666
6667 procedure call_envstr;
6668 begin
6669 Form_pea.Visible:=true;
6670 Form_pea.PanelRFSinteractive.visible:=false;
6671 Form_pea.PanelTools.visible:=true;
6672 interacting:=false;
6673 end;
6674
6675 procedure call_list;
6676 begin
6677 Form_pea.Visible:=true;
6678 Form_pea.PanelRFSinteractive.visible:=false;
6679 Form_pea.PanelTools.visible:=true;
6680 interacting:=false;
6681 end;
6682
6683 procedure call_hexpreview;
6684 begin
6685 Form_pea.Visible:=true;
6686 Form_pea.PanelRFSinteractive.visible:=false;
6687 Form_pea.PanelTools.visible:=true;
6688 interacting:=false;
6689 end;
6690
6691 { TForm_pea }
6692
6693 procedure TForm_pea.ButtonDone1Click(Sender: TObject);
6694 begin
6695 Close;
6696 end;
6697
6698 procedure TForm_pea.ButtonPeaExitClick(Sender: TObject);
6699 begin
6700 halt(-4);
6701 end;
6702
6703 procedure TForm_pea.ButtonPW1Click(Sender: TObject);
6704 begin
6705 if (EditPW1.Text='') and (EditConfirm1.Text='') then pw:='default'
6706 else
6707 if (upcase(paramstr(1))='PEA') and (EditPW1.Text<>EditConfirm1.Text) then
6708 begin
6709 MessageDlg('Passwords doesn''t match, please retype "Passphrase" and "Confirm" fields', mtWarning, [mbOK], 0);
6710 exit;
6711 end
6712 else pw:=EditPW1.Text;
6713 if LabelKeyFileName1.Caption='<none>' then keyfile_name:='NOKEYFILE'
6714 else keyfile_name:=LabelKeyFileName1.Caption;
6715 PanelPW1.Visible:=false;
6716 interacting:=false;
6717 end;
6718
6719 procedure TForm_pea.ButtonPW2Click(Sender: TObject);
6720 begin
6721 Form_pea.Close;
6722 end;
6723
6724 procedure TForm_pea.ButtonRFSinteractive1Click(Sender: TObject);
6725 begin
6726 Form_pea.Close;
6727 end;
6728
6729 procedure TForm_pea.ButtonRFSinteractiveClick(Sender: TObject);
6730 begin
6731 case ComboBox1.ItemIndex of
6732 0: begin
6733 try
6734 vol_size:=SpinEdit1.Value;
6735 case ComboBox2.ItemIndex of
6736 1: vol_size:=vol_size*1024;
6737 2: vol_size:=vol_size*1024*1024;
6738 3: vol_size:=vol_size*1024*1024*1024;
6739 end;
6740 except
6741 MessageDlg('Cannot get volume size', mtWarning, [mbOK], 0);
6742 exit;
6743 end;
6744 end;
6745 1: vol_size:=1457664;//FD
6746 2: vol_size:=10*1024*1024;//limit for attachment size of some mail services
6747 3: vol_size:=25*1024*1024;//limit for attachment size of most mail services
6748 4: vol_size:=650*1024*1024;//CD 650 MB
6749 5: vol_size:=700*1024*1024;//CD 700 MB
6750 6: vol_size:=4092*1024*1024;//max file size for FAT32 filesystem
6751 7: vol_size:=4480*1024*1024;//size DVD+R
6752 8: vol_size:=8128*1024*1024;//size for DVD-R DL
6753 9: vol_size:=23040*1024*1024;//size for Blu-Ray
6754 end;
6755 case ComboBox3.ItemIndex of //volume checks
6756 0: vol_algo:='WHIRLPOOL';
6757 1: vol_algo:='SHA3_512';
6758 2: vol_algo:='SHA512';
6759 3: vol_algo:='BLAKE2B';
6760 4: vol_algo:='SHA3_256';
6761 5: vol_algo:='SHA256';
6762 6: vol_algo:='BLAKE2S';
6763 7: vol_algo:='RIPEMD160';
6764 8: vol_algo:='SHA1';
6765 9: vol_algo:='MD5';
6766 10: vol_algo:='CRC64';
6767 11: vol_algo:='CRC32';
6768 12: vol_algo:='ADLER32';
6769 13: vol_algo:='NOALGO';
6770 end;
6771 interacting:=false;
6772 PanelRFSinteractive.visible:=false;
6773 end;
6774
6775 procedure TForm_pea.ButtonToolsCancelClick(Sender: TObject);
6776 begin
6777 toolactioncancelled:=true;
6778 end;
6779
6780 procedure TForm_pea.ButtonUtilsCancelClick(Sender: TObject);
6781 begin
6782 Form_pea.Close;
6783 end;
6784
6785 procedure TForm_pea.ButtonUtilsResetClick(Sender: TObject);
6786 begin
6787 ListMemo.Clear;
6788 end;
6789
6790 procedure getunits;
6791 var
6792 s:ansistring;
6793 nunits,i:qword;
6794 drivestr:array[1..255] of char;
6795 begin
6796 {$IFDEF MSWINDOWS}
6797 Form_pea.ComboBoxUnits.Clear;
6798 GetLogicalDriveStrings(255,@drivestr);
6799 i:=1;
6800 nunits:=0;
6801 repeat
6802 s:='';
6803 nunits:=nunits+1;
6804 while (i<=255) and (drivestr[i]<>#00) do
6805 begin
6806 s:=s+char(drivestr[i]);
6807 inc(i);
6808 end;
6809 inc(i);
6810 if s<>'' then Form_pea.ComboBoxUnits.Items.Add(s);
6811 until length(s)=0;
6812 nunits:=nunits-1;
6813 {$ENDIF}
6814 end;
6815
6816 procedure TForm_pea.ButtonUtilsOKClick(Sender: TObject);
6817 var
6818 cl,bin_name,in_param:ansistring;
6819 i:integer;
6820 P:TProcessUTF8;
6821 begin
6822 Form_report.StringGrid1.PopupMenu:=nil;
6823 bin_name:=stringdelim(escapefilename(executable_path,desk_env)+'pea'+EXEEXT);
6824 in_param:='';
6825 cl:='';
6826 for i:=0 to ListMemo.Lines.Count do
6827 if length(ListMemo.Lines[i])>1 then
6828 in_param:=in_param+stringdelim(ListMemo.Lines[i])+' ';
6829 case ComboBoxUtils.ItemIndex of
6830 20: begin end;
6831 21: begin end;
6832 22: begin end;
6833 else if in_param='' then exit;
6834 end;
6835 case ComboBoxUtils.ItemIndex of
6836 0: cl:=bin_name+' CHECK HEX CRC32 ON '+in_param;
6837 1: cl:=bin_name+' CHECK HEX CRC64 ON '+in_param;
6838 2: cl:=bin_name+' CHECK HEX MD5 ON '+in_param;
6839 3: cl:=bin_name+' CHECK HEX RIPEMD160 ON '+in_param;
6840 4: cl:=bin_name+' CHECK HEX SHA1 ON '+in_param;
6841 5: cl:=bin_name+' CHECK HEX BLAKE2S ON '+in_param;
6842 6: cl:=bin_name+' CHECK HEX SHA256 ON '+in_param;
6843 7: cl:=bin_name+' CHECK HEX SHA3_256 ON '+in_param;
6844 8: cl:=bin_name+' CHECK HEX BLAKE2B ON '+in_param;
6845 9: cl:=bin_name+' CHECK HEX SHA512 ON '+in_param;
6846 10: cl:=bin_name+' CHECK HEX SHA3_512 ON '+in_param;
6847 11: cl:=bin_name+' CHECK HEX WHIRLPOOL ON '+in_param;
6848 12: cl:=bin_name+' CHECK HEX CRC32 CRC64 MD5 RIPEMD160 SHA1 BLAKE2S SHA256 SHA3_256 ON '+in_param;
6849 13: cl:=bin_name+' CHECK HEX ALL ON '+in_param;
6850 14: cl:=bin_name+' CHECK HEX LIST ON '+in_param;
6851 15: cl:=bin_name+' RFS AUTONAME ASK NONE BATCH '+stringdelim(ListMemo.Lines[0]); //one file
6852 16: cl:=bin_name+' RFJ '+stringdelim(ListMemo.Lines[0])+' BATCH AUTONAME'; //one file (strictly)
6853 17: cl:=bin_name+' COMPARE '+in_param; //two files or one file (ask for second file, ignores more files)
6854 18: cl:=bin_name+' HEXPREVIEW '+stringdelim(ListMemo.Lines[0]); //one file
6855 19: begin
6856 if MessageDlg('Do you want to securely delete selected file(s)? The operation can''t be undone and files will be not recoverable', mtWarning, [mbYes,mbNo], 0)=6 then
6857 begin
6858 cl:=bin_name+' WIPE MEDIUM '+in_param;
6859 P:=TProcessUTF8.Create(nil);
6860 {$IFDEF MSWINDOWS}
6861 P.Options := [poNoConsole,poWaitOnExit];
6862 {$ELSE}
6863 P.Options := [poWaitOnExit];
6864 {$ENDIF}
6865 cl:=(cl);
6866 P.CommandLine:=cl;
6867 if validatecl(cl)<>0 then begin MessageDlg('Operation stopped, potentially dangerous command detected (i.e. command concatenation not allowed within the program): '+cl, mtWarning, [mbOK], 0); exit; end;
6868 P.Execute;
6869 P.Free;
6870 i:=0;
6871 repeat
6872 if length(ListMemo.Lines[i])>1 then
6873 if not fileexists(ListMemo.Lines[i]) then ListMemo.Lines.Delete(i)
6874 else i:=i+1;
6875 until i>=ListMemo.Lines.Count;
6876 exit;
6877 end
6878 else exit;
6879 end;
6880 20: begin
6881 {$IFDEF MSWINDOWS}
6882 in_param:=ComboBoxUnits.Caption;
6883 if MessageDlg('The operation can take some time, depending on the size of the disk, continue?', mtInformation, [mbYes,mbNo], 0)=6 then
6884 cl:=bin_name+' SANITIZE FAST '+in_param
6885 else exit;
6886 {$ELSE}
6887 MessageDlg('Sorry, function not supported on current system', mtInformation, [mbOK], 0);
6888 exit;
6889 {$ENDIF}
6890 end;
6891 21: begin
6892 {$IFDEF MSWINDOWS}
6893 in_param:=ComboBoxUnits.Caption;
6894 if MessageDlg('The operation can take some time, depending on the size of the disk, continue?', mtInformation, [mbYes,mbNo], 0)=6 then
6895 cl:=bin_name+' SANITIZE ZERO '+in_param
6896 else exit;
6897 {$ELSE}
6898 MessageDlg('Sorry, function not supported on current system', mtInformation, [mbOK], 0);
6899 exit;
6900 {$ENDIF}
6901 end;
6902 22: cl:=bin_name+' ENVSTR';
6903 end;
6904 P:=TProcessUTF8.Create(nil);
6905 {$IFDEF MSWINDOWS}
6906 P.Options := [poNoConsole];
6907 {$ENDIF}
6908 cl:=(cl);
6909 P.CommandLine:=cl;
6910 if validatecl(cl)<>0 then begin MessageDlg('Operation stopped, potentially dangerous command detected (i.e. command concatenation not allowed within the program): '+cl, mtWarning, [mbOK], 0); exit; end;
6911 P.Execute;
6912 P.Free;
6913 end;
6914
6915 procedure change_imagesplit;
6916 begin
6917 with Form_pea do
6918 begin
6919 case ComboBox1.ItemIndex of
6920 0: ImageSplit.Picture.Bitmap:=nil;
6921 1: ImageSplit.Picture.Bitmap:=Bfd;
6922 2: ImageSplit.Picture.Bitmap:=Bmail;
6923 3: ImageSplit.Picture.Bitmap:=Bmail;
6924 4: ImageSplit.Picture.Bitmap:=Bdvd;
6925 5: ImageSplit.Picture.Bitmap:=Bdvd;
6926 6: ImageSplit.Picture.Bitmap:=Bhd;
6927 7: ImageSplit.Picture.Bitmap:=Bdvd;
6928 8: ImageSplit.Picture.Bitmap:=Bdvd;
6929 9: ImageSplit.Picture.Bitmap:=Bdvd;
6930 end;
6931 end;
6932 end;
6933
6934 procedure ComboBox1_onchange;
6935 begin
6936 with Form_pea do
6937 begin
6938 change_imagesplit;
6939 if ComboBox1.ItemIndex = 0 then
6940 begin
6941 SpinEdit1.Visible:=true;
6942 ComboBox2.Visible:=true;
6943 end
6944 else
6945 begin
6946 SpinEdit1.Visible:=false;
6947 ComboBox2.Visible:=false;
6948 end;
6949 end;
6950 end;
6951
6952 procedure TForm_pea.ComboBox1Change(Sender: TObject);
6953 begin
6954 ComboBox1_onchange;
6955 end;
6956
6957 procedure enabledropmenu;
6958 begin
6959 with Form_pea do
6960 begin
6961 ListMemo.Enabled:=True;
6962 ListMemo.Visible:=True;
6963 LabelUtilsInput.Visible:=True;
6964 LabelOpenFile0.Visible:=True;
6965 LabelOpenFile2.Visible:=True;
6966 LabelOpenFile3.Visible:=True;
6967 ButtonUtilsReset.Enabled:=True;
6968 ComboBoxUnits.Visible:=false;
6969 end;
6970 end;
6971
6972 procedure disabledropmenu;
6973 begin
6974 with Form_pea do
6975 begin
6976 ListMemo.Enabled:=False;
6977 ListMemo.Clear;
6978 ListMemo.Visible:=False;
6979 LabelUtilsInput.Visible:=False;
6980 LabelOpenFile0.Visible:=False;
6981 LabelOpenFile2.Visible:=False;
6982 LabelOpenFile3.Visible:=False;
6983 ButtonUtilsReset.Enabled:=False;
6984 if ComboBoxUtils.ItemIndex<>22 then
6985 begin
6986 ComboBoxUnits.Visible:=true;
6987 getunits;
6988 ComboBoxUnits.ItemIndex:=0;
6989 end
6990 else ComboBoxUnits.Visible:=false;
6991 end;
6992 end;
6993
6994 procedure TForm_pea.ComboBoxUtilsChange(Sender: TObject);
6995 begin
6996 case ComboBoxUtils.ItemIndex of
6997 0: enabledropmenu;
6998 1: enabledropmenu;
6999 2: enabledropmenu;
7000 3: enabledropmenu;
7001 4: enabledropmenu;
7002 5: enabledropmenu;
7003 6: enabledropmenu;
7004 7: enabledropmenu;
7005 8: enabledropmenu;
7006 9: enabledropmenu;
7007 10: enabledropmenu;
7008 11: enabledropmenu;
7009 12: enabledropmenu;
7010 13: enabledropmenu;
7011 14: enabledropmenu;
7012 15: enabledropmenu;
7013 16: enabledropmenu;
7014 17: enabledropmenu;
7015 18: enabledropmenu;
7016 19: enabledropmenu;
7017 20: disabledropmenu;
7018 21: disabledropmenu;
7019 22: disabledropmenu;
7020 end;
7021 end;
7022
7023 procedure TForm_pea.EditPW1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
7024 );
7025 var
7026 pw,pr:ansistring;
7027 pw_strength:dword;
7028 pw_rating:byte;
7029 begin
7030 if LabelKeyFileName1.Caption[1]<>'<' then
7031 begin
7032 Shape2.Width:=240;
7033 Shape2.Brush.Color:=PBLUE;
7034 LabelPS1.Caption:='Using KeyFile';
7035 end
7036 else
7037 begin
7038 pw:=EditPW1.Text;
7039 evaluate_password(pw,pw_strength);
7040 if (pw_strength>8) then
7041 if (pw_strength<240) then Shape2.Width:=pw_strength
7042 else Shape2.Width:=240
7043 else Shape2.Width:=8;
7044 if pw_strength<24 then Shape2.Brush.Color:=PRED
7045 else
7046 if pw_strength<48 then Shape2.Brush.Color:=PYELLOW
7047 else
7048 if pw_strength<72 then Shape2.Brush.Color:=PLGREEN
7049 else Shape2.Brush.Color:=PGREEN;
7050 case Shape2.Brush.Color of
7051 PRED: pr:='Weak';
7052 PYELLOW: pr:='Poor';
7053 PLGREEN: pr:='Adequate';
7054 PGREEN: pr:='Good';
7055 end;
7056 LabelPS1.Caption:=pr+' ('+inttostr(pw_strength)+')';
7057 end;
7058 end;
7059
7060 procedure TForm_pea.FormClose(Sender: TObject; var CloseAction: TCloseAction);
7061 var
7062 randf: file of byte;
7063 randarr: TKey2048;
7064 begin
7065 try
7066 shl_rand(randarr); //read and leftshift of 1 byte data from persistent random seed file
7067 gen_rand(randarr); //create new reandom seed file
7068 assignfile(randf,persistent_source); //write keyfile as new seed file
7069 rewrite(randf);
7070 blockwrite(randf,randarr,256);
7071 closefile(randf);
7072 except
7073 end;
7074 end;
7075
7076 procedure TForm_pea.LabelE1Click(Sender: TObject);
7077 begin
7078 if details=true then
7079 begin
7080 Panel1.visible:=true;
7081 LabelE1.Caption:='+';
7082 details:=false;
7083 end
7084 else
7085 begin
7086 Panel1.visible:=false;
7087 LabelE1.Caption:='-';
7088 details:=true;
7089 end;
7090 end;
7091
7092 procedure TForm_pea.LabelKeyFile1Click(Sender: TObject);
7093 begin
7094 if OpenDialog1.Execute then
7095 if OpenDialog1.FileName<>'' then
7096 begin
7097 LabelKeyFileName1.Caption:=OpenDialog1.FileName;
7098 Shape2.Width:=240;
7099 Shape2.Brush.Color:=PBLUE;
7100 LabelPS1.Caption:='Using KeyFile';
7101 end;
7102 end;
7103
7104 procedure getthemepath(var thpath:ansistring);
7105 var
7106 theme_name,s:ansistring;
7107 begin
7108 s:=graphicsfolder;
7109 if s<>'' then setlength(s,length(s)-1);
7110 theme_name:=extractfilename(s);
7111 //default and no graphic themes are in application's path, custom themes are in configuration path (application's path for portable versions, user's home/application data for installable versions)
7112 if (upcase(theme_name)<>upcase(DEFAULT_THEME)) and (upcase(theme_name)<>'NOGRAPHIC') then thpath:=confpath
7113 else thpath:=executable_path;
7114 end;
7115
7116 procedure load_icons; //load icons from bitmaps
7117 var
7118 thpath:ansistring;
7119 i16res:integer;
7120 begin
7121 getthemepath(thpath);
7122 i16res:=(qscaleimages*16) div 100;
7123 //valorize all captions, hints, TStrings Items
7124 try
7125 Bfd:=TBitmap.Create;
7126 Bmail:=TBitmap.Create;
7127 Bhd:=TBitmap.Create;
7128 Bdvd:=TBitmap.Create;
7129 Binfo:=TBitmap.Create;
7130 Blog:=TBitmap.Create;
7131 Bok:=TBitmap.Create;
7132 Bcancel:=TBitmap.Create;
7133 Butils:=TBitmap.Create;
7134 Badmin:=TBitmap.Create;
7135 if graphicsfolder<>'themes'+directoryseparator+'nographic'+directoryseparator then
7136 begin
7137 Form_pea.imagelist1.getbitmap(1,Bfd);
7138 Form_pea.imagelist1.getbitmap(2,Bmail);
7139 Form_pea.imagelist1.getbitmap(3,Bhd);
7140 Form_pea.imagelist1.getbitmap(4,Bdvd);
7141 Form_pea.imagelist1.getbitmap(5,Binfo);
7142 Form_pea.imagelist1.getbitmap(6,Blog);
7143 Form_pea.imagelist1.getbitmap(7,Bok);
7144 Form_pea.imagelist1.getbitmap(8,Bcancel);
7145 Form_pea.imagelist1.getbitmap(9,Butils);
7146 Form_pea.imagelist1.getbitmap(10,Badmin);
7147 end;
7148 if graphicsfolder='themes'+directoryseparator+'nographic'+directoryseparator then
7149 begin
7150 Form_pea.imagelist1.getbitmap(0,Bfd);
7151 Form_pea.imagelist1.getbitmap(0,Bmail);
7152 Form_pea.imagelist1.getbitmap(0,Bhd);
7153 Form_pea.imagelist1.getbitmap(0,Bdvd);
7154 Form_pea.imagelist1.getbitmap(0,Binfo);
7155 Form_pea.imagelist1.getbitmap(0,Blog);
7156 Form_pea.imagelist1.getbitmap(0,Bok);
7157 Form_pea.imagelist1.getbitmap(0,Bcancel);
7158 Form_pea.imagelist1.getbitmap(0,Butils);
7159 Form_pea.imagelist1.getbitmap(0,Badmin);
7160 end;
7161 if (graphicsfolder<>'themes'+directoryseparator+'nographic'+directoryseparator) and (graphicsfolder<>'themes'+directoryseparator+'ten-embedded'+directoryseparator) then
7162 begin
7163 Binfo.LoadFromFile(thpath+graphicsfolder+'16'+directoryseparator+'16-info.bmp');
7164 Blog.LoadFromFile(thpath+graphicsfolder+'16'+directoryseparator+'16-paste.bmp');
7165 Bok.LoadFromFile(thpath+graphicsfolder+'16'+directoryseparator+'16-test.bmp');
7166 Bcancel.LoadFromFile(thpath+graphicsfolder+'16'+directoryseparator+'16-stop.bmp');
7167 end;
7168 setpbitmap(Bfd,i16res);
7169 setpbitmap(Bmail,i16res);
7170 setpbitmap(Bhd,i16res);
7171 setpbitmap(Bdvd,i16res);
7172 setpbitmap(Binfo,i16res);
7173 setpbitmap(Blog,i16res);
7174 setpbitmap(Bok,i16res);
7175 setpbitmap(Bcancel,i16res);
7176 setpbitmap(Butils,i16res);
7177 setpbitmap(Badmin,i16res);
7178 Form_pea.peautilsbtn.Glyph:=Butils;
7179 Form_pea.pmrunasadmin.Bitmap:=Badmin;
7180 Form_pea.Image3.Picture.Bitmap:=Binfo;
7181 Form_pea.Image4.Picture.Bitmap:=Binfo;
7182 Form_pea.Image5.Picture.Bitmap:=Binfo;
7183 Form_pea.Image7.Picture.Bitmap:=Binfo;
7184 Form_pea.ImageUtils.Picture.Bitmap:=Binfo;
7185 Form_pea.buttonpw1.Glyph:=Bok;
7186 Form_pea.buttonpw2.Glyph:=Bcancel;
7187 Form_pea.ButtonPeaExit.Glyph:=Bcancel;
7188 Form_pea.ButtonPeaExit1.Glyph:=Bcancel;
7189 Form_pea.buttonrfsinteractive.Glyph:=Bok;
7190 Form_pea.buttonrfsinteractive1.Glyph:=Bcancel;
7191 Form_pea.buttonutilsok.Glyph:=Bok;
7192 Form_pea.buttonutilscancel.Glyph:=Bcancel;
7193 Form_pea.buttontoolscancel.Glyph:=Bcancel;
7194 except
7195 //MessageDlg('some icons not found', mtWarning, [mbOK], 0); //it's deactivated in final compilation to allow the program to work outside of PeaZip package
7196 end;
7197 end;
7198
wingetappdatanull7199 function wingetappdata(var s:ansistring):integer;
7200 {$IFDEF MSWINDOWS}
7201 var
7202 pidl: PItemIDList;
7203 Buf: array [0..MAX_PATH] of Char;
7204 {$ENDIF}
7205 begin
7206 wingetappdata:=-1;
7207 {$IFDEF MSWINDOWS}
7208 try
7209 if Succeeded(ShGetSpecialFolderLocation(Form_pea.Handle,26,pidl)) then //26 is CSIDL_APPDATA numerical value
7210 if ShGetPathfromIDList(pidl, Buf ) then
7211 begin
7212 s:=(Buf)+'\PeaZip\';
7213 CoTaskMemFree(pidl);
7214 wingetappdata:=0;
7215 end
7216 else CoTaskMemFree(pidl);
7217 except
7218 end;
7219 {$ENDIF}
7220 end;
7221
7222 procedure TForm_pea.FormCreate(Sender: TObject);
7223
7224 procedure readconf_relativeline(nlines:integer; var dummy:ansistring);
7225 var
7226 i:integer;
7227 begin
7228 for i:=1 to nlines do readln(conf,dummy);
7229 end;
7230
7231 var
7232 dummy:ansistring;
7233 begin
7234 fshown:=false;
7235 executable_path:=extractfilepath((paramstr(0)));
7236 if executable_path[length(executable_path)]<>directoryseparator then executable_path:=executable_path+directoryseparator;
7237 setcurrentdir(executable_path);
7238 SetFocusedControl(EditPW1);
7239 getdesk_env(desk_env,caption_build,delimiter);
7240 height_set:=false;
7241 toolactioncancelled:=false;
7242 Form_pea.Caption:='PEA '+P_RELEASE+' ('+PEAUTILS_RELEASE+') / specs '+inttostr(PEA_FILEFORMAT_VER)+'.'+inttostr(PEA_FILEFORMAT_REV);
7243 if (PEA_FILEFORMAT_VER <> pea_utils.PEA_FILEFORMAT_VER) or (PEA_FILEFORMAT_REV <> pea_utils.PEA_FILEFORMAT_REV) then
7244 Form_pea.Caption:='PEA '+P_RELEASE+' ('+PEAUTILS_RELEASE+') / Warning: inconsistent internal specs level!';
7245 try
7246 {PEA executable must be in the same path of altconf.txt file, otherwise or if
7247 theming errors occurs, default theming values will be loaded}
7248 assignfile(conf,executable_path+'altconf.txt'); //load alternative configuration path
7249 filemode:=0;
7250 reset(conf);
7251 read_header(conf);
7252 readln(conf,dummy);
7253 readln(conf,confpath);
7254 CloseFile(conf);
7255 if (confpath='same') or (confpath='"same"') or (confpath='''same''') or (confpath=' ') or (confpath='') then confpath:=executable_path; //if confpath parameter is set to 'same' or empty use classic conf location (in res folder)
7256 {$IFDEF MSWINDOWS}
7257 if (confpath='appdata') or (confpath='"appdata"') or (confpath='''appdata''') or (confpath='%appdata%') then
7258 if wingetappdata(confpath)<>0 then confpath:=(GetEnvironmentVariable('APPDATA'))+'\PeaZip\'; //if wingetappdata fails use env variables
7259 {$ELSE}
7260 MenuItem1.visible:=false;
7261 pmrunasadmin.visible:=false;
7262 {$ENDIF}
7263 {$IFDEF LINUX}
7264 if (confpath='appdata') or (confpath='"appdata"') or (confpath='''appdata''') or (confpath='%appdata%') then confpath:=GetEnvironmentVariable('HOME')+'/.PeaZip/';
7265 {$ENDIF}
7266 {$IFDEF DRAGONFLY}
7267 if (confpath='appdata') or (confpath='"appdata"') or (confpath='''appdata''') or (confpath='%appdata%') then confpath:=GetEnvironmentVariable('HOME')+'/.PeaZip/';
7268 {$ENDIF}
7269 {$IFDEF NETBSD}
7270 if (confpath='appdata') or (confpath='"appdata"') or (confpath='''appdata''') or (confpath='%appdata%') then confpath:=GetEnvironmentVariable('HOME')+'/.PeaZip/';
7271 {$ENDIF}
7272 if not(directoryexists(confpath)) then mkdir(confpath);
7273 if (confpath[1]='.') and (confpath[2]='.') then confpath:='..'+directoryseparator+confpath; //relative path, needs to be adjusted since pea is in a subfolder of peazip path
7274 confpath:=expandfilename(confpath);
7275 if confpath[length(confpath)]<>directoryseparator then confpath:=confpath+directoryseparator;
7276 if not(directoryexists(confpath)) then confpath:=executable_path; //if alternative configuration directory does not exist or is not accessible, use res path
7277 persistent_source:=confpath+'rnd';
7278 assignfile(conf,(confpath+'conf.txt'));
7279 filemode:=0;
7280 reset(conf);
7281 readln(conf,dummy);
7282 readln(conf,graphicsfolder);
7283 if graphicsfolder[1]='r' then graphicsfolder:='themes'+directoryseparator+DEFAULT_THEME+directoryseparator;
7284 readln(conf,dummy); opacity:=strtoint(dummy);
7285 readln(conf,color1);
7286 readln(conf,color2);
7287 readln(conf,color3);
7288 readln(conf,color4);
7289 readln(conf,color5);
7290 readln(conf,dummy); gridaltcolor:=strtoint(dummy);
7291 readln(conf,dummy); pzooming:=strtoint(dummy);
7292 readln(conf,dummy); pspacing:=strtoint(dummy);
7293 readconf_relativeline(6,dummy); closepolicy:=strtoint(dummy);
7294 CloseFile(conf);
7295 if opacity<0 then opacity:=0;
7296 if opacity>100 then opacity:=100;
7297 if (closepolicy<0) or (closepolicy>4) then closepolicy:=1;
7298 if color1='' then color1:=ColorToString(PAPPCOL);
7299 if color2='' then color2:=colortostring(clWindow);
7300 if color3='' then color3:=ColorToString(PTACOL);
7301 if color4='' then color4:='$00669999';
7302 if color5='' then color5:=colortostring(clWindowText);
7303 except
7304 persistent_source:=executable_path+'rnd';
7305 graphicsfolder:='themes'+directoryseparator+DEFAULT_THEME+directoryseparator;
7306 dodirseparators(graphicsfolder);
7307 opacity:=100;
7308 color1:=ColorToString(PAPPCOL);
7309 color2:=colortostring(clWindow);
7310 color3:=ColorToString(PTACOL);
7311 color4:='$00669999';
7312 color5:=colortostring(clWindowText);
7313 closepolicy:=1;
7314 pzooming:=100;
7315 pspacing:=4;
7316 gridaltcolor:=0;
7317 end;
7318 Unit_report.color1:=color1;
7319 Unit_report.color2:=color2;
7320 Form_pea.LabelOpen.visible:=false;
7321 if (opacity<100) then
7322 begin
7323 Form_pea.AlphaBlend:=true;
7324 Form_pea.AlphaBlendValue:=255+opacity-100;
7325 end;
7326 PanelDecrypt1.visible:=false;
7327 PanelEncrypt1.visible:=false;
7328 PanelPW1.visible:=false;
7329 PanelRFSinteractive.visible:=false;
7330 PanelTools.visible:=false;
7331 LabelE1.visible:=false;
7332 Panel1.visible:=false;
7333 details:=false;
7334 control:=false;
7335 interacting:=true;
7336 end;
7337
7338 procedure TForm_pea.FormDropFiles(Sender: TObject;
7339 const FileNames: array of String);
7340 var i:integer;
7341 begin
7342 if Form_pea.PanelUtils.visible=false then exit;
7343 if ListMemo.Enabled=false then exit;
7344 for i := 0 to High(FileNames) do
7345 begin
7346 ListMemo.Append(FileNames[i]);
7347 end;
7348 end;
7349
7350 procedure set_items_height;
7351 var
7352 refsize,rowheight,tabheightl,tabheight:integer;
7353 begin
7354 with Form_pea do
7355 begin
7356 refsize:=ButtonRefSize.Height;
7357 get_pformscaling(refsize,qscale,qscaleimages);
7358 qscale:=(qscale*pzooming) div 100;
7359 qscaleimages:=(qscaleimages*pzooming) div 100;
7360 Width:=560*qscale div 100;
7361 Height:=270*qscale div 100;
7362 Form_report.Width:=800*qscale div 100;
7363 Form_report.Height:=420*qscale div 100;
7364 //tabs
7365 tabheight:=36*qscale div 100;
7366 tabheightl:=48*qscale div 100;
7367 Form_report.PanelTitleRep.Height:=tabheight;
7368 Form_report.Panelsp0.Height:=tabheightl;
7369 Panelsp0.Height:=tabheightl;
7370 Panelsp1.Height:=tabheightl;
7371 Panelsp2.Height:=tabheightl;
7372 //grid
7373 rowheight:=((16+2+pspacing) * qscale) div 100;
7374 Form_report.StringGrid1.DefaultRowHeight:=rowheight;
7375 Form_report.StringGrid2.DefaultRowHeight:=rowheight;
7376 end;
7377 end;
7378
7379 procedure TForm_pea.FormShow(Sender: TObject);
7380 var
7381 kfun,funutil,i:integer;
7382 begin
7383 if fshown=true then exit;
7384 fshown:=true;
7385 Form_pea.Visible:=false;
7386 set_items_height;
7387 load_icons;
7388 if color3='clForm' then color3:=ColorToString(PTACOL);
7389 getpcolors(StringToColor(color1),StringToColor(color2),StringToColor(color3));
7390 img_utils.relwindowcolor:=stringtocolor(color2);
7391 Form_pea.Color:=StringToColor(color2);
7392 Form_pea.LabelE1.Font.Color:=pgray;
7393 Form_pea.labelopenfile2.Font.Color:=ptextaccent;
7394 Form_pea.labelopenfile0.Font.Color:=ptextaccent;
7395 Form_report.Color:=StringToColor(color2);
7396 Form_report.ShapeTitleREPb1.Brush.Color:=pvvlblue;
7397 Form_report.ShapeTitleREPb2.Brush.Color:=pvvlblue;
7398 Form_report.LabelSaveTxt.Font.Color:=ptextaccent;
7399 Form_report.LabelSaveTxt1.Font.Color:=ptextaccent;
7400 if gridaltcolor=1 then
7401 begin
7402 Form_report.StringGrid1.AlternateColor:=stringtocolor(collow);
7403 Form_report.StringGrid2.AlternateColor:=stringtocolor(collow);
7404 end
7405 else
7406 begin
7407 Form_report.StringGrid1.AlternateColor:=stringtocolor(color2);
7408 Form_report.StringGrid2.AlternateColor:=stringtocolor(color2);
7409 end;
7410 if paramcount>0 then
7411 begin
7412 if upcase(paramstr(1))='PEAUTILS' then
7413 begin
7414 try
7415 kfun:=strtoint(paramstr(2));
7416 Form_pea.Visible:=True;
7417 Form_pea.ComboBoxUtils.ItemIndex:=kfun;
7418 Form_pea.ComboBoxUtilsChange(nil);
7419 for i:=3 to paramcount do
7420 Form_pea.ListMemo.Append(paramstr(i));
7421 except
7422 Form_pea.ComboBoxUtilsChange(nil);
7423 end;
7424 end
7425 else
7426 begin
7427 funutil:=0;
7428 case upcase(paramstr(1)) of
7429 'PEA' : call_pea;
7430 'UNPEA' : call_unpea;
7431 'RFS' : call_rfs;
7432 'RFJ' : call_rfj;
7433 'WIPE' : call_wipe;
7434 'SANITIZE' : call_sanitize;
7435 'COMPARE' : call_compare;
7436 'CHECK' : call_check;
7437 'ENVSTR' : call_envstr;
7438 'LIST' : call_list;
7439 'HEXPREVIEW' : call_hexpreview;
7440 else funutil:=1;//internal_error('Incorrect request for Pea, the action "'+paramstr(1)+'" is not supported');
7441 end;
7442 if funutil=0 then Form_pea.PanelUtils.visible:=false
7443 else
7444 begin
7445 kfun:=12;
7446 Form_pea.Visible:=True;
7447 Form_pea.ComboBoxUtils.ItemIndex:=kfun;
7448 Form_pea.ComboBoxUtilsChange(nil);
7449 for i:=1 to paramcount do
7450 Form_pea.ListMemo.Append(paramstr(i));
7451 end;
7452 end;
7453 end
7454 else
7455 begin
7456 Form_pea.Visible:=True;
7457 Form_pea.ComboBoxUtilsChange(nil);
7458 end;
7459 end;
7460
7461 procedure TForm_pea.ImageUtilsClick(Sender: TObject);
7462 begin
7463 MessageDlg('Select a function (e.g. hash files) and drag here, or type/paste (one per line), a list of input files/folders if applicable to selected feature.', mtInformation, [mbOK], 0);
7464 end;
7465
7466 procedure TForm_pea.LabelLog1Click(Sender: TObject);
7467 begin
7468 Form_report.Visible:=true;
7469 Form_report.WindowState:=wsNormal;
7470 end;
7471
cp_opennull7472 function cp_open(s:ansistring; desk_env:byte):integer;
7473 var
7474 w:widestring;
7475 begin
7476 cp_open:=-1;
7477 if s<>'' then
7478 {$IFDEF MSWINDOWS}
7479 w:=utf8decode(s);
7480 cp_open:=ShellExecuteW(Form_pea.Handle, PWideChar ('open'), PWideChar(w), PWideChar (''), PWideChar (''), 1);//all Windows from 95 and NT3.1
7481 if cp_open<33 then
7482 cp_open:=shellexecuteW(Form_pea.handle,PWideChar('open'),PWideChar('RUNDLL32.EXE'),PWideChar('shell32.dll,OpenAs_RunDLL '+w),PWideChar (''), 1);
7483 {$ENDIF}
7484 {$IFDEF LINUX}cp_open:=cp_open_linuxlike(s,desk_env);{$ENDIF}//try to open via Gnome or KDE
7485 {$IFDEF DRAGONFLY}cp_open:=cp_open_linuxlike(s,desk_env);{$ENDIF}
7486 {$IFDEF NETBSD}cp_open:=cp_open_linuxlike(s,desk_env);{$ENDIF}
7487 end;
7488
7489 procedure cp_search(desk_env:byte);
7490 begin
7491 {$IFDEF MSWINDOWS}
7492 shellexecutew(Form_pea.handle, PWideChar('find'), PWideChar(''), PWideChar(''), PWideChar (''), SW_SHOWNORMAL);
7493 {$ENDIF}
7494 {$IFDEF LINUX}cp_search_linuxlike(desk_env);{$ENDIF}//try to search via Gnome or KDE
7495 {$IFDEF DRAGONFLY}cp_search_linuxlike(desk_env);{$ENDIF}
7496 {$IFDEF NETBSD}cp_search_linuxlike(desk_env);{$ENDIF}
7497 end;
7498
7499 procedure TForm_pea.LabelOpenClick(Sender: TObject);
7500 begin
7501 cp_open(output,desk_env);
7502 end;
7503
7504 procedure TForm_pea.labelopenfile0Click(Sender: TObject);
7505 begin
7506 cp_search(desk_env);
7507 end;
7508
7509 procedure TForm_pea.labelopenfile2Click(Sender: TObject);
7510 var i:integer;
7511 begin
7512 if OpenDialog2.execute then
7513 if OpenDialog2.FileName<>'' then
7514 begin
7515 for i := 0 to OpenDialog2.Files.Count-1 do
7516 begin
7517 ListMemo.Append(OpenDialog2.Files[i]);
7518 end;
7519 end;
7520 end;
7521
7522 procedure TForm_pea.mainmenuhelpClick(Sender: TObject);
7523 begin
7524 cp_open(FIRSTDOM+'peazip-help.html',desk_env);
7525 end;
7526
7527 procedure TForm_pea.pmupdatesClick(Sender: TObject);
7528 begin
7529 cp_open(FIRSTDOM,desk_env);
7530 end;
7531
7532 procedure TForm_pea.pmdonationsClick(Sender: TObject);
7533 begin
7534 cp_open(FIRSTDOM+'donations.html',desk_env);
7535 end;
7536
7537 procedure TForm_pea.PanelPW1MouseMove(Sender: TObject; Shift: TShiftState; X,
7538 Y: Integer);
7539 var
7540 i:integer;
7541 st:string;
7542 begin
7543 sample_mouse_ent(ment,x,y);
7544 ment_sample:=ment;
7545 SHA256Final(ment_sample,mentd_sample);
7546 st:='';
7547 for i:=0 to 3 do st:=st+hexstr(@mentd_sample[i],1);
7548 LabelSample1.Caption:=st;
7549 end;
7550
7551 procedure TForm_pea.peautilsbtnClick(Sender: TObject);
7552 var
7553 pp:TPoint;
7554 begin
7555 pp.x:=peautilsbtn.Left+peautilsbtn.Width;
7556 pp.y:=peautilsbtn.top+peautilsbtn.height;
7557 pp:=clienttoscreen(pp);
7558 peautilsmenu.Alignment:=paRight;
7559 peautilsmenu.PopUp(pp.x,pp.y);
7560 peautilsmenu.Alignment:=paLeft;
7561 end;
7562
7563 procedure TForm_pea.pmhelpClick(Sender: TObject);
7564 begin
7565 cp_open(FIRSTDOM+'peazip-help.html',desk_env);
7566 end;
7567
7568 procedure TForm_pea.pmrunasadminClick(Sender: TObject);
7569 var
7570 w:widestring;
7571 begin
7572 {$IFDEF MSWINDOWS}
7573 w:=utf8decode('"'+executable_path+'pea.exe"');
7574 ShellExecuteW(Form_pea.Handle, PWideChar ('runas'), PWideChar(w), PWideChar (''), PWideChar (''), SW_SHOWNORMAL);
7575 Close;
7576 {$ENDIF}
7577 end;
7578
7579 procedure TForm_pea.Timer1Timer(Sender: TObject); //gives the time to draw the UI before the CPU intensive task begin
7580 begin
7581 if control=true then exit;
7582 if interacting=true then exit;
7583 control:=true;
7584 parse_action;
7585 end;
7586
7587 initialization
7588 {$I unit_pea.lrs}
7589
7590 {$IFDEF MSWINDOWS}
7591 OleInitialize(nil);
7592 {$ENDIF}
7593
7594 finalization
7595 {$IFDEF MSWINDOWS}
7596 OleUninitialize
7597 {$ENDIF}
7598
7599 end.
7600