Dynamische Arrays "verketten"

[Bjoerk]

Bei #9 kann das Inc(Temp) raus. Und die Exit Bedingung stimmt nicht ganz ("Test" kann ja in "Test" bei Offset 1 enthalten sein). BTW, Dennis, wer hat dir eigentlich gesagt, daß das schnell sein soll? Gerade bei langen Strings ist das sehr viel langsamer. Meine verwendete PosEx ist in etwa die von D7.

Beispiel:

Delphi-Quellcode:

unit MultiPosTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Types;

type
  TStrPositions = class
  private
    FItems: TList;
    function GetCount: integer;
    function GetItems(Index: integer): integer;
    function PosEx(const SubStr, S: string; const Index: integer): integer;
  public
    procedure Pos(const SubStr, S: string; Offset: integer);
    property Count: integer read GetCount;
    property Items[Index: integer]: integer read GetItems; default;
    constructor Create;
    destructor Destroy; override;
  end;

  TMultiPosTestForm = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  end;

var
  MultiPosTestForm: TMultiPosTestForm;

implementation

{$R *.dfm}

{ TStrPositions }

constructor TStrPositions.Create;
begin
  FItems := TList.Create;
end;

destructor TStrPositions.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TStrPositions.GetCount: integer;
begin
  Result := FItems.Count;
end;

function TStrPositions.GetItems(Index: integer): integer;
begin
  Result := Integer(FItems[Index]);
end;

function TStrPositions.PosEx(const SubStr, S: string; const Index: integer): integer;
var
  I, J, A, B: integer;
begin
  Result := 0;
  A := Length(S);
  B := Length(SubStr);
  I := Index;
  if (A > 0) and (B > 0) and (I > 0) then
    while (Result = 0) and (I <= A - B + 1) do
    begin
      if S[I] = SubStr[1] then
      begin
        J := 1;
        while (J < B) and (S[I + J] = SubStr[J + 1]) do
          Inc(J);
        if J = B then
          Result := I;
      end;
      Inc(I);
    end;
end;

procedure TStrPositions.Pos(const SubStr, S: string; Offset: integer);
var
  I: integer;
begin
  FItems.Clear;
  I := PosEx(SubStr, S, Offset);
  while I > 0 do
  begin
    FItems.Add(Pointer(I));
    I := PosEx(SubStr, S, I + Length(SubStr));
  end;
end;

{ TMultiPosTestForm }

function RandomString(const StringLength: integer): string;
const
  CharSet: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  I, Index: integer;
begin
  SetLength(Result, StringLength);
  for I := 1 to StringLength do
  begin
    Index := Random(Length(CharSet)) + 1;
    Result[I] := CharSet[Index];
  end;
end;

function MultiPos(const SubStr, S: String; Offset: Integer = 1): TIntegerDynArray;
var
  Temp: PChar;
  Position: Integer;
  Further: TIntegerDynArray;
begin
  SetLength(Result, 0);
  if (Offset > 0) and (Offset <= (Length(S) - Length(SubStr) + 1)) then
  begin
    Temp := @S[OffSet];
    Position := Pos(SubStr, String(Temp));
    if Position <> 0 then
    begin
      SetLength(Result, 1);
      Result[0] := Position + Offset - 1;
      Further := MultiPos(SubStr, S, Offset + Position + Length(SubStr) - 1);
      if Length(Further) <> 0 then
      begin
        SetLength(Result, 1 + Length(Further));
        Move(Further[0], Result[1], Length(Further) * SizeOf(Integer));
        FillChar(Further[0], SizeOf(Integer), 0);
      end;
    end;
  end;
end;

procedure TMultiPosTestForm.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutDown := true;
  Randomize;
end;

procedure TMultiPosTestForm.Button1Click(Sender: TObject);
var
  T1, T2, T1All, T2All: Cardinal;
  I, N, FindPosCount: integer;
  SubStr, S: string;
  Indices: TIntegerDynArray;
  StrPositions: TStrPositions;
begin
  StrPositions := TStrPositions.Create;
  try
    FindPosCount := 3;
    T1All := 0;
    T2All := 0;
    for N := 1 to 100 do
    begin
      repeat
        SubStr := RandomString(2);
        S := RandomString(100000);

        T1 := GetTickCount;
        Indices := MultiPos(SubStr, S, 1);
        T1All := T1All + GetTickCount - T1;

        T2 := GetTickCount;
        StrPositions.Pos(SubStr, S, 1);
        T2All := T2All + GetTickCount - T2;

        if Length(Indices) <> StrPositions.Count then
          ShowMessage('Error');

        for I := 0 to Length(Indices) - 1 do
          if Indices[I] <> StrPositions[I] then
            ShowMessage('Error');

      until StrPositions.Count >= FindPosCount;
    end;
    Caption := Format('MultiPos %d ms, StrPositions %d ms', [T1All, T2All]);
  finally
    StrPositions.Free;
  end;
end;

end.