Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/nastroje/WP.ZIP/wp.dpr

Text File | 2001-07-11 | 8.1 KB | 277 lines

program wp;
{$APPTYPE CONSOLE}
uses
  SysUtils, twofish, sha1;

var
everythingOK: boolean;
checkdir:boolean;

procedure _HashString(s: string; var Digest: TSHA1Digest);  // produce a hash of a string
var
  Context: TSHA1Context;                 // record to store intermediate data
begin
  SHA1Init(Context);                     // initialise the data record
  SHA1Update(Context,@S[1],Length(S));   // update the data record with the string
  SHA1Final(Context,Digest);             // produce the final hash
end;


procedure SecureErase(pass:integer;filename:string);
var
  Buffer: array[0..8191] of byte;
  Source: file;
  i, j, n, a: integer;
  rena:string;                   // renames file to delete
  KeyData: TTwofishData;         // the initialized key data
  Digest: TSHA1Digest;           // hash digest
  IV: array[0..15] of byte;      // the initialization vector needed for chaining modes
  Key: string;                   // key initialization
begin
if RenameFile(filename,extractfilepath(filename)+'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaa') then
begin
rena:=extractfilepath(filename)+'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaa';
AssignFile(Source,rena);
end
else
begin
  AssignFile(Source,Filename);
end;
  write(extractfilename(filename));
  for a:=1 to pass do         //enter into the deletion of files
  begin
  try
    Reset(Source,1);  // make sure we don;t have an error
  except
    writeln;
    writeln('wp: can''t get file to wipe: '+filename);
    everythingOK:=False;
    Exit;
  end;

  write('.');

  repeat   // first with 0's
    n:= FilePos(Source);
    BlockRead(Source,Buffer,Sizeof(Buffer),i);
    for j:= 1 to (i div 16) do
      FillChar(Buffer, SizeOf(Buffer), 0);
    Seek(Source,n);
    BlockWrite(Source,Buffer,i);
  until i<> Sizeof(Buffer);

  seek(source,0);
  repeat   // second with 1's
    n:= FilePos(Source);
    BlockRead(Source,Buffer,Sizeof(Buffer),i);
    for j:= 1 to (i div 16) do
      FillChar(Buffer, SizeOf(Buffer), 255);
    Seek(Source,n);
    BlockWrite(Source,Buffer,i);
  until i<> Sizeof(Buffer);

   Key:= filename+datetimetostr(now);   //produce the key to initialize the key space
   _HashString(Key,Digest);             // make a hash of the key
   TwofishInit(KeyData,@Digest,Sizeof(Digest),nil);   // initialize the key data using a hash of the key
   FillChar(IV,Sizeof(IV),0);                         // make the IV all zeros
   TwofishEncryptCBC(KeyData,@IV,@IV);                // encrypt the IV to get a 'random' IV
   Move(IV,KeyData.InitBlock,Sizeof(KeyData.InitBlock)); // move the IV into the keydata so can use chaining
   TwofishReset(KeyData);
   seek(source,0);                             // reset the keydata so it uses the new IV
  repeat        // third with garbage
    n:= FilePos(Source);
    BlockRead(Source,Buffer,Sizeof(Buffer),i);
    for j:= 1 to (i div 16) do                        // 16 is the blocksize of Twofish so process in 16 byte blocks
      TwofishEncryptCBC(KeyData,@Buffer[(j-1)*Sizeof(IV)],@Buffer[(j-1)*Sizeof(IV)]);
    if (i mod 16)<> 0 then                            // encrypt the last bytes that don't fit in to a full block
    begin
      Move(KeyData.LastBlock,IV,Sizeof(IV));
      TwofishEncryptCBC(KeyData,@IV,@IV);             // encrypt the full block again (so that it is encrypted twice)
      for j:= 1 to (i mod 16) do
        Buffer[(i and not 15)+j]:= Buffer[(i and not 15)+j] xor IV[j];    // xor this encrypted block with the short block
    end;
    Seek(Source,n);
    BlockWrite(Source,Buffer,i);                      // write out the buffer to the file
  until i<> Sizeof(Buffer);
  CloseFile(Source);
  end;
  TwofishBurn(KeyData);  //we destroy any info about the key
  erase(source);         // erase the file
  everythingOK:=true;
end;

//wipes a dir
procedure wipedir(dir:string);
var
  Found: integer;//added
  SRec: TSearchRec;//added
  attributes,newattributes:word;
begin
       if dir<>'' then
       begin
         try
           chdir(dir);
         except
           writeln('wp: can''t find directory: '+dir);
           exit;
         end;
       end;

    Found:= FindFirst('*.*',faReadOnly or faSysFile,SRec); { Use FindFirst so we can specify wild cards in the filename }
    if Found<> 0 then
    begin
      Writeln('wp: file not found: ' +dir+'\*.*');
      exit;
    end; //added
    while Found= 0 do
    begin            //added

      try
        attributes:=filegetattr(SRec.Name);
        newattributes:=attributes;
        newattributes:=newattributes and not faReadOnly;
        filesetattr(SRec.Name,newattributes);
      except
        writeln;
        writeln('wp: can''t wipe '+SRec.Name+', file might be in use.');
        exit;
      end;
       SecureErase(strtoint(paramstr(1)),SRec.Name);

      if everythingOK=true then
      begin
         writeln;
         //Writeln('File wiped >> '+SRec.Name);
      end
      else
      begin
         writeln;
         writeln('Errors where reported while wiping: '+SRec.Name);
         writeln('File might be corrupted.');
      end;
      Found:= FindNext(SRec);   { Find the next file }
    end;// added while
    FindClose(SRec);
    if checkdir then
    begin
      chdir('..');
      rmdir(dir);
    end;
    writeln;
    Writeln('Directory wiped: '+dir);
    checkdir:=true;
end;


var
    attributes,newattributes:word;
    ii,  Found: integer;//added
    SRec: TSearchRec;//added
    Sure: char;
    dir: string;

begin
everythingOK:=false;
checkdir:=true;

if (paramcount<2) or (paramstr(1)='-?') or (paramstr(1)='/?') then
begin
  writeln('WP - Erases files in a secure way.');
  writeln('By Uri Fridman. [e-mail]');
  writeln('Usage:');
  writeln('      wp [No. of passes] filename1 <filename2> ...');
  writeln;
  writeln('The program is freeware.');
  writeln('There are no warranties at all. Use at your own risk!');
  exit;
end;

writeln;

try
  strtoint(paramstr(1));
except
  writeln('Parameter #1 [No. of passes] should be a number.');
  writeln('Type "wp -?" for help.');
  exit;
end;

writeln('Once wiped the files are impossible to recover,');
write('are you sure you want to wipe the file(s)? (y,n): ');
readln(Sure);
if (Sure<>'Y') and (Sure<>'y') then
begin
  writeln('File Wipe aborted.');
  exit;
end;

 writeln('Wiping:');

  for ii:=2 to ParamCount do  { Cycle through all the files specified added}
  begin //added

    if paramstr(ii)='.' then
    begin
     checkdir:=false;
    end;

        attributes:=filegetattr(paramstr(ii));
        if attributes=faDirectory then
        begin
          wipedir(paramstr(ii));
          exit;
        end;

       dir:=extractfilepath(paramstr(ii));
       if dir<>'' then
       begin
         try
           chdir(dir);
         except
           writeln('wp: can''t find directory: '+dir);
           exit;
         end;
       end;
       dir:='';

    Found:= FindFirst(ParamStr(ii),faReadOnly or faSysFile,SRec); { Use FindFirst so we can specify wild cards in the filename }
    if Found<> 0 then
    begin
      Writeln('wp: file not found: ',ParamStr(ii));
      exit;
    end; //added
    while Found= 0 do
    begin            //added
      try
        attributes:=filegetattr(SRec.Name);
        newattributes:=attributes;
        newattributes:=newattributes and not faReadOnly;
        filesetattr(SRec.Name,newattributes);
      except
        writeln;
        writeln('wp: can''t wipe '+SRec.Name+', file might be in use.');
        exit;
      end;

       SecureErase(strtoint(paramstr(1)),SRec.Name);

      if everythingOK=true then
      begin
         writeln;
         //Writeln('File wiped >> '+SRec.Name);
      end
      else
      begin
         writeln;
         writeln('Errors where reported while wiping :: '+SRec.Name);
         writeln('File might be corrupted.');
      end;

      Found:= FindNext(SRec);   { Find the next file }
    end;// added while
    FindClose(SRec);
  end; //added for
writeln;
Writeln('File(s) wiped');
exit;
end.