高分寻求支持中文的快速字符串操作函数(加大富翁300分)

Question

寻求下列函数,速度第一,当然不能出错,要支持中文
    判断字符串A在字符串B中出现的次数
    f('aabbccaaabbbcccaaaabbbbcccc','aa')=4
    取得字符串A中字符串B之前的字符串
    f('abc','b')='a'
    取得字符串A中字符串B之后的字符串
    f('abc','b')='c'
    取得字符串A中字符串B和字符串C之间的字符串(不包含字符串B和字符串C)
    f('abc','a','c')='c'
    获取字符串A中最后一个字符串B后面的字符串值,并且返回这个字符串间隔符B的起始位置
    f('abcabc','b',s)=5 s='c'
    获取字符串A中最后一个字符串B前面的字符串值,并且返回这个字符串间隔符B的起始位置
    f('abcabc','b',s)=5 s='abca'
    快速替换函数,类似StringReplace
    FastReplace    读取字符串A中字符串B与字符串C之间的的字符到列表(TStrings)中
    f('aacabcacc','a','c',aList)=3 aList='a','b','c'
    批替换函数:
    根据分界符找('a','c')到要替换的字符串并替换成相应的值,利用上面的函数.
    aList中的Names值在源字符串中的排列是按顺序的(上面的函数取出的)
    aList.Names[0]:='a';
    aList.Names[1]:='b';
    aList.Names[2]:='c';
    aList.Strings[0]:='x';
    aList.Strings[1]:='y';
    aList.Strings[2]:='z';
    f('aacabcacc','a','c',aList)='axcaycazc'哪位收藏有的话请发给我一份,谢谢
[email protected]
大富翁论坛的300分在
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1638520

Answer 1

>>  取得字符串A中字符串B和字符串C之间的字符串(不包含字符串B和字符串C)
>>  f('abc','a','c')='c'
  按你的说法，f(A, B, C) 应该等于字符串'b'才对，怎么是:'c'

Answer 2

谢谢copy_paste,一时大意写错了

Answer 3

累啊不知有没错，感觉没什么错,:D:D:D:D
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}
const
  MAX_CHAR = 256;
  SizeInt = SizeOf(Integer);type
  PByteArr = ^TByteArr;
  TByteArr = array [0..MaxInt - 1] of Byte;
  PCharArr = ^TCharArr;
  TCharArr = array [0..MaxInt - 1] of Char;
  TFoundPos = function(Position: Integer; Param: Pointer): Boolean; 
  
{
  TextStr       查找的源字串
  SubStr        查找的子串
  IgnoreCase    True：不区别子串
  FoundPos      回调，当查找到后调用，参数为对应的子串起始位置，并确定循环是否继续
  FoundParam    为回调FoundPos的参数.
  Result        子串的个数
}  
function FindSubPos(const TextStr, SubStr: string; IgnoreCase: Boolean; 
  FoundPos: TFoundPos; Param: Pointer): Integer;
var
  Text, Sub: PByte;
  Buffer: array [0..MAX_CHAR - 1] of Integer;
  I, J, CurrPos, SubLen, TextLen: Integer;
begin
  Result := 0;
  SubLen := Length(SubStr);
  TextLen := Length(TextStr);
  if SubLen > TextLen then
    Exit;  Sub := @SubStr[1];
  Text := @TextStr[1];  if IgnoreCase then
  begin
    GetMem(Sub, SubLen);
    Move(SubStr[1], Sub^, SubLen);
    Sub := PByte(StrUpper(PChar(Sub)));
  end;  for I := 0 to MAX_CHAR - 1 do
    Buffer[I] := SubLen;
  for I := 0 to SubLen - 2 do
    Buffer[PByteArr(Sub)^[I]] := SubLen - I - 1;  CurrPos := SubLen - 1;
  try
    while CurrPos < TextLen do
    begin
      //'aabcaaabcaaaab','aa'
      I := CurrPos;
      J := SubLen - 1;
      while (J >= 0) and
        ((PByteArr(Text)^[I] = PByteArr(Sub)^[J]) or
         (IgnoreCase and (UpCase(PCharArr(Text)^[I]) = PCharArr(Sub)^[J]))) do
      begin
        Dec(J);
        Dec(I);
      end;
      if -1 = J then
      begin
        Inc(Result);
        if Assigned(FoundPos) then
          if not FoundPos(CurrPos - SubLen + 2, Param) then break;
        Inc(CurrPos, SubLen);
      end else
      begin
        if IgnoreCase then
          Inc(CurrPos, Buffer[Byte(UpCase(PCharArr(Text)^[CurrPos]))])
        else
          Inc(CurrPos, Buffer[PByteArr(Text)^[CurrPos]]);
      end;
    end;
  finally
    if IgnoreCase then
      FreeMem(Sub);
  end;
end;   { 判断字符串A在字符串B中出现的次数
  f('aabbccaaabbbcccaaaabbbbcccc','aa')=4 }
function GetSubCount(const Source, Sub: string): Integer;
begin
  Result := FindSubPos(Source, Sub, False, nil, nil);
end;   function FoundSub(Position: Integer; Param: PInteger): Boolean; 
begin
  Result := False;
  Param^ := Position;
end;{ 取得字符串A中字符串B之前的字符串
  f('abc','b')='a'}
function GetPredSub(const Source, Sub: string; Index: Integer = 0): string;
var
  Count, Position: Integer;  
begin           
  Count := FindSubPos(Source, Sub, False, @FoundSub, @Position);
  Result := '';
  if (Count > 0) and (Position > 0) then
    Result := Copy(Source, 1, Position - 1);  
end;{ 取得字符串A中字符串B之后的字符串
  f('abc','b')='c' }
function GetSuccSub(const Source, Sub: string; Index: Integer = 0): string;
var
  Count, Position: Integer;  
begin           
  Count := FindSubPos(Source, Sub, False, @FoundSub, @Position);
  if (Count > 0) and (Position > 0) then
    Result := Copy(Source, Position + 1, MaxInt)
  else
    Result := Source;
end;{ 快速替换函数,类似StringReplace
  FastReplace }    
function FoundReplace(Position: Integer; Stream: TStream): Boolean;
begin
  Result := True;
  Stream.WriteBuffer(Position, SizeInt);
end;function StringReplace(const S, OldPattern, NewPattern: string;
  IgnoreCase: Boolean; ReplaceCount: PInteger = nil): string;
var
  R: PChar;
  P: PCharArr;
  PPos: PInteger;
  Stream: TMemoryStream;
  CurrPos, Count, RetLen, OldLen, NewLen, SourceLen: Integer;
begin
  Stream := TMemoryStream.Create;
  try
    Count := FindSubPos(S, OldPattern, IgnoreCase, @FoundReplace, Stream);
    if Assigned(ReplaceCount) then
      ReplaceCount^ := Count;
    if Count = 0 then Exit;    P := @S[1];
    PPos := Stream.Memory;
    OldLen := Length(OldPattern);
    NewLen := Length(NewPattern);
    CurrPos := 0;
    SourceLen := Length(S);
    SetLength(Result, SourceLen - OldLen * Count + NewLen * Count);
    R := @Result[1];
    while Count > 0 do
    begin
      RetLen := PPos^ - CurrPos - 1;
      if RetLen > 0 then
      begin
        Move(P^[CurrPos], R^, RetLen);
        Inc(R, RetLen);
      end;
      if NewLen > 0 then
      begin
        Move(NewPattern[1], R^, NewLen);
        Inc(R, NewLen);
      end;
      Inc(CurrPos, RetLen + OldLen);
      Inc(PPos);
      Dec(Count);
    end;    if CurrPos <> SourceLen then
      Move(P^[CurrPos], R^, SourceLen - CurrPos);
  finally
    Stream.Free;
  end;
end;  {     
  取得字符串A中字符串B和字符串C之间的字符串(不包含字符串B和字符串C)
  f('abc','a','c')='b'
}
function GetBetween(const Source, Front, Last: string): string;
var
  Count, FrontPos, LastPos: Integer;
begin
  Result := '';
  Count := FindSubPos(Source, Front, False, @FoundSub, @FrontPos);
  if (Count > 0) and (FrontPos > 0) then
  begin
    Count := FindSubPos(Source, Last, False, @FoundSub, @LastPos);
    if (Count > 0) and (LastPos > 0) then
    begin
      Count := FrontPos + Length(Front);
      Result := Copy(Source, Count, LastPos - Count);
    end;
  end;
end;
  
{ 获取字符串A中最后一个字符串B后面的字符串值,并且返回这个字符串间隔符B的起始位置
  f('abcabc','b',s)=5 s='c' }  
function FoundLast(Position: Integer; Param: PInteger): Boolean; 
begin
  Result := True;
  Param^ := Position;
end;function GetLastSub(const Source, Sub: string; var Last: string): Integer;
var
  Count: Integer;
begin
  Last := '';
  Result := 0;
  Count := FindSubPos(Source, Sub, False, @FoundLast, @Result);
  if (Count > 0) and (Result <> 0) then
    Last := Copy(Source, Result + Length(Sub), MaxInt);
end;{ 获取字符串A中最后一个字符串B前面的字符串值,并且返回这个字符串间隔符B的起始位置
  f('abcabc','b',s)=5 s='abca'}
function GetLastFront(const Source, Sub: string; var Front: string): Integer;
var
  Count: Integer;
begin
  Front := '';
  Result := 0;
  Count := FindSubPos(Source, Sub, False, @FoundLast, @Result);
  if (Count > 0) and (Result <> 0) then
    Front := Copy(Source, 1, Result - 1);
end;procedure TForm1.Button1Click(Sender: TObject);  procedure Add(const S: string);
  begin
    Memo1.Lines.Add(S);
  end;var
  S: string; 
  Index: Integer; 
begin
  Add(Format('GetSubCount: %d', [GetSubCount('aabcaaabcaaaab','aa')]));
  //判断字符串A在字符串B中出现的次数
  //f('aabbccaaabbbcccaaaabbbbcccc','aa')=4  Add(Format('GetPredSub: %s', [GetPredSub('abc', 'b')]));
  //  取得字符串A中字符串B之前的字符串
  //  f('abc','b')='a'  Add(Format('GetSuccSub: %s', [GetSuccSub('abc', 'b')]));
  //  取得字符串A中字符串B之后的字符串
  //  f('abc','b')='c'  Add(Format('GetBetween: %s', [GetBetween('abc', 'a', 'c')]));
  //  取得字符串A中字符串B和字符串C之间的字符串(不包含字符串B和字符串C)
  //  f('abc','a','c')='c'  Index := GetLastSub('abcabc', 'b', S);
  Add(Format('GetLastSub Index: %d, sub: %s', [Index, S]));
  //  获取字符串A中最后一个字符串B后面的字符串值,并且返回这个字符串间隔符B的起始位置
  //  f('abcabc','b',s)=5 s='c'  Index := GetLastFront('abcabc','b', s);
  Add(Format('GetLastFront Index: %d, sub: %s', [Index, S]));
  //  获取字符串A中最后一个字符串B前面的字符串值,并且返回这个字符串间隔符B的起始位置
  //  f('abcabc','b',s)=5 s='abca'  S := StringReplace('我是穷苦大众的Delphi人', 'Delphi', 'Borland', False);
  Add(StringReplace(S, '穷苦', '幸福', False));  
end;

Answer 4

这个BM算法我DFW发过，我找了些BUG，不错现在我在DFW不能发言，所以也没办法修改了，以后再说，你看看有什么问题。

Answer 5

万分感谢!星期一上班马上测试.
DFW上的copy_paste就是您吧,高人呀,呵

Answer 6

真倒霉啊，本来马甲还能用，想着没事看看yysun的那账号确认的贴，一不小心点了确认账号的链连，真是，，，真是，，，马甲也壮烈了俺只能在这回贴了那GetBetweenString有个小问题，如下：
原：
      ...
      if FirstPos <> -1 then
      begin
        LastPos := FindMatchIndex(LastSub, LastBuffer, LastLen, CurrPos + FirstLen);
改：
if FirstPos <> -1 then
      begin
        LastPos := FindMatchIndex(LastSub, LastBuffer, LastLen, FirstPos + FirstLen);俺是对DFW没辄了....