Алгоритм Бойера-Мура

program Z;
uses crt;
var
str, std: string;
m, s: byte;
n:array [0..255] of integer;
type
  TBMTable = array [0..255] of Integer;
 
procedure MakeBMTable( var BMT : TBMTable; const P : String);
var
  i : Integer;
begin
  for i := 0 to 255 do BMT[i] := Length(P);
    for i := Length(P) downto 1 do
      if BMT[Byte(P[i])] = Length(P) then
        BMT[Byte(P[i])] := Length(P) - i;
end;
 
function BMSearch( StartPos : Integer; const S, P : String;
  const BMT : TBMTable) : Integer;
var
  Pos, lp, i : Integer;
begin
  lp := Length(P);
  Pos := StartPos + lp -1;
  while Pos < Length(S) do
    if P[lp] <> S[Pos] then Pos := Pos + BMT[Byte(S[Pos])]
    else for i := lp - 1 downto 1 do
      if P[i] <> S[Pos - lp + i] then
      begin
        Inc(Pos);
        Break;
      end
      else if i = 1 then
      begin
        Result := Pos - lp + 1;
        Exit;
      end;
  Result := 0;
end;
 
begin
readln(str);             //строка в которой ищем
readln(std);             //строка которую ищем
MakeBMTable(n, std);
m:=BMSearch(s, str, std, n);;
writeln(m);
end.

type
  TIntVect = array [0..255] of Integer;
  TBMTable = array [0..0] of TIntVect;
  PBMTable = ^TBMTable;
function FindRightmost( const S, P : String;
  n : Integer) : Integer;
var
  i, j, lp : Integer;
begin
  Result := 0;
  lp := Length(P);
  if lp > n then Exit;
  for i := n - lp + 1 downto 1 do
  for j := 1 to lp do
  if P[j] <> S[i+j-1] then Break
  else if j = lp then
  begin
    Result := i;
    Exit;
  end;
end;
procedure MakeBMTable( var BMT : PBMTable; const P : String);
var
  i, j, lp, MaxShift, CurShift, SufPos : Integer;
  Suffix : String;
begin
  lp := Length(P);
  GetMem(BMT, SizeOf(TIntVect)*lp);
  for i := 0 to 255 do BMT^[lp-1][i] := lp;
  for i := lp downto 1 do
  if BMT^[lp-1][Byte(P[i])] = lp then
  BMT^[lp-1][Byte(P[i])] := lp - i;
  MaxShift := lp;
  for i := lp - 1 downto 1 do
  begin
    SetLength(Suffix, lp - i);
    Move(P[i+1], Suffix[1], lp - i);
    if Pos(Suffix, P) = 1 then MaxShift := i;
    for j := 0 to 255 do
    begin
      CurShift := MaxShift;
      SetLength(Suffix, lp - i + 1);
      Suffix[1] := Char(j);
      Move(P[i + 1], Suffix[2], lp - i );
      SufPos := FindRightmost(P, Suffix, lp - 1);
      if SufPos <> 0 then CurShift := i - SufPos;
      BMT^[i-1][j] := CurShift;
    end;
    BMT^[i-1][Byte(P[i])] := 0;
  end;
end;
function BMSearch( StartPos, lp : Integer; const S : String;
  BMT : PBMTable) : Integer;
var
  Pos, i : Integer;
begin
  Pos := StartPos + lp -1;
  while Pos < Length(S) do
  for i := lp downto 1 do
  if BMT^[i-1][Byte(S[Pos-lp+i])] <> 0 then
  begin
    Pos := Pos + BMT^[i-1][Byte(S[Pos-lp+i])];
    Break;
  end
  else if i = 1 then
  begin
    Result := Pos - lp + 1;
    Exit;
  end;
  Result := 0;
end;