A String class for delphi

A string class wich incapsulates several string functions

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.




 

Share this article!

Follow us!

Find more helpful articles: