rm_jclstrings.pas.~1~

这是一个功能强大

            end;
            Break;
          end;
        end
        else
        begin
          { copy current character and start over with the next }
          ResultPtr^ := SourcePtr^;
          Inc(ResultPtr);
          Inc(SourcePtr);
        end;
      end;
    end;
    { set result length and copy result into S }
    SetLength(ResultStr, ResultLength);
    S := ResultStr;
  end;
end;
{$ENDIF CLR}

function StrReplaceChar(const S: string; const Source, Replace: Char): string;
{$IFNDEF CLR}
var
  I: Integer;
{$ENDIF ~CLR}
begin
  {$IFDEF CLR}
  Result := S.Replace(Source, Replace);
  {$ELSE}
  Result := S;
  for I := 1 to Length(S) do
    if Result[I] = Source then
      Result[I] := Replace;
  {$ENDIF CLR}
end;

function StrReplaceChars(const S: string; const Chars: TSysCharSet; Replace: Char): string;
var
  I: Integer;
  {$IFDEF CLR}
  sb: StringBuilder;
  {$ENDIF CLR}
begin
  {$IFDEF CLR}
  sb := StringBuilder.Create(S);
  for I := 0 to sb.Length - 1 do
    if AnsiChar(sb[I]) in Chars then
      sb[I] := Replace;
  Result := sb.ToString();
  {$ELSE}
  Result := S;
  for I := 1 to Length(S) do
    if Result[I] in Chars then
      Result[I] := Replace;
  {$ENDIF CLR}
end;

function StrReplaceButChars(const S: string; const Chars: TSysCharSet;
  Replace: Char): string;
var
  I: Integer;
  {$IFDEF CLR}
  sb: StringBuilder;
  {$ENDIF CLR}
begin
  {$IFDEF CLR}
  sb := StringBuilder.Create(S);
  for I := 0 to sb.Length - 1 do
    if not (AnsiChar(sb[I]) in Chars) then
      sb[I] := Replace;
  Result := sb.ToString();
  {$ELSE}
  Result := S;
  for I := 1 to Length(S) do
    if not (Result[I] in Chars) then
      Result[I] := Replace;
  {$ENDIF CLR}
end;

function StrReverse(const S: string): string;
begin
  Result := S;
  StrReverseInplace(Result);
end;

procedure StrReverseInPlace(var S: string);
{$IFDEF CLR}
var
  I, LenS: Integer;
  sb: StringBuilder;
begin
  LenS := Length(S);
  sb := StringBuilder.Create(LenS);
  sb.Length := LenS;
  for I := 0 to LenS - 1 do
    sb[I] := S[LenS - I - 1];
  S := sb.ToString();
end;
{$ELSE}
var
  P1, P2: PChar;
  C: Char;
begin
  UniqueString(S);
  P1 := PChar(S);
  P2 := P1 + SizeOf(Char) * (Length(S) - 1);
  while P1 < P2 do
  begin
    C := P1^;
    P1^ := P2^;
    P2^ := C;
    Inc(P1);
    Dec(P2);
  end;
end;
{$ENDIF CLR}

function StrSingleQuote(const S: string): string;
begin
  Result := AnsiSingleQuote + S + AnsiSingleQuote;
end;

function StrSmartCase(const S: string; Delimiters: TSysCharSet): string;
var
  {$IFDEF CLR}
  Index: Integer;
  LenS: Integer;
  sb: StringBuilder;
  {$ELSE}
  Source, Dest: PChar;
  Index, Len: Integer;
  {$ENDIF CLR}
begin
  Result := '';
  if Delimiters = [] then
    Include(Delimiters, AnsiSpace);

  if S <> '' then
  begin
    Result := S;
    {$IFDEF CLR}
    sb := StringBuilder.Create(S);
    LenS := Length(S);
    Index := 0;
    while Index < LenS do
    begin
      if (AnsiChar(sb[Index]) in Delimiters) and (Index + 1 < LenS) and
        not (AnsiChar(sb[Index + 1]) in Delimiters) then
        sb[Index + 1] := CharUpper(sb[Index + 1]);
      Inc(Index);
    end;
    sb[0] := CharUpper(sb[0]);
    Result := sb.ToString();
    {$ELSE}
    UniqueString(Result);

    Len := Length(S);
    Source := PChar(S);
    Dest := PChar(Result);
    Inc(Dest);

    for Index := 2 to Len do
    begin
      if (Source^ in Delimiters) and not (Dest^ in Delimiters) then
        Dest^ := CharUpper(Dest^);
      Inc(Dest);
      Inc(Source);
    end;
    Result[1] := CharUpper(Result[1]);
    {$ENDIF CLR}
  end;
end;

function StrStringToEscaped(const S: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(S) do
  begin
    case S[I] of
      AnsiBackspace:
        Result := Result + '\b';
      AnsiBell:
        Result := Result + '\a';
      AnsiCarriageReturn:
        Result := Result + '\r';
      AnsiFormFeed:
        Result := Result + '\f';
      AnsiLineFeed:
        Result := Result + '\n';
      AnsiTab:
        Result := Result + '\t';
      AnsiVerticalTab:
        Result := Result + '\v';
      '\':
        Result := Result + '\\';
      '"':
        Result := Result + '\"';
    else
      // Characters < ' ' are escaped with hex sequence
      if S[I] < #32 then
        Result := Result + Format('\x%.2x',[Integer(S[I])])
      else
        Result := Result + S[I];
    end;
  end;
end;

function StrStripNonNumberChars(const S: string): string;
var
  I: Integer;
  C: Char;
begin
  Result := '';
  for I := 1 to Length(S) do
  begin
    C := S[I];
    if CharIsNumberChar(C) then
      Result := Result + C;
  end;
end;

function StrToHex(const Source: string): string;
var
  Index: Integer;
  C, L, N: Integer;
  BL, BH: Byte;
  S: string;
  {$IFDEF CLR}
  sb: StringBuilder;
  {$ENDIF CLR}
begin
  {$IFDEF CLR}
  sb := StringBuilder.Create;
  {$ELSE}
  Result := '';
  {$ENDIF CLR}
  if Source <> '' then
  begin
    S := Source;
    L := Length(S);
    if Odd(L) then
    begin
      S := '0' + S;
      Inc(L);
    end;
    Index := 1;
    {$IFDEF CLR}
    sb.Length := L div 2;
    {$ELSE}
    SetLength(Result, L div 2);
    {$ENDIF CLR}
    C := 1;
    N := 1;
    while C <= L do
    begin
      BH := CharHex(S[Index]);
      Inc(Index);
      BL := CharHex(S[Index]);
      Inc(Index);
      Inc(C, 2);
      if (BH = $FF) or (BL = $FF) then
      begin
        Result := '';
        Exit;
      end;
      {$IFDEF CLR}
      sb[N] :=
      {$ELSE}
      Result[N] :=
      {$ENDIF CLR}
        Char((BH shl 4) + BL);
      Inc(N);
    end;
  end;
  {$IFDEF CLR}
  Result := sb.ToString();
  {$ENDIF CLR}
end;

function StrTrimCharLeft(const S: string; C: Char): string;
var
  I, L: Integer;
begin
  I := 1;
  L := Length(S);
  while (I <= L) and (S[I] = C) do Inc(I);
  Result := Copy(S, I, L - I + 1);
end;

function StrTrimCharsLeft(const S: string; const Chars: TSysCharSet): string;
var
  I, L: Integer;
begin
  I := 1;
  L := Length(S);
  while (I <= L) and (S[I] in Chars) do Inc(I);
  Result := Copy(S, I, L - I + 1);
end;

function StrTrimCharsRight(const S: string; const Chars: TSysCharSet): string;
var
  I: Integer;
begin
  I := Length(S);
  while (I >= 1) and (S[I] in Chars) do Dec(I);
  Result := Copy(S, 1, I);
end;

function StrTrimCharRight(const S: string; C: Char): string;
var
  I: Integer;
begin
  I := Length(S);
  while (I >= 1) and (S[I] = C) do Dec(I);
  Result := Copy(S, 1, I);
end;

function StrTrimQuotes(const S: string): string;
var
  First, Last: Char;
  L: Integer;
begin
  L := Length(S);
  if L > 1 then
  begin
    First := S[1];
    Last := S[L];
    if (First = Last) and ((First = AnsiSingleQuote) or (First = AnsiDoubleQuote)) then
      Result := Copy(S, 2, L - 2)
    else
      Result := S;
  end
  else
    Result := S;
end;

function StrUpper(const S: string): string;
begin
  Result := S;
  StrUpperInPlace(Result);
end;

procedure StrUpperInPlace(var S: string);
{$IFDEF PIC}
begin
  StrCase(S, AnsiUpOffset);
end;
{$ELSE}
asm
        // StrCase(Str, AnsiUpOffset)
        MOV     EDX, AnsiUpOffset
        JMP     StrCase
end;
{$ENDIF PIC}

{$IFNDEF CLR}
procedure StrUpperBuff(S: PChar);
{$IFDEF PIC}
begin
  StrCaseBuff(S, AnsiUpOffset);
end;
{$ELSE}
asm
        // StrCaseBuff(S, UpOffset)
        MOV     EDX, AnsiUpOffset
        JMP     StrCaseBuff
end;
{$ENDIF PIC}
{$ENDIF ~CLR}

{$IFDEF WIN32}
function StrOemToAnsi(const S: string): string;
begin
  SetLength(Result, Length(S));
  if S <> '' then
    OemToAnsiBuff(@S[1], @Result[1], Length(S));
end;
{$ENDIF WIN32}

{$IFDEF WIN32}
function StrAnsiToOem(const S: string): string;
begin
  SetLength(Result, Length(S));
  if S <> '' then
    AnsiToOemBuff(@S[1], @Result[1], Length(S));
end;
{$ENDIF WIN32}


{$IFNDEF CLR}
//=== String Management ======================================================

procedure StrAddRef(var S: string);
var
  Foo: string;
begin
  if StrRefCount(S) = -1 then
    UniqueString(S)
  else
  begin
    Foo := S;
    Pointer(Foo) := nil;
  end;
end;

function StrAllocSize(const S: string): Longint;
var
  P: Pointer;
begin
  Result := 0;
  if Pointer(S) <> nil then
  begin
    P := Pointer(Integer(Pointer(S)) - AnsiRfOffset);
    if Integer(P^) <> -1 then
    begin
      P := Pointer(Integer(Pointer(S)) - AnsiAlOffset);
      Result := Integer(P^);
    end;
  end;
end;

procedure StrDecRef(var S: string);
var
  Foo: string;
begin
  case StrRefCount(S) of
    -1, 0: { nothing } ;
     1:
       begin
         Finalize(S);
         Pointer(S) := nil;
       end;
  else
    Pointer(Foo) := Pointer(S);
  end;
end;

function StrLen(S: PChar): Integer; assembler;
asm
        TEST    EAX, EAX
        JZ      @@EXIT

        PUSH    EBX
        MOV     EDX, EAX                 // save pointer
@L1:    MOV     EBX, [EAX]               // read 4 bytes
        ADD     EAX, 4                   // increment pointer
        LEA     ECX, [EBX-$01010101]     // subtract 1 from each byte
        NOT     EBX                      // invert all bytes
        AND     ECX, EBX                 // and these two
        AND     ECX, $80808080           // test all sign bits
        JZ      @L1                      // no zero bytes, continue loop
        TEST    ECX, $00008080           // test first two bytes
        JZ      @L2
        SHL     ECX, 16                  // not in the first 2 bytes
        SUB     EAX, 2
@L2:    SHL     ECX, 9                   // use carry flag to avoid a branch
        SBB     EAX, EDX                 // compute length
        POP     EBX

        JZ      @@EXIT                   // Az: SBB sets zero flag
        DEC     EAX                      // do not include null terminator
@@EXIT:
end;

function StrLength(const S: string): Longint;
var
  P: Pointer;
begin
  Result := 0;
  if Pointer(S) <> nil then
  begin
    P := Pointer(Integer(Pointer(S)) - AnsiLnOffset);
    Result := Integer(P^) and (not $80000000 shr 1);
  end;
end;