[Back to FILES SWAG index]  [Back to Main SWAG index]  [Original]

{
> I'm looking For a turbo pascal routine that will wipe Files
> off of disks the way (or similar to the way) that Norton's
> Wipeinfo wipe's Files.  I'd like the call to be something
> like wipeFile(fn:String);  Preferrably, I would also like
> the deleted directory entry wiped to prevent one from seeing
> what the File that used to be there was named, or how large
> it was.  Any help would greatly be appreciated.

> Here is my wipe File. The directory entry is not cleared.
Well, today an idea occured: clearing directory entries is not as
difficult as I tought. No Assembler needed, no strange Dos calls, just
plain TP. Here an updated version. Even the CIA won't get your Files
back!
}

Procedure DosWipe(Path : PathStr);
{ wipes Files according to Department of Defense standard DOD 5220.22-M }
Var
  DataFile : File;
  DirInfo  : SearchRec;

  Procedure WipeFile(Var DataFile : File);
  Const
    NullByte : Byte = 0;
    FFByte   : Byte = $FF;
    F6Byte   : Byte = $F6;
  Var
    Result : Word;
    Count  : Byte;
    Count2 : LongInt;
  begin
    Reset(DataFile, 1);
    For Count := 1 to 3 do
    begin
      Seek(DataFile,0);
      For Count2 := 0 to FileSize(DataFile) - 1 do
        BlockWrite(DataFile, FFByte, 1, result);
      Seek(DataFile,0);
      For Count2 := 0 to FileSize(DataFile) - 1 do
        BlockWrite(DataFile, NullByte, 1, result);
    end;

    Seek(DataFile, 0);
    For Count := 0 to FileSize(DataFile) - 1 do
      BlockWrite(DataFile, F6Byte, 1, result);
    Close(DataFile);
  end;

  Procedure ClearDirEntry;
  begin
    Reset(DataFile);
    Truncate(DataFile);                  { erase size entry }
    Close(DataFile);
    Rename(DataFile, 'TMP00000.$$$');    { erase name entry }
  end;

Var
  D : DirStr;
  N : NameStr;
  E : ExtStr;
begin
  FSplit(Path, D, N, E);
  FindFirst(Path, Archive, DirInfo);

  While DosError = 0 do
  begin
    Assign(DataFile, D+DirInfo.Name);
    WipeFile(DataFile);
    ClearDirEntry;
    Erase(DataFile);
    FindNext(DirInfo);
  end;
end;

[Back to FILES SWAG index]  [Back to Main SWAG index]  [Original]