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:

  fsFrom,fsTo : TFilestream;
  u,u1 : string;
  size1 : integer;
  f: file;
  l,l1 : Longint;

begin
  if not Fileexists(Edit1.Text) then
    begin
    showmessage('Can not open file.');
    exit;
    end;
    u := 'rrrrrrr';
    u1 := 'f';
    AssignFile(f, Edit1.Text);
    Reset(f, 1);
    size1 := GetFileSize(Edit1.Text);
    for l := 3000 to size1 do
    begin
      Seek(f, l);
      BlockRead(f, u[1], Length(u));
      if u = ''rrrrrrr'' then
        begin
        for l1 := 1 to 28000 do
        begin
        BlockWrite(f, u1[1], 1);
        end;
        end;
     end;
     CloseFile(f);					

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:

function Patch1(const FileName: TFileName): Boolean;
var
  l,l1: Longint;
  u,u1: string;
  f: file;
  size1: integer;
begin
  Result := False;
  u := 'testtest';
  u1 := 'f';
  size1 := GetFileSize(FileName);
//  size1 := size1 - 10;
  AssignFile(f, FileName);
  Reset(f, 1);
  l := 0;
  for l := 0 to size1 do
  begin
    Seek(f, l);
    BlockRead(f, u[1], Length(u));
    if u = 'testtest' then
    begin
      for l1 := 0 to 28000 do
      begin
      BlockWrite(f,u1[1], Length(u1));
      end;
    end;
  end;
  CloseFile(f);
end;					

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:
51:
52:

var
  f      : file;
  u      : array[0..65535]of char;
  lPos   : longint;
  iRead,
  iWrite : integer;
begin
  {$I-}
  AssignFile(f,ExtractFilePath(paramstr(0)) + 'binary.dat');
  ReSet(f,1);

  if(IoResult = 0) then begin
    repeat
      // aktuelle Position merken, & 8 Bytes lesen
      lPos := filepos(f); BlockRead(f,u,8,iRead);

      // waren es 8 Bytes?
      if(iRead = 8) then begin
        // ist es das Wort "testtest"?
        if(lstrcmp(u,'testtest') = 0) then begin
          // debugger
          ShowMessage(Format('"%s" at position %d',[u,lPos]));

          // Puffer mit F's füllen, & 28.000 Stück schreiben
          fillchar  (u,sizeof(u),'f');
          BlockWrite(f,u,28000,iWrite);
          // Fehler beim Schreiben (evtl. Dateiende!);
          // Schleife verlassen
          if(iWrite <> 28000) then break;

          // Puffer auf #0 zurücksetzen; sonst wird nicht
          // mehr korrekt weitergemacht
          fillchar  (u,sizeof(u),#0);
          // das liegt an der Funktion "lstrcmp", die zwei PChars
          // (null-terminiert) miteinander vergleicht. Wenn der
          // Puffer aber lauter F's enthält, entsteht beim erneuten
          // Einlesen der Datei ein String wie
          //
          //  testtestfffffffffffffffffffffffffff....
          //
          // Folglich stimmt die Bedingung nicht mehr!
        end else
        // es war nicht das Wort "testtest";
        // Suchposition um Eins erhöhen
          Seek(f,lPos+1);
      end;
    until(iRead = 0);

    CloseFile(f);
  end;
  {$I+}
end;