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.