jclstrings.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

  end;
  { append null terminator, copy into S and reset the string length }
  ResultPtr^ := #0;
  S := ResultStr;
  SetLength(S, StrLen(PChar(S)));
end;

procedure StrReplace(var S: AnsiString; const Search, Replace: AnsiString; Flags: TReplaceFlags);
begin
  if (S <> '') and (Search <> '') then
  begin
    if rfIgnoreCase in Flags then
      StrReplaceCI(S, Search, Replace, Flags)
    else
      StrReplaceCS(S, Search, Replace, Flags);
  end;
end;

//--------------------------------------------------------------------------------------------------

function StrReplaceChar(const S: AnsiString; const Source, Replace: Char): AnsiString;
var
  I: Integer;
begin
  Result := S;
  for I := 1 to Length(S) do
    if Result[I] = Source then
      Result[I] := Replace;
end;

//--------------------------------------------------------------------------------------------------

function StrReplaceChars(const S: AnsiString; const Chars: TSysCharSet; Replace: Char): AnsiString;
var
  I: Integer;
begin
  Result := S;
  for I := 1 to Length(S) do
    if Result[I] in Chars then
      Result[I] := Replace;
end;

//--------------------------------------------------------------------------------------------------
function StrReplaceButChars(const S: AnsiString; const Chars: TSysCharSet;
  Replace: Char): AnsiString;
var
  I: Integer;
begin
  Result := S;
  for I := 1 to Length(S) do
    if not (Result[I] in Chars) then
      Result[I] := Replace;
end;

//--------------------------------------------------------------------------------------------------

function StrReverse(const S: AnsiString): AnsiString;
var
  P1, P2: PChar;
  C: AnsiChar;
begin
  Result := S;
  UniqueString(Result);
  P1 := PChar(Result);
  P2 := P1 + SizeOf(AnsiChar) * (Length(Result) - 1);
  while P1 < P2 do
  begin
    C := P1^;
    P1^ := P2^;
    P2^ := C;
    Inc(P1);
    Dec(P2);
  end;
end;

//--------------------------------------------------------------------------------------------------

procedure StrReverseInPlace(var S: AnsiString);
var
  P1, P2: PChar;
  C: AnsiChar;
begin
  UniqueString(S);
  P1 := PChar(S);
  P2 := P1 + SizeOf(AnsiChar) * (Length(S) - 1);
  while P1 < P2 do
  begin
    C := P1^;
    P1^ := P2^;
    P2^ := C;
    Inc(P1);
    Dec(P2);
  end;
end;

//--------------------------------------------------------------------------------------------------

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

//--------------------------------------------------------------------------------------------------

function StrSmartCase(const S: AnsiString; Delimiters: TSysCharSet): AnsiString;
var
  Source, Dest: PChar;

begin
  Result := '';

  if Delimiters = [] then
    Include(Delimiters, AnsiSpace);

  if S <> '' then
  begin
    Result := S;
    UniqueString(Result);
    
    Source  := PChar(S);
    Dest := PChar(Result);

    Inc(Dest);

    while Source^ <> #0 do
    begin
      if (Source^ in Delimiters) and (Dest^ <> #0) then
        Dest^ := UpCase(Dest^);

      Inc(Dest);
      Inc(Source);
    end;

    Result[1] := UpCase(Result[1]); 
  end;
end;

//--------------------------------------------------------------------------------------------------

function StrStringToEscaped(const S: AnsiString): AnsiString;
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: AnsiString): AnsiString;
var
  I: Integer;
  C: AnsiChar;
begin
  Result := '';
  for I := 1 to Length(S) do
  begin
    C := S[I];
    if CharIsNumber(C) then
      Result := Result + C;
  end;
end;

//--------------------------------------------------------------------------------------------------

function StrToHex(const Source: AnsiString): AnsiString;
var
  P: PChar;
  C, L, N: Integer;
  BL, BH: Byte;
  S: AnsiString;
begin
  Result := '';
  if Source <> '' then
  begin
    S := Source;
    L := Length(S);
    if Odd(L) then
    begin
      S := '0' + S;
      Inc(L);
    end;
    P := PChar(S);
    SetLength(Result, L div 2);
    C := 1;
    N := 1;
    while C <= L do
    begin
      BH := CharHex(P^);
      Inc(P);
      BL := CharHex(P^);
      Inc(P);
      Inc(C, 2);
      if (BH = $FF) or (BL = $FF) then
      begin
        Result := '';
        Exit;
      end;
      Byte(Result[N]) := Byte((BH shl 4) + BL);
      Inc(N);
    end;
  end;
end;

//--------------------------------------------------------------------------------------------------

function StrTrimCharLeft(const S: AnsiString; C: AnsiChar): AnsiString;
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: AnsiString; const Chars: TSysCharSet): AnsiString;
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: AnsiString; const Chars: TSysCharSet): AnsiString;
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: AnsiString; C: AnsiChar): AnsiString;
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: AnsiString): AnsiString;
var
  First, Last: AnsiChar;
  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: AnsiString): AnsiString;
var
  L: Integer;
begin
  L := Length(S);
  SetLength(Result, L);
  Move(S[1], Result[1], L);
  StrUpperInPlace(Result);
end;

//--------------------------------------------------------------------------------------------------

procedure StrUpperInPlace(var S: AnsiString); assembler;
asm
        // StrCase(Str, UpOffset)
        MOV     EDX, AnsiUpOffset
        JMP     StrCase
end;

//--------------------------------------------------------------------------------------------------

procedure StrUpperBuff(S: PAnsiChar); assembler;
asm
        // StrCaseBuff(S, UpOffset)
        MOV     EDX, AnsiUpOffset
        JMP     StrCaseBuff
end;

//--------------------------------------------------------------------------------------------------

{$IFDEF WIN32}
function StrOemToAnsi(const S: AnsiString): AnsiString;
begin
  SetLength(Result, Length(S));
  OemToAnsiBuff(@S[1], @Result[1], Length(S));
end;
{$ENDIF WIN32}

//--------------------------------------------------------------------------------------------------

{$IFDEF WIN32}
function StrAnsiToOem(const S: AnsiString): AnsiString;
begin
  SetLength(Result, Length(S));
  AnsiToOemBuff(@S[1], @Result[1], Length(S));
end;
{$ENDIF WIN32}

//--------------------------------------------------------------------------------------------------


//==================================================================================================
// String Management
//==================================================================================================

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

//--------------------------------------------------------------------------------------------------

function StrAllocSize(const S: AnsiString): 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: AnsiString);
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: AnsiString): 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;