一步步教你优化Delphi字串查找(转载)
一步步教你优化Delphi字串查找
2005-06-13 11:46 作者： 朱晓峰 出处： csdn开发高手 责任编辑：方舟
本人在编写离线浏览器WebSeizer的过程中，用到大量字符串处理函数，这是很耗CPU的一个处理过程，为了编写出高效率的网页解析引擎，对优化代码作了一番研究。
1 、高精度的计时函数
代码优化时需要用到精确的计时器。常用的有GetTickCount函数，可以达到毫秒级的精度。但还是很不够的，这时可以采用提高循环次数的办法。另外，还有一个精度更高的定时——“高分辨率性能计数器”（high-resolution performance counter），它提供了两个API函数，取得计数器频率的QueryPerformanceFrequency和取得计数器数值的QueryPerformanceCounter。实现原理是利用计算机中的8253,8254可编程时间间隔定时器芯片实现的。在计算机内部有三个独立的16位计数器。
计数器可以以二进制或二—十进制(BDC)计数。计数器每秒产生1193180次脉冲，每次脉冲使计数器的数字减一，产生频率是可变的,用QueryPerformanceFrequency可以得到,一般情况下都是1193180。QueryPerformance Counter可以得到当前的计数器值。所以只要你的计算机
够快，理论上精度可以达到1/1193180秒。
2 、代码优化实例
下面以一个自定义的字符串函数的为例，说明代码优化过程。
Delphi提供的字符串函数里有一个Pos函数，它的定义是：
function Pos(Substr: string; S: string): Integer;
它的作用是在字符串S中查找字符串Substr，返回值是Substr在S中第一次出现的位置，如果没有找到，返回值为0。
在本人编写WebSeizer软件（天空软件站有下载）过程中，Pos已经不能满足要求。一方面：在处理网页中的字符串时，要求对大小写不敏感，即< h t m l > 和<HTML>代表的含义完全一样。另一方面：我们还要求有一个函数，返回值是Substr在S中最后一次出现的位置，而不是第一次出现的位置。下面是这个函数的未经优化的代码。
function RightPos(const Substr,S: string): Integer;
var
iPos: Integer;
TmpStr:string;
begin
TmpStr:=s;
iPos := Pos(Substr,TmpStr); Result:=0;
//查找Substr第一次出现位置
while iPos<>0 do
begin
Delete(TmpStr,1,iPos+length(Substr)-1);
//删除已经查找过的字符
Result:=Result+iPos;
iPos := Pos(Substr,TmpStr); //查找Substr出现位置
if iPos=0 then break;
Result:=Result+length(Substr)-1;
end;
end;
这个函数里，用到了Delete函数，我们再来看一看System.pas文件里Delete函数的实现过程，请看下面代码：
procedure _LStrDelete{ var s : AnsiString; index, count : Integer };
asm
{ EAX Pointer to s }
{ EDX index }
{ ECX count }
PUSH EBX
PUSH ESI
PUSH EDI
MOV EBX,EAX
MOV ESI,EDX
MOV EDI,ECX
CALL UniqueString
MOV EDX,[EBX]
TEST EDX,EDX { source already empty:
nothing to do }
JE @@exit
MOV ECX,[EDX-skew].StrRec.length
{ make index 0-based, if not in [0 .. Length(s)-1]
do nothing }
DEC ESI
JL @@exit
CMP ESI,ECX
JGE @@exit
{ limit count to [0 .. Length(s) - index] }
TEST EDI,EDI
JLE @@exit
SUB ECX,ESI { ECX = Length(s) - index
}
CMP EDI,ECX
JLE @@1
MOV EDI,ECX
@@1:
{ move length - index - count characters from
s+index+count to s+index }
SUB ECX,EDI { ECX = Length(s) - index
- count }
ADD EDX,ESI { EDX = s+index }
LEA EAX,[EDX+EDI] { EAX = s+index+count }
CALL Move
{ set length(s) to length(s) - count }
MOV EDX,[EBX]
MOV EAX,EBX
MOV EDX,[EDX-skew].StrRec.length
SUB EDX,EDI
CALL _LStrSetLength
@@exit:
POP EDI
POP ESI
POP EBX
end;
Delete 函数中，有这两句：CALL Move和CALL_LstrSetLength。其中Move函数是将一个内存块拷贝到另一个地址，LstrSetLength函数将改变字符串的长度，其中也有对内存进行分配的代码。这些对内存进行操作的函数都是极其消耗CPU运行时间的，所以Delete函数也是一个极其消耗CPU运行时间的函数。为了尽量避免使用这些函数，我对自定义函数RightPos进行了改写。
修改后不再使用Delete及Pos函数，直接通过指针对内存操作，提高了效率。
function RightPosEx(const Substr,S: string): Integer;
var
iPos: Integer;
TmpStr: string;
i, j, lvlen: Integer;
PCharS, PCharSub: PChar;
begin
PCharS := PChar(s); //将字符串转化为PChar格式
PCharSub := PChar(Substr);
Result := 0;
lvlen := length(Substr);
for i := 0 to length(S) - 1 do
begin
for j := 0 to lvlen - 1 do
begin
if PCharS[i + j] <> PCharSub[j] then break;
end;
if j = lvlen then Result := i + 1;
end;
end;
请看第一句PCharS:=PChar(s)，它的作用是将Delphi字符串强制转化为PChar 格式(PChar 是Windows中使用的标准字符串，不包含长度信息，使用0为结束标志)，并得到指向PChar字符串的指针PcharS。
下面就要对自定义函数的运行时间进行测量，为了提高测量的精度，减小随机性，我们计算重复10000次所需的时间。代码如下：
var
i,len,iPos: Integer;
PerformanceCount1,PerformanceCount2,Count:int64;
begin
len:=10000; //重复次数
QueryPerformanceCounter(PerformanceCount1);//开始计数
for i:=0 to len-1 do
begin
iPos:=RightPos(’12’,Edit1.Text); //被测试的函数
end;
QueryPerformanceCounter(PerformanceCount2); //结束计数
Count:=(PerformanceCount2-PerformanceCount1);
Label1.Caption:=inttostr(iPos)+’ time=’+inttostr(Count);
End;
我的配置是Duron700，256M内存，测试中RightPos函数重复了10000遍，RightPos使用的参数为：Substr=12，S=Edit12ewew12tet。得到的测量结果是Count=217000，又对其他几个函数作了对比，结果如下：
函数名
重复次数
QueryPerformanceCounter 计数值
Pos
10000
150000
RightPos
10000
217000
RightPosEx
10000
160000
可以看出测试的结果是比较满意的，改进过的RightPosEx函数效率比RightPos高很多，考虑到测试用的字符串比较短，使用长字符串效果更明显。如果直接使用Delphi的字符串格式而不用转为PChar格式，则效率又可提高一步。但字符串格式是Delphi语言自定义的,存在兼容性问题。所以这一版本的字串搜索函数就不列出来了，读者在前面代码的基础上很容易就可写出来的。代码优化到底要执行到哪一步，是仁者见仁，智者见智的问题。有的人偏重于提高效率，有的人偏重于保证兼容性，这需要在实际使用过程中作取舍。
----
实际测试，
{*
//长字符串（大概1M左右)
1000次
BDS 2007 见Demos
(Delete) time: 323301
(CopyStr) time: 953036
(LastPosEx)Pos: 144881
time: 3665003
(Pos)Pos: 58745
time: 314023
(FastPosEx)Pos: 58745
time: 11383136
(fstAt)Pos: 58745
time: 354948
(SmartPos)Pos: 58745
time: 206409
*}
const
COUNT_NUM = 10000;
procedure TForm1.btnDeleteAndCopyStrClick(Sender: TObject);
var
i, lvlen, iPos: Integer;
PerformanceCount1, PerformanceCount2, Count: int64;
lvSubString, lvSourceString: string;
begin
lvlen := COUNT_NUM; //重复次数
lvSourceString := edtSourceString.Text;
if chkUseMemoSource.Checked then
begin
lvSourceString := mmoSourceString.Text;
lvlen := lvlen div 10;
end;
QueryPerformanceCounter(PerformanceCount1); //开始计数
lvSubString := lvSourceString;
for i := 0 to lvlen - 1 do
begin
Delete(lvSubString, 1, 1);
end;
QueryPerformanceCounter(PerformanceCount2); //结束计数
Count := (PerformanceCount2 - PerformanceCount1);
mmoMessage.Lines.Add('(Delete) time: ' + inttostr(Count));
QueryPerformanceCounter(PerformanceCount1); //开始计数
lvSubString := lvSourceString;
for i := 0 to lvlen - 1 do
begin
lvSubString := CopyStr(lvSubString, 2, Length(lvSubString));
end;
QueryPerformanceCounter(PerformanceCount2); //结束计数
Count := (PerformanceCount2 - PerformanceCount1);
mmoMessage.Lines.Add('(CopyStr) time: ' + inttostr(Count));
end;
procedure TForm1.btnPosTestClick(Sender: TObject);
var
i, lvlen, iPos: Integer;
PerformanceCount1, PerformanceCount2, Count: int64;
lvSubString, lvSourceString: string;
begin
lvlen := COUNT_NUM; //重复次数
lvSourceString := edtSourceString.Text;
lvSubString := edtPosTest.Text;
if chkUseMemoSource.Checked then
begin
lvSourceString := mmoSourceString.Text;
lvlen := lvlen div 10;
end;
QueryPerformanceCounter(PerformanceCount1); //开始计数
for i := 0 to lvlen - 1 do
begin
iPos := LastPosEx(lvSubString, lvSourceString); //被测试的函数
end;
QueryPerformanceCounter(PerformanceCount2); //结束计数
Count := (PerformanceCount2 - PerformanceCount1);
mmoMessage.Lines.Add('(LastPosEx)Pos: ' + inttostr(iPos) + sLineBreak + ' time: ' + inttostr(Count));
QueryPerformanceCounter(PerformanceCount1); //开始计数
for i := 0 to lvlen - 1 do
begin
iPos := Pos(lvSubString, lvSourceString); //被测试的函数
end;
QueryPerformanceCounter(PerformanceCount2); //结束计数
Count := (PerformanceCount2 - PerformanceCount1);
mmoMessage.Lines.Add('(Pos)Pos: ' + inttostr(iPos) + sLineBreak + ' time: ' + inttostr(Count));
QueryPerformanceCounter(PerformanceCount1); //开始计数
for i := 0 to lvlen - 1 do
begin
iPos := FastPosEx(PChar(lvSourceString), Length(lvSourceString), PChar(lvSubString), Length(lvSubString)); //被测试的函数
end;
QueryPerformanceCounter(PerformanceCount2); //结束计数
Count := (PerformanceCount2 - PerformanceCount1);
mmoMessage.Lines.Add('(FastPosEx)Pos: ' + inttostr(iPos) + sLineBreak + ' time: ' + inttostr(Count));
QueryPerformanceCounter(PerformanceCount1); //开始计数
for i := 0 to lvlen - 1 do
begin
iPos := fstAt(lvSubString, lvSourceString); //被测试的函数
end;
QueryPerformanceCounter(PerformanceCount2); //结束计数
Count := (PerformanceCount2 - PerformanceCount1);
mmoMessage.Lines.Add('(fstAt)Pos: ' + inttostr(iPos) + sLineBreak + ' time: ' + inttostr(Count));
QueryPerformanceCounter(PerformanceCount1); //开始计数
for i := 0 to lvlen - 1 do
begin
iPos := SmartPos(lvSubString, lvSourceString); //被测试的函数
end;
QueryPerformanceCounter(PerformanceCount2); //结束计数
Count := (PerformanceCount2 - PerformanceCount1);
mmoMessage.Lines.Add('(SmartPos)Pos: ' + inttostr(iPos) + sLineBreak + ' time: ' + inttostr(Count));
end;
