diff --git a/src/shared/utils.pas b/src/shared/utils.pas
index 6bfe7915453d93af3b465d0fb5b0a7fbd97e46df..308293da64e3aed41b94449e6f71a2b3d69727ac 100644 (file)
--- a/src/shared/utils.pas
+++ b/src/shared/utils.pas
SysUtils, Classes;
SysUtils, Classes;
+// ////////////////////////////////////////////////////////////////////////// //
+type
+ SSArray = array of ShortString;
+
+
// ////////////////////////////////////////////////////////////////////////// //
type
TUtf8DecoderFast = packed record
// ////////////////////////////////////////////////////////////////////////// //
type
TUtf8DecoderFast = packed record
function UpCase1251 (ch: Char): Char;
function LoCase1251 (ch: Char): Char;
function UpCase1251 (ch: Char): Char;
function LoCase1251 (ch: Char): Char;
+function toLowerCase1251 (const s: AnsiString): AnsiString;
+
// `true` if strings are equal; ignoring case for cp1251
function StrEquCI1251 (const s0, s1: AnsiString): Boolean;
// `true` if strings are equal; ignoring case for cp1251
function StrEquCI1251 (const s0, s1: AnsiString): Boolean;
function createDiskFile (pathname: AnsiString): TStream;
// little endian
function createDiskFile (pathname: AnsiString): TStream;
// little endian
+procedure writeSign (st: TStream; const sign: AnsiString);
+function checkSign (st: TStream; const sign: AnsiString): Boolean;
+
+procedure writeBool (st: TStream; b: Boolean);
+function readBool (st: TStream): Boolean;
+
+procedure writeStr (st: TStream; const str: AnsiString; maxlen: LongWord=65535);
+function readStr (st: TStream; maxlen: LongWord=65535): AnsiString;
+
procedure writeInt (st: TStream; v: Byte); overload;
procedure writeInt (st: TStream; v: ShortInt); overload;
procedure writeInt (st: TStream; v: Word); overload;
procedure writeInt (st: TStream; v: Byte); overload;
procedure writeInt (st: TStream; v: ShortInt); overload;
procedure writeInt (st: TStream; v: Word); overload;
TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
// returns formatted string if `writerCB` is `nil`, empty string otherwise
TFormatStrFCallback = procedure (constref buf; len: SizeUInt);
// returns formatted string if `writerCB` is `nil`, empty string otherwise
-function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
+function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
function wchar2win (wc: WideChar): AnsiChar; inline;
function utf2win (const s: AnsiString): AnsiString;
function wchar2win (wc: WideChar): AnsiChar; inline;
function utf2win (const s: AnsiString): AnsiString;
procedure clear (); inline;
procedure append (constref it: ItemT); inline;
procedure clear (); inline;
procedure append (constref it: ItemT); inline;
+ procedure delete (idx: Integer); inline;
+ function remove (idx: Integer): ItemT; inline;
public
property count: Integer read mCount;
public
property count: Integer read mCount;
end;
end;
+procedure FillMemory (Dest: Pointer; Len: LongWord; Ch: Byte); inline;
+procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline;
+procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline;
+
+
implementation
implementation
+uses
+ xstreams;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline;
+begin
+ Move(Src^, Dest^, Len);
+end;
+
+procedure FillMemory (Dest: Pointer; Len: LongWord; Ch: Byte); inline;
+begin
+ FillChar(Dest^, Len, Ch);
+end;
+
+procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline;
+begin
+ FillChar(Dest^, Len, 0);
+end;
+
// ////////////////////////////////////////////////////////////////////////// //
constructor TSimpleList.TEnumerator.Create (const aitems: TItemArr; acount: Integer);
// ////////////////////////////////////////////////////////////////////////// //
constructor TSimpleList.TEnumerator.Create (const aitems: TItemArr; acount: Integer);
procedure TSimpleList.append (constref it: ItemT); inline;
procedure TSimpleList.append (constref it: ItemT); inline;
+var
+ newsz: Integer;
begin
begin
- if (mCount = Length(mItems)) then
+ if (mCount >= Length(mItems)) then
begin
begin
- if (mCount = 0) then SetLength(mItems, 128) else SetLength(mItems, mCount*2);
+ newsz := mCount+(mCount div 3)+128;
+ SetLength(mItems, newsz);
end;
mItems[mCount] := it;
Inc(mCount);
end;
end;
mItems[mCount] := it;
Inc(mCount);
end;
+procedure TSimpleList.delete (idx: Integer); inline;
+var
+ f: Integer;
+begin
+ if (idx >= 0) and (idx < mCount) then
+ begin
+ for f := idx+1 to mCount-1 do mItems[f-1] := mItems[f];
+ end;
+end;
+
+
+function TSimpleList.remove (idx: Integer): ItemT; inline;
+var
+ f: Integer;
+begin
+ if (idx >= 0) and (idx < mCount) then
+ begin
+ result := mItems[idx];
+ for f := idx+1 to mCount-1 do mItems[f-1] := mItems[f];
+ end
+ else
+ begin
+ result := Default(ItemT);
+ end;
+end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
var
wc2shitmap: array[0..65535] of AnsiChar;
// ////////////////////////////////////////////////////////////////////////// //
var
wc2shitmap: array[0..65535] of AnsiChar;
end;
end;
+function toLowerCase1251 (const s: AnsiString): AnsiString;
+var
+ f: Integer;
+ ch: AnsiChar;
+begin
+ for ch in s do
+ begin
+ if (ch <> LoCase1251(ch)) then
+ begin
+ result := '';
+ SetLength(result, Length(s));
+ for f := 1 to Length(s) do result[f] := LoCase1251(s[f]);
+ exit;
+ end;
+ end;
+ // nothing to do
+ result := s;
+end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
// utils
// `ch`: utf8 start
// ////////////////////////////////////////////////////////////////////////// //
// utils
// `ch`: utf8 start
end;
{$ENDIF}
end;
{$ENDIF}
+procedure writeSign (st: TStream; const sign: AnsiString);
+begin
+ if (Length(sign) > 0) then st.WriteBuffer(sign[1], Length(sign));
+end;
+
+function checkSign (st: TStream; const sign: AnsiString): Boolean;
+var
+ buf: packed array[0..7] of Char;
+ f: Integer;
+begin
+ result := false;
+ if (Length(sign) > 0) then
+ begin
+ if (Length(sign) <= 8) then
+ begin
+ st.ReadBuffer(buf[0], Length(sign));
+ for f := 1 to Length(sign) do if (buf[f-1] <> sign[f]) then exit;
+ end
+ else
+ begin
+ for f := 1 to Length(sign) do
+ begin
+ st.ReadBuffer(buf[0], 1);
+ if (buf[0] <> sign[f]) then exit;
+ end;
+ end;
+ end;
+ result := true;
+end;
+
procedure writeInt (st: TStream; v: Byte); overload; begin writeIntegerLE(st, @v, 1); end;
procedure writeInt (st: TStream; v: ShortInt); overload; begin writeIntegerLE(st, @v, 1); end;
procedure writeInt (st: TStream; v: Word); overload; begin writeIntegerLE(st, @v, 2); end;
procedure writeInt (st: TStream; v: Byte); overload; begin writeIntegerLE(st, @v, 1); end;
procedure writeInt (st: TStream; v: ShortInt); overload; begin writeIntegerLE(st, @v, 1); end;
procedure writeInt (st: TStream; v: Word); overload; begin writeIntegerLE(st, @v, 2); end;
@@ -1104,6 +1227,31 @@ procedure writeIntBE (st: TStream; v: LongInt); overload; begin writeIntegerBE(s
procedure writeIntBE (st: TStream; v: Int64); overload; begin writeIntegerBE(st, @v, 8); end;
procedure writeIntBE (st: TStream; v: UInt64); overload; begin writeIntegerBE(st, @v, 8); end;
procedure writeIntBE (st: TStream; v: Int64); overload; begin writeIntegerBE(st, @v, 8); end;
procedure writeIntBE (st: TStream; v: UInt64); overload; begin writeIntegerBE(st, @v, 8); end;
+procedure writeBool (st: TStream; b: Boolean); begin writeInt(st, Byte(b)); end;
+function readBool (st: TStream): Boolean; begin result := (readByte(st) <> 0); end;
+
+
+procedure writeStr (st: TStream; const str: AnsiString; maxlen: LongWord=65535);
+begin
+ if (Length(str) > maxlen) then raise XStreamError.Create('string too long');
+ if (maxlen <= 65535) then writeInt(st, Word(Length(str))) else writeInt(st, LongWord(Length(str)));
+ if (Length(str) > 0) then st.WriteBuffer(str[1], Length(str));
+end;
+
+function readStr (st: TStream; maxlen: LongWord=65535): AnsiString;
+var
+ len: Integer;
+begin
+ result := '';
+ if (maxlen <= 65535) then len := readWord(st) else len := Integer(readLongWord(st));
+ if (len < 0) or (len > maxlen) then raise XStreamError.Create('string too long');
+ if (len > 0) then
+ begin
+ SetLength(result, len);
+ st.ReadBuffer(result[1], len);
+ end;
+end;
+
procedure readIntegerLE (st: TStream; vp: Pointer; size: Integer);
{$IFDEF ENDIAN_LITTLE}
procedure readIntegerLE (st: TStream; vp: Pointer; size: Integer);
{$IFDEF ENDIAN_LITTLE}
*)
*)
-function formatstrf (const fmt: AnsiString; args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
+function formatstrf (const fmt: AnsiString; const args: array of const; writerCB: TFormatStrFCallback=nil): AnsiString;
const
PadSpaces: AnsiString = ' ';
PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
const
PadSpaces: AnsiString = ' ';
PadZeroes: AnsiString = '00000000000000000000000000000000000000000000000000000000000000000000000';
fmtblen: Integer;
pclen: Integer;
pc: PAnsiChar;
fmtblen: Integer;
pclen: Integer;
pc: PAnsiChar;
+ ccname: ShortString;
procedure writer (constref buf; len: SizeUInt);
var
procedure writer (constref buf; len: SizeUInt);
var
xpos := High(strbuf);
strbuf[xpos] := #0; Dec(xpos);
repeat
xpos := High(strbuf);
strbuf[xpos] := #0; Dec(xpos);
repeat
- if hex then
+ if not hex then
begin
strbuf[xpos] := AnsiChar((n mod 10)+48);
Dec(xpos);
begin
strbuf[xpos] := AnsiChar((n mod 10)+48);
Dec(xpos);
xpos := High(strbuf);
strbuf[xpos] := #0; Dec(xpos);
repeat
xpos := High(strbuf);
strbuf[xpos] := #0; Dec(xpos);
repeat
- if hex then
+ if not hex then
begin
strbuf[xpos] := AnsiChar((n mod 10)+48);
Dec(xpos);
begin
strbuf[xpos] := AnsiChar((n mod 10)+48);
Dec(xpos);
end;
vtObject: // args[curarg].VObject.Classname (TObject)
begin
end;
vtObject: // args[curarg].VObject.Classname (TObject)
begin
- if (sign <> '-') then indent(width-Length(args[curarg].VObject.Classname));
- xwrite(args[curarg].VObject.Classname);
- if (sign = '-') then indent(width-Length(args[curarg].VObject.Classname));
+ if (args[curarg].VObject <> nil) then ccname := args[curarg].VObject.Classname else ccname := '<nil>';
+ if (sign <> '-') then indent(width-Length(ccname));
+ xwrite(ccname);
+ if (sign = '-') then indent(width-Length(ccname));
end;
vtClass: // args[curarg].VClass.Classname (TClass)
begin
end;
vtClass: // args[curarg].VClass.Classname (TClass)
begin
- if (sign <> '-') then indent(width-Length(args[curarg].VClass.Classname));
- xwrite(args[curarg].VClass.Classname);
- if (sign = '-') then indent(width-Length(args[curarg].VClass.Classname));
+ if (args[curarg].VClass <> nil) then ccname := args[curarg].VClass.Classname else ccname := '<nil>';
+ if (sign <> '-') then indent(width-Length(ccname));
+ xwrite(ccname);
+ if (sign = '-') then indent(width-Length(ccname));
end;
//vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
vtAnsiString: // AnsiString(args[curarg].VAnsiString) (Pointer)
end;
//vtPWideChar: begin end; // args[curarg].VPWideChar (PWideChar)
vtAnsiString: // AnsiString(args[curarg].VAnsiString) (Pointer)