1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
|
{
*********************************************************************
Copyright (C) 1997, 1998 Gertjan Schouten
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************
System Utilities For Free Pascal
}
{==============================================================================}
{ standard functions }
{==============================================================================}
type
PString = ^String;
{ For FloatToText }
TFloatFormat = (ffGeneral, ffExponent, ffFixed, ffNumber, ffCurrency);
TFloatValue = (fvExtended, fvCurrency, fvSingle, fvReal, fvDouble, fvComp);
TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
TFloatRec = Record
Exponent: Integer;
Negative: Boolean;
Digits: Array[0..18] Of Char;
End;
const
{ For floattodatetime and VariantToDate }
{$ifndef FPUNONE}
MinDateTime: TDateTime = -693593.0; { 01/01/0001 12:00:00.000 AM }
MaxDateTime: TDateTime = 2958465.99999; { 12/31/9999 11:59:59.999 PM }
{$if defined(FPC_HAS_TYPE_EXTENDED) or defined(FPC_HAS_TYPE_FLOAT128)}
MinCurrency: Currency = -922337203685477.5807;
MaxCurrency: Currency = 922337203685477.5807;
{$else}
MinCurrency: Currency = -922337203685477.0000;
MaxCurrency: Currency = 922337203685477.0000;
{$endif}
{$else}
MinCurrency: Currency = -9223372036854775807;
MaxCurrency: Currency = 9223372036854775807;
{$endif}
Const
LeadBytes: set of Char = [];
EmptyStr : string = '';
NullStr : PString = @EmptyStr;
EmptyWideStr : WideString = '';
// NullWideStr : PWideString = @EmptyWideStr;
Var TrueBoolStrs,
FalseBoolStrs : Array of String;
// declaring this breaks delphi compatibility and e.g. tw3721.pp
// function NewStr(Const S: ShortString): PShortString; overload;
function NewStr(const S: string): PString; overload;
procedure DisposeStr(S: PString); overload;
procedure DisposeStr(S: PShortString); overload;
procedure AssignStr(var P: PString; const S: string);
procedure AppendStr(var Dest: String; const S: string);
function UpperCase(const s: string): string;
function LowerCase(const s: string): string; overload;
{ the compiler can't decide else if it should use the char or the ansistring
version for a variant }
function LowerCase(const V: variant): string; overload;{$ifdef SYSUTILSINLINE}inline;{$endif}
function CompareStr(const S1, S2: string): Integer; overload;
function CompareMemRange(P1, P2: Pointer; Length: PtrUInt): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function CompareMem(P1, P2: Pointer; Length: PtrUInt): Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
function CompareText(const S1, S2: string): integer;
function SameText(const s1,s2:String):Boolean;
function AnsiUpperCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiLowerCase(const s: string): string;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiCompareStr(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiCompareText(const S1, S2: string): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiSameText(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiSameStr(const s1,s2:String):Boolean;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrIComp(S1, S2: PChar): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrLComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrLIComp(S1, S2: PChar; MaxLen: cardinal): integer;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrLower(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiStrUpper(Str: PChar): PChar;{$ifdef SYSUTILSINLINE}inline;{$endif}
function AnsiLastChar(const S: string): PChar;
function AnsiStrLastChar(Str: PChar): PChar;
function Trim(const S: string): string;
function TrimLeft(const S: string): string;
function TrimRight(const S: string): string;
function QuotedStr(const S: string): string;
function AnsiQuotedStr(const S: string; Quote: char): string;
function AnsiDequotedStr(const S: string; AQuote: Char): string;
function AnsiExtractQuotedStr(var Src: PChar; Quote: Char): string;
function AdjustLineBreaks(const S: string): string;
function AdjustLineBreaks(const S: string; Style: TTextLineBreakStyle): string;
function IsValidIdent(const Ident: string): boolean;
function IntToStr(Value: integer): string;
function IntToStr(Value: Int64): string;
function IntToStr(Value: QWord): string;
function IntToHex(Value: integer; Digits: integer): string;
function IntToHex(Value: Int64; Digits: integer): string;
function IntToHex(Value: QWord; Digits: integer): string;
function StrToInt(const s: string): integer;
function TryStrToInt(const s: string; Out i : integer) : boolean;
function StrToInt64(const s: string): int64;
function TryStrToInt64(const s: string; Out i : int64) : boolean;
function StrToQWord(const s: string): QWord;
function TryStrToQWord(const s: string; Out Q : QWord) : boolean;
function StrToIntDef(const S: string; Default: integer): integer;
function StrToInt64Def(const S: string; Default: int64): int64;
function StrToQWordDef(const S: string; Default: QWord): QWord;
function LoadStr(Ident: integer): string;
// function FmtLoadStr(Ident: integer; const Args: array of const): string;
Function Format (Const Fmt : String; const Args : Array of const) : String;
Function Format (Const Fmt: string; const Args: array of const; const FormatSettings: TFormatSettings): string;
Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const) : Cardinal;
Function FormatBuf (Var Buffer; BufLen : Cardinal; Const Fmt; fmtLen : Cardinal; Const Args : Array of const; Const FormatSettings: TFormatSettings) : Cardinal;
Function StrFmt(Buffer,Fmt : PChar; Const args: Array of const) : Pchar;
Function StrFmt(Buffer,Fmt : PChar; Const Args: Array of const; Const FormatSettings: TFormatSettings): PChar;
Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const) : Pchar;
Function StrLFmt(Buffer : PCHar; Maxlen : Cardinal;Fmt : PChar; Const args: Array of const; Const FormatSettings: TFormatSettings) : Pchar;
Procedure FmtStr(Var Res: String; Const Fmt : String; Const args: Array of const);
Procedure FmtStr(Var Res: string; const Fmt : string; Const args: Array of const; Const FormatSettings: TFormatSettings);
{$ifndef FPUNONE}
{$ifdef FPC_HAS_TYPE_EXTENDED}
Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer): String;
Function FloatToStrF(Value: Extended; format: TFloatFormat; Precision, Digits: Integer; Const FormatSettings: TFormatSettings): String;
{$endif FPC_HAS_TYPE_EXTENDED}
Function FloatToStrF(Value: Double; format: TFloatFormat; Precision, Digits: Integer): String;
Function FloatToStrF(Value: Double; format: TFloatFormat; Precision, Digits: Integer; Const FormatSettings: TFormatSettings): String;
Function FloatToStrF(Value: Single; format: TFloatFormat; Precision, Digits: Integer): String;
Function FloatToStrF(Value: Single; format: TFloatFormat; Precision, Digits: Integer; Const FormatSettings: TFormatSettings): String;
Function FloatToStrF(Value: Comp; format: TFloatFormat; Precision, Digits: Integer): String;
Function FloatToStrF(Value: Comp; format: TFloatFormat; Precision, Digits: Integer; Const FormatSettings: TFormatSettings): String;
Function FloatToStrF(Value: Currency; format: TFloatFormat; Precision, Digits: Integer): String;
Function FloatToStrF(Value: Currency; format: TFloatFormat; Precision, Digits: Integer; Const FormatSettings: TFormatSettings): String;
{$ifndef FPC_COMP_IS_INT64}
Function FloatToStrF(Value: Int64; format: TFloatFormat; Precision, Digits: Integer): String;
Function FloatToStrF(Value: Int64; format: TFloatFormat; Precision, Digits: Integer; Const FormatSettings: TFormatSettings): String;
{$endif FPC_COMP_IS_INT64}
Function CurrToStrF(Value: Currency; Format: TFloatFormat; Digits: Integer): string;
Function CurrToStrF(Value: Currency; Format: TFloatFormat; Digits: Integer; Const FormatSettings: TFormatSettings): string;
{$ifdef FPC_HAS_TYPE_EXTENDED}
Function FloatToStr(Value: Extended): String;
Function FloatToStr(Value: Extended; Const FormatSettings: TFormatSettings): String;
{$endif FPC_HAS_TYPE_EXTENDED}
Function FloatToStr(Value: Double): String;
Function FloatToStr(Value: Double; Const FormatSettings: TFormatSettings): String;
Function FloatToStr(Value: Single): String;
Function FloatToStr(Value: Single; Const FormatSettings: TFormatSettings): String;
Function FloatToStr(Value: Currency): String;
Function FloatToStr(Value: Currency; Const FormatSettings: TFormatSettings): String;
Function FloatToStr(Value: Comp): String;
Function FloatToStr(Value: Comp; Const FormatSettings: TFormatSettings): String;
{$ifndef FPC_COMP_IS_INT64}
Function FloatToStr(Value: Int64): String;
Function FloatToStr(Value: Int64; Const FormatSettings: TFormatSettings): String;
{$endif FPC_COMP_IS_INT64}
Function StrToFloat(Const S : String) : Extended;
Function StrToFloat(Const S : String; Const FormatSettings: TFormatSettings) : Extended;
Function StrToFloatDef(Const S: String; Const Default: Extended): Extended;
Function StrToFloatDef(Const S: String; Const Default: Extended; Const FormatSettings: TFormatSettings): Extended;
Function TryStrToFloat(Const S : String; Out Value: Single): Boolean;
Function TryStrToFloat(Const S : String; Out Value: Single; Const FormatSettings: TFormatSettings): Boolean;
Function TryStrToFloat(Const S : String; Out Value: Double): Boolean;
Function TryStrToFloat(Const S : String; Out Value: Double; Const FormatSettings: TFormatSettings): Boolean;
{$ifdef FPC_HAS_TYPE_EXTENDED}
Function TryStrToFloat(Const S : String; Out Value: Extended): Boolean;
Function TryStrToFloat(Const S : String; Out Value: Extended; Const FormatSettings: TFormatSettings): Boolean;
{$endif FPC_HAS_TYPE_EXTENDED}
Function TextToFloat(Buffer: PChar; Out Value: Extended): Boolean;
Function TextToFloat(Buffer: PChar; Out Value: Extended; Const FormatSettings: TFormatSettings): Boolean;
Function TextToFloat(Buffer: PChar; Out Value; ValueType: TFloatValue): Boolean;
Function TextToFloat(Buffer: PChar; Out Value; ValueType: TFloatValue; Const FormatSettings: TFormatSettings): Boolean;
Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer): Longint;
Function FloatToText(Buffer: PChar; Value: Extended; format: TFloatFormat; Precision, Digits: Integer; Const FormatSettings: TFormatSettings): Longint;
Function FloatToDateTime (Const Value : Extended) : TDateTime;
Function FloattoCurr (Const Value : Extended) : Currency;
function TryFloatToCurr(const Value: Extended; var AResult: Currency): Boolean;
Function CurrToStr(Value: Currency): string;
Function CurrToStr(Value: Currency; Const FormatSettings: TFormatSettings): string;
function StrToCurr(const S: string): Currency;
function StrToCurr(const S: string; Const FormatSettings: TFormatSettings): Currency;
function TryStrToCurr(const S: string;Out Value : Currency): Boolean;
function TryStrToCurr(const S: string;Out Value : Currency; Const FormatSettings: TFormatSettings): Boolean;
function StrToCurrDef(const S: string; Default : Currency): Currency;
function StrToCurrDef(const S: string; Default : Currency; Const FormatSettings: TFormatSettings): Currency;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar; FormatSettings : TFormatSettings): Integer;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
Procedure FloatToDecimal(Out Result: TFloatRec; const Value; ValueType: TFloatValue; Precision, Decimals : integer);
Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Function FormatFloat(Const Format : String; Value : Extended) : String;
Function FormatFloat(Const Format : String; Value : Extended; Const FormatSettings: TFormatSettings) : String;
function FormatCurr(const Format: string; Value: Currency): string;
Function FormatCurr(const Format: string; Value: Currency; Const FormatSettings: TFormatSettings): string;
{$endif}
function StrToBool(const S: string): Boolean;
function BoolToStr(B: Boolean;UseBoolStrs:Boolean=False): string;
function BoolToStr(B: Boolean;const TrueS,FalseS:string): string; inline;
function StrToBoolDef(const S: string; Default: Boolean): Boolean;
function TryStrToBool(const S: string; out Value: Boolean): Boolean;
function LastDelimiter(const Delimiters, S: string): Integer;
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
function SScanf(const s: string; const fmt : string;const Pointers : array of Pointer) : Integer;
{// MBCS Functions. No MBCS yet, so mostly these are calls to the regular counterparts.}
Type
TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);
Function ByteType(const S: string; Index: Integer): TMbcsByteType;
Function StrByteType(Str: PChar; Index: Cardinal): TMbcsByteType;
Function ByteToCharLen(const S: string; MaxLen: Integer): Integer;
Function CharToByteLen(const S: string; MaxLen: Integer): Integer;
Function ByteToCharIndex(const S: string; Index: Integer): Integer;
Function StrCharLength(const Str: PChar): Integer;
function StrNextChar(const Str: PChar): PChar;
const
{$ifndef unix}
SwitchChars = ['/','-'];
{$else}
SwitchChars = ['-'];
{$endif}
Type
TSysCharSet = Set of char;
PSysCharSet = ^TSysCharSet;
Function FindCmdLineSwitch(const Switch: string; const Chars: TSysCharSet;IgnoreCase: Boolean): Boolean;
Function FindCmdLineSwitch(const Switch: string; IgnoreCase: Boolean): Boolean;
Function FindCmdLineSwitch(const Switch: string): Boolean;
function WrapText(const Line, BreakStr: string; const BreakChars: TSysCharSet; MaxCol: Integer): string;
function WrapText(const Line: string; MaxCol: Integer): string;
{==============================================================================}
{ extra functions }
{==============================================================================}
function LeftStr(const S: string; Count: integer): string;
function RightStr(const S: string; Count: integer): string;
function BCDToInt(Value: integer): integer;
|
