rm_jclstrings.pas.~1~

这是一个功能强大

      if N >= 0 then
      begin
        Inc(I);
        Val := Val * 8 + N;
      end;
      if I < Len then
      begin
        N := Pos(S[I + 1], OctDigits) - 1;
        if N >= 0 then
        begin
          Inc(I);
          Val := Val * 8 + N;
        end;
      end;
    end;

    if val > 255 then
      {$IFDEF CLR}
      raise EJclStringError.Create(RsNumericConstantTooLarge);
      {$ELSE}
      raise EJclStringError.CreateRes(@RsNumericConstantTooLarge);
      {$ENDIF CLR}

    Result := Result + Chr(Val);
  end;

begin
  Result := '';
  I := 1;
  Len := Length(S);
  while I <= Len do
  begin
    if not ((S[I] = '\') and (I < Len)) then
      Result := Result + S[I]
    else
    begin
      Inc(I); // Jump over escape character
      case S[I] of
        'a':
          Result := Result + AnsiBell;
        'b':
          Result := Result + AnsiBackspace;
        'f':
          Result := Result + AnsiFormFeed;
        'n':
          Result := Result + AnsiLineFeed;
        'r':
          Result := Result + AnsiCarriageReturn;
        't':
          Result := Result + AnsiTab;
        'v':
          Result := Result + AnsiVerticalTab;
        '\':
          Result := Result + '\';
        '"':
          Result := Result + '"';
        '''':
          Result := Result + ''''; // Optionally escaped
        '?':
          Result := Result + '?';  // Optionally escaped
        'x':
          if I < Len then
            // Start of hex escape sequence
            HandleHexEscapeSeq
          else
            // '\x' at end of string is not escape sequence
            Result := Result + '\x';
        '0'..'7':
          // start of octal escape sequence
          HandleOctEscapeSeq;
      else
        // no escape sequence
        Result := Result + '\' + S[I];
      end;
    end;
    Inc(I);
  end;
end;

function StrLower(const S: string): string;
begin
  Result := S;
  StrLowerInPlace(Result);
end;

procedure StrLowerInPlace(var S: string);
{$IFDEF PIC}
begin
  StrCase(S, AnsiLoOffset);
end;
{$ELSE}
assembler;
asm
        // StrCase(S, AnsiLoOffset)

        XOR     EDX, EDX         // MOV     EDX, LoOffset
        JMP     StrCase
end;
{$ENDIF PIC}

{$IFNDEF CLR}
procedure StrLowerBuff(S: PChar);
{$IFDEF PIC}
begin
  StrCaseBuff(S, AnsiLoOffset);
end;
{$ELSE}
assembler;
asm
        // StrCaseBuff(S, LoOffset)
        XOR     EDX, EDX                // MOV     EDX, LoOffset
        JMP     StrCaseBuff
end;
{$ENDIF PIC}
{$ENDIF ~CLR}

{$IFDEF CLR}
procedure MoveString(const Source: string; SrcIndex: Integer;
  var Dest: string; DstIndex, Count: Integer);
begin
  Dec(SrcIndex);
  Dec(DstIndex);
  Dest := Dest.Remove(DstIndex, Count).Insert(DstIndex, Source.Substring(SrcIndex, Count));
end;
{$ENDIF CLR}

procedure StrMove(var Dest: string; const Source: string;
  const ToIndex, FromIndex, Count: Integer);
begin
  // Check strings
  if (Source = '') or (Length(Dest) = 0) then
    Exit;

  // Check FromIndex
  if (FromIndex <= 0) or (FromIndex > Length(Source)) or
     (ToIndex <= 0) or (ToIndex > Length(Dest)) or
     ((FromIndex + Count - 1) > Length(Source)) or ((ToIndex + Count - 1) > Length(Dest)) then
     { TODO : Is failure without notice the proper thing to do here? }
     Exit;

  // Move
  {$IFDEF CLR}
  MoveString(Source, FromIndex, Dest, ToIndex, Count);
  {$ELSE}
  Move(Source[FromIndex], Dest[ToIndex], Count);
  {$ENDIF CLR}
end;

function StrPadLeft(const S: string; Len: Integer; C: Char): string;
var
  L: Integer;
begin
  L := Length(S);
  if L < Len then
    Result := StringOfChar(C, Len - L) + S
  else
    Result := S;
end;

function StrPadRight(const S: string; Len: Integer; C: Char): string;
var
  L: Integer;
begin
  L := Length(S);
  if L < Len then
    Result := S + StringOfChar(C, Len - L)
  else
    Result := S;
end;

function StrProper(const S: string): string;
begin
  {$IFDEF CLR}
  Result := S.ToLower;
  {$ELSE}
  Result := StrLower(S);
  {$ENDIF CLR}
  if Result <> '' then
    Result[1] := UpCase(Result[1]);
end;

{$IFNDEF CLR}
procedure StrProperBuff(S: PChar);
begin
  if (S <> nil) and (S^ <> #0) then
  begin
    StrLowerBuff(S);
    S^ := CharUpper(S^);
  end;
end;
{$ENDIF ~CLR}

function StrQuote(const S: string; C: Char): string;
var
  L: Integer;
begin
  L := Length(S);
  Result := S;
  if L > 0 then
  begin
    if Result[1] <> C then
    begin
      Result := C + Result;
      Inc(L);
    end;
    if Result[L] <> C then
      Result := Result + C;
  end;
end;

function StrRemoveChars(const S: string; const Chars: TSysCharSet): string;
{$IFDEF CLR}
var
  I: Integer;
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(Length(S));
  for I := 0 to S.Length - 1 do
    if not (AnsiChar(S[I]) in Chars) then
      sb.Append(S[I]);
  Result := sb.ToString();
end;
{$ELSE}
var
  Source, Dest: PChar;
  Len, Index: Integer;
begin
  Len := Length(S);
  SetLength(Result, Len);
  UniqueString(Result);
  Source := PChar(S);
  Dest := PChar(Result);
  for Index := 0 to Len-1 do
  begin
    if not (Source^ in Chars) then
    begin
      Dest^ := Source^;
      Inc(Dest,SizeOf(Char));
    end;
    Inc(Source,SizeOf(Char));
  end;
  SetLength(Result, (Longint(Dest) - Longint(PChar(Result))) div SizeOf(Char));
end;
{$ENDIF CLR}

function StrKeepChars(const S: string; const Chars: TSysCharSet): string;
{$IFDEF CLR}
var
  I: Integer;
  sb: StringBuilder;
begin
  sb := StringBuilder.Create(Length(S));
  for I := 0 to S.Length - 1 do
    if AnsiChar(S[I]) in Chars then
      sb.Append(S[I]);
  Result := sb.ToString();
end;
{$ELSE}
var
  Source, Dest: PChar;
  Len, Index: Integer;
begin
  Len := Length(S);
  SetLength(Result, Len);
  UniqueString(Result);
  Source := PChar(S);
  Dest := PChar(Result);
  for Index := 0 to Len-1 do
  begin
    if Source^ in Chars then
    begin
      Dest^ := Source^;
      Inc(Dest,SizeOf(Char));
    end;
    Inc(Source,SizeOf(Char));
  end;
  SetLength(Result, (Longint(Dest) - Longint(PChar(Result))) div SizeOf(Char));
end;
{$ENDIF CLR}

function StrRepeat(const S: string; Count: Integer): string;
{$IFDEF CLR}
var
  I, Len: Integer;
  sb: StringBuilder;
begin
  Len := Length(S);
  if Len * Count > 0 then
  begin
    sb := StringBuilder.Create(Len * Count);
    for I := Count - 1 downto 0 do
      sb.Append(S);
    Result := sb.ToString();
  end
  else
    Result := '';
end;
{$ELSE}
var
  Len, Index: Integer;
  Dest, Source: PChar;
begin
  Len := Length(S);
  SetLength(Result, Count * Len);
  Dest := PChar(Result);
  Source := PChar(S);
  if Dest <> nil then
    for Index := 0 to Count - 1 do
  begin
    Move(Source^, Dest^, Len*SizeOf(Char));
    Inc(Dest,Len*SizeOf(Char));
  end;
end;
{$ENDIF CLR}

function StrRepeatLength(const S: string; L: Integer): string;
{$IFDEF CLR}
var
  Count: Integer;
  LenS, Index: Integer;
begin
  Result := '';
  LenS := Length(S);

  if (LenS > 0) and (S <> '') then
  begin
    Count := L div LenS;
    if Count * LenS < L then
      Inc(Count);
    SetLength(Result, Count * LenS);
    Index := 1;
    while Count > 0 do
    begin
      MoveString(S, 1, Result, Index, LenS);
      Inc(Index, LenS);
      Dec(Count);
    end;
    if Length(S) > L then
      SetLength(Result, L);
  end;
end;
{$ELSE}
var
  Len: Integer;
  Dest: PChar;
begin
  Result := '';
  Len := Length(S);

  if (Len > 0) and (S <> '') then
  begin
    SetLength(Result,L);
    Dest := PChar(Result);
    while (L > 0) do
    begin
      Move(S[1],Dest^,Min(L,Len)*SizeOf(Char));
      Inc(Dest,Len);
      Dec(L,Len);
    end;
  end;
end;
{$ENDIF CLR}

procedure StrReplace(var S: string; const Search, Replace: string; Flags: TReplaceFlags);
{$IFDEF CLR}
begin
  S := StringReplace(S, Search, Replace, Flags); // !!! Convertion to System.String
end;
{$ELSE}
var
  SearchStr: string;
  ResultStr: string; { result string }
  SourcePtr: PChar;      { pointer into S of character under examination }
  SourceMatchPtr: PChar; { pointers into S and Search when first character has }
  SearchMatchPtr: PChar; { been matched and we're probing for a complete match }
  ResultPtr: PChar;      { pointer into Result of character being written }
  ResultIndex,
  SearchLength,          { length of search string }
  ReplaceLength,         { length of replace string }
  BufferLength,          { length of temporary result buffer }
  ResultLength: Integer; { length of result string }
  C: Char;               { first character of search string }
  IgnoreCase: Boolean;
begin
  if Search = '' then
    if S = '' then
    begin
      S := Replace;
      Exit;
    end
    else
      raise EJclStringError.CreateRes(@RsBlankSearchString);

  if S <> '' then
  begin
    IgnoreCase := rfIgnoreCase in Flags;
    if IgnoreCase then
      SearchStr := AnsiUpperCase(Search)
    else
      SearchStr := Search;
    { avoid having to call Length() within the loop }
    SearchLength := Length(Search);
    ReplaceLength := Length(Replace);
    ResultLength := Length(S);
    BufferLength := ResultLength;
    SetLength(ResultStr, BufferLength);
    { get pointers to begin of source and result }
    ResultPtr := PChar(ResultStr);
    SourcePtr := PChar(S);
    C := SearchStr[1];
    { while we haven't reached the end of the string }
    while True do
    begin
      { copy characters until we find the first character of the search string }
      if IgnoreCase then
        while (CharUpper(SourcePtr^) <> C) and (SourcePtr^ <> #0) do
        begin
          ResultPtr^ := SourcePtr^;
          Inc(ResultPtr);
          Inc(SourcePtr);
        end
      else
        while (SourcePtr^ <> C) and (SourcePtr^ <> #0) do
        begin
          ResultPtr^ := SourcePtr^;
          Inc(ResultPtr);
          Inc(SourcePtr);
        end;
      { did we find that first character or did we hit the end of the string? }
      if SourcePtr^ = #0 then
        Break
      else
      begin
        { continue comparing, +1 because first character was matched already }
        SourceMatchPtr := SourcePtr + 1;
        SearchMatchPtr := PChar(SearchStr) + 1;
        if IgnoreCase then
          while (CharUpper(SourceMatchPtr^) = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do
          begin
            Inc(SourceMatchPtr);
            Inc(SearchMatchPtr);
          end
        else
          while (SourceMatchPtr^ = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do
          begin
            Inc(SourceMatchPtr);
            Inc(SearchMatchPtr);
          end;
        { did we find a complete match? }
        if SearchMatchPtr^ = #0 then
        begin
          // keep track of result length
          Inc(ResultLength, ReplaceLength - SearchLength);
          if ReplaceLength > 0 then
          begin
            // increase buffer size if required
            if ResultLength > BufferLength then
            begin
              BufferLength := ResultLength * 2;
              ResultIndex := ResultPtr - PChar(ResultStr) + 1;
              SetLength(ResultStr, BufferLength);
              ResultPtr := @ResultStr[ResultIndex];
            end;
            { append replace to result and move past the search string in source }
            Move((@Replace[1])^, ResultPtr^, ReplaceLength);
          end;
          Inc(SourcePtr, SearchLength);
          Inc(ResultPtr, ReplaceLength);
          { replace all instances or just one? }
          if not (rfReplaceAll in Flags) then
          begin
            { just one, copy until end of source and break out of loop }
            while SourcePtr^ <> #0 do
            begin
              ResultPtr^ := SourcePtr^;
              Inc(ResultPtr);
              Inc(SourcePtr);