home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / nastroje / WP.ZIP / wp.dpr < prev    next >
Text File  |  2001-07-11  |  8KB  |  277 lines
  1. program wp;
  2. {$APPTYPE CONSOLE}
  3. uses
  4.   SysUtils, twofish, sha1;
  5.  
  6. var
  7. everythingOK: boolean;
  8. checkdir:boolean;
  9.  
  10. procedure _HashString(s: string; var Digest: TSHA1Digest);  // produce a hash of a string
  11. var
  12.   Context: TSHA1Context;                 // record to store intermediate data
  13. begin
  14.   SHA1Init(Context);                     // initialise the data record
  15.   SHA1Update(Context,@S[1],Length(S));   // update the data record with the string
  16.   SHA1Final(Context,Digest);             // produce the final hash
  17. end;
  18.  
  19.  
  20. procedure SecureErase(pass:integer;filename:string);
  21. var
  22.   Buffer: array[0..8191] of byte;
  23.   Source: file;
  24.   i, j, n, a: integer;
  25.   rena:string;                   // renames file to delete
  26.   KeyData: TTwofishData;         // the initialized key data
  27.   Digest: TSHA1Digest;           // hash digest
  28.   IV: array[0..15] of byte;      // the initialization vector needed for chaining modes
  29.   Key: string;                   // key initialization
  30. begin
  31. if RenameFile(filename,extractfilepath(filename)+'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaa') then
  32. begin
  33. rena:=extractfilepath(filename)+'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaa';
  34. AssignFile(Source,rena);
  35. end
  36. else
  37. begin
  38.   AssignFile(Source,Filename);
  39. end;
  40.   write(extractfilename(filename));
  41.   for a:=1 to pass do         //enter into the deletion of files
  42.   begin
  43.   try
  44.     Reset(Source,1);  // make sure we don;t have an error
  45.   except
  46.     writeln;
  47.     writeln('wp: can''t get file to wipe: '+filename);
  48.     everythingOK:=False;
  49.     Exit;
  50.   end;
  51.  
  52.   write('.');
  53.  
  54.   repeat   // first with 0's
  55.     n:= FilePos(Source);
  56.     BlockRead(Source,Buffer,Sizeof(Buffer),i);
  57.     for j:= 1 to (i div 16) do
  58.       FillChar(Buffer, SizeOf(Buffer), 0);
  59.     Seek(Source,n);
  60.     BlockWrite(Source,Buffer,i);
  61.   until i<> Sizeof(Buffer);
  62.  
  63.   seek(source,0);
  64.   repeat   // second with 1's
  65.     n:= FilePos(Source);
  66.     BlockRead(Source,Buffer,Sizeof(Buffer),i);
  67.     for j:= 1 to (i div 16) do
  68.       FillChar(Buffer, SizeOf(Buffer), 255);
  69.     Seek(Source,n);
  70.     BlockWrite(Source,Buffer,i);
  71.   until i<> Sizeof(Buffer);
  72.  
  73.    Key:= filename+datetimetostr(now);   //produce the key to initialize the key space
  74.    _HashString(Key,Digest);             // make a hash of the key
  75.    TwofishInit(KeyData,@Digest,Sizeof(Digest),nil);   // initialize the key data using a hash of the key
  76.    FillChar(IV,Sizeof(IV),0);                         // make the IV all zeros
  77.    TwofishEncryptCBC(KeyData,@IV,@IV);                // encrypt the IV to get a 'random' IV
  78.    Move(IV,KeyData.InitBlock,Sizeof(KeyData.InitBlock)); // move the IV into the keydata so can use chaining
  79.    TwofishReset(KeyData);
  80.    seek(source,0);                             // reset the keydata so it uses the new IV
  81.   repeat        // third with garbage
  82.     n:= FilePos(Source);
  83.     BlockRead(Source,Buffer,Sizeof(Buffer),i);
  84.     for j:= 1 to (i div 16) do                        // 16 is the blocksize of Twofish so process in 16 byte blocks
  85.       TwofishEncryptCBC(KeyData,@Buffer[(j-1)*Sizeof(IV)],@Buffer[(j-1)*Sizeof(IV)]);
  86.     if (i mod 16)<> 0 then                            // encrypt the last bytes that don't fit in to a full block
  87.     begin
  88.       Move(KeyData.LastBlock,IV,Sizeof(IV));
  89.       TwofishEncryptCBC(KeyData,@IV,@IV);             // encrypt the full block again (so that it is encrypted twice)
  90.       for j:= 1 to (i mod 16) do
  91.         Buffer[(i and not 15)+j]:= Buffer[(i and not 15)+j] xor IV[j];    // xor this encrypted block with the short block
  92.     end;
  93.     Seek(Source,n);
  94.     BlockWrite(Source,Buffer,i);                      // write out the buffer to the file
  95.   until i<> Sizeof(Buffer);
  96.   CloseFile(Source);
  97.   end;
  98.   TwofishBurn(KeyData);  //we destroy any info about the key
  99.   erase(source);         // erase the file
  100.   everythingOK:=true;
  101. end;
  102.  
  103. //wipes a dir
  104. procedure wipedir(dir:string);
  105. var
  106.   Found: integer;//added
  107.   SRec: TSearchRec;//added
  108.   attributes,newattributes:word;
  109. begin
  110.        if dir<>'' then
  111.        begin
  112.          try
  113.            chdir(dir);
  114.          except
  115.            writeln('wp: can''t find directory: '+dir);
  116.            exit;
  117.          end;
  118.        end;
  119.  
  120.     Found:= FindFirst('*.*',faReadOnly or faSysFile,SRec); { Use FindFirst so we can specify wild cards in the filename }
  121.     if Found<> 0 then
  122.     begin
  123.       Writeln('wp: file not found: ' +dir+'\*.*');
  124.       exit;
  125.     end; //added
  126.     while Found= 0 do
  127.     begin            //added
  128.  
  129.       try
  130.         attributes:=filegetattr(SRec.Name);
  131.         newattributes:=attributes;
  132.         newattributes:=newattributes and not faReadOnly;
  133.         filesetattr(SRec.Name,newattributes);
  134.       except
  135.         writeln;
  136.         writeln('wp: can''t wipe '+SRec.Name+', file might be in use.');
  137.         exit;
  138.       end;
  139.        SecureErase(strtoint(paramstr(1)),SRec.Name);
  140.  
  141.       if everythingOK=true then
  142.       begin
  143.          writeln;
  144.          //Writeln('File wiped >> '+SRec.Name);
  145.       end
  146.       else
  147.       begin
  148.          writeln;
  149.          writeln('Errors where reported while wiping: '+SRec.Name);
  150.          writeln('File might be corrupted.');
  151.       end;
  152.       Found:= FindNext(SRec);   { Find the next file }
  153.     end;// added while
  154.     FindClose(SRec);
  155.     if checkdir then
  156.     begin
  157.       chdir('..');
  158.       rmdir(dir);
  159.     end;
  160.     writeln;
  161.     Writeln('Directory wiped: '+dir);
  162.     checkdir:=true;
  163. end;
  164.  
  165.  
  166. var
  167.     attributes,newattributes:word;
  168.     ii,  Found: integer;//added
  169.     SRec: TSearchRec;//added
  170.     Sure: char;
  171.     dir: string;
  172.  
  173. begin
  174. everythingOK:=false;
  175. checkdir:=true;
  176.  
  177. if (paramcount<2) or (paramstr(1)='-?') or (paramstr(1)='/?') then
  178. begin
  179.   writeln('WP - Erases files in a secure way.');
  180.   writeln('By Uri Fridman. urifrid@hushmail.com');
  181.   writeln('Usage:');
  182.   writeln('      wp [No. of passes] filename1 <filename2> ...');
  183.   writeln;
  184.   writeln('The program is freeware.');
  185.   writeln('There are no warranties at all. Use at your own risk!');
  186.   exit;
  187. end;
  188.  
  189. writeln;
  190.  
  191. try
  192.   strtoint(paramstr(1));
  193. except
  194.   writeln('Parameter #1 [No. of passes] should be a number.');
  195.   writeln('Type "wp -?" for help.');
  196.   exit;
  197. end;
  198.  
  199. writeln('Once wiped the files are impossible to recover,');
  200. write('are you sure you want to wipe the file(s)? (y,n): ');
  201. readln(Sure);
  202. if (Sure<>'Y') and (Sure<>'y') then
  203. begin
  204.   writeln('File Wipe aborted.');
  205.   exit;
  206. end;
  207.  
  208.  writeln('Wiping:');
  209.  
  210.   for ii:=2 to ParamCount do  { Cycle through all the files specified added}
  211.   begin //added
  212.  
  213.     if paramstr(ii)='.' then
  214.     begin
  215.      checkdir:=false;
  216.     end;
  217.  
  218.         attributes:=filegetattr(paramstr(ii));
  219.         if attributes=faDirectory then
  220.         begin
  221.           wipedir(paramstr(ii));
  222.           exit;
  223.         end;
  224.  
  225.        dir:=extractfilepath(paramstr(ii));
  226.        if dir<>'' then
  227.        begin
  228.          try
  229.            chdir(dir);
  230.          except
  231.            writeln('wp: can''t find directory: '+dir);
  232.            exit;
  233.          end;
  234.        end;
  235.        dir:='';
  236.  
  237.     Found:= FindFirst(ParamStr(ii),faReadOnly or faSysFile,SRec); { Use FindFirst so we can specify wild cards in the filename }
  238.     if Found<> 0 then
  239.     begin
  240.       Writeln('wp: file not found: ',ParamStr(ii));
  241.       exit;
  242.     end; //added
  243.     while Found= 0 do
  244.     begin            //added
  245.       try
  246.         attributes:=filegetattr(SRec.Name);
  247.         newattributes:=attributes;
  248.         newattributes:=newattributes and not faReadOnly;
  249.         filesetattr(SRec.Name,newattributes);
  250.       except
  251.         writeln;
  252.         writeln('wp: can''t wipe '+SRec.Name+', file might be in use.');
  253.         exit;
  254.       end;
  255.  
  256.        SecureErase(strtoint(paramstr(1)),SRec.Name);
  257.  
  258.       if everythingOK=true then
  259.       begin
  260.          writeln;
  261.          //Writeln('File wiped >> '+SRec.Name);
  262.       end
  263.       else
  264.       begin
  265.          writeln;
  266.          writeln('Errors where reported while wiping :: '+SRec.Name);
  267.          writeln('File might be corrupted.');
  268.       end;
  269.  
  270.       Found:= FindNext(SRec);   { Find the next file }
  271.     end;// added while
  272.     FindClose(SRec);
  273.   end; //added for
  274. writeln;
  275. Writeln('File(s) wiped');
  276. exit;
  277. end.