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