A String Class for Delphi
A string class which encapsulates several string functions.
I have created this small string class based on QStrings and FastStrings, so it is fast and handles several string functions. By the way, to compile and use this class you will need FastStrings (you can get a copy from Peter Morris homepage).
Why make a string class? Well, although this class lacks operator overloading, I need it, and thought someone might benefit from it.
UPDATE: Added case-sensitive StartsWith and EndsWith.
FIXED: Bugs in Left, Right, and 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.
A String Class for Delphi
A String Class for Delphi : Multi-thousand tips to make your life easier.
A string class which encapsulates several string functions.
I have created this small string class based on QStrings and FastStrings, so it is fast and handles several string functions. By the way, to compile and use this class you will need FastStrings (you can get a copy from Peter Morris homepage).
Why make a string class? Well, although this class lacks operator overloading, I need it, and thought someone might benefit from it.
UPDATE: Added case-sensitive StartsWith and EndsWith.
FIXED: Bugs in Left, Right, and 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.
A String Class for Delphi
By Howtodotips
A String Class for Delphi : Multi-thousand tips to make your life easier.