"Fossies" - the Fresh Open Source Software Archive

Member "peazip-8.0.0.src/unit5.pas" (2 May 2021, 8755 Bytes) of package /linux/misc/peazip-8.0.0.src.zip:


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

    1 unit Unit5; 
    2 
    3 {$mode objfpc}{$H+}
    4 
    5 interface
    6 
    7 uses
    8   Unit7, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
    9   StdCtrls, ExtCtrls, Spin, ComCtrls,
   10   hash, sha512, whirl512, sha1, sha256, mem_util,
   11   pea_utils, Buttons, ButtonPanel;
   12 
   13 type
   14 
   15   { TFormKF }
   16 
   17   TFormKF = class(TForm)
   18     ButtonKF: TButton;
   19     ButtonKFLoadFile: TButton;
   20     ButtonPanel1: TButtonPanel;
   21     ButtonSuggestPW: TButton;
   22     CheckBoxSuggestPW: TCheckBox;
   23     EditEnt: TEdit;
   24     EditSuggestPW: TEdit;
   25     GroupBoxKF: TGroupBox;
   26     ImageInfoArchive1: TImage;
   27     OpenDialog2: TOpenDialog;
   28     PanelKeyfile: TPanel;
   29     ProgressBar1: TProgressBar;
   30     SaveDialog1: TSaveDialog;
   31     SpinEditSuggestPW: TSpinEdit;
   32     procedure ButtonKFClick(Sender: TObject);
   33     procedure ButtonKFLoadFileClick(Sender: TObject);
   34     procedure ButtonSuggestPWClick(Sender: TObject);
   35     procedure EditEntKeyPress(Sender: TObject; var Key: char);
   36     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
   37     procedure GroupBoxKFMouseMove(Sender: TObject; Shift: TShiftState; X,
   38       Y: Integer);
   39     procedure ImageInfoArchive1Click(Sender: TObject);
   40     procedure PanelKeyfileMouseMove(Sender: TObject; Shift: TShiftState; X,
   41       Y: Integer);
   42     procedure Shape3MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
   43       );
   44   private
   45     { private declarations }
   46   public
   47     { public declarations }
   48   end; 
   49 
   50 var
   51   FormKF: TFormKF;
   52   persistent_source,txt_keyfile_notcreated,txt_error_openfile,st:ansistring;
   53   SHA512Context: THashContext;
   54   SHA512Digest: TSHA512Digest;
   55   WhirlContext_File: THashContext;
   56   WhirlDigest_File: TWhirlDigest;
   57   SHA512ContextSample:THashContext;
   58   SHA512DigestSample: TSHA512Digest;
   59   WhirlContextSample: THashContext;
   60   WhirlDigestSample: TWhirlDigest;
   61   mentd,kentd,fentd: TWhirlDigest;
   62   fingerprint:TSHA512Digest;
   63   d_sample: TSHA256Digest;
   64   ment,kent,fent,sample: THashContext;
   65 
   66 implementation
   67 
   68 procedure read_rand(var arr: array of byte);
   69 var
   70    randf: file of byte;
   71 begin
   72 try
   73 //read current rand seed file
   74 assignfile(randf,(persistent_source));
   75 filemode:=0;
   76 reset(randf);
   77 blockread(randf,arr,256);
   78 closefile(randf);
   79 except
   80 end;
   81 end;
   82 
   83 procedure gen_rand(var arr: array of byte);
   84 var
   85    ment1,kent1,fent1: THashContext;
   86 begin
   87 ment1:=ment;
   88 kent1:=kent;
   89 fent1:=fent;
   90 generate_keyf (arr,persistent_source,fingerprint,ment1,kent1,fent1);
   91 end;
   92 
   93 procedure shl_rand(var arr: array of byte);
   94 var
   95    randf: file of byte;
   96    randarr: TKey2048;
   97    i: integer;
   98 begin
   99 try
  100 //read current rand seed file
  101 assignfile(randf,(persistent_source));
  102 filemode:=0;
  103 reset(randf);
  104 blockread(randf,randarr,256);
  105 closefile(randf);
  106 //left shift by one byte the rand seed (in randarr)
  107 for i:=0 to 254 do arr[i]:=randarr[i+1];
  108 arr[255]:=randarr[0];
  109 except
  110 end;
  111 end;
  112 
  113 procedure gen_pw(keyarr:TKey2048; pwsize:integer; var pw:ansistring);
  114 var
  115    i,j:integer;
  116    spchar:boolean;
  117 begin
  118 setlength(pw,pwsize);
  119 for i:=0 to pwsize do pw[i]:=char(0);
  120 if FormKF.CheckBoxSuggestPW.State=cbChecked then spchar:=false else spchar:=true;
  121 i:=1;
  122 j:=0;
  123 repeat
  124    keyarr[j]:=keyarr[j] xor random(256);
  125    if spchar=false then //strictly char, upcase char and number as required by some services
  126       if ((keyarr[j]>47) and (keyarr[j]<58)) or ((keyarr[j]>64) and (keyarr[j]<91)) or ((keyarr[j]>96) and (keyarr[j]<123)) then
  127          begin
  128          pw[i]:=char(keyarr[j]);
  129          i:=i+1;
  130          end
  131       else begin end
  132    else //allow symbols and special characters
  133       if (keyarr[j]>31) and (keyarr[j]<127) and (keyarr[j]<>34) and (keyarr[j]<>39) then
  134          begin
  135          pw[i]:=char(keyarr[j]);
  136          i:=i+1;
  137          end;
  138    j:=j+1;
  139 until (i=pwsize+1) or (j=256);
  140 while i<pwsize+1 do
  141    begin
  142    j:=random(128);
  143    if spchar=false then
  144       if ((j>47) and (j<58)) or ((j>64) and (j<91)) or ((j>96) and (j<123)) then
  145          begin
  146          pw[i]:=char(j);
  147          i:=i+1;
  148          end
  149       else begin end
  150    else
  151       if ((j>31) and (j<127)) then
  152          begin
  153          pw[i]:=char(j);
  154          i:=i+1;
  155          end;
  156    end;
  157 end;
  158 
  159 { TFormKF }
  160 
  161 procedure TFormKF.ButtonKFClick(Sender: TObject);
  162 //create keyfile, recreate the system's fingerprint the entropy bar is zeroed since less entropy is introduced than the first time the system fingerprint was taken (at application startup, when entropy bar was set to 16)
  163 var
  164    keyf: file of byte;
  165    keyarr: TKey2048;
  166    keyf_name:ansistring;
  167    numwritten:integer;
  168 begin
  169 if SaveDialog1.execute then
  170    begin
  171    if SaveDialog1.Filename<>'' then keyf_name:=SaveDialog1.Filename
  172    else keyf_name:='KeyFile';
  173    assignfile(keyf,keyf_name);
  174    rewrite(keyf);
  175    end
  176 else
  177    begin
  178    pMessageWarningOK(txt_keyfile_notcreated);
  179    exit;
  180    end;
  181 read_rand(keyarr);
  182 gen_rand(keyarr);
  183 blockwrite(keyf,keyarr,256,numwritten); //write 256 byte (2048 bit) keyarr to file
  184 closefile(keyf);
  185 get_fingerprint (fingerprint,false);
  186 ProgressBar1.Position:=0;
  187 end;
  188 
  189 procedure TFormKF.ButtonKFLoadFileClick(Sender: TObject);
  190 var
  191    fse,i:integer;
  192    f:file of byte;
  193 begin //conservative entropy evaluation: 2 bit for timing (file selection takes longer than mouse or keyboard operations) 1 bit for filename character file content enthropy is quite hazardous to evaluate, 1 bit is assigned for each byte of size up to 512 bit (digest size).
  194 try
  195 if OpenDialog2.Execute then
  196    if OpenDialog2.Filename<>'' then
  197       begin
  198       sample_file_ent(fent,OpenDialog2.Filename);
  199       sample:=fent;
  200       SHA256Final(sample,d_sample);
  201       st:='';
  202       for i:=0 to 3 do st:=st+hexstr(@d_sample[i],1);
  203       assignfile(f,OpenDialog2.Filename);
  204       filemode:=0;
  205       reset(f);
  206       if system.filesize(f)>512 then fse:=512
  207       else fse:=system.filesize(f);
  208       closefile(f);
  209       ProgressBar1.Position:=ProgressBar1.Position+2+length(OpenDialog2.Filename)+fse;
  210       end;
  211 except
  212 pMessageErrorOK(txt_error_openfile);
  213 end;
  214 end;
  215 
  216 procedure TFormKF.ButtonSuggestPWClick(Sender: TObject);
  217 var
  218    keyarr: TKey2048;
  219    pw:ansistring;
  220 begin
  221 read_rand(keyarr);
  222 gen_rand(keyarr);
  223 gen_pw(keyarr,SpinEditSuggestPW.Value,pw);
  224 EditSuggestPW.Text:=pw;
  225 get_fingerprint (fingerprint,false);
  226 ProgressBar1.Position:=0;
  227 end;
  228 
  229 procedure TFormKF.EditEntKeyPress(Sender: TObject; var Key: char);
  230 //conservative entropy evaluation: 1 for the character +1 bit for the keypress delta time (memory sampling is done only under Windows so is no taken in account for this conservative exteem)
  231 var
  232    i:integer;
  233 begin
  234 sample_keyb_ent(kent,ord(Key));
  235 sample:=kent;
  236 SHA256Final(sample,d_sample);
  237 st:='';
  238 for i:=0 to 3 do st:=st+hexstr(@d_sample[i],1);
  239 ProgressBar1.Position:=ProgressBar1.Position+2;
  240 end;
  241 
  242 procedure TFormKF.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  243 var
  244    randf: file of byte;
  245    randarr: TKey2048;
  246 begin
  247 try
  248    shl_rand(randarr); //read and leftshift of 1 byte data from persistent random seed file
  249    gen_rand(randarr); //create keyfile starting from data of previous seed file shifted of 1 byte
  250    assignfile(randf,persistent_source); //write keyfile as new seed file
  251    rewrite(randf);
  252    blockwrite(randf,randarr,256);
  253    closefile(randf);
  254 except
  255 end;
  256 end;
  257 
  258 procedure TFormKF.GroupBoxKFMouseMove(Sender: TObject; Shift: TShiftState; X,
  259   Y: Integer);
  260 var
  261    i:integer;
  262 begin //conservative entropy evaluation: 3 bit per movement, 1 for each of the two axis + 1 for delta timer
  263 sample_mouse_ent(ment,x,y);
  264 sample:=ment;
  265 SHA256Final(sample,d_sample);
  266 st:='';
  267 for i:=0 to 3 do st:=st+hexstr(@d_sample[i],1);
  268 ProgressBar1.Position:=ProgressBar1.Position+3;
  269 end;
  270 
  271 procedure TFormKF.ImageInfoArchive1Click(Sender: TObject);
  272 begin
  273 pMessageInfoOK(Imageinfoarchive1.Hint);
  274 end;
  275 
  276 procedure TFormKF.PanelKeyfileMouseMove(Sender: TObject; Shift: TShiftState; X,
  277   Y: Integer);
  278 //conservative entropy evaluation: 3 bit per movement, 1 for each of the two axis + 1 for delta timer
  279 var
  280    i:integer;
  281 begin
  282 sample_mouse_ent(ment,x,y);
  283 sample:=ment;
  284 SHA256Final(sample,d_sample);
  285 st:='';
  286 for i:=0 to 3 do st:=st+hexstr(@d_sample[i],1);
  287 ProgressBar1.Position:=ProgressBar1.Position+3;
  288 end;
  289 
  290 procedure TFormKF.Shape3MouseMove(Sender: TObject; Shift: TShiftState; X,
  291   Y: Integer);
  292 //conservative entropy evaluation: 3 bit per movement, 1 for each of the two axis + 1 for delta timer
  293 var
  294    i:integer;
  295 begin
  296 sample_mouse_ent(ment,x,y);
  297 sample:=ment;
  298 SHA256Final(sample,d_sample);
  299 st:='';
  300 for i:=0 to 3 do st:=st+hexstr(@d_sample[i],1);
  301 ProgressBar1.Position:=ProgressBar1.Position+3;
  302 end;
  303 
  304 initialization
  305   {$I unit5.lrs}
  306 
  307 end.
  308