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:

function BytePos(const x: Byte; var Buffer; const Size: Integer): Integer;
begin
  for Result := 0 to Size-1 do
    if (PByteArray(Buffer)[Result] = x) then
      Exit;
  Result := -1;
end;

procedure TForm1.Button1Click(Sender: TObject);
  var
    tmp: AnsiString;
    MS1, MS2: TMemoryStream;
    P1, P2: PByteArray;
    i: Integer;
begin
  tmp := 'Das ist ein Test, jawohl!';
  MS1 := TMemoryStream.Create;
  MS1.Write(PAnsiChar(tmp)^, Length(tmp));
  P1 := MS1.Memory;

  tmp := 'Test';
  MS2 := TMemoryStream.Create;
  MS2.Write(PAnsiChar(tmp)^, Length(tmp));
  P2 := MS2.Memory;

  i := BytePos(P2[0], P1, MS1.Size);
  if (i >= 0) and (i <= MS1.Size -MS2.Size) then begin
    if CompareMem(@P1[i], P2, MS2.Size) then
      ShowMessage('Gefunden an Position '+IntToStr(i))
    else
      ShowMessage('Nicht gefunden!');
  end
  else
    ShowMessage('Nicht enthalten!');

  MS2.Free;
  MS1.Free;
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:

type TByteArray: Array of Byte;

function CheckForPattern(StartPos: Integer; Source, Pattern: TByteArray ): Boolean;
begin
  result := true;
  for i := 0 to length(Pattern) do
  if Source[Startpos + i] <> Pattern[i] then
  begin
     result := False;
     break;
  end;
end;

function SearchPattern(Source, Pattern: TByteArray): Integer;
begin
  for i := 0 to length(Source) - length(Pattern) do
  begin
    if CheckForPattern(i, Source, Pattern) then
    begin
      result := i;
      break;
    end;
  end;
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:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:

TBC_IntArray = Array[AnsiChar] of Integer;

function PreProcess_BMH_BC(p: AnsiString): TBC_IntArray;
var i, m: Integer;
    c: Char;
begin
  m := Length(p);
  for c := low(AnsiChar) to High(AnsiChar) do
    result[c] := m;
  for i := 1 to m-1 do     // !! m-1 !!
    result[p[i]] := m-i;
end;

function Search_BMH_Unrolled(t,p: AnsiString): Integer;
var m, n, k, j: Integer;
    BC: TBC_IntArray;
    BC_last: Integer;
    Large: Integer;
begin
  m := Length(p);
  n := Length(t);
  Large := m + n + 1;

  BC := PreProcess_BMH_BC(p);

  // "echten" BC-Shift merken
  BC_last := BC[p[m]];
  // BC(lastCh) mit "Large" überschreiben
  BC[p[m]] := Large;

  k := m;
  result := 0;

  while k <= n do
  begin
      //fast loop
      repeat
        k := k + BC[t[k]];
      until k > n;

      //undo
      if k <= Large then
        //Muster nicht gefunden
        break
      else
        k := k - Large;

      j := 1;
      // slow loop
      while (j < m) and (p[m-j] = t[k-j]) do
        inc(j);

      if j=m then
      begin
        // Muster gefunden
        //result := k - j + 1;
        //k := k + m; //oder: break;
        if result = 0 then
          result := k-j+1;
        k := k + 1;
      end else
      begin
          // Muster verschieben
          if t[k] = p[m] then
            k := k + BC_last
          else
            k := k + BC[t[k]];
      end;
  end;
end;