Delphi实验：在串中查找第i个子串的位置及效率评测

lw549说 取得字符串中指定子字符串出现第n次的位置,效率不高,勉强可用 。感上兴趣，于是试上一试。
程序附在最后，这里是一些说明文字：
1、为快速写好，没有使用应当使用的控制台方式，而是使用了GUI方式；
2、测试的样例是查找包含有四处子串的字符串，四次分别查四个位置。这个在Button1Click方法中完成，它调用Tests来进行具体测试，以被测函数、第几次出现、循环次数为参数；
3、Tests依次在一个循环中重复调用每个具体的函数，同时为了公平起见（也许前面的函数为后面的铺了一些路——内存、高速缓冲），这样的测试进行TEST_COUNT次，最后输出每次的平均时间；
4、经过前期的测试，lw549 的代码的确效率不高，所以单独给它小一些的循环次数（一千次），以免造成程序假死现象；其它的为十万次；
5、其它三个函数的思想为：
PosN_Pos: 使用Pos函数及Copy函数；
PosN_PosEx: 使用Delphi 7中增加的PosEx函数；
PosN_StrPos: 使用StrPos函数。

程序输出：

Search "function GetNSubStringPos(N: Integer; SubString,AString: String): Integer;" for "String"
1:
substr index: 1; LOOP COUNT = 1000
GetNSubStringPos: return 17; Timing: 37.60 ms
substr index: 1; LOOP COUNT = 100000
PosN_Pos: return 17; Timing: 40.40 ms
PosN_PosEx: return 17; Timing: 15.60 ms
PosN_StrPos: return 22; Timing: 37.80 ms
2:
substr index: 2; LOOP COUNT = 1000
GetNSubStringPos: return 42; Timing: 96.80 ms
substr index: 2; LOOP COUNT = 100000
PosN_Pos: return 42; Timing: 81.20 ms
PosN_PosEx: return 42; Timing: 47.00 ms
PosN_StrPos: return 47; Timing: 53.00 ms
3:
substr index: 3; LOOP COUNT = 1000
GetNSubStringPos: return 50; Timing: 109.40 ms
substr index: 3; LOOP COUNT = 100000
PosN_Pos: return 50; Timing: 118.80 ms
PosN_PosEx: return 50; Timing: 53.00 ms
PosN_StrPos: return 55; Timing: 62.60 ms
4:
substr index: 4; LOOP COUNT = 1000
GetNSubStringPos: return 58; Timing: 128.20 ms
substr index: 4; LOOP COUNT = 100000
PosN_Pos: return 58; Timing: 162.60 ms
PosN_PosEx: return 58; Timing: 59.40 ms
PosN_StrPos: return 63; Timing: 74.80 ms

可以看出，测试的结果（效率）是： PosN_PosEx > PosN_StrPos > PosN_Pos >> GetNSubStringPos 。
我本来期望的是 PosN_StrPos 最厉害，但结果不是。估计是 PosEx 优化得比较厉害。

附代码：


Unit1.pas:

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBTables;
type
TPosNFunc = function (N: Integer; const SubString,AString: String): Integer;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure Tests(const funcs: array of TPosNFunc;
const funcnames: array of string; iStr: integer; loopcount: integer);
public
end;
var
Form1: TForm1;
implementation
uses
StrUtils;
{$R *.dfm}
function GetNSubStringPos(N: Integer; SubString,AString: String): Integer;
//返回第n个SubString在AString中出现的位置
//如果没找到,返回-1
var
FindCount: Integer;
Pos: Integer;
begin
Result := -1;
Pos := 0;
for FindCount := 1 to N do begin
Inc(Pos);
while MidStr(AString, Pos, Length(SubString)) <> SubString do begin
if Length(AString) < Length(SubString) + Pos then
Exit;//未找到
Inc(Pos);
end;
end;
Result := Pos;
end;
function PosN_Pos(N: Integer; SubString, AString: String): Integer;
var
p: integer;
nSub: integer;
nSrc: integer;
begin
nSub := Length( SubString );
nSrc := Length( AString );
result := -nSub;
while N>0 do
begin
p := Pos(SubString, AString);
if p=0 then
break;
Dec( N );
Inc( result, p+nSub );
AString := Copy( AString, p+nSub+1, nSrc-nSub-p-1 );
Dec( nSrc, nSub+p );
end;
if N>0 then
result := -1;
end;
function PosN_PosEx(N: Integer; SubString,AString: String): Integer;
var
p: integer;
nSub: integer;
begin
nSub := Length( SubString );
result := 0;
p := 0;
while N>0 do
begin
p := PosEx( SubString, AString, p+1 );
if p=0 then
break;
Dec( N );
result := p;
Inc( p, nSub );
end;
if N>0 then
result := -1;
end;
function PosN_StrPos(N: Integer; SubString, AString: String): Integer;
var
pSub, pSrc, p: Pchar;
nSub: integer;
begin
nSub := Length( SubString );
pSub := PChar(SubString);
pSrc := PChar(AString);
p := pSrc;
while (N>0) do
begin
p := StrPos( p, pSub );
if (p=nil) then
break;
Inc( p, nSub );
Dec( N );
end;
if (N=0) and (p<>nil) then
result := p - pSrc
else
result := 0;
end;
const
STR = 'function GetNSubStringPos(N: Integer; SubString,AString: String): Integer;';
SUBSTR = 'String';
TEST_COUNT = 5;
procedure TForm1.Tests( const funcs: array of TPosNFunc;
const funcnames: array of string;
iStr: integer;
loopcount: integer );
var
i, j, k: Integer;
tm: Longword;
func: TPosNFunc;
count: integer;
retv: array of integer;
results: array of Longword;
begin
count := Length(funcs);
assert( count=Length(funcnames) );
Memo1.Lines.Add( Format('substr index: %d; LOOP COUNT = %d',
[iStr, loopCount]) );
SetLength( retv, count );
SetLength( results, count );
for j:=0 to count-1 do
results[j] := 0;
for k:=1 to TEST_COUNT do
begin
for j:=0 to count-1 do
begin
func := funcs[j];
tm := GetTickCount;
for i:=1 to loopcount do
retv[j] := func( iStr, SUBSTR, str );
Inc( results[j], GetTickCount - tm );
end;
end;
for j:=0 to count-1 do
begin
Memo1.Lines.Add( Format( '%s: return %d; Timing: %n ms',
[funcnames[j], retv[j],
results[j]*1.0/TEST_COUNT ] ) );
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
for i:=1 to 4 do
begin
Memo1.Lines.Add( Format( '%d:', [i]) );
Tests( [@GetNSubStringPos], ['GetNSubStringPos'], i, 1000 );
Tests( [@PosN_Pos, @PosN_PosEx, @PosN_StrPos],
['PosN_Pos', 'PosN_PosEx', 'PosN_StrPos'],
i, 100000 );
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear;
Memo1.Lines.Add( Format( 'Search "%s" for "%s"', [STR, SUBSTR] ) );
end;
end.
Unit1.dfm:

object Form1: TForm1
Left = 243
Top = 164
Width = 578
Height = 516
AlphaBlendValue = 192
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poDefaultPosOnly
OnCreate = FormCreate
DesignSize = (
570
489)
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 3
Top = 32
Width = 565
Height = 457
Anchors = [akLeft, akTop, akRight, akBottom]
Lines.Strings = (
'Memo1')
ScrollBars = ssVertical
TabOrder = 0
end
object Button1: TButton
Left = 3
Top = 6
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
end