TMemoryStream: Position einer Bytefolge ermitteln

Seven of Nine · Verfasst: Fr 13.04.12 12:59

Ich habe den Inhalt zweier Binär-datein in je einem Memorystream abgelegt

Anschl. ermittle ich den Inhalt einer gewissen Anzahl an Bytes an einer definierten Position im 1.ten Memory-Stream
und möchte dann ich im 2.ten Memory-Stream überprüfen ob die selbe Bytefolge vorkommt und an welcher Stelle.

Bisher kenne ich nur eine Lösung die mir die Bytes als ASCII-String umwandelt und ich dann anhand der ASCII-Strings vergleichen kann (Pos)
Da die zeichenfolgen aber lange sind, dauert mir das zu lange.
Wie lässt sich so etwas auf Binaär-Ebene realisieren?

lG M

Narses · Verfasst: Fr 13.04.12 13:36

Moin!

Meinst du sowas? :gruebel:

markieren

Delphi-Quelltext

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;

Einschränkung: findet nur das erste Auftreten der gesuchten Bytefolge, funktioniert nur bis max. 2GB großen Speicherblöcken und ist nicht unbedingt performanceoptimiert.

Stichwort für eine optimierte Suche: Boyer-Moore

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

Gausi · Verfasst: Fr 13.04.12 13:48

Naja, dann musst du pos halt selber programmieren. Dazu würde ich erstmal den zu durchsuchenden Stream in ein Byte-Array packen, und dann das Muster darin suchen. Ich weiß grade nicht, wie fix die Indexbasierten Zugriffe beim MemoryStream sind.
In etwa so:

markieren

Delphi-Quelltext

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;

Wenn das Suchmuster länger als ein paar Bytes ist, dann wird der Boyer-Moore-Algorithmus einen starken Geschwindigkeitsvorteil bringen, der immer deutlicher wird, wenn das Muster länger wird.

Für AnsiStrings sieht das so aus, für ein ByteArray müsste man das etwas anpassen, da bei Strings der erste Index bei 1 liegt, nicht bei 0. Ist aus meiner Diplomarbeit rauskopiert, in der Literatur heißen die Variablen t, p, m, n etc. auch immer so. ;-)

markieren

Delphi-Quelltext

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;

Geschwindigkeit des ersten Verfahrens: Ganz grob "Länge des zu durchsuchenden Streams"
Geschwindigkeit des zweiten Verfahren: Grob geschätzt 128x schneller, wenn das Pattern länger als 128Bytes lang ist, sonst nur um den Faktor "Länge des Patterns" schneller.

_________________
We are, we were and will not be.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme