1:

~asswort.txt                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:

procedure Killdatei(Filename: string);
const bufCnt=1024;
var a: Array [1..bufCnt] of byte;
    f: file;
    i, sz: integer;
begin
  assignfile(f,FileName);
  reset(f,1);
  sz:=FileSize(f);
  for i:=1 to sz div bufCnt do blockwrite(f, a, bufCnt);
  blockwrite(f, a, sz mod bufCnt);
  closeFile(f);
  erase(f);
end;                    

1:
2:
3:
4:

repeat
  BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
  BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:

function WipeFile(const szFilename: string): boolean;
var
  f      : file;
  buf    : array[0..65535]of byte;
  i,
  iRead,
  iWrite : integer;
  fpos   : longint;
begin
  {$I-}
  AssignFile(f,szFileName);
  ReSet(f,1);

  if(IoResult = 0) then begin
    repeat
      fPos := filepos(f);                    // aktuelle Position merken
      BlockRead(f,buf,sizeof(buf),iRead);    // max. 65k lesen

      // der tatsächlich gelesene Wert steckt in "iRead" und
      // ist irgendwann Null, wenn das Ende der Datei erreicht
      // wurde und keine Bytes mehr gelesen werden können
      if(iRead > 0) then
        // (alte?) Methode des DOD (US-Verteidigungsministerium):
        // einmal 00 schreiben; einmal FF schreiben (3 Wiederholungen)
        // dann F6 schreiben
        // (Norton WipeInfo macht´s heute noch so; außer, das 0x01
        // anstelle von 0xff angegeben ist)
        for i := 1 to 7 do begin
          case i of
            1,3,5 : fillchar(buf,iRead,  0); // Inhalt mit 0x00 überschreiben
            2,4,6 : fillchar(buf,iRead,255); // Inhalt mit 0xff überschreiben
            7     : fillchar(buf,iRead,246); // Inhalt mit 0xf6 überschreiben
          end;

          seek(f,fPos);                      // gespeicherte Position suchen
          BlockWrite(f,buf,iRead,iWrite);    // Puffer schreiben
          if(iWrite <> iRead) then break;    // Fehler! :o(
        end;
    until(iRead = 0) or (iWrite <> iRead);

    CloseFile(f);                            // alte Datei schließen
    Rename(f,'D');                           // alten Namen "vernichten"
    ReWrite(f,1);                            // alte Position "vernichten"
    CloseFile(f);
    Erase(f);                                // Datei löschen
  end;
  {$I+}

  Result := (IoResult = 0);
end;