据说牛得一塌糊涂的哈希（Hash）列表 - DelphiHash.pas(50)

哈哈，这是标题党的一贯做法，单元是我刚刚写的，连验证工作都没做，似乎可能还冒着热气~~~~，留给需要的人：unit DelphiHash;interfaceuses Windows, Classes;type PKeyValuePair = ^TKeyValuePair;
TKeyValuePair = record Next: PKeyValuePair;
Key: AnsiString;
Value:integer;
end;
PPKeyValuePair = ^PKeyValuePair;
TAnsiStringHashList = class(TPersistent) private FCount:integer;
BucketSize:integer;
FLock: TRTLCriticalSection;
FUseLock:Boolean;
Buckets: array of PKeyValuePair;
protected procedure Lock;
procedure Unlock;
function Find(const Key: AnsiString): PPKeyValuePair;
function HashIt(const Key: AnsiString): Cardinal;
dynamic;
public constructor Create(LockAccess:Boolean = True;
Size: Cardinal = 256);
destructor Destroy;
override;
procedure Add(const Key: AnsiString;
const Value:integer);
procedure Assign(Source: TPersistent);override;
procedure AssignTo(Dest: TPersistent);override;
function KeyExtist(const Key: AnsiString): Boolean;
function Modify(const Key: AnsiString;const Value: Integer): Boolean;
function ValueOf(const Key: AnsiString): Integer;
procedure Remove(const Key: AnsiString);
function Count: Integer;
procedure Clear;
end;
implementation// #########################################// # #// # <Delphi Hash> ++ Write by 小雨哥 #// # #// #########################################{ TAnsiStringHashList }constructor TAnsiStringHashList.Create(LockAccess:Boolean;
Size: Cardinal);
begin
inherited Create;
InitializeCriticalSection(FLock);
FUseLock := LockAccess;
BucketSize := Size;
SetLength(Buckets, BucketSize);
end;
destructor TAnsiStringHashList.Destroy;
begin
Clear;
SetLength(Buckets, 0);
DeleteCriticalSection(FLock);
inherited Destroy;
end;
function TAnsiStringHashList.HashIt(const Key: AnsiString): Cardinal;var i:integer;
begin
// ######################################################// # #// # 发布在 comp.lang.c 新闻组的著名的 DJB Hash #// # 由 Daniel J. Bernstein 教授发明 #// # 据传是史上最具散列(hash)效果的函数之一 #// # #// ###################################################### Result := 5381;
for i := 1 to Length(Key)do
Result := ((Result shl 5) + Result) + Ord(Key);
end;
function TAnsiStringHashList.Find(const Key: AnsiString): PPKeyValuePair;var Hash: Integer;
begin
Hash := HashIt(Key) mod Cardinal(BucketSize);
Lock;
try Result := @Buckets[Hash];
while Result^ <> nildo
begin
if Result^.Key = Key then
Exit else
Result := @Result^.Next;
end;
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Add(const Key: AnsiString;
const Value: integer);var Hash: Integer;
Bucket: PKeyValuePair;
begin
Hash := HashIt(Key) mod Cardinal(BucketSize);
New(Bucket);
Lock;
try Bucket^.Key := Key;
Bucket^.Value := Value;
Bucket^.Next := Buckets[Hash];
Buckets[Hash] := Bucket;
Inc(FCount);
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Assign(Source: TPersistent);var I:integer;
RsPKeyValuePair;
begin
if Assigned(Source) then
begin
Self.Clear;
if Source is TStrings then
begin
Self.Lock;
try for I := 0 to TStrings(Source).Count - 1do
Self.Add(TStrings(Source), Integer(TStrings(Source).Objects));
finally Self.Unlock;
end;
end else
if Source is TAnsiStringHashList then
begin
Self.FUseLock := TAnsiStringHashList(Source).FUseLock;
TAnsiStringHashList(Source).Lock;
Self.Lock;
try Self.BucketSize := TAnsiStringHashList(Source).BucketSize;
SetLength(Self.Buckets, Self.BucketSize);
for I := 0 to TAnsiStringHashList(Source).BucketSize - 1do
begin
Rs := @TAnsiStringHashList(Source).Buckets;
while Rs^ <> nildo
begin
Self.Add(Rs^.Key, Rs^.Value);
Rs := @Rs^.Next;
end;
end;
finally Self.Unlock;
TAnsiStringHashList(Source).Unlock;
end;
end;
end;
end;
procedure TAnsiStringHashList.AssignTo(Dest: TPersistent);var I:integer;
RsPKeyValuePair;
begin
if Assigned(Dest) then
begin
if Dest is TStrings then
begin
Self.Lock;
try TStrings(Dest).Clear;
for I := 0 to BucketSize - 1do
begin
Rs := @Buckets;
while Rs^ <> nildo
begin
TStrings(Dest).AddObject(Rs^.Key, TObject(Rs^.Value));
Rs := @Rs^.Next;
end;
end;
finally Self.Unlock;
end;
end else
if Dest is TAnsiStringHashList then
begin
TAnsiStringHashList(Dest).Clear;
TAnsiStringHashList(Dest).FUseLock := Self.FUseLock;
TAnsiStringHashList(Dest).Lock;
Self.Lock;
try TAnsiStringHashList(Dest).BucketSize := Self.BucketSize;
SetLength(TAnsiStringHashList(Dest).Buckets, Self.BucketSize);
for I := 0 to BucketSize - 1do
begin
Rs := @Buckets;
while Rs^ <> nildo
begin
TAnsiStringHashList(Dest).Add(Rs^.Key, Rs^.Value);
Rs := @Rs^.Next;
end;
end;
finally Self.Unlock;
TAnsiStringHashList(Dest).Unlock;
end;
end;
end;
end;
procedure TAnsiStringHashList.Clear;var I: Integer;
P, N: PKeyValuePair;
begin
Lock;
try for I := 0 to High(Buckets)do
begin
P := Buckets;
while P <> nildo
begin
N := P^.Next;
Dispose(P);
P := N;
end;
Buckets := nil;
end;
FCount := 0;
finally Unlock;
end;
end;
function TAnsiStringHashList.Count: Integer;
begin
Lock;
try Result := FCount;
finally Unlock;
end;
end;
function TAnsiStringHashList.KeyExtist(const Key: AnsiString): Boolean;
begin
Result := (Find(Key)^ <> nil);
end;
procedure TAnsiStringHashList.Lock;
begin
if FUseLock then
EnterCriticalSection(FLock);
end;
function TAnsiStringHashList.Modify(const Key: AnsiString;
const Value: Integer): Boolean;var P: PKeyValuePair;
begin
P := Find(Key)^;
Lock;
try Result := P <> nil;
if Result then
P^.Value := Value;
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Remove(const Key: AnsiString);var P: PKeyValuePair;
Prev: PPKeyValuePair;
begin
Prev := Find(Key);
Lock;
try P := Prev^;
if P <> nil then
begin
Prev^ := P^.Next;
Dispose(P);
Dec(FCount);
end;
finally Unlock;
end;
end;
procedure TAnsiStringHashList.Unlock;
begin
if FUseLock then
LeaveCriticalSection(FLock);
end;
function TAnsiStringHashList.ValueOf(const Key: AnsiString): Integer;var P: PKeyValuePair;
begin
P := Find(Key)^;
Lock;
try if P <> nil then
Result := P^.Value else
Result := -1;
finally Unlock;
end;
end;
end.
大家知道，Delphi有自带的 THashedStringList [在 inifiles.pas 里]，也可以完成快速搜索的任务，这里提供另外的例子，只是仅供参考。我确实没有测试，但估计也不会有太大问题，理论上可以上100万以上的数据（适当调整BucketSize值，以减小深度），检索时间最坏情况下，应该也不会大于20ms。某些情况下，利用里面的 Assign、AssignTo 方法，甚至可以将这个类与 TStrings 联合起来使用。假如哪位细心的朋友验证测试发现问题，请留言指正。谢谢。

有关如何产生测试文本的问题...，可以写个这样的小代码来产生测试文本：uses Windows, SysUtils, Classes, MMSystem;const cChrs :array[0..51] of AnsiChar = ('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z', 'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z');function MakerRandomString(nLen:integer):AnsiString;
inline;
function GetChar:AnsiChar;
inline;
begin
Result := cChrs[Random(52)];
end;
var I:integer;
begin
Result := '';
for I := 0 to nLen - 1do
Result := Result + GetChar;
end;
type TTestTextGenerator = class(TThread) private FEntryTotal:integer;
FEntryList: TStrings;
FElapseTime:longword;
public constructor Create(const Amount: integer;
DstList: TStrings;
TerminateProc: TNotifyEvent);
procedure Execute;
override;
property ElapseTime: longword read FElapseTime;
property EntryList: TStrings read FEntryList;
end;
var TextGenerator: TTestTextGenerator;{ TTestTextGenerator }constructor TTestTextGenerator.Create(const Amount: integer;
DstList: TStrings;
TerminateProc: TNotifyEvent);
begin
FEntryTotal := Amount;
FEntryList := DstList;
FEntryList.Capacity := FEntryTotal;
FreeOnTerminate := True;
OnTerminate := TerminateProc;
inherited Create(False);
end;
procedure TTestTextGenerator.Execute;var S:AnsiString;
I:integer;
t1,t2:longword;
begin
Priority := tpLower;
Sleep(10);
t1:=timegettime;
for I := 0 to FEntryTotal - 1do
begin
if Terminated then
exit;
S := MakerRandomString(4 + Random(12));
FEntryList.AddObject(S, nil);
end;
t2:= timegettime;
FElapseTime := t2 - t1;
TextGenerator := nil;
end;
// OnTerminate 函数参考rocedure TForm1.TextGeneratorThreadTerminate(Sender: TObject);
begin
Caption := IntToStr(TTestTextGenerator(Sender).ElapseTime);
if SaveDlg.Execute then
TTestTextGenerator(Sender).EntryList.SaveToFile(SaveDlg.FileName);
end;
// TextGenerator 线程创建函数参考:var sl: TStrings;procedure TForm1.Button1Click(Sender: TObject);
begin
sl := TStringList.Create;
Button1.Enabled := False;
TextGenerator := TTestTextGenerator.Create(1000000, sl, TextGeneratorThreadTerminate);
end;
这个片段可以产生100万条文本，每条文本最小长度是 4，最大长度是 15。

关于 BucketSize 值调整的问题，需要根据具体的数据量来进行。通常，调整这个数值，数值越大，广度就越大，深度就越小，广度大要比深度大好，因为广度是由计算出来的Hash值直接定位，深度需要对节点进行遍历，遍历比直接定位费时。但广度大的缺点是消耗在Buckets维度上的内存就大了，所以要综合衡量，一般假设Hash可以做到完全随机均匀分布的话，广度等于数据量时，检索的速度最快。所以，一个Hash算法的好坏，是至关重要的，测量算法的好坏，也就是测量Hash是否在给定的广度上均匀分布，也就是看每个节点是否都有数据被分配到，每个节点分配到数据的数量是否基本一致。

沙发顶上去

收藏

顶一个。

看完楼主的这个帖子以后，我的心久久不能平静，震撼啊！为什么会有如此好的帖子！我纵横网络bbs多年，自以为再也不会有任何帖子能打动我，没想到今天看到了如此精妙绝伦的这样一篇帖子。楼主，是你让我深深地理解了“人外有人，天外有天”这句话。谢谢你！在看完这帖子以后，我没有立即回复，因为我生怕我庸俗不堪的回复会玷污了这网上少有的帖子。但是我还是回复了，因为我觉得如果不能在如此精彩的帖子后面留下自己的网名，那我死也不会瞑目的！能够在如此精彩的帖子后面留下自己的网名是多么骄傲的一件事啊！楼主，请原谅我的自私！我知道无论用多么华丽的辞藻来形容楼主您帖子的精彩程度都是不够的，都是虚伪的，所以我只想说一句：您的帖子太好了！我愿意一辈子的看下去！这篇帖子构思新颖，题材独具匠心，段落清晰，情节诡异，跌宕起伏，主线分明，引人入胜，平淡中显示出不凡的文学功底，可谓是字字珠玑，句句经典，是我辈应当学习之典范。就小说艺术的角度而言，这篇帖子可能不算太成功，但它的实验意义却远远大于成功本身。正所谓：“一马奔腾，射雕引弓，天地都在我心中！”楼主真不愧为无厘界新一代的开山怪！本来我已经对这个社区失望了，觉得这个社区没有前途了，心里充满了悲哀。但是看了你的这个帖子，又让我对社区产生了希望。是你让我的心里重新燃起希望之火，是你让我的心死灰复燃，是你拯救了我一颗拨凉拨凉的心！本来我决定不会在社区回任何帖子了，但是看了你的帖子，我告诉自己这个帖子是一定要回的！这是百年难得一见的好贴啊！苍天有眼啊，让我在优生之年得以观得 如此精彩绝伦的帖子！楼主的话真如“大音希声扫阴翳”，犹如“拨开云雾见青天”，使我等网民看到了希望，看到了未来！晴天霹雳，醍醐灌顶或许不足以形容大师文章的万一；巫山行云，长江流水更难以比拟大师的文才！黄钟大吕，振聋发聩！你烛照天下，明见万里；雨露苍生，泽被万方！透过你深邃的文字，我仿佛看到了你鹰视狼顾，龙行虎步的伟岸英姿；仿佛看到了你手执如椽大笔，写天下文章的智慧神态；仿佛看见了你按剑四顾，江山无数的英武气概！楼主，你说的多好啊！我在社区打滚这么多年，所谓阅人无数，见怪不怪了，但一看到楼主的气势，我就觉得楼主同在社区里灌水的那帮小混蛋有着本质的差别，那忧郁的语调，那熟悉的签名，还有字里行间高屋建瓴的辞藻。没用的，楼主，就算你怎么换马甲都是没有用的，你的亿万拥戴者早已经把你认出来了，你一定就是传说中的最强id。自从社区改版之后，我就已经心灰意冷，对社区也没抱什么希望了，传说已经幻灭，神话已经终结，留在社区还有什么意思。没想到，没想到，今天可以再睹楼主的风范，我激动得忍不住就在屏幕前流下了眼泪。是啊，只要在楼主的带领下，社区就有希望了。我的内心再一次沸腾了，我胸腔里的血再一次燃烧了。楼主的话概括扼要，一语道出了我们苦想多年的而不可得答案的几个重大问题的根本。楼主就好比社区的明灯，楼主就好比社区的方向，楼主就好比社区的栋梁。有楼主在，社区的明天必将更好！楼主你的高尚情操太让人感动了。在现在这样一个物欲横流的金钱社会里，竟然还能见到楼主这样的性情中人，无疑是我这辈子最大的幸运。让我深深感受到了人性的伟大。楼主的帖子，就好比黑暗中刺裂夜空的闪电，又好比撕开乌云的阳光，一瞬间就让我如饮甘露，让我明白了永恒的真理在这个世界上是真实存在着的。只有楼主这样具备广阔胸怀和完整知识体系的人，才能作为这真理的唯一引言者。看了楼主的帖子，让我陷入了严肃的思考中，我认为，如果不把楼主的帖子顶上去，就是对真理的一种背叛，就是对谬论的极大妥协。因此，我决定义无返顾的顶了！楼主，在遇到你之前，我对人世间是否有真正的圣人是怀疑的；而现在，我终于相信了！我曾经忘情于汉廷的歌赋，我曾经惊讶于李杜的诗才，我曾经流连于宋元的词曲；但现在，我才知道我有多么浅薄！楼主的帖子实在是写得太好了。文笔流畅，修辞得体，深得魏晋诸朝遗风，更将唐风宋骨发扬得入木三分，能在有生之年看见楼主的这个帖子。实在是我三生之幸啊。看完楼主的这个帖子之后，我竟感发生出一种无以名之的悲痛感――啊，这么好的帖子，如果将来我再也看不到了，那我该怎么办？那我该怎么办？直到我毫不犹豫的把楼主的这个帖子收藏了，我内心的那种激动才逐渐平复下来。可是我立刻想到，这么好的帖子，倘若别人看不到，那么不是浪费楼主的心血吗？经过痛苦的思想斗争，我终于下定决心，我要把这个帖子一直往上顶，往上顶到所有人都看到为止！我现在终于明白我缺乏的是什么了，正是楼主那种对真理的执着追求和楼主那种对理想的艰苦实践所产生的厚重感。面对楼主的帖子，我震惊得几乎不能动弹了，楼主那种裂纸欲出的大手笔，竟使我忍不住一次次的翻开楼主的帖子，每看 一次，赞赏之情就激长数分，我总在想，是否有神灵活在它灵秀的外表下，以至能使人三月不知肉味，使人有余音穿梁，三日不绝的感受。楼主，你写得实在是太好了！我唯一能做的，就只有把这个帖子顶上去这件事了。我支持您!

...... 这么厉害？.....擦汗！

支持小雨哥的技术贴。支持DJB，据说男人都得有，不然不行。

又见小雨哥。。

请看hash函数的冲突对比：http://blog.csai.cn/user3/50125/archives/2009/35638.htmlDelphi自带，跟楼主写的，在Add to hashtable时，慢的地方在于：TAnsiStringHashList.Find...if Result^.Key = Key then
Exit也就是字符比较处理部分。一般我是用N(N>2)个函数产生的Key值，作为字串比较(一而再，再而三，这种机率非常小)，也就是Key: array [0..N] of Cardinal，然后用整形来比较，速度快上N倍，特别是在add时。N个hash值，可以在上面的连接，找一个平均分比较高的函数。

mark一下，有空测试一下（地质这小鸟人，改写列传了）。

难得在大富翁上见到这样的贴子了

精彩时间到了。基于以上函数，我们可以写一个测试封装，让测试封装函数给出我们想知道的答案：1）基本测试封装：type TXCompare = procedure (s1,s2:WideString;
var lresult: boolean);
Cardinal_TimeElapsedResult = Cardinal;const xLoop = 9999;
xs1 = '测试啦，字符串比较测试。不测不知道，不信就动手，Ctrl+C Ctrl+V 而已';
xs2 = '测试啦，字符串比较测试。不测不知道，不信就动手，Ctrl+C Ctrl+V 而已';function EffectTest(Proc: TXCompare;
Loop: integer = xLoop):Cardinal_TimeElapsedResult;var lr:boolean;
t1,t2: Cardinal;
begin
t1 := timeGettime;
while (Loop > 0)do
begin
dec(Loop);
Proc(xs1, xs2, lr);
end;
t2 := timeGettime;
Result := t2-t1;
end;
这个函数封装基本测试，上面需要测试的函数，只要逐一放到这个函数里，函数的结果就会告诉我们想知道的一切。比如：procedure TForm3.Button1Click(Sender: TObject);
begin
Memo1.Lines.AddObject( format('General Compare: %d',[EffectTest(generalCompare)]), nil);
end;
procedure TForm3.Button2Click(Sender: TObject);
begin
Memo1.Lines.AddObject( format('Hashkey Compare: %d',[EffectTest(hashkeyCompare)]), nil);
end;
procedure TForm3.Button3Click(Sender: TObject);
begin
Memo1.Lines.AddObject( format('JB_AND_SB Compare: %d',[EffectTest(JB_AND_SB_Compare)]), nil);
end;
procedure TForm3.Button4Click(Sender: TObject);
begin
Memo1.Lines.AddObject( format('Memory Compare: %d',[EffectTest(memoryCompare)]), nil);
end;

测试是有误差的，缩小误差的基本办法就是测试很多次，并取平均值：procedure TForm3.Button5Click(Sender: TObject);const num = 100;var mloop:integer;
hlf:Cardinal;
begin
Memo1.Lines.AddObject('Time Elapsed Test', nil);
Memo1.Lines.AddObject(format('each Compare loop %d',[xLoop]), nil);
Memo1.Lines.AddObject(format('each Effect loop %d',[num]), nil);
Memo1.Lines.AddObject(format('Result := (SUM(%d)(for each Compare TimeElapsed)) / %d',[num,num]), nil);
Memo1.Lines.AddObject('-------------------------------------', nil);
hlf := 0;
mloop := num;
while mloop > 0do
begin
hlf := hlf + EffectTest(generalCompare);
dec(mloop);
end;
Memo1.Lines.AddObject( format('1) General Compare: %d',[hlf div num]), nil);
Memo1.Lines.AddObject('-------------------------------------', nil);
hlf := 0;
mloop := num;
while mloop > 0do
begin
hlf := hlf + EffectTest(hashkeyCompare);
dec(mloop);
end;
Memo1.Lines.AddObject( format('2) Hashkey Compare: %d',[hlf div num]), nil);
Memo1.Lines.AddObject('-------------------------------------', nil);
hlf := 0;
mloop := num;
while mloop > 0do
begin
hlf := hlf + EffectTest(JB_AND_SB_Compare);
dec(mloop);
end;
Memo1.Lines.AddObject( format('3) JB_AND_SB Compare: %d',[hlf div num]), nil);
Memo1.Lines.AddObject('-------------------------------------', nil);
hlf := 0;
mloop := num;
while mloop > 0do
begin
hlf := hlf + EffectTest(memoryCompare);
dec(mloop);
end;
Memo1.Lines.AddObject( format('4) Memory Compare: %d',[hlf div num]), nil);
Memo1.Lines.AddObject('-------------------------------------', nil);
end;

注意上面的 num=100 和 xloop=9999 这样的条件。这些条件是我的老电脑上可以接受的条件，太多次的循环会直接把我的电脑搞挂的。大家可以根据自己实际测试情况做调整。

上面那个 SB 的 JB 函数 JB 得不够，由于它在某些特殊情况下会有很好表现，所以再贴出更进步的实现：procedure JB_AND_SB_Compare(s1,s2:WideString;var lresult: boolean);
inline;var len, iend, idx:integer;
P1, P2Longword;
begin
if Length(s1) <> Length(s2) then
begin
lresult := false;
exit;
end;
len := Length(s1);
if (len < 2) then
begin
lresult := (s1 = s2);
exit;
end else
if (len and 1 = 1) then
begin
if s1[Len] <> s2[Len] then
begin
lresult := false;
exit;
end else
begin
P1 := PLongword(@s1[1]);
P2 := PLongword(@s2[1]);
idx := integer(P1);
iend := idx + ((len-1) shr 1);
end;
end else
begin
P1 := PLongword(@s1[1]);
P2 := PLongword(@s2[1]);
idx := integer(P1);
iend := idx + (len shr 1);
end;
while iend > idxdo
begin
if P1^ = P2^ then
lresult := True else
begin
lresult := False;
break;
end;
inc(P1);
inc(P2);
inc(idx, 4);
end;
end;
这里实现的要点是减小循环次数，把本来需要按照字符个数进行循环的次数缩减一半，同时不失去发现不等立即退出的特点。

我测试的数据：第一次测试，字符串是xs1和xs2，同时去掉最后那个“而已”的“已”字。环境 BDS2006 + 单核P4 2.66Time Elapsed Testeach Compare loop 99999each Effect loop 300Result := (SUM(300)(for each Compare TimeElapsed)) / 300-------------------------------------1) General Compare: 41-------------------------------------2) JB_AND_SB Compare: 41-------------------------------------3) Memory Compare: 43-------------------------------------第二次测试，字符串就是上面xs1和xs2环境 BDS2006 + 单核P4 2.66Time Elapsed Testeach Compare loop 99999each Effect loop 300Result := (SUM(300)(for each Compare TimeElapsed)) / 300-------------------------------------1) General Compare: 41-------------------------------------2) JB_AND_SB Compare: 40-------------------------------------3) Memory Compare: 43-------------------------------------可以看到，JB_AND_SB_Compare 函数与完全优化过的Delphi运行时函数StrCompare（是全asm代码）旗鼓相当，与同样属于完全优化过的asm运行时函数CompareMem略胜...，至于那个内部四次取Key的函数，同样条件下，我等了很久很久都没有计算完成，所以在最后测试的时候临时取消了它的参与资格...这个测试是在 酷睿2 2.4 双核上的，字符串是xs1和xs2Time Elapsed Testeach Compare loop 99999each Effect loop 300Result := (SUM(300)(for each Compare TimeElapsed)) / 300-------------------------------------1) General Compare: 20-------------------------------------2) JB_AND_SB Compare: 19-------------------------------------3) Memory Compare: 20-------------------------------------

小雨哥实在太牛，佩服

QQ在线 观察得很仔细，提出了很好的建议。字符串进行比较，在老版本 Delphi 里，由于当时很多人更多地考虑 Delphi “能干什么”，而不是考虑 Delphi 是否可以“干得更好”，所以，精力都放在实现上。到了最近一些的新版本，比如 BDS2006 等，对运行库做了很大更新，所有基础函数都做了最大限度的优化，其中就包括字符串的比较。这个可以写一堆函数，做一些简单的测试来看看：1）第一个函数 先来一个完全依赖 Delphi 本身运行时库效率的字符串比较（generalCompare）：procedure generalCompare(s1,s2:WideString;
var lresult: boolean);
inline;
begin
if s1 = s2 then
lresult := true else
lresult := false;
end;
2）第二个函数（memoryCompare）再来用一个无性比较函数（所谓无性，是指不管字符串还是数字或是其他什么，一律当作内存中一块连续的二进制数字，也就是所谓的内存比较）。procedure memoryCompare(s1,s2:WideString;var lresult: boolean);
inline;
begin
if Length(s1) <> Length(s2) then
begin
lresult := false;
exit;
end;
lresult := CompareMem(@s1[1], @s2[1], Length(s1) shl 1);
end;
3）再来一个据说貌似 SB ，其实很 JB 的字符串比较（JB_AND_SB_Compare） - 【注意：这个函数已经在后面帖子 ID：3992258 里重新写了，请直接利用新写的版本】这个函数结合了内存比较和数字比较的优点，是个潜力函数，尤其在被比较的字符串不相等时， 可以独占立即返回的优势。procedure JB_AND_SB_Compare(s1,s2:WideString;var lresult: boolean);
inline;var iend, idx:integer;
P1, P2word;
begin
if Length(s1) <> Length(s2) then
begin
lresult := false;
exit;
end;
P1 := Pword(@s1[1]);
P2 := Pword(@s2[1]);
idx := integer(P1);
iend := idx + (Length(s1)shl 1);
while iend > idxdo
begin
if P1^ = P2^ then
lresult := True else
begin
lresult := False;
break;
end;
inc(P1);
inc(P2);
inc(idx, 2);
end;
end;
4）模拟 QQ在线 描述的“N(N>2)个函数产生的Key值”比较（hashkeyCompare）事实上需要对同一个字符串做二次不同函数的的取Key操作，这个函数在调用过程中需要在内部做四次字符串Hash，这一点让它在与前面几个函数对比测试中吃了大亏。因为这种对比测试，要求代码最好不要有一个无谓的动作，甚至是否使用中间变量都是需要衡量半天的。procedure hashkeyCompare(s1,s2:WideString;
var lresult: boolean);
inline;
functiondo
x(str:WideString): Cardinal;inline;
var x:integer;
begin
x := length(str);
Result := 0;
while x > 0do
begin
inc(Result, word(str[x]));
dec(x, 2);
end;
end;
function SB_hash(Str : String) : Cardinal;
inline;
var i : Cardinal;
begin
Result := 0;
for i := 1 to Length(Str)do
begin
Result := Ord(str) + (Result shl 6) + (Result shl 16) - Result;
end;
end;
var keybuff:array[boolean,boolean]of Cardinal;
begin
keybuff[False][False]:=do
x(s1);
keybuff[False][True]:= SB_hash(s2);
keybuff[True][False]:=do
x(s1);
keybuff[True][True]:= SB_hash(s2);
if (keybuff[True][False] = keybuff[False][False]) and(keybuff[True][True] = keybuff[False][True]) then
lresult := true else
lresult := False;
end;