A String class for delphi

I have done this small string class basing myself on QStrings and FastStrings, thus this class is fast and handles several string functions. BTW in order to compile and use this class you will need FastStrings (you can get a copy at 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.

UPDATE: Added case sensitive StartsWith and EndsWith
FIXED : Bugs in Left, Right, Faster WordCount (copied from QStrings)

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.