DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡ ①
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡ ②
发布代码
发布控件
文档资料
经典工具
≡事务区≡ ③
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入： tkzcol
今日帖子： 16
在线用户： 16
导航： 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者：
男 comeheres (tomorrow) ▲▲▲▲▲ -
普通会员
2013/1/21 14:38:21
标题：
用stringreplace函数替换字符串，出现假死问题怎么办？ 浏览:5455
加入我的收藏
楼主：       我用Stringreplace函数来替换一段大小为大概1M的字符串中的空格，文本内容是类似"01 00 08 2A 18 60 3E ……"，也就是去掉文本里的空格，变成"0100082A18603E…"这样。
      但是Stringreplace函数来替换，程序会假死。请教一下大家，有没有速度更快的字符串替换函数？或者有没有其他更高效的方法来去掉字符串里的空格？先谢谢了～
----------------------------------------------
业余编程爱好者
作者：
男 gagakao (走走) ★☆☆☆☆ -
普通会员
2013/1/21 14:47:34
1楼： sl:TStringList-载入
sl.text
不知道效率怎么样
----------------------------------------------
-
作者：
男 lobtao (lob) ★☆☆☆☆ -
普通会员
2013/1/21 15:29:00
2楼： 正则表达式替换塞
----------------------------------------------
没有做不到，只有想不到。
bolg：http://hi.baidu.com/lobtao
Email：lobtao@qq.com
QQ：369687916
作者：
男 iamdream (银河恒久远，梦想无止境！) ★☆☆☆☆ -
大贡献会员
2013/1/21 15:36:10
3楼： 自己写个函数好了，将文本读到一个字符串，再将除空格外的字符写到另一个字符串或流中就可以了。
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……
作者：
男 comeheres (tomorrow) ▲▲▲▲▲ -
普通会员
2013/1/21 23:12:35
4楼： 正则表达式替换塞
----------
用TRegEx.Replace，也需要卡上十几秒，唉。。
----------------------------------------------
业余编程爱好者
作者：
男 f00l (小生(骗术师)) ★☆☆☆☆ -
普通会员
2013/1/21 23:31:27
5楼： 才一MB的数据不可能这么慢的...
你是不是都把时间花在界面上了-0-难道用Memo去了?而且不beginupdate一下?
----------------------------------------------
-
作者：
男 comeheres (tomorrow) ▲▲▲▲▲ -
普通会员
2013/1/22 0:06:14
5楼： 暂时找不到什么好办法，还是将读取文件到十六进制文本时，不加入空格好了，再把UTF8编码和解码的函数稍微修改下。

谢谢楼上的几位，如果谁有好的方法，不妨贡献出来啊~~
----------------------------------------------
业余编程爱好者
作者：
男 f00l (小生(骗术师)) ★☆☆☆☆ -
普通会员
2013/1/22 0:08:45
6楼： 试了一下,用Stringreplace的确需要很长时间,那你就手动填充一下数据好了....
----------------------------------------------
-
作者：
男 comeheres (tomorrow) ▲▲▲▲▲ -
普通会员
2013/1/22 0:15:49
6楼： 才一MB的数据不可能这么慢的...
你是不是都把时间花在界面上了-0-难道用Memo去了?而且不beginupdate一下?
---------- 
没用memo。。。用stringreplace或者正则可以使用beginupdate吗？
----------------------------------------------
业余编程爱好者
作者：
男 comeheres (tomorrow) ▲▲▲▲▲ -
普通会员
2013/1/22 0:17:50
7楼： 试了一下,用Stringreplace的确需要很长时间,那你就手动填充一下数据好了....
---------- 
哈哈，我还是从问题源头上找解决办法了，读取文件到十六进制文本时，不加空格，修改后保存时一点不卡了
----------------------------------------------
业余编程爱好者
作者：
男 f00l (小生(骗术师)) ★☆☆☆☆ -
普通会员
2013/1/22 0:23:15
7楼： const
  MB = 1024 * 1024;
var
  StrSource, StrNew, StrTemp: string;
  I, J: Integer;
  C: Cardinal;
begin
  SetLength(StrSource, 3 * MB);
  Randomize;
  C := GetTickCount;
  for I := 0 to MB - 1 do
  begin
    StrTemp := Format('%2x ', [Random(256)]);
    Move(StrTemp[1], StrSource[I * 3 + 1], 3 * SizeOf(Char));
  end;
  Memo1.Lines.Text := StrSource;
  ShowMessage(Format('Size: %d, Time: %d', [Length(StrSource) * SizeOf(Char) , GetTickCount - C]));
  SetLength(StrNew, 2 * MB);
  C := GetTickCount;
  for J := 0 to MB - 1 do
  begin
    StrTemp := Copy(StrSource, J * 3 + 1, 2);
    Move(StrTemp[1], StrNew[J * 2 + 1], 2 * SizeOf(Char));
  end;
  Memo2.Lines.Text := StrNew;
  ShowMessage(Format('Size: %d, Time: %d', [Length(StrNew) * SizeOf(Char) , GetTickCount - C]));
end;

写了段很烂的代码.没有用到啥优化
1.8G的单核CPU创建6MB大小的字符串也只用了1.5秒
去空格也只用了0.5秒...
这是最笨的办法了...你自己想办法优化吧...
----------------------------------------------
-
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/22 1:26:17
8楼： function DelAllSpace(var str: string): string;
var
  i: integer;
begin
  i := 1;
  repeat
    i := pos(' ', str, i);
    delete(str, i, 1);
  until i = 0;
  Result := str;
end;
应该不慢，单元system的 函数pos和delete 在32位是汇编优化
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 zfzhhh (hongshu) ★☆☆☆☆ -
普通会员
2013/1/22 15:01:08
9楼： stringreplace是数据量越大，处理速度越慢的
用正则表达式的话，xe2自带的不能处理数据流，转为字符串处理速度也慢
使用diregex可以处理数据流，速度也超级快，不过没有破解完全的版本。经常会弹出未注册
----------------------------------------------
-
作者：
男 comeheres (tomorrow) ▲▲▲▲▲ -
普通会员
2013/1/23 0:13:06
10楼： 写了段很烂的代码.没有用到啥优化
1.8G的单核CPU创建6MB大小的字符串也只用了1.5秒
去空格也只用了0.5秒...
这是最笨的办法了...你自己想办法优化吧...
----------
嗯，这个速度快多了，谢谢了
----------------------------------------------
业余编程爱好者
作者：
男 comeheres (tomorrow) ▲▲▲▲▲ -
普通会员
2013/1/23 0:14:14
11楼： 应该不慢，单元system的 函数pos和delete 在32位是汇编优化
----------

Pos函数效率很低的吧，很卡的
----------------------------------------------
业余编程爱好者
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/1/23 8:22:26
12楼： 其实可以用空间换时间的方法，我测了下以下方法，去1兆的空格，不到0.02秒,其实真正计算时间在我的机器上0.016秒

procedure TForm50.SpeedButton2Click(Sender: TObject);
var
  buf: array of AnsiChar;
  i, j: Integer;
  tmpCh: ansichar;
  tmpStr: AnsiString;
  d1, d2: TDateTime;
  ts: TStringList;
begin
  ts := TStringList.Create;
  try
    ts.LoadFromFile('c:\b.txt');
    tmpStr := ts.Text;
    //计时
    d1 := now;
    SetLength(buf, length(tmpstr) + 1);
    j := 0;
    for I := 1 to Length(tmpStr) do
    begin
      tmpCh := tmpStr[i];
      if tmpCh <> #32 then
      begin
        buf[j] := tmpCh;
        inc(j);
      end;
    end;
    buf[j] := #0;
    tmpStr := StrPas(pansichar(buf));
    d2 := now;
    //计时
    ts.Text := tmpStr;
    ts.SaveToFile('c:\x.txt');
    Caption := FormatDateTime('ss.zzz', d2 - d1);
  finally
    ts.Free;
  end;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/1/23 8:51:50
13楼： 也可以用指针方法，时间也差不多是0.015,0.016秒，估计还有其它更好的方法
procedure TForm50.SpeedButton3Click(Sender: TObject);
var
  buf: array of AnsiChar;
  tmpCh: ansichar;
  tmpStr: AnsiString;
  d1, d2: TDateTime;
  ts: TStringList;
  pc: PAnsiChar;
  pc1: PAnsiChar;
begin
  ts := TStringList.Create;
  try
    ts.LoadFromFile('c:\b.txt');
    tmpStr := ts.Text;
    //计时
    d1 := now;
    pc1 := @tmpStr[1];
    SetLength(buf, length(tmpStr) + 1);
    pc := @buf[0];
    while (pc1^ <> #0) do
    begin
      if (pc1^ <> #32) then
      begin
        pc^ := pc1^;
        inc(pc);
      end;
      inc(pc1);
    end;
    pc := @buf[0];
    tmpStr := StrPas(pc);
    d2 := now;
    //计时
    ts.Text := tmpStr;
    ts.SaveToFile('c:\x.txt');
    Caption := FormatDateTime('ss.zzz', d2 - d1);
  finally
    ts.Free;
  end;
end;
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/1/23 9:10:28
14楼： 在测试了以上两种方法，处理6兆文本，也差不多，约0.063秒,我估计还有更好的方法，盒子里牛人多如牛毛
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/1/23 9:32:10
15楼： 想起我我玩过筛质数的问题，当我筛1亿内质数，当做到0.4秒，再也提升不了，再看一下专业的，人家弄100亿内质数也是秒级的
----------------------------------------------
-
作者：
男 egust (欢迎访问 Delphi@smth.org) ★☆☆☆☆ -
普通会员
2013/1/23 10:45:33
16楼： 8楼：
function DelAllSpace(var str: string): string;
var
  i: integer;
begin
  i := 1;
  repeat
    i := pos(' ', str, i);
    delete(str, i, 1);
  until i = 0;
  Result := str;
end;
应该不慢，单元system的 函数pos和delete 在32位是汇编优化


没记错的话一提优化 bmsr 就提汇编吧？把一个时间复杂度为 O(n) 的问题硬给做成了 O(n^2)，汇编有毛用啊？

==========

hq200306：
已经极限了，本来这个过程就没有耗时操作，应该不比一个字符一个字符复制两遍内存慢多少，跟算素数没有可比性
----------------------------------------------
cnblogs中我写的关于Delphi的blog，欢迎访问：
http://www.cnblogs.com/egust/
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/23 11:03:52
17楼： 要快? 还不容易?
const
  MB = 1024 * 1024 div 3 ;
var
  s: string;
  I: integer;
  Tick: Cardinal;
  len:integer;
begin

  s:='';
  Randomize;
  Memo_Output.Lines.add('----------开始产生1m长字符串----------');
  Tick := GetTickCount;
  for I := 0 to MB div StringElementSize(s) - 1 do s := s + Format('%.2x ', [Random(256)]);
  Tick := GetTickCount - Tick;
  Memo_Output.Lines.add(s);
  Memo_Output.Lines.add(Format('产生字串s: Size: %d, 耗费时间: %d 毫秒', [strsize(s), Tick]));
   Memo_Output.Lines.add('----------开始删除1m长字符串的空格----------');
   len:=length(s) *2 div 3;
  tick:= GetTickCount;
  for i := 0 to   MB div StringElementSize(s) - 1 do  move(s[3*i+1],s[2*i+1],2*StringElementSize(s));
  setlength(s,len);
  Tick:=GetTickCount-Tick ;
  Memo_Output.Lines.add(s);
  Memo_Output.Lines.add(Format('删除字串s空格: Size: %d, 耗费时间: %d 毫秒', [strsize(s), Tick]));
end;
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/23 11:10:44
18楼： 还可以更快,因为
for i := 0 to   MB div StringElementSize(s) - 1 do  move(s[3*i+1],s[2*i+1],2*StringElementSize(s));会产生多次函数调用包括 move() 包括 3*I(实际是class operator Multiply(a: integer; b: integer): integer;) 还有加法 实际上是
class operator Add(a: integer; b: integer): integer;)
每次调用32位下都有 如下多余操作,传值的eax, 返回 ret, 从eax取值 所以想要更快的话,可以把上面语句汇编话.将还可以快1/3左右.
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/23 11:20:56
19楼： 发现1m大小不到1ms 改成6m 结果14ms,垃圾双核笔记本
const
  MB = 1024 * 1024  ;
var
  s: string;
  I: integer;
  Tick: Cardinal;
  len:integer;
begin

  s:='';
  Randomize;
  Memo_Output.Lines.add('----------开始产生6m长字符串----------');
  Tick := GetTickCount;
  for I := 0 to MB  - 1 do s := s + Format('%.2x ', [Random(256)]);
  Tick := GetTickCount - Tick;
  Memo_Output.Lines.add(s);
  Memo_Output.Lines.add(Format('产生字串s: Size: %d, 耗费时间: %d 毫秒', [strsize(s), Tick]));
   Memo_Output.Lines.add('----------开始删除1m长字符串的空格----------');
   len:=length(s) *2 div 3;
  tick:= GetTickCount;
  for i := 0 to   MB  - 1 do  move(s[3*i+1],s[2*i+1],2*StringElementSize(s));
  setlength(s,len);
  Tick:=GetTickCount-Tick ;
  Memo_Output.Lines.add(s);
  Memo_Output.Lines.add(Format('删除字串s空格: Size: %d, 耗费时间: %d 毫秒', [strsize(s), Tick]));
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/23 11:27:34
20楼： 附 Uint28 加法和乘法 intdiv  求模优化


function U128Add(x, y: uint128): uint128;
{$IFDEF PUREPASCAL}
begin
    Int128Rec(Result).Hi := Int128Rec(a).Hi + Int128Rec(b).Hi;
  Int128Rec(Result).Lo := Int128Rec(a).Lo + Int128Rec(b).Lo;
  if ((Int128Rec(Result).Lo <= Int128Rec(a).Lo) or (Int128Rec(Result).Lo <= Int128Rec(b).Lo)) and
    ((Int128Rec(a).Lo > 0) and (Int128Rec(b).Lo > 0)) then Int128Rec(Result).Hi := Int128Rec(Result).Hi + 1;
end;
{$ENDIF PUREPASCAL}
{$IFDEF CPUX86}
asm
  //[eax]->x, [edx]->y , [ecx]->result
  push [eax]
  push [eax+4]
  push [eax+8]
  push [eax+12]
  pop [ecx+12]
  pop [ecx+8]
  pop [ecx+4]
  pop [ecx]
  mov eax,[edx]
  add [ecx],eax
  mov eax,[edx+4]
  adc [ecx+4],eax
  mov eax,[edx+8]
  adc [ecx+8],eax
  mov eax,[edx+12]
  adc [ecx+12],eax
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
asm
  //[rdx]->x, [r8]->y,[rcx]->result
  push [r8]
  push [r8+8]
  pop [rcx+8]
  pop [rcx]
  mov rax,[rdx]
  add [rcx],rax
  mov rax,[rdx+8]
  adc [rcx+8],rax
end;
{$ENDIF CPUX64}

function U128MUl(a, b: uint128): uint128;
{$IFDEF CPUX86}
{
 //[eax]->a, [edx]->b , [ecx]->result
 {a1,a2,a3,a4 分别乘 b1,b2,b3,b4 进位是(N*32)+(N*32)bit
 N为后面的数值-1 所以result:=
 a1*b1+ (a1*b2 shl 32)+(a1*b3 shl 64) +(a1*b4 shl 96)
 +(a2*b1 shl 32)+(a2*b2 shl 64)+(a2*b3 shl 96)+(a2*b4 shl 128)
 +(a3*b1 shl 64)+(a3*b2 shl 96)+(a3*b3 shl 128)+(a3*b4 shl 160)
 +(a4*b1 shl 96)+(a4*b2 shl 128)+(a4*b3 shl 160)(a4*b4 shl 192)

 去掉 进位>=128的 然后吧进位相同的合并
 resulr:=
 a1*b1+((a1*b2 + a2*b1) shl 32)
 + ((a1*b3 +a2*b2+a3*b1) shl 64)
 +((a1*b4+ a2*b3+a3*b2+ a4*b1) shl 96)
}
asm

  push ebp
  mov ebp,esp
  sub ebp,32
  push ebx
  mov [ecx+8],0
  mov [ecx+12],0 //result.HI:=0
  MOVDQU xmm0,[eax]
  MOVDQU [ebp],xmm0 //[ebp]<-a
  mov ebx,edx       //[ebx]<-b
  mov eax,[ebp]
  mul [ebx]
  mov [ecx],eax
  mov [ecx+4],edx //a1*b1
  mov eax,[ebp]
  mul [ebx+4]
  add [ecx+4],eax
  adc [ecx+8],edx  //(a1*b2 ) shl 32
  mov eax,[ebp+4]
  mul [ebx]       //a2*b1
  add [ecx+4],eax
  adc [ecx+8],edx  //(a2*b1) shl 32
  adc [ecx+12],0
  mov eax,[ebp]
  mul [ebx+8]
  add [ecx+8],eax
  adc [ecx+12],edx //(a1*b3) shl 64
  mov eax,[ebp+4]
  mul [ebx+4]
  add [ecx+8],eax
  adc [ecx+12],edx //(a2*b2) shl 64
  mov eax,[ebp+8]
  mul [ebx]
  add [ecx+8],eax
  adc [ecx+12],edx //(a3*b1) shl 64
  mov eax,[ebp]
  mul [ebx+12]
  add [ecx+12],eax //(a1*b4) shl 96
  mov eax,[ebp+4]
  mul [ebx+8]
  add [ecx+12],eax //(a2*b3) shl 96
  mov eax,[ebp+8]
  mul [ebx+4]
  add [ecx+12],eax //(a3*b2) shl 96
  mov eax,[ebp+12]
  mul [ebx]
  add [ecx+12],eax //(a4*b1) shl 96
  pop ebx
  pop ebp

end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
//[rdx]->a, [r8]->b,[rcx]->result
asm
  {a1,a2 b1 b2
  a1*b1+((a1*b2) shl 64)+((a2*b1) shl 64)+((a2*b2) shl 128)
  }
  mov r9,rdx    //[r9]<-x
  mov rax,[r9]
  mov rdx,[r8+8]
  mul rdx     //a1*b2
  mov [rcx+8],rax
  mov rax,[r9+8]
  mov rdx,[r8]
  mul rdx      //a2*b1
  add [rcx+8],rax
  mov rax,[r9]
  mov rdx,[r8]
  mul rdx      //a1*b1
  mov [rcx],rax
  add [rcx+8],rdx
end;
{$ENDIF CPUX64}

function U128MUlPas(a, b: uint128): uint128;
  function mul64To128(aa, bb: uint64): uint128;
  var
    AHi, ALo, BHi, BLo: uint64;
    T128: uint128;
  begin
    T128 := 0;
    AHi := int64Rec(aa).Hi;
    ALo := int64Rec(aa).Lo;
    BHi := int64Rec(bb).Hi;
    BLo := int64Rec(bb).Lo;
    Int128Rec(T128).Lo := AHi * BHi;
    Result := T128 shl 64;
    Int128Rec(T128).Lo := AHi * BLo; //A.hi*B.Lo
    Result := Result + (T128 shl 32);
    Int128Rec(T128).Lo := ALo * BHi; //A.Lo*B.Hi
    Result := Result + (T128 shl 32);
    Int128Rec(T128).Lo := ALo * BLo; //Lo*Lo
    Result := Result + T128;
  end;

var
  AHi, ALo, BHi, BLo: uint64;
  T128: uint128;
begin
  AHi := Int128Rec(a).Hi;
  ALo := Int128Rec(a).Lo;
  BHi := Int128Rec(b).Hi;
  BLo := Int128Rec(b).Lo;

  T128 := mul64To128(AHi, BLo);
  Result := T128 shl 64;

  T128 := mul64To128(ALo, BHi);
  Result := Result + (T128 shl 64);

  T128 := mul64To128(ALo, BLo);
  Result := Result + T128;
end;
function U128Intdiv(a, b: uint128): uint128;
{$IFDEF CPUX86}
asm
//  push ecx
//  call uint128.bsr
//  pop ecx
//  mov [ecx],eax
//  mov [ecx+4],0
//  mov [ecx+8],0
//  mov [ecx+12],0
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
asm
  //[rdx]->a, [r8]->b,[rcx]->result
  PUSH    RBX
  PUSH    RSI
  PUSH    RDI
  mov     r9,rcx    //result<->r9
  MOV     RBX,[r8]          //b.lo->rbx
  MOV     R8,[r8+8]          //b.hi-r8
  OR      R8,R8
  JNZ     @@slow_ldiv     //both high words are zero
  mov     rax,[rdx]    //a.lo->rax
  mov     rdx,[rdx+8]    //a.hi->rdx
  OR      rdx,rdx
  JZ      @@quick_ldiv
  OR      RBX,RBX
  JZ      @@quick_ldiv    //if RCX:RBX == 0 force a zero divide
@@slow_ldiv:
  MOV     RCX,128          //shift counter
  XOR     RDI,RDI          //fake a 64 bit dividend
  XOR     RSI,RSI          //

@@xloop:
  SHL     RAX,1          //shift dividend left one bit
  RCL     RDX,1
  RCL     RSI,1
  RCL     RDI,1
  CMP     RDI,R8          //dividend larger?
  JB      @@nosub
  JA      @@subtract
  CMP     RSI,RBX          //maybe
  JB      @@nosub
@@subtract:
  SUB     RSI,RBX
  SBB     RDI,R8          //subtract the divisor
  INC     RAX          //build quotient
@@nosub:
  LOOP    @@xloop
  //
  //When done with the loop the four registers values' look like:
  //
  //|     RDI    |    RSI     |    RDX     |    RAX     |
  //|        remainder        |         quotient        |
  //
  //MOV     RAX,RSI
  //MOV     RDX,RDI          //use remainder
  jmp @@finish

@@quick_ldiv:
  DIV     RBX          //unsigned divide
  //XCHG    RAX,RDX
  XOR     RDX,RDX
@@finish:
  mov [r9],rax
  mov [r9+8],rdx
  POP     RDI
  POP     RSI
  POP     RBX
end;
{$ENDIF CPUX64}

function U128IntdivPas(a, D: uint128): uint128;
  function IntDivU128(aa, dd: uint128): uint128;
  var
    c: integer;
    U, t: uint128;
  begin
    U := 0;
    t := 0;
    Result := 0;
    case CompareValue(aa, dd) of
      EqualsValue:
        begin
          Result := 1;
          exit;
        end;
      LessThanValue: exit;
    else
      begin
        Result := 1;
        c := UintsHighBit(aa) - UintsHighBit(dd);
        Result := Result shl c;
        U := dd shl c;
        if CompareValue(aa, U) = LessThanValue then
        begin
          U := U shr 1;
          Result := Result shr 1;
        end;
        t := aa - U;
        Result := Result + IntDivU128(t, dd);
      end;
    end;
  end;

begin
  Result := IntDivU128(a, D);
end;

function U128MOD(a, b: uint128): uint128;
{$IFDEF CPUX86}
//[eax]->a, [edx]->b , [ecx]->result
asm
  Pxor xmm0,xmm0
  MOVDQU [ecx],xmm0     //result:=0
  push ebp
  push ebx
  push esi
  push edi
  sub esp,64
  mov ebp,esp
  mov esi,eax    //@a <-> [esi]
  mov edi,edx  //@b <-> [edi]
  mov [ebp],ecx  //@result <-> [ebp]
  mov ebx,ebp
  add ebx, 20   //@tmpb <-> [ebx]
  mov esi,ebp
  add esi,40         //@tmpa:=esi
  MOVDQU xmm0,[eax]
  MOVDQU [esi],xmm0   //tmpa:=a
  mov eax,edi
  call uint128.bsr
  mov [ebp+8],eax        //b.bsr <-> [ebp+8]
@@a_bsr:
  mov eax,esi
  call uint128.bsr
  mov [ebp+4],eax     //a.bsr <-> [ebp+4]
  cmp eax,32
  ja @@a_Compare_b
  cmp [ebp+8],32
  ja @@a_Compare_b
  mov eax, [esi]  //a.lo-> eax
  mov edx,[esi+4]//a.hi-> edx
  div [edi]    //div b
  mov ecx,[ebp]
  mov [ecx],edx //mod -> result.0qw
  jmp @@end
@@a_Compare_b:
  mov eax,[esi+12]
  cmp eax,[edi+12]
  ja @@dayu
  jb @@xiaoyu
  mov eax,[esi+8]
  cmp eax,[edi+8]
  ja @@dayu
  jb @@xiaoyu
  mov eax,[esi+4]
  cmp eax,[edi+4]
  ja @@dayu
  jb @@xiaoyu
  mov eax,[esi]
  cmp eax,[edi]
  ja @@dayu
  jb @@xiaoyu
@@dengyu:
  Pxor xmm0,xmm0
  mov ecx,[ebp]
  MOVDQU [ecx],xmm0     //if a=b then result:=0
  jmp @@end
@@xiaoyu:
  mov ecx,[ebp]
  MOVDQU xmm0,[esi]
  MOVDQU [ecx],xmm0      //result:=a
  jmp @@end  //if a<b then result:=a
@@dayu:
  mov eax,edi  //u128shr(b,count) b<-> [edx]  count<->[ecx] 参数传递 b:eax, count:edx ,result:ecx
  mov edx,[ebp+4]
  sub edx,[ebp+8]
  mov ecx,ebx
  call U128shl    //tmpb:= b shl (a.bsr-b.bsr)
  mov eax,[esi+12]
  cmp eax,[ebx+12]
  jb @@tmpb_shr_1
  ja @@a_sub_tmpb
  mov eax,[esi+8]
  cmp eax,[ebx+8]
  jb @@tmpb_shr_1
  ja @@a_sub_tmpb
  mov eax,[esi+4]
  cmp eax,[ebx+4]
  jb @@tmpb_shr_1
  ja @@a_sub_tmpb
  mov eax,[esi]
  cmp eax,[ebx]
  jb @@tmpb_shr_1
  ja @@a_sub_tmpb
  jmp @@dengyu
@@tmpb_shr_1:
  shr [ebx+12],1
  rcr [ebx+8],1
  rcr [ebx+4],1
  rcr [ebx],1
@@a_sub_tmpb:
  mov eax,[ebx]   //a:=a-tmpb
  sub [esi], eax
  mov eax,[ebx+4]
  sbb [esi+4],eax
  mov eax,[ebx+8]
  sbb [esi+8],eax
  mov eax,[ebx+12]
  sbb [esi+12],eax
  jmp @@a_bsr
@@end:
  add esp,64
  pop edi
  pop esi
  pop ebx
  pop ebp
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
asm
  //[rdx]->a, [r8]->b,[rcx]->result
  PUSH    RBX
  PUSH    RSI
  PUSH    RDI
  mov     r9,rcx    //result<->r9
  MOV     RBX,[r8]          //b.lo->rbx
  MOV     R8,[r8+8]          //b.hi-r8
  OR      R8,R8
  JNZ     @@slow_ldiv     //both high words are zero
  mov     rax,[rdx]    //a.lo->rax
  mov     rdx,[rdx+8]    //a.hi->rdx
  OR      rdx,rdx
  JZ      @@quick_ldiv
  OR      RBX,RBX
  JZ      @@quick_ldiv    //if RCX:RBX == 0 force a zero divide
@@slow_ldiv:
  MOV     RCX,128          //shift counter
  XOR     RDI,RDI          //fake a 64 bit dividend
  XOR     RSI,RSI          //

@@xloop:
  SHL     RAX,1          //shift dividend left one bit
  RCL     RDX,1
  RCL     RSI,1
  RCL     RDI,1
  CMP     RDI,R8          //dividend larger?
  JB      @@nosub
  JA      @@subtract
  CMP     RSI,RBX          //maybe
  JB      @@nosub
@@subtract:
  SUB     RSI,RBX
  SBB     RDI,R8          //subtract the divisor
  INC     RAX          //build quotient
@@nosub:
  LOOP    @@xloop
  //
  //When done with the loop the four registers values' look like:
  //
  //|     RDI    |    RSI     |    RDX     |    RAX     |
  //|        remainder        |         quotient        |
  //
  MOV     RAX,RSI
  MOV     RDX,RDI          //use remainder
  jmp     @@finish
@@quick_ldiv:
  DIV     RBX          //unsigned divide
  XCHG    RAX,RDX
  XOR     RDX,RDX
@@finish:
  mov [r9],rax
  mov [r9+8],rdx
  POP     RDI
  POP     RSI
  POP     RBX
end;
{$ENDIF CPUX64}

function U128MODPas(a, M: uint128): uint128;
  function ModU128(aa, mm: uint128): uint128;
  var
    c, ac, mc: integer;
    U, t: uint128;
  begin
    U := 0;
    t := 0;
    Result := 0;
    mc := UintsHighBit(mm);
    case CompareValue(aa, mm) of
      EqualsValue: exit;
      LessThanValue: Result := aa;
    else
      begin
        ac := UintsHighBit(aa);
        if ac <= 64 then
        begin
          Result := Int128Rec(aa).Lo mod Int128Rec(mm).Lo;
          exit;
        end;
        c := ac - mc;
        U := mm shl c;
        if CompareValue(aa, U) = LessThanValue then U := U shr 1;
        t := aa - U;
        Result := ModU128(t, mm);
      end;
    end; //case
  end;

begin
  Result := ModU128(a, M);

end;

function U128shlSSE(x: uint128; count: byte): uint128;
{$IFDEF CPUX86}
asm
  MOVDQU xmm0,[eax]
  MOVDQU [ecx],xmm0
  mov eax,ecx
  xor ecx,ecx
  mov cl,dl
  cmp cl,0
  je @@4
  cmp cl,128
  jb @@Higher64
  PXOR xmm0,xmm0
  MOVDQU [eax],xmm0
  jmp @@4
@@Higher64:
  cmp cl,64
  jb @@lower64
  sub cl,64
  MOVD xmm1,ecx
  PSLLDQ xmm0,8
  PSLLQ xmm0,xmm1
  MOVDQU [eax],xmm0
  jmp @@4
@@lower64:
  MOVDQU xmm2,xmm0
  MOVD xmm1,ecx
  PSLLQ xmm0,xmm1
  mov edx,64
  sub edx,ecx
  MOVD xmm1,edx
  PSLLDQ xmm2,8
  PSRLQ xmm2,xmm1
  por xmm0,xmm2
  MOVDQU [eax],xmm0
@@4:
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
asm
  MOVDQU xmm0,[rdx]
  MOVDQU [rcx],xmm0 //result:=x
  mov rax,rcx
  xor rcx,rcx
  mov rdx,r8
  mov cl,dl
  cmp cl,0
  je @@4
  cmp cl,128
  jb @@Higher64
  PXOR xmm0,xmm0
  MOVDQU [rax],xmm0
  jmp @@4
@@Higher64:
  cmp cl,64
  jb @@lower64
  sub cl,64
  MOVD xmm1,ecx
  PSLLDQ xmm0,8
  PSLLQ xmm0,xmm1
  MOVDQU [rax],xmm0
  jmp @@4
@@lower64:
  MOVDQU xmm2,xmm0
  MOVD xmm1,ecx
  PSLLQ xmm0,xmm1
  mov edx,64
  sub edx,ecx
  MOVD xmm1,edx
  PSLLDQ xmm2,8
  PSRLQ xmm2,xmm1
  por xmm0,xmm2
  MOVDQU [rax],xmm0
@@4:
end;
{$ENDIF CPUX64}

function U128shl(x: uint128; count: byte): uint128;
{$IFDEF CPUX86}
asm
  push [eax]
  push [eax+4]
  push [eax+8]
  push [eax+12]
  pop [ecx+12]
  pop [ecx+8]
  pop [ecx+4]
  pop [ecx]      //result:=x;
  mov eax,ecx   //cl要用到,所以
  mov cl,dl     //cl:=count
  cmp  cl, 0     //IT count=0 then exit
  je @@4
  cmp cl ,128     //count>=128 则result:=0
  jb @@96
  mov [eax],0
  mov [eax+4],0
  mov [eax+8],0
  mov [eax+12],0
  jmp @@4
@@96:
  cmp cl,96      //count>=96 则1dword->4dword    其余置0
  jb @@64
  mov edx,[eax]
  sub cl,96
  shl edx,cl
  mov [eax+12],edx
  mov [eax],0
  mov [eax+4],0
  mov [eax+8],0
  jmp @@4
@@64:
  cmp cl,64      //count>=64 则1dword->3dword; 2dword->4dword ;1、2dword<-0
  jb @@32
  sub cl,64
  mov edx, [eax]
  shld [eax+4],edx,cl
  shl edx,cl
  mov [eax+8],edx
  mov edx,[eax+4]
  mov [eax+12],edx
  mov [eax],0
  mov [eax+4],0
  jmp @@4
@@32:cmp cl, 32     //count>=32 则 1dword->2dword ;2dword-3dword; 3dword->4dword; 1dword<-0
  jb @@3
  sub cl,32
  mov edx,[eax+4]
  shld [eax+8], edx, cl
  mov edx,[eax]
  shld [eax+4],edx,cl
  shl [eax],cl
  mov edx,[eax+8]
  mov [eax+12],edx
  mov edx,[eax+4]
  mov [eax+8],edx
  mov edx,[eax]
  mov [eax+4],edx
  mov [eax],0
  jmp @@4
@@3:          //count<32 则本字移动
  mov edx, [eax+8]
  shld [eax+12],edx,cl
  mov edx,[eax+4]
  shld [eax+8], edx,cl
  mov edx,[eax]
  shld [eax+4],edx,cl
  shl [eax],cl
@@4:
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
asm
  mov rax,rcx  //[rax]->result
  push [rdx]
  push [rdx+8]
  pop [rax+8]
  pop [rax] //result:=x;
  mov rcx,r8
  cmp cl,0
  je @@1
  cmp cl,128
  jb @@Higher64
  mov [rax],0
  mov [rax+4],0
  mov [rax+8],0
  mov [rax+12],0
  jmp @@1
@@Higher64:
  cmp cl,64
  jl @@lower64
  sub cl,64
  mov rdx,[rax]
  shl rdx,cl
  mov [rax+8],rdx
  push 0
  pop [rax]
  jmp @@1
@@lower64:
  mov rdx,[rax]
  shld [rax+8], rdx,cl
  shl rdx,cl
  mov [rax],rdx
@@1:
end;
{$ENDIF CPUX64}
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 iamdream (银河恒久远，梦想无止境！) ★☆☆☆☆ -
大贡献会员
2013/1/23 11:46:20
21楼： //好玩，我也写个命令行程序：将以下代码保存成MyClean.dpr，可以在D5~D2010中编译。
//代码未做多少优化，不过可以支持很大的文件，程序占用内存与文件大小无关。
program MyClean;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows,
  Classes;

function BuildParamList: TStrings;
var
  i: Integer;
begin
  Result := TStringList.Create;
  for i := 1 to ParamCount() do begin
    if Pos('=', ParamStr(i)) > 0 then begin
      Result.Add(ParamStr(i));
    end;
  end;
end;

// command format:  MyClean /Gen /size=1 /outfile=test.txt
procedure GenTestFile;
var
  params: TStrings;
  genSize: Integer;
  genFile: string;
  len: Integer;
  tmp: AnsiString;
  buf: AnsiString;
  idx: Integer;
  tick: DWord;
begin
  params := BuildParamList;
  try
    WriteLn('Generate Testing File...');
    genSize := StrToIntDef(params.Values['/size'], 1) * 1024 * 1024;  //MB
    genFile := params.Values['/outfile'];
    if genFile = '' then begin
      genFile := 'test.txt';
    end;

    len := 0;
    idx := 1;
    SetLength(buf, 4096 * 3);
    Randomize();
    tick := GetTickCount();
    with TFileStream.Create(genFile, fmCreate) do try
      while len < genSize do begin
        tmp := AnsiString(Format('%.2x ', [Random(256)]));
        CopyMemory(@buf[idx], @tmp[1], 3);
        Inc(idx, 3);
        Inc(len, 3);
        if (idx + 3 > SizeOf(buf)) or (len >= genSize) then begin
          Write(buf[1], idx -1);
          idx := 1;
        end;
      end;
    finally
      Free;
    end;
    tick := GetTickCount - tick;
    WriteLn(Format('Generate OK, %0.3fs', [tick / 1000.0])); 
  finally
    params.Free;
  end;
end;

// command format:  MyClean /Clean /Source=a.txt /Target=b.txt
procedure CleanSpace;

  procedure Clean(Source, Target: TStream);
  var
    bufSrc: AnsiString;
    bufTgt: AnsiString;
    i, k: Integer;
    len: Integer;
    tick: DWord;
    allTicks: DWord;
  begin
    SetLength(bufSrc, 4096 * 3);
    SetLength(bufTgt, 4096 * 3);
    allTicks := 0;
    repeat
      len := Source.Read(bufSrc[1], SizeOf(bufSrc));
      i := 1;
      k := 1;
      tick := GetTickCount;
      while i <= len do begin
        if Byte(bufSrc[i]) <> Byte(VK_SPACE) then begin
          bufTgt[k] := bufSrc[i];
          Inc(k);
        end;
        Inc(i);
      end;
      Inc(allTicks, GetTickCount - tick);
      if k > 1 then begin
        Target.Write(bufTgt[1], k -1);
      end;
    until len = 0;
    WriteLn(Format('Clean Time: %0.3fs', [allTicks / 1000.0]));
  end;

var
  params: TStrings;
  srcFile: string;
  tgtFile: string;
  fsSource: TFileStream;
  fsTarget: TFileStream;
  tick: DWord;
begin
  params := BuildParamList;
  try
    WriteLn('Clean Spaces...');
    srcFile := params.Values['/source'];
    tgtFile := params.Values['/target'];

    tick := GetTickCount;
    fsSource := TFileStream.Create(srcFile, fmOpenRead or fmShareDenyWrite);
    try
      fsTarget := TFileStream.Create(tgtFile, fmCreate);
      try
        Clean(fsSource, fsTarget);
      finally
        fsTarget.Free;
      end;
    finally
      fsSource.Free;
    end;
    tick := GetTickCount - tick;
    WriteLn(Format('Clean OK, %0.3fs', [tick / 1000.0]));
  finally
    params.Free;
  end;
end;

var
  i: Integer;
begin
  // Insert user code here
  for i := 1 to ParamCount() do begin
    if SameText('/Gen', ParamStr(i)) then begin
      GenTestFile;
      Break;
    end else if SameText('/Clean', ParamStr(i)) then begin
      CleanSpace;
      Break;
    end;
  end;
end.
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/23 11:49:04
21楼： 编译器是如何优化的?你可能认为很高深,其实原理很简单,就是常用操作和函数汇编化,包括微软,gcc intelc 都是如此,比如intelc,你选择cpu型号和程序类型后,intel会有工具帮助打开关闭一个编译指令,就是delphi下 类似指令
{$IFDEF PUREPASCAL}
begin
 //...
end;
{$ELSE !PUREPASCAL}
{$IFDEF SSE}
{$IFDEF CPUX86}
asm
 //...
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
//...
{$ENDIF CPUX64}
{$ELSE !SSE}
 {$IFDEF CPUX86}
asm
 //...
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
//...
{$ENDIF CPUX64}
{$ENDIF !SSE}
{$ENDIF !PUREPASCAL}
这样 编译器就会链接最优那个汇编 
比如Uint28xor 

function U128BitXORSSE(a, b: uint128): uint128;
{$IFDEF CPUX86}
//[eax]->x, [edx]->y , [ecx]->result
ASM
  MOVDQU xmm0,[eax]
  MOVDQU xmm1,[edx]
  pxor xmm0,xmm1
  MOVDQU [ecx],xmm0
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
//[rdx]->x, [r8]->y,[rcx]->result
asm
  MOVDQU xmm0,[rdx]
  MOVDQU xmm1,[r8]
  pxor xmm0,xmm1
  MOVDQU [ecx],xmm0
end;
{$ENDIF CPUX64}

function U128BitXOR(a, b: uint128): uint128;
{$IFDEF CPUX86}
ASM
  push [eax]
  push [eax+4]
  push [eax+8]
  push [eax+12]
  pop [ecx+12]
  pop [ecx+8]
  pop [ecx+4]
  pop [ecx]      //result:=x;
  mov eax,[edx]
  XOR [ecx],eax
  mov eax,[edx+4]
  XOR [ecx+4],eax
  mov eax,[edx+8]
  XOR [ecx+8],eax
  mov eax,[edx+12]
  XOR [ecx+12],eax
end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
asm
  push [rdx]
  push [rdx+8]
  pop [rcx+8]
  pop [rcx] //result:=x;
  mov rax,[r8]
  XOR [rcx],rax
  mov rax,[r8+8]
  XOR [rcx+8],rax
end;
{$ENDIF CPUX64}

function U128BitXORPas(a, b: uint128): uint128;
begin
  Int128Rec(Result).Lo := Int128Rec(a).Lo XOR Int128Rec(b).Lo;
  Int128Rec(Result).Hi := Int128Rec(a).Hi XOR Int128Rec(b).Hi;
end;
这个 可以直接使用sse 的128为 pxor 速度比其它就快得多
---------- 64位 程序 ----------
---------- XOR ----------
开始1亿次 Asm XOR SSE: U= a XOR b  123241234 XOR 456788757 =476219399
1亿次Asm AND SEE 耗费 375 毫秒
----------
开始1亿次 Asm shl: U= a and b  123241234 XOR 456788757 =476219399
1亿次Asm XOR 耗费 827 毫秒
----------
开始1亿次 pascal XOR:U128XORPas(A, B) | U128XORPas(123241234,456788757) =476219399

---------- 32位 程序 ----------
---------- XOR ----------
开始1亿次 Asm XOR SSE: U= a XOR b  123241234 XOR 456788757 =476219399
1亿次Asm AND SEE 耗费 468 毫秒
----------
开始1亿次 Asm shl: U= a and b  123241234 XOR 456788757 =476219399
1亿次Asm XOR 耗费 1061 毫秒
----------
开始1亿次 pascal XOR:U128XORPas(A, B) | U128XORPas(123241234,456788757) =476219399
1亿次pascal XOR 耗费 1872 毫秒

1亿次pascal XOR 耗费 1216 毫秒
现在delphi xe3版本 字符串操作在32位下基本上都汇编话了,但64为严重短缺,这完全是一个苦力活.可能到xe5看才能完善, 微软vs 汇编代码就比delphi全的多,这也是字符串操作很多时候64位比32为慢的原因.理论上大多数数时候64为应该更快的.
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/23 12:06:52
22楼： 就楼主的列子来说,算法上还能不能更快呢?能,如果你是多核超线程cpu
你可以把s分段计算 在多个线程里
TThread.CreateAnonymousThread(
    procedure
    begin
      for i := 0 to   MB div 4 -1 do  move(s[3*i+1],s[2*i+1],size);
    end).start;
TThread.CreateAnonymousThread(
    procedure
    begin
      for j :=  MB div 4 to   MB div 4*2 -1 do  move(s[3*j+1],s[2*j+1],size);
    end).start
......
最后 Tenent.WaitFor 处理结果,估计4核44线程 以上将在1ms以内
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/1/23 13:28:23
23楼： 我还在原来的方法做了改进，可以不加内存空间的，处理含空格6M字符,时间上为0.015秒,不知有么有内存泄露，估计可以改进,其实学无止境


procedure TForm50.SpeedButton5Click(Sender: TObject);
var
  tmpStr: AnsiString;
  d1, d2: TDateTime;
  ts: TStringList;
  pc: PAnsiChar;
  pc1: PAnsiChar;
begin
  ts := TStringList.Create;
  try
    ts.LoadFromFile('c:\b.txt');
    tmpStr := ts.Text;
    //计时
    d1 := now;
    pc1 := @tmpStr[1];
    pc := pc1;
    while (pc1^ <> #0) do
    begin
      if (pc1^ <> #32) then
      begin
        pc^ := pc1^;
        inc(pc);
      end;
      inc(pc1);
    end;
    pc^ := #0;
    d2 := now;
    ts.Text := tmpStr;
    //计时
    ts.SaveToFile('c:\x.txt');
    Caption := FormatDateTime('ss.zzz', d2 - d1);
  finally
    ts.Free;
  end;
end;
----------------------------------------------
-
作者：
男 iamdream (银河恒久远，梦想无止境！) ★☆☆☆☆ -
大贡献会员
2013/1/23 14:02:22
24楼： TStringList打开大文件会比较慢，而且多大文件就得至少占多大内存。
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/1/23 14:08:02
25楼： TStringList不会太慢，20多兆也就一秒
----------------------------------------------
-
作者：
男 iamdream (银河恒久远，梦想无止境！) ★☆☆☆☆ -
大贡献会员
2013/1/23 14:11:11
26楼： TStringList处理几百兆的文件就会明显慢了，当然一般100兆以内没啥问题（和内存大小有关）。
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……
作者：
男 iamdream (银河恒久远，梦想无止境！) ★☆☆☆☆ -
大贡献会员
2013/1/23 14:26:15
27楼： //刚才我的代码用错了SizeOf,应该改为Length，那样写文件非常快：
// (保存为MyClean.dpr, D5~D2010均可以编译)
program MyClean;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  Windows,
  Classes;

function BuildParamList: TStrings;
var
  i: Integer;
begin
  Result := TStringList.Create;
  for i := 1 to ParamCount() do begin
    if Pos('=', ParamStr(i)) > 0 then begin
      Result.Add(ParamStr(i));
    end;
  end;
end;

// command format:  MyClean /Gen /size=1 /outfile=test.txt
procedure GenTestFile;
var
  params: TStrings;
  genSize: Integer;
  genFile: string;
  len: Integer;
  tmp: AnsiString;
  buf: AnsiString;
  idx: Integer;
  tick: DWord;
begin
  params := BuildParamList;
  try
    WriteLn('Generate Testing File...');
    genSize := StrToIntDef(params.Values['/size'], 1) * 1024 * 1024;  //MB
    genFile := params.Values['/outfile'];
    if genFile = '' then begin
      genFile := 'test.txt';
    end;

    len := 0;
    idx := 1;
    SetLength(buf, 4096 * 3);
    Randomize();
    tick := GetTickCount();
    with TFileStream.Create(genFile, fmCreate) do try
      while len < genSize do begin
        tmp := AnsiString(Format('%.2x ', [Random(256)]));
        CopyMemory(@buf[idx], @tmp[1], 3);
        Inc(idx, 3);
        Inc(len, 3);
        if (idx + 3 > Length(buf)) or (len >= genSize) then begin
          Write(buf[1], idx -1);
          idx := 1;
        end;
      end;
    finally
      Free;
    end;
    tick := GetTickCount - tick;
    WriteLn(Format('Generate OK, %0.3fs', [tick / 1000.0])); 
  finally
    params.Free;
  end;
end;

// command format:  MyClean /Clean /Source=a.txt /Target=b.txt
procedure CleanSpace;

  procedure Clean(Source, Target: TStream);
  var
    bufSrc: AnsiString;
    bufTgt: AnsiString;
    i, k: Integer;
    len: Integer;
    tick: DWord;
    allTicks: DWord;
  begin
    SetLength(bufSrc, 4096 * 3);
    SetLength(bufTgt, 4096 * 3);
    allTicks := 0;
    repeat
      len := Source.Read(bufSrc[1], Length(bufSrc));
      i := 1;
      k := 1;
      tick := GetTickCount;
      while i <= len do begin
        { 如果确定是两个字符后跟一个空格，可以直接用PWord^来赋值，速度更快一些
        PWord(@bufTgt[k])^ := PWord(@bufSrc[i])^;
        Inc(i, 3);
        Inc(k, 2);
        }
        if Byte(bufSrc[i]) <> Byte(VK_SPACE) then begin
          bufTgt[k] := bufSrc[i];
          Inc(k);
        end;
        Inc(i);
        //}
      end;
      Inc(allTicks, GetTickCount - tick);
      if k > 1 then begin
        Target.Write(bufTgt[1], k -1);
      end;
    until len = 0;
    WriteLn(Format('Clean Time: %0.3fs', [allTicks / 1000.0]));
  end;

var
  params: TStrings;
  srcFile: string;
  tgtFile: string;
  fsSource: TFileStream;
  fsTarget: TFileStream;
  tick: DWord;
begin
  params := BuildParamList;
  try
    WriteLn('Clean Spaces...');
    srcFile := params.Values['/source'];
    tgtFile := params.Values['/target'];

    tick := GetTickCount;
    fsSource := TFileStream.Create(srcFile, fmOpenRead or fmShareDenyWrite);
    try
      fsTarget := TFileStream.Create(tgtFile, fmCreate);
      try
        Clean(fsSource, fsTarget);
      finally
        fsTarget.Free;
      end;
    finally
      fsSource.Free;
    end;
    tick := GetTickCount - tick;
    WriteLn(Format('Clean OK, %0.3fs', [tick / 1000.0]));
  finally
    params.Free;
  end;
end;

var
  i: Integer;
begin
  // Insert user code here
  for i := 1 to ParamCount() do begin
    if SameText('/Gen', ParamStr(i)) then begin
      GenTestFile;
      Break;
    end else if SameText('/Clean', ParamStr(i)) then begin
      CleanSpace;
      Break;
    end;
  end;
end.
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……
作者：
男 egust (欢迎访问 Delphi@smth.org) ★☆☆☆☆ -
普通会员
2013/1/23 15:08:24
28楼： [quote]就楼主的列子来说,算法上还能不能更快呢?能,如果你是多核超线程cpu
你可以把s分段计算 在多个线程里
TThread.CreateAnonymousThread(
    procedure
    begin
      for i := 0 to   MB div 4 -1 do  move(s[3*i+1],s[2*i+1],size);
    end).start;
TThread.CreateAnonymousThread(
    procedure
    begin
      for j :=  MB div 4 to   MB div 4*2 -1 do  move(s[3*j+1],s[2*j+1],size);
    end).start
......
最后 Tenent.WaitFor 处理结果,估计4核44线程 以上将在1ms以内
[/quote]
您又没搞清楚情况吧？不知道您的“处理结果”是基于怎样的数据和硬件，多大数据量，多大 L2/L3 cache。一个简单的内存读写工作，瓶颈根本就不在 CPU 而是内存，甭管几核几线程都有 RAM 速度在那卡着，频繁切线程切 cache 结果是典型的滥用线程导致速度变慢，要不您试试？
----------------------------------------------
cnblogs中我写的关于Delphi的blog，欢迎访问：
http://www.cnblogs.com/egust/
作者：
男 egust (欢迎访问 Delphi@smth.org) ★☆☆☆☆ -
普通会员
2013/1/23 15:15:06
29楼： 26楼：
TStringList处理几百兆的文件就会明显慢了，当然一般100兆以内没啥问题（和内存大小有关）。



明显有关的是硬盘 IO 啊，10G/s 数量级的内存跟 100M/s 数据级的硬盘比起来都是光速了。换个500M/s 的 ssd，100M 也就 0.2s 就完了，普通硬盘读个 2s 也不奇怪啊
----------------------------------------------
cnblogs中我写的关于Delphi的blog，欢迎访问：
http://www.cnblogs.com/egust/
作者：
男 iamdream (银河恒久远，梦想无止境！) ★☆☆☆☆ -
大贡献会员
2013/1/23 15:30:05
30楼： 呵呵，我平常用的电脑不是太好，如果一下子申请个几百兆内存，还是会明显感觉到速度慢；当然，硬盘更慢，不过，我的代码里清除空格部分是将清除部分与读写文件分开统计的。
其实对此类问题，只须注意不要不断地申请内存就可以了，比如StringReplace就是不断地在拼接字符串及Copy，在遇到大量操作时速度自然慢了。
至于更进一步的优化可能没有太大必要了，除非处理海量数据，不过那样可能考虑的方法就会有本质的不同了。
----------------------------------------------
-广袤璀璨的银河,永无止境的梦想(梦无止境游银河) 博客挂了……
作者：
男 comeheres (tomorrow) ▲▲▲▲▲ -
普通会员
2013/1/23 20:00:25
31楼： 楼上各位都是牛人，新手压力好大……呵呵，可以好好学习一下了，谢谢各位！
----------------------------------------------
业余编程爱好者
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/24 9:09:16
32楼： for egust

测试了一下, 线程还是有效的,多次运行后的总时间更少.字符串变成60m后就明显有优势了.另外字符串大小低于2m时 多次运行后,总时间会小很多,常常低于1ms,分析应该是我的cpu 2级缓存2m,字符串在2级缓存存取.所以你说的是对的,这个列子最大的影响权重是由内存访问次数、访问量、和内存速度。附代码

const
  MB = 1024 * 1024 ;
  threadcount=2;
var
  s, ss: string;
  I: integer;
  Tick: Cardinal;
  len,count: integer;
  events: array of TLightweightEvent;
begin

  s := '';
  Randomize;
  Memo_Output.Lines.Add('----------开始产生60m长字符串----------');
  Tick := GetTickCount;
  for I := 0 to MB - 1 do s := s + Format('%.2x ', [Random(256)]);
  Tick := GetTickCount - Tick;
  //  Memo_Output.Lines.Add(s);
  Memo_Output.Lines.Add(Format('产生字串s: Size: %d, 耗费时间: %d 毫秒', [strsize(s), Tick]));
  Memo_Output.Lines.Add('----------开始删除1m长字符串的空格----------');
  ss := s; //保存s
  len := length(s) * 2 div 3;

    Tick := GetTickCount;
  for I := 0 to MB - 1 do move(s[3 * I + 1], s[2 * I + 1], 2 * StringElementSize(s));
  setlength(s, len);
  Tick := GetTickCount - Tick;
  //    Memo_Output.Lines.Add(s);
  Memo_Output.Lines.Add(Format('删除字串s空格: Size: %d, 耗费时间: %d 毫秒', [strsize(s), Tick]));
//多线程删除空格
  s := ss; //恢复s
  setlength(events, threadcount);
  count:= MB div threadcount;
  try
    //    Tick := GetTickCount;
    for I := 0 to threadcount - 1 do
    begin
      events[I] := TLightweightEvent.Create;
      events[I].ResetEvent;
    end;
    Tick := GetTickCount;

    TThread.CreateAnonymousThread(
      procedure
      var
        I: integer;
      begin
        for I := 0 to count - 1 do move(s[3 * I + 1], s[2 * I + 1], 2 * StringElementSize(s));
        events[0].SetEvent;
      end).Start;
    TThread.CreateAnonymousThread(
      procedure
      var
        I: integer;
      begin
        for I := count  to 2*count - 1 do move(s[3 * I + 1], s[2 * I + 1], 2 * StringElementSize(s));
        events[1].SetEvent;
      end).Start;
//
//    TThread.CreateAnonymousThread(
//      procedure
//      var
//        I: integer;
//      begin
//        for I := 2*count to 3*count - 1 do move(s[3 * I + 1], s[2 * I + 1], 2 * StringElementSize(s));
//        events[2].SetEvent;
//      end).Start;
//    TThread.CreateAnonymousThread(
//      procedure
//      var
//        I: integer;
//      begin
//        for I := 3*count  to 4*count - 1 do move(s[3 * I + 1], s[2 * I + 1], 2 * StringElementSize(s));
//        events[3].SetEvent;
//      end).Start;
//
//    TThread.CreateAnonymousThread(
//      procedure
//      var
//        I: integer;
//      begin
//        for I := 4*count to 5*count - 1 do move(s[3 * I + 1], s[2 * I + 1], 2 * StringElementSize(s));
//        events[4].SetEvent;
//      end).Start;
//    TThread.CreateAnonymousThread(
//      procedure
//      var
//        I: integer;
//      begin
//        for I := 5*count  to 6*count - 1 do move(s[3 * I + 1], s[2 * I + 1], 2 * StringElementSize(s));
//        events[5].SetEvent;
//      end).Start;

   for i := 0 to threadcount-1 do
    if events[i].WaitFor(3000) <> wrSignaled then
    begin
      Memo_Output.Lines.Add(inttostr(i)+'号线程3秒超时或错误');
      exit;
    end;
     setlength(s, len);
    Tick := GetTickCount - Tick;
//        Memo_Output.Lines.Add(s);
    Memo_Output.Lines.Add(Format(inttostr(threadcount)+'线程删除字串s空格: Size: %d, 耗费时间: %d 毫秒', [strsize(s), Tick]));
  finally
    for I := 0 to High(events) do events[I].Free;
    setlength(events, 0);
  end;
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/24 9:11:14
33楼： ----------开始产生6m长字符串----------
产生字串s: Size: 6291456, 耗费时间: 811 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 4194304, 耗费时间: 32 毫秒
2线程删除字串s空格: Size: 4194304, 耗费时间: 15 毫秒
----------开始产生6m长字符串----------
产生字串s: Size: 6291456, 耗费时间: 905 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 4194304, 耗费时间: 16 毫秒
2线程删除字串s空格: Size: 4194304, 耗费时间: 16 毫秒
----------开始产生6m长字符串----------
产生字串s: Size: 6291456, 耗费时间: 951 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 4194304, 耗费时间: 16 毫秒
2线程删除字串s空格: Size: 4194304, 耗费时间: 16 毫秒
----------开始产生6m长字符串----------
产生字串s: Size: 6291456, 耗费时间: 904 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 4194304, 耗费时间: 31 毫秒
2线程删除字串s空格: Size: 4194304, 耗费时间: 16 毫秒
----------开始产生6m长字符串----------
产生字串s: Size: 6291456, 耗费时间: 873 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 4194304, 耗费时间: 15 毫秒
2线程删除字串s空格: Size: 4194304, 耗费时间: 15 毫秒
----------开始产生6m长字符串----------
产生字串s: Size: 6291456, 耗费时间: 889 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 4194304, 耗费时间: 47 毫秒
2线程删除字串s空格: Size: 4194304, 耗费时间: 16 毫秒
----------开始产生6m长字符串----------
产生字串s: Size: 6291456, 耗费时间: 874 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 4194304, 耗费时间: 16 毫秒
2线程删除字串s空格: Size: 4194304, 耗费时间: 15 毫秒
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/24 9:12:56
34楼： ----------开始产生60m长字符串----------
产生字串s: Size: 62914560, 耗费时间: 8471 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 41943040, 耗费时间: 265 毫秒
2线程删除字串s空格: Size: 41943040, 耗费时间: 156 毫秒
----------开始产生60m长字符串----------
产生字串s: Size: 62914560, 耗费时间: 8799 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 41943040, 耗费时间: 234 毫秒
2线程删除字串s空格: Size: 41943040, 耗费时间: 156 毫秒
----------开始产生60m长字符串----------
产生字串s: Size: 62914560, 耗费时间: 8752 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 41943040, 耗费时间: 218 毫秒
2线程删除字串s空格: Size: 41943040, 耗费时间: 156 毫秒
----------开始产生60m长字符串----------
产生字串s: Size: 62914560, 耗费时间: 8721 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 41943040, 耗费时间: 250 毫秒
2线程删除字串s空格: Size: 41943040, 耗费时间: 171 毫秒
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 bmsr (白忙剩人) ★☆☆☆☆ -
普通会员
2013/1/24 9:13:59
35楼： ----------开始产生1m长字符串----------
产生字串s: Size: 1048572, 耗费时间: 125 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 699048, 耗费时间: 15 毫秒
2线程删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
----------开始产生1m长字符串----------
产生字串s: Size: 1048572, 耗费时间: 156 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
2线程删除字串s空格: Size: 699048, 耗费时间: 16 毫秒
----------开始产生1m长字符串----------
产生字串s: Size: 1048572, 耗费时间: 156 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
2线程删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
----------开始产生1m长字符串----------
产生字串s: Size: 1048572, 耗费时间: 156 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
2线程删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
----------开始产生1m长字符串----------
产生字串s: Size: 1048572, 耗费时间: 156 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
2线程删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
----------开始产生1m长字符串----------
产生字串s: Size: 1048572, 耗费时间: 141 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
2线程删除字串s空格: Size: 699048, 耗费时间: 16 毫秒
----------开始产生1m长字符串----------
产生字串s: Size: 1048572, 耗费时间: 141 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
2线程删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
----------开始产生1m长字符串----------
产生字串s: Size: 1048572, 耗费时间: 140 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
2线程删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
----------开始产生1m长字符串----------
产生字串s: Size: 1048572, 耗费时间: 140 毫秒
----------开始删除1m长字符串的空格----------
删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
2线程删除字串s空格: Size: 699048, 耗费时间: 0 毫秒
----------------------------------------------
http://blog.sina.com.cn/bmsrnote
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/1/24 10:02:59
36楼： 我用  23楼  的方法测73兆（(75,376,310 字节）花141毫秒,改在台式机上70毫秒,我觉楼上的可能高深了，我觉一维数组判断不是空格的就往前填就是了，一次遍历
----------------------------------------------
-
作者：
男 mondaywoo (mondaywoo) ★☆☆☆☆ -
普通会员
2013/1/24 17:03:32
37楼： 學習學習
----------------------------------------------
-
作者：
男 linkyang (linkyang) ★☆☆☆☆ -
普通会员
2013/1/26 23:01:48
38楼： 拜读了，真的都是高手啊！
----------------------------------------------
-
作者：
男 zjp1314flx (zjp1314flx) ▲▲▲▲▲ -
普通会员
2013/2/5 17:42:09
39楼：

高手好多
----------------------------------------------
-
作者：
男 silverbullet (Silver Bulelt) ▲▲▲▲▲ -
普通会员
2013/2/10 21:22:49
40楼： 坐视楼上各位大牛将问题复杂化……
平时做程序如果有哪些模块需要提高效率的，就直接用C去写动态链接库了……
----------------------------------------------
Just do it!
作者：
男 lin_xx (woody) ★☆☆☆☆ -
普通会员
2013/2/18 10:50:15
41楼： Try it
----------------------------------------------
我爱2CCC.COM~~~
MSN:linxx2008#hotmail.com
Mail:Woody.Lin#dg.gigabyte.com.cn
作者：
男 jiucenglou (九层楼) ★☆☆☆☆ -
普通会员
2013/10/25 21:13:11
42楼： 请问hq200306、如果要替换的不是空格、而是一个字串、针对这种需要查找子字串的情况、也可以空间换时间吗？能请您给一个实例吗？谢谢！
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/10/26 8:16:54
43楼： 我在xe5下试了下TPerlRegEx和StringReplace都比较慢，全文替换1M文本，TPerlRegEx要花24秒，StringReplace要花8秒，写了个简易方法，只要0.05秒就能完成，但用到是xe5的pos函数，之前的版本可能有问题

function myReplaceStr(const st, oldSubstr, newSubStr: string): string;
var
  idx, len: Integer;
  iStart: Integer;
  sb: TStringBuilder;
begin
  len := Length(oldSubstr);
  iStart := 1;
  sb := TStringBuilder.Create;
  try
    repeat
      idx := Pos(oldSubstr, st, iStart);
      if idx > 0 then
      begin
        sb.Append(Copy(st, iStart, idx - iStart));
        sb.Append(newSubStr);
        iStart := idx + len;
      end;
    until idx <= 0;
    sb.Append(Copy(st, iStart, length(st)));
    Result := sb.ToString;
  finally
    sb.Free;
  end;
end;
----------------------------------------------
-
作者：
男 jiucenglou (九层楼) ★☆☆☆☆ -
普通会员
2013/10/26 18:52:00
44楼： 谢谢hq200306的时间和帮助！您能讲一下xe5的pos函数可能出问题的大致原因吗？
----------------------------------------------
-
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/10/26 20:45:35
45楼： 我的意思不是pos函数本身的问题，之前delphi自带的pos只有有两个参数，没有没有第三个参数，xe5这版有第三个参数，如果用早期的版开发，可以将xe5的pos函数复制来用。上面的方法只能参考下，估计还有更好的方法。有时发现emb的有些类库实在效率太低了，只能自己改改
----------------------------------------------
-
作者：
男 jiucenglou (九层楼) ★☆☆☆☆ -
普通会员
2013/10/28 14:48:44
46楼： 谢谢hq200306的热心帮助！
----------------------------------------------
-
作者：
男 sephil (NAILY Soft) ★☆☆☆☆ -
盒子中级会员
2013/10/28 15:26:42
46楼： 如果你的格式就是 XX XX XX 这样很简单的规则，
那就没必要用Pos、Replace什么的，每隔2个字符删除1个字符即可

以下代码，3M文件，15ms
注意测试文件编码为ANSI，最后一个字符是空格，如果不是需要修改下
“45 90 21 13 93 24 ”
=>
“459021139324”

var
  I, Ticks: Cardinal;
  S, D: PByte;
begin
  with TMemoryStream.Create do
  try
    LoadFromFile('C:\Users\凡\Desktop\1.txt');
    S := PByte(Memory) + 3;
    D := PByte(Memory) + 2;
    Ticks := GetTickCount;
    for I := 1 to Size div 3 do
    begin
      Move(S^, D^, 2);
      Inc(S, 3);
      Inc(D, 2);
    end;
    Size := Size div 3 * 2;
    Ticks := GetTickCount - Ticks;
    Caption := IntToStr(Ticks);
    SaveToFile('C:\Users\凡\Desktop\2.txt');
  finally
    Free;
  end;
end;
----------------------------------------------
Copyright 2008 ? NAILY Soft

Click here to redirect to my home
Click here to redirect to my blog
作者：
男 sephil (NAILY Soft) ★☆☆☆☆ -
盒子中级会员
2013/10/28 15:39:52
47楼： 又做了下测试，12M文件也是15ms
才想起来，GetTickCount最小只能精确到15~16ms
也就是说十几M的文件没用到15ms
24M则用了57ms
----------------------------------------------
Copyright 2008 ? NAILY Soft

Click here to redirect to my home
Click here to redirect to my blog
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/10/28 16:25:54
48楼： 回sephil (NAILY Soft)，42楼所问的是全文字符串替换的问题了，并不是替换空格，恰好我无聊拿了玩一下，sephil (NAILY Soft)也可以玩一下
----------------------------------------------
-
作者：
男 jiucenglou (九层楼) ★☆☆☆☆ -
普通会员
2013/10/28 17:29:08
49楼： 谢谢sephil的方法，很有建设性，效率很高，佩服一下！
像hq200306提到的、如果是替换字符串、而非单个字符，请问您会怎样做、达到如此高效？
----------------------------------------------
-
作者：
男 wzwcn (wzw) ★☆☆☆☆ -
普通会员
2013/10/28 18:01:32
50楼： 我的方法很简单,应该也不太慢:
function strip_space(const sstr:string):string;
var rp,p:PChar;
    len,i:Integer;
begin
  len:=length(sstr);
  rp:=GetMem(len);
  try
    p:=rp;
    for i:=1 to len do
    begin
      if sstr[i]<>#32 then
      begin
        p^:=sstr[i];
        inc(p);
      end;
    end;
    result:=rp;
  finally
    FreeMem(rp);
  end;
end;
----------------------------------------------
-
作者：
男 ruralboy (青瓜白菜番茄红) ★☆☆☆☆ -
盒子活跃会员
2013/10/28 19:05:58
50楼： sephil 兄, 程序启动后加入这个 API 就可以获得精确时间

timeBeginPeriod(1);
----------------------------------------------
作者：
男 ruralboy (青瓜白菜番茄红) ★☆☆☆☆ -
盒子活跃会员
2013/10/28 22:44:52
51楼： 不定字符串替换只能用 POS 搜索定位.

POS 的性能很神奇,不要小看它.下面是个性能测试:

参测成员:

  记事本

  windows 写字板

  DELPHI POS 测试程序

测试文本: 
  将 DELPHI 包含的 Variants.pas 单元的内容复制 360 份,得到一个 62M 的 Txt 文件.

测试结果
  记事本 3秒
  windows 写字板 6秒
  DELPHI POS 测试程序 0.047秒


备注:

测试 CPU 为 I5 3450.

写字板的评测不准确,因其界面的响应有 1-2 秒延迟,所谓界面的响应指的是打开文件后,按下 CTRL + END 键让输入焦点转移到文件后.这方面记事本没有任何延迟.

DELPHI POS 程序程序代码如下:


procedure TForm1.btn1Click(Sender: TObject);
var
  t: Cardinal;
  s: string;
  sl: TStringlist;
begin
  sl := Tstringlist.Create;
  sl.LoadFromFile('C:\Users\Ruralist\Desktop\123.txt');
  s := sl.Text;
  sl.free;
  t := GetTickCount;
  if pos('"要查询的字符串!"', s) > 0 then caption := IntToStr(GetTickCount - t);

end;


POS 函数源码如下: 

// 看不懂:)

procedure       _Pos{ substr : ShortString; s : ShortString ) : Integer};
asm
{     ->EAX     Pointer to substr          }
{       EDX     Pointer to string          }
{     <-EAX     Position of substr in s or 0    }

        PUSH    EBX
        PUSH    ESI
        PUSH    EDI

        MOV     ESI,EAX { Point ESI to substr          }
        MOV     EDI,EDX { Point EDI to s          }

        XOR     ECX,ECX { ECX = Length(s)          }
        MOV     CL,[EDI]
        INC     EDI          { Point EDI to first char of s  }

        PUSH    EDI          { remember s position to calculate index        }

        XOR     EDX,EDX { EDX = Length(substr)          }
        MOV     DL,[ESI]
        INC     ESI          { Point ESI to first char of substr     }

        DEC     EDX          { EDX = Length(substr) - 1          }
        JS      @@fail  { < 0 ? return 0          }
        MOV     AL,[ESI]        { AL = first char of substr          }
        INC     ESI          { Point ESI to 2'nd char of substr      }

        SUB     ECX,EDX { #positions in s to look at    }
          { = Length(s) - Length(substr) + 1      }
        JLE     @@fail
@@loop:
        REPNE   SCASB
        JNE     @@fail
        MOV     EBX,ECX { save outer loop counter          }
        PUSH    ESI          { save outer loop substr pointer        }
        PUSH    EDI          { save outer loop s pointer          }

        MOV     ECX,EDX
        REPE    CMPSB
        POP     EDI          { restore outer loop s pointer  }
        POP     ESI          { restore outer loop substr pointer     }
        JE      @@found
        MOV     ECX,EBX { restore outer loop counter    }
        JMP     @@loop

@@fail:
        POP     EDX          { get rid of saved s pointer    }
        XOR     EAX,EAX
        JMP     @@exit

@@found:
        POP     EDX          { restore pointer to first char of s    }
        MOV     EAX,EDI { EDI points of char after match        }
        SUB     EAX,EDX { the difference is the correct index   }
@@exit:
        POP     EDI
        POP     ESI
        POP     EBX
end;
----------------------------------------------
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/10/28 22:54:10
52楼： 我写了个纯pas的pos函数,麻烦楼上测一下比汇编慢多少
function posX(const subStr, st: string; iStart: Integer): Integer;
var
  i, j, k: Integer;
  len1, len2: Integer;
begin
  if (subStr = '') or (iStart <= 0) then
  begin
    Result := 0;
    exit;
  end;

  len1 := Length(subStr);
  len2 := Length(st);

  for j := iStart to len2 do
  begin
    k := j;
    for i := 1 to len1 do
    begin
      if subStr[i] <> st[k] then
        break;
      inc(k);
      if k > len2 then
        Break;
    end;

    if i = len1 then
    begin
      exit(j);
    end;
  end;

  Result := 0;
end;
----------------------------------------------
-
作者：
男 ruralboy (青瓜白菜番茄红) ★☆☆☆☆ -
盒子活跃会员
2013/10/28 23:25:13
53楼： 做了一些修改. Exit(j); 为 Exit; result := 0 删除了

测试结果在 0.125 至 0.145 之间徘徊.

顺便多测试了 POS, 在 0.031-0.045 之间徘徊
----------------------------------------------
作者：
男 ruralboy (青瓜白菜番茄红) ★☆☆☆☆ -
盒子活跃会员
2013/10/28 23:36:43
54楼： 其实不一定要汇编,普通的 Pascal 也挺快, StrUtils.pas 的 PosEx 也徘徊在0.030-0.045 之间.


function PosEx(const SubStr, S: string; Offset: Cardinal = 1): Integer;
var
  I,X: Integer;
  Len, LenSubStr: Integer;
begin
  if Offset = 1 then
    Result := Pos(SubStr, S)
  else
  begin
    I := Offset;
    LenSubStr := Length(SubStr);
    Len := Length(S) - LenSubStr + 1;
    while I <= Len do
    begin
      if S[I] = SubStr[1] then
      begin
        X := 1;
        while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
          Inc(X);
        if (X = LenSubStr) then
        begin
          Result := I;
          exit;
        end;
      end;
      Inc(I);
    end;
    Result := 0;
  end;
end;
----------------------------------------------
作者：
男 sephil (NAILY Soft) ★☆☆☆☆ -
盒子中级会员
2013/10/29 10:16:46
55楼： @hq200306 
哦，我还说这么个问题怎么整得这么复杂

@ruralboy
按此在新窗口浏览图片
----------------------------------------------
Copyright 2008 ? NAILY Soft

Click here to redirect to my home
Click here to redirect to my blog
作者：
男 hq200306 (200306) ★☆☆☆☆ -
普通会员
2013/10/29 11:43:12
56楼： 这是涉及全文替换算法问题，如果要替换文件小无所谓，几兆到几百兆就看算法了，delphi自带的pos速度还是很快的,我试了下100兆调用pos某内容,自己纯写pascal的方法,计算时间至少要比他多一倍
----------------------------------------------
-
作者：
男 err0rc0de (code) ▲▲▲▲△ -
普通会员
2013/10/29 14:41:32
57楼： Pos请gg/baidu算法: BM/BMH/sunday
replace: 新申请出新块，直接写入，而不是Move

N年前DFW有讨论过这类问题了。
----------------------------------------------
-
作者：
男 sxqwhxq (步惊云) ★☆☆☆☆ -
普通会员
2013/10/29 16:48:37
58楼： 如果每个程序员都像前面几位大师对代码精益求精，这世界再也不会臃肿不堪了。
----------------------------------------------
-
作者：
男 kazarus (kazarus) ★☆☆☆☆ -
普通会员
2013/10/29 21:18:06
59楼： mark
----------------------------------------------
-
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行160.1563毫秒 RSS