6/3/2018
0
1892

Строковый класс для Delphi


Класс строк, инкапсулирующий несколько строковых функций.
Я создал этот небольшой строковый класс на основе QStrings и FastStrings, поэтому он быстрый и поддерживает несколько строковых функций. Кстати, чтобы скомпилировать и использовать этот класс, вам понадобится FastStrings (копию можно получить на домашней странице Peter Morris).
Зачем делать строковый класс? Ну, хотя в этом классе отсутствует перегрузка операторов, он мне нужен, и я подумал, что кому-то он может пригодиться.
ОБНОВЛЕНИЕ: Добавлены чувствительные к регистру StartsWith и EndsWith.
ИСПРАВЛЕНО: Ошибки в Left, Right и Faster WordCount (скопировано из 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.










Строковый класс для Delphi


Строковый класс для Delphi : Несколько тысяч советов, которые сделают вашу жизнь проще.


Класс строк, инкапсулирующий несколько строковых функций.
Я создал этот небольшой строковый класс на основе QStrings и FastStrings, поэтому он быстрый и поддерживает несколько строковых функций. Кстати, чтобы скомпилировать и использовать этот класс, вам понадобится FastStrings (копию можно получить на домашней странице Peter Morris).
Зачем делать строковый класс? Ну, хотя в этом классе отсутствует перегрузка операторов, он мне нужен, и я подумал, что кому-то он может пригодиться.
ОБНОВЛЕНИЕ: Добавлены чувствительные к регистру StartsWith и EndsWith.
ИСПРАВЛЕНО: Ошибки в Left, Right и Faster WordCount (скопировано из 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.



Строковый класс для Delphi

Строковый класс для Delphi : Несколько тысяч советов, которые сделают вашу жизнь проще.
рекомендовать друзьям
  • gplus
  • pinterest

Комментарий

Оставить комментарий

Оценивать