Uma string class para delphi

Uma string classe que encapsula várias funções string

Eu fiz essa pequena string class baseando-me QStrings e FastStrings, assim, esta classe é rápida e manipula várias funções string. A fim de compilar e usar essa classe você vai precisar de FastStrings (você pode obter uma cópia em Peter Morris Homepage).

Why make a string class? well although this class lacks operator overloading I need it, and thought someone migth benefit of it.

Por que fazer uma string class? Bem, embora a falta desta seja superada pelos operadores, eu preciso dela, e pensei que alguém possa se beneficiar dela.

RENOVADO: foi adicionado case sensitive StartsWith e EndsWith

CORRIGIDOS: bugs na WordCount, Esquerda, Direita, Rápida (copiada de QStrings) (Left, Right, Faster WordCount)

unit IMLCommon;



interface



uses

  SysUtils, Classes;



type

  TCharSet = Set of Char;



  TString = class

  private

    Buffer: AnsiString;

    FWordSeparators: TCharset;



    function GetLength: Integer;

    function GetRefCount: Integer;

    function GetCharacter(const Index: Integer): Char;

    function GetWordSeparators: TCharSet;



    function GetAsPChar: PChar;

    function GetAsInteger: Integer;

    function GetAsWord: Word;

    function GetWordCount: Integer;



    procedure SetLength(const Value: Integer);

    procedure SetCharacter(const Index: Integer; const Value: Char);

    procedure SetWordSeparators(const Value: TCharSet);



    procedure SetAsPChar(const Value: PChar);

    procedure SetAsInteger(const Value: Integer);

    procedure SetAsWord(const Value: Word);

  protected

    function FindEx(Const SubString: String; const CaseSensitive: Boolean = True;

      const StartPos: Integer = 1; const ForwardSearch: Boolean = True): Integer;

    function InternalInteger(var Variable: Integer; const HighBound, LowBound: Integer): Boolean;

    function InternalWord(Const Index: Integer): String;

  public

    function Left(Count: Integer): String;

    function Rigth(Count: Integer): String;

    function Mid(const AStart, ACount: Integer): String;

    function Uppercase: String;

    function LowerCase: String;



    function IsEmpty: Boolean;

    function StartsWith(const AString:String;

      Const CaseSensitive: Boolean = False): Boolean;

    function EndsWith(const AString: String;

      const CaseSensitive: Boolean = False): Boolean;

    function Find(Const SubString: String; const StartPos: Integer = 1;

      const CaseSensitive: Boolean = True): Integer;

    function FindRev(Const SubString: String; const StartPos: Integer = -1;

      const CaseSensitive: Boolean = True): Integer;

    function Contains(const SubString: String;

      const CaseSensitive: Boolean = True): Boolean;

    function IsNumber: Boolean;



    function Append(const Value: String): String;

    function Prepend(const Value: String): String;

    function Remove(const Index, Length: Integer): String;



    procedure Truncate(const NewLength: Integer);

    procedure Fill(const AChar: Char; NewLength: Integer = -1);

    procedure Insert(const Index: Integer; const AString: String);



    property Content: String Read Buffer Write Buffer;

    property RefCount:Integer read GetRefCount;

    property Characters[Const Index: Integer]: Char read GetCharacter write SetCharacter; default;

    property Words[Const Index: Integer]: String read InternalWord;

    property WordCount: Integer read GetWordCount;

    property Length: Integer read GetLength write SetLength;

    property WordSeparators: TCharSet read GetWordSeparators write SetWordSeparators;



    property AsPChar: PChar read GetAsPChar write SetAsPChar;

    property AsInteger: Integer read GetAsInteger write SetAsInteger;

    property AsWord: Word read GetAsWord write SetAsWord;

  end;



implementation



uses

  {JclStrings,} FastStrings;



{ TString }



function TString.EndsWith(const AString: String;

  const CaseSensitive: Boolean): Boolean;

begin

  if CaseSensitive then

    Result := AnsiSameStr(AString, Rigth(System.Length(AString)))

  else

    Result := AnsiSameText(AString,Rigth(System.Length(AString)));

end;



function TString.FindEx(const SubString: String;

  const CaseSensitive: Boolean; const StartPos: Integer;

  const ForwardSearch: Boolean): Integer;

begin

  Result := SmartPos(SubString, Buffer, CaseSensitive, StartPos, ForwardSearch);

end;



procedure TString.Fill(const AChar: Char; NewLength: Integer);

begin

  if (NewLength < 0) then

  begin

    if Length > 0 then

      FillChar(Buffer[1], Length, ord(AChar))

    else

      FillChar(Buffer[1], 1, ord(AChar));

  end

  else

  begin

    SetLength(NewLength);

    FillChar(Buffer[1], Length, ord(AChar));

  end;

end;



function TString.Find(const SubString: String; const StartPos: Integer;

  const CaseSensitive: Boolean): Integer;

begin

  Result := FindEx(SubString, CaseSensitive, StartPos);

end;



function TString.FindRev(const SubString: String; const StartPos: Integer;

  const CaseSensitive: Boolean): Integer;

var

  RealStartPos: Integer;

begin

  if StartPos < 0 then RealStartPos := Length else RealStartPos := StartPos;

  Result := FindEx(SubString, CaseSensitive, RealStartPos, False);

end;



function TString.GetAsPChar: PChar;

begin

  Result := PChar(Buffer);

end;



function TString.GetCharacter(const Index: Integer): Char;

begin

  if IsEmpty or (Index > Length) then

    Result := #0

  else

    Result := Buffer[Index];

end;



function TString.GetLength: Integer;

var

  P: Pointer;

begin

  Result := 0;

  if Pointer(Buffer) <> nil then

  begin

    P := Pointer(Integer(Pointer(Buffer)) - 4);

    Result := Integer(P^) and (not $80000000 shr 1);

  end;

end;



function TString.IsEmpty: Boolean;

begin

  Result := (Length = 0);

end;



function TString.Left(Count: Integer): String;

begin

  if Count > Length then

    Result := Buffer

  else begin

    System.SetLength(Result, Count);

    Move(Buffer[1],Result[1],Count);

  end;

end;



function TString.LowerCase: String;

begin

  Result := SysUtils.LowerCase( Buffer );

end;



function TString.Mid(const AStart, ACount: Integer): String;

begin

  Result := Copy(Buffer, AStart, ACount);

end;



function TString.Rigth(Count: Integer): String;

begin

  if Count > Length then

    Result := ''

  else begin

    System.SetLength(Result, Count);

    Move(Buffer[Length -(Count-1)],Result[1],Count);

  end;

end;



procedure TString.SetAsPChar(const Value: PChar);

begin

  Buffer := Value;

end;



procedure TString.SetCharacter(const Index: Integer; const Value: Char);

begin

  if not IsEmpty then

    if (Index < Length) and (Value <> GetCharacter(Index)) then

      Buffer[Index] := Value;

end;



procedure TString.SetLength(const Value: Integer);

begin

  System.SetLength( Buffer, Value );

end;



function TString.StartsWith(const AString: String;

  const CaseSensitive: Boolean): Boolean;

begin

  if CaseSensitive then

    Result := AnsiSameStr(AString, Left(System.Length(AString)))

  else

    Result := AnsiSameText(AString,Left(System.Length(AString)));

end;



procedure TString.Truncate(const NewLength: Integer);

begin

  Length := NewLength;

end;



function TString.Uppercase: String;

begin

  Result := SysUtils.UpperCase( Buffer );

end;



function TString.Contains(const SubString: String;

  const CaseSensitive: Boolean): Boolean;

begin

  Result := Find(SubString, 1, CaseSensitive) > 0;

end;



procedure TString.Insert(const Index: Integer; const AString: String);

begin

  System.Insert(AString, Buffer, Index);

end;



function TString.Append(const Value: String): String;

begin

  Insert(Length, Value);

  Result := Buffer;

end;



function TString.Prepend(const Value: String): String;

begin

  Insert(1, Value);

  Result := Buffer;

end;



function TString.Remove(const Index, Length: Integer): String;

begin

  Result := Buffer;

  Delete(Result, Index, Length);

end;



function TString.IsNumber: Boolean;

var

  i: Integer;

begin

  Result := True;

  for i := 1 to Length do

    if not (GetCharacter(i) in ['0'..'9', '+','-','.']) then

    begin

      Result := False;

      Exit;

    end;

end;



function TString.InternalInteger(var Variable: Integer; const HighBound,

  LowBound: Integer): Boolean;

var

  ErrorCode: Integer;

begin

  Result := False;

  if IsEmpty or not IsNumber then Exit;

  Val(Buffer, Variable, ErrorCode);

  Result := (Errorcode = 0) and ((Variable >= LowBound) and (Variable <= HighBound));

end;



function TString.GetAsInteger: Integer;

begin

  InternalInteger(Result, High(Integer), Low(Integer));

end;



procedure TString.SetAsInteger(const Value: Integer);

begin

  Str(Value, Buffer);

end;



function TString.GetAsWord: Word;

var

  Tmp: Integer;

begin

  if InternalInteger(Tmp, 0, 65535) then

    Result := Tmp

  else

    Result := 0;

end;



procedure TString.SetAsWord(const Value: Word);

begin

  Str(Value, Buffer);

end;



function TString.GetWordSeparators: TCharSet;

begin

  Result := FWordSeparators;

end;



procedure TString.SetWordSeparators(const Value: TCharSet);

begin

  if FWordSeparators <> Value then

    FWordSeparators := Value;

end;



function TString.InternalWord(const Index: Integer): String;

var

  I,J,N: Integer;

  L: LongWord;

  P: PChar;

  A: Boolean;

begin

  if (Index <= 0) then Exit;

  L := Length;

  P := Pointer(Buffer);

  A := False;

  N := 1;

  for I := 1 to L do

  begin

    if not (P^ in WordSeparators) then

    begin

      if not A then

      begin

        if N = Index then

        begin

          N := L+1;

          Inc(P);

          for J := I+1 to L do

          begin

            if P^ in WordSeparators then

            begin

              N := J;

              Break;

            end;

            Inc(P);

          end;

          Result := Copy(Buffer,I,N-I);

          Exit;

        end;

        A := True;

        Inc(N);

      end;

    end

    else if A then

      A := False;

    Inc(P);

  end;

  Result := '';

end;



function TString.GetWordCount: Integer;



  function CountOfWords(const S: string; const Delimiters: TCharSet): Integer;

  asm

        PUSH EBX

        TEST EAX,EAX

        JE @@q0

        MOV ECX,[EAX-4]

        MOV EBX,EAX

        DEC ECX

        JS @@qz

        PUSH ESI

        XOR EAX,EAX

        JMP @@lp2

@@iw: INC EAX

        DEC ECX

        JS @@ex

@@lp1: MOVZX ESI,BYTE PTR [EBX+ECX]

        BT [EDX],ESI

        JC @@nx

        DEC ECX

        JNS @@lp1

@@ex: POP ESI

        POP EBX

        RET

@@lp2: MOVZX ESI,BYTE PTR [EBX+ECX]

        BT [EDX],ESI

        JNC @@iw

@@nx: DEC ECX

        JNS @@lp2

        POP ESI

        POP EBX

        RET


@@qz: XOR EAX,EAX

@@q0: POP EBX

  end;



begin

  if IsEmpty then

  begin

    Result := 0;

    Exit;

  end;



  Result := CountOfWords(Buffer, FWordSeparators);

end;



function TString.GetRefCount: Integer;

var

  P: Pointer;

begin

  Result := 0;

  if Pointer(Buffer) <> nil then

  begin

    P := Pointer(Integer(Pointer(Buffer)) - 8);

    Result := Integer(P^);

  end;

end;



end.