{$apptype console}
uses SysUtils, StrUtils, Diagnostics;
procedure Run(const AName: string; const Action: TProc);
var
sw: TStopwatch;
begin
sw := TStopwatch.Create;
sw.Start;
Action();
sw.Stop;
Writeln(Format('%s: %3d ms', [AName, sw.ElapsedMilliseconds]));
Flush(Output);
end;
function MakeLargeDelimString(ACount: Integer; ADelim: Char): string;
begin
Result := StringOfChar('x', 50);
while ACount > 0 do
begin
Dec(ACount);
Result := Result + StringOfChar('y', 50);
end;
end;
function GetTok1(const Line: string; const Delim: string; const TokenNum: Byte): string;
{ LK Feb 12, 2007 - This function has been optimized as best as possible }
var
I, P, P2: integer;
begin
P2 := Pos(Delim, Line);
if TokenNum = 1 then begin
if P2 = 0 then
Result := Line
else
Result := copy(Line, 1, P2-1);
end
else begin
P := 0; { To prevent warnings }
for I := 2 to TokenNum do begin
P := P2;
if P = 0 then break;
P2 := PosEx(Delim, Line, P+1);
end;
if P = 0 then
Result := ''
else if P2 = 0 then
Result := copy(Line, P+1, MaxInt)
else
Result := copy(Line, P+1, P2-P-1);
end;
end; { GetTok }
function GetTok2(const Line: string; const Delim: Char; const TokenNum: Byte): string;
{ LK Feb 12, 2007 - This function has been optimized as best as possible }
{ LK Nov 7, 2009 - Reoptimized using PChars instead of calls to Pos and PosEx }
{ See; http://stackoverflow.com/questions/1694001/is-there-a-fast-gettoken-routine-for-delphi }
var
I: integer;
PLine, PStart: PChar;
begin
PLine := PChar(Line);
PStart := PLine;
inc(PLine);
for I := 1 to TokenNum do begin
while (PLine^ <> #0) and (PLine^ <> Delim) do
inc(PLine);
if I = TokenNum then begin
SetString(Result, PStart, PLine - PStart);
break;
end;
if PLine^ = #0 then begin
Result := '';
break;
end;
inc(PLine);
PStart := PLine;
end;
end; { GetTok }
// Using indexing to get delimiter character
// this assumes that Delim has length(1); probably a worthwhile special case
function GetTok3(const Line: string; const Delim: string; const TokenNum: Byte): string;
var
I: integer;
PLine, PStart: PChar;
begin
PLine := PChar(Line);
PStart := PLine;
inc(PLine);
for I := 1 to TokenNum do begin
while (PLine^ <> #0) and (PLine^ <> Delim[1]) do
inc(PLine);
if I = TokenNum then begin
SetString(Result, PStart, PLine - PStart);
break;
end;
if PLine^ = #0 then begin
Result := '';
break;
end;
inc(PLine);
PStart := PLine;
end;
end; { GetTok }
// Do all tokenization up front.
function GetTok4(const Line: string; const Delim: Char): TArray<string>;
var
cp, start: PChar;
count: Integer;
begin
// Count sections
count := 1;
cp := PChar(Line);
start := cp;
while True do
begin
if cp^ <> #0 then
begin
if cp^ <> Delim then
Inc(cp)
else
begin
Inc(cp);
Inc(count);
end;
end
else
begin
Inc(count);
Break;
end;
end;
SetLength(Result, count);
cp := start;
count := 0;
while True do
begin
if cp^ <> #0 then
begin
if cp^ <> Delim then
Inc(cp)
else
begin
SetString(Result[count], start, cp - start);
Inc(cp);
Inc(count);
end;
end
else
begin
SetString(Result[count], start, cp - start);
Break;
end;
end;
end;
type
TTokenizer = record
private
FSource: string;
FCurrPos: PChar;
FDelim: Char;
public
procedure Reset(const ASource: string; ADelim: Char); inline;
function GetToken(out AResult: string): Boolean; inline;
end;
procedure TTokenizer.Reset(const ASource: string; ADelim: Char);
begin
FSource := ASource; // keep reference alive
FCurrPos := PChar(FSource);
FDelim := ADelim;
end;
function TTokenizer.GetToken(out AResult: string): Boolean;
var
cp, start: PChar;
delim: Char;
begin
// copy members to locals for better optimization
cp := FCurrPos;
delim := FDelim;
if cp^ = #0 then
begin
AResult := '';
Exit(False);
end;
start := cp;
while (cp^ <> #0) and (cp^ <> Delim) do
Inc(cp);
SetString(AResult, start, cp - start);
if cp^ = Delim then
Inc(cp);
FCurrPos := cp;
Result := True;
end;
var
n: Integer;
src: string;
theDelim: Char;
count: Integer;
begin
try
for n := 1 to 5 do
begin
theDelim := '|';
count := 3 * n;
src := MakeLargeDelimString(count, theDelim);
Writeln(Format('*** count=%d, Length(src)=%d', [count, Length(src)]));
Run('GetTok1', procedure
var
i, j: Integer;
begin
for i := 1 to 1000000 do
for j := 1 to count + 1 do
GetTok1(src, theDelim, j);
end);
Run('GetTok2', procedure
var
i, j: Integer;
begin
for i := 1 to 1000000 do
for j := 1 to count + 1 do
GetTok2(src, theDelim, j);
end);
Run('GetTok3', procedure
var
i, j: Integer;
begin
for i := 1 to 1000000 do
for j := 1 to count + 1 do
GetTok3(src, theDelim, j);
end);
Run('GetTok4', procedure
var
i: Integer;
begin
for i := 1 to 1000000 do
GetTok4(src, theDelim); // extracts all tokens
end);
Run('GetTokBK', procedure
var
i: Integer;
tok: TTokenizer;
s: string;
begin
for i := 1 to 1000000 do
begin
tok.Reset(src, theDelim);
while tok.GetToken(s) do // runs count times, uses retvalue for stop, not ''
;
end;
end);
end;
except
on e: Exception do
Writeln(e.Message);
end;
end.