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

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函数。

程序输出：

可以看出，测试的结果（效率）是：  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