TRecord1 = record
      a: longword;
      b: word;
      c: byte;
      d: Extended;
    end;

var
  shift: array[0..255] of Byte;     
  Look_At: Integer;                   

procedure Ts_init(P: PChar; m: Integer);
var
   i: Integer;
begin
  for i := 0 to 255 do shift[i] := m + 1;
  for i := 0 to m - 1 do Shift[Ord(p[i])] := m - i;
  Look_at := 0;
  while (look_At < m - 1) do
   begin
     if (p[m - 1] = p[m - (look_at + 2)]) then Exit
     else
        Inc(Look_at, 1);
   end;

end;


function Ts_Search(Text, p: PChar; m: Integer; Start: Longint): Longint;
var
   I: Longint;
   T: PChar;
begin
   T      := Text + Start;   
   Result := -1;
   repeat
     i := m - 1;
    while (t[i] <> p[i]) do t := t + shift[Ord(t[m])];
     i := i - 1; 
    if i < 0 then i := 0;
    while (t[i] = p[i]) do
      begin
       if i = 0 then Result := t - Text;
       i := i - 1;
     end;
    if Result = -1 then t := t + Look_AT + shift[Ord(t[m + look_at])];
   until Result <> -1;
end;

procedure SearchTextInFile(Str: String);
var
   tt: string;
   L: Integer;
   L2, sp, a: Longint;
   F: file;         
  Size: Integer;   
  Buffer: PChar; 
begin
   tt := Str;
  L  := Length(TT);     
  ts_init(PChar(TT), L);
  try
     AssignFile(F, 'test.txt');
     Reset(F, 1);                 
    Size := FileSize(F);           
    GetMem(Buffer, Size + L + 1);   
    try
       BlockRead(F, Buffer^, Size);
      StrCat(Buffer, PChar(TT));     
      SP := 0;           
      A  := 0;             
      while SP < Size do
       begin
         L2 := Ts_Search(Buffer, PChar(TT), L, SP);
        SP := L2 + L;
        Inc(a);   
      end;
    finally
       FreeMem(Buffer);   
    end;
   finally
     CloseFile(F);           
  end;
 end;

uses Windows, SysUtils;
{$APPTYPE CONSOLE}
type
    PDWORD = ^DWORD;
   
const
    szex = 4;  // size of example

var
   f: File;
   sz, rr, r, fpos,
   n, nofs: Integer;
   buff: array [0..32767] of byte; // 32 kbytes

begin
 Assign (f, ParamStr (1));
 {$I-}
  Reset (f, 1);
  if IOresult <> 0 then exit;
 sz := FileSize (f);
 FillChar (buff, sizeof (buff), 0); // init.
 nofs := 0;
 rr := sizeof (buff) - (szex - 1); // 3 байта используются для дополнения
 if sz > 0 then
 while TRUE do
 begin
  fpos := FilePos (f); // save position
  BlockRead (f, buff[nofs], rr, r);  // read
  // Производим поиск, не трогая последние три смещения (поскольку проверяются 4 байта)
  for n := 0 to r - szex - 1 do
   { if (buff[n + 0] = 1) and (buff[n + 1] = 2) and  // unoptimized variant
        (buff[n + 2] = 3) and (buff[n + 3] = 4) then }
   if PDWORD(@buff[n])^  = $04030201 then // optimized variant
    begin
     WriteLn (format ('Result found at $%x', [fpos + n - nofs]));
    end;
  if r < rr then  // end of file check
             break;
  nofs := szex - 1; // unchecked bytes
  // move last nofs bytes to start of buff
  Move (buff[r - nofs], buff[0], nofs);
 end;
 Close(f);
 WriteLn ('Scan complete');
 Readln;
end.