1 {*********************************************************}
3 { Zeos Database Objects }
4 { System Utility Classes and Functions }
6 { Originally written by Sergey Seroukhov }
8 {*********************************************************}
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
13 { License Agreement: }
15 { This library is distributed in the hope that it will be }
16 { useful, but WITHOUT ANY WARRANTY; without even the }
17 { implied warranty of MERCHANTABILITY or FITNESS FOR }
18 { A PARTICULAR PURPOSE. See the GNU Lesser General }
19 { Public License for more details. }
21 { The source code of the ZEOS Libraries and packages are }
22 { distributed under the Library GNU General Public }
23 { License (see the file COPYING / COPYING.ZEOS) }
24 { with the following modification: }
25 { As a special exception, the copyright holders of this }
26 { library give you permission to link this library with }
27 { independent modules to produce an executable, }
28 { regardless of the license terms of these independent }
29 { modules, and to copy and distribute the resulting }
30 { executable under terms of your choice, provided that }
31 { you also meet, for each linked independent module, }
32 { the terms and conditions of the license of that module. }
33 { An independent module is a module which is not derived }
34 { from or based on this library. If you modify this }
35 { library, you may extend this exception to your version }
36 { of the library, but you are not obligated to do so. }
37 { If you do not wish to do so, delete this exception }
38 { statement from your version. }
41 { The project web site is located on: }
42 { http://zeos.firmos.at (FORUM) }
43 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
44 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
46 { http://www.sourceforge.net/projects/zeoslib. }
49 { Zeos Development Group. }
50 {********************************************************@}
59 Variants, Classes, {$IFDEF MSEgui}mclasses,{$ENDIF} SysUtils, Types,
60 ZMessages, ZCompatibility;
63 {** Modified comaprison function. }
64 TZListSortCompare = function (Item1, Item2: Pointer): Integer of object;
66 {** Modified list of pointers. }
67 TZSortedList = class (TList)
69 procedure QuickSort(SortList: PPointerList; L, R: Integer;
70 SCompare: TZListSortCompare);
72 procedure Sort(Compare: TZListSortCompare);
76 Determines a position of a first delimiter.
77 @param Delimiters a string with possible delimiters.
78 @param Str a string to be checked.
79 @return a position of the first found delimiter or 0 if no delimiters was found.
81 function FirstDelimiter(const Delimiters, Str: string): Integer;
84 Determines a position of a LAST delimiter.
85 @param Delimiters a string with possible delimiters.
86 @param Str a string to be checked.
87 @return a position of the last found delimiter or 0 if no delimiters was found.
89 function LastDelimiter(const Delimiters, Str: string): Integer;
92 Compares two PWideChars without stopping at #0 (Unicode Version)
93 @param P1 first PWideChars
94 @param P2 seconds PWideChars
95 @return <code>True</code> if the memory at P1 and P2 are equal
97 function MemLCompUnicode(P1, P2: PWideChar; Len: Integer): Boolean;
100 Compares two PAnsiChars without stopping at #0
101 @param P1 first PAnsiChar
102 @param P2 seconds PAnsiChar
103 @return <code>True</code> if the memory at P1 and P2 are equal
105 function MemLCompAnsi(P1, P2: PAnsiChar; Len: Integer): Boolean;
108 Checks is the string starts with substring.
109 @param Str a string to be checked.
110 @param SubStr a string to test at the start of the Str.
111 @return <code>True</code> if Str started with SubStr;
113 function StartsWith(const Str, SubStr: ZWideString): Boolean; overload;
114 function StartsWith(const Str, SubStr: RawByteString): Boolean; overload;
116 Checks is the string ends with substring.
117 @param Str a string to be checked.
118 @param SubStr a string to test at the end of the Str.
119 @return <code>True</code> if Str ended with SubStr;
121 function EndsWith(const Str, SubStr: ZWideString): Boolean; overload;
122 function EndsWith(const Str, SubStr: RawByteString): Boolean; overload;
125 Converts SQL string into float value.
126 @param Str an SQL string with comma delimiter.
127 @param Def a default value if the string can not be converted.
128 @return a converted value or Def if conversion was failt.
130 {$IFDEF WITH_RAWBYTESTRING}
131 function SQLStrToFloatDef(Str: RawByteString; Def: Extended): Extended; overload;
133 function SQLStrToFloatDef(Str: String; Def: Extended): Extended; overload;
136 Converts SQL string into float value.
137 @param Str an SQL string with comma delimiter.
138 @return a converted value or Def if conversion was failt.
140 function SQLStrToFloat(const Str: AnsiString): Extended;
143 Converts a character buffer into pascal string.
144 @param Buffer a character buffer pointer.
145 @param Length a buffer length.
146 @return a string retrived from the buffer.
148 function BufferToStr(Buffer: PWideChar; Length: LongInt): string; overload;
149 function BufferToStr(Buffer: PAnsiChar; Length: LongInt): string; overload;
150 function BufferToBytes(Buffer: Pointer; Length: LongInt): TByteDynArray;
153 Converts a string into boolean value.
154 @param Str a string value.
155 @return <code>True</code> is Str = 'Y'/'YES'/'T'/'TRUE'/<>0
157 function StrToBoolEx(Str: string): Boolean;
160 Converts a boolean into string value.
161 @param Bool a boolean value.
162 @return <code>"True"</code> or <code>"False"</code>
164 function BoolToStrEx(Bool: Boolean): String;
167 Checks if the specified string can represent an IP address.
168 @param Str a string value.
169 @return <code>True</code> if the string can represent an IP address
170 or <code>False</code> otherwise.
172 function IsIpAddr(const Str: string): Boolean;
175 Splits string using the multiple chars.
176 @param Str the source string
177 @param Delimiters the delimiters string
178 @return the result list where plased delimited string
180 function SplitString(const Str, Delimiters: string): TStrings;
183 Puts to list a splitted string using the multiple chars which replaces
184 the previous list content.
185 @param List a list with strings.
186 @param Str the source string
187 @param Delimiters the delimiters string
189 procedure PutSplitString(List: TStrings; const Str, Delimiters: string);
192 Appends to list a splitted string using the multiple chars.
193 @param List a list with strings.
194 @param Str the source string
195 @param Delimiters the delimiters string
197 procedure AppendSplitString(List: TStrings; const Str, Delimiters: string);
200 Composes a string from the specified strings list delimited with
202 @param List a list of strings.
203 @param Delimiter a delimiter string.
204 @return a composed string from the list.
206 function ComposeString(List: TStrings; const Delimiter: string): string;
209 Converts a float value into SQL string with '.' delimiter.
210 @param Value a float value to be converted.
211 @return a converted string value.
213 function FloatToSQLStr(Value: Extended): string;
216 Puts to list a splitted string using the delimiter string which replaces
217 the previous list content.
218 @param List a list with strings.
219 @param Str the source string
220 @param Delimiters the delimiter string
222 procedure PutSplitStringEx(List: TStrings; const Str, Delimiter: string);
225 Splits string using the delimiter string.
226 @param Str the source string
227 @param Delimiters the delimiter string
228 @return the result list where plased delimited string
230 function SplitStringEx(const Str, Delimiter: string): TStrings;
233 Appends to list a splitted string using the delimeter string.
234 @param List a list with strings.
235 @param Str the source string
236 @param Delimiters the delimiters string
238 procedure AppendSplitStringEx(List: TStrings; const Str, Delimiter: string);
241 Converts bytes into a AnsiString representation.
242 @param Value an array of bytes to be converted.
243 @return a converted AnsiString.
245 function BytesToStr(const Value: TByteDynArray): AnsiString;
248 Converts AnsiString into an array of bytes.
249 @param Value a AnsiString to be converted.
250 @return a converted array of bytes.
252 function StrToBytes(const Value: AnsiString): TByteDynArray; overload;
254 {$IFDEF WITH_RAWBYTESTRING}
256 Converts a UTF8String into an array of bytes.
257 @param Value a UTF8String to be converted.
258 @return a converted array of bytes.
260 function StrToBytes(const Value: UTF8String): TByteDynArray; overload;
262 Converts a UTF8String into an array of bytes.
263 @param Value a UTF8String to be converted.
264 @return a converted array of bytes.
266 function StrToBytes(const Value: RawByteString): TByteDynArray; overload;
268 Converts a RawByteString into an array of bytes.
269 @param Value a RawByteString to be converted.
270 @return a converted array of bytes.
273 function StrToBytes(const Value: WideString): TByteDynArray; overload;
275 Converts a String into an array of bytes.
276 @param Value a String to be converted.
277 @return a converted array of bytes.
279 {$IFDEF PWIDECHAR_IS_PUNICODECHAR}
280 function StrToBytes(const Value: UnicodeString): TByteDynArray; overload;
283 Converts bytes into a variant representation.
284 @param Value an array of bytes to be converted.
285 @return a converted variant.
287 function BytesToVar(const Value: TByteDynArray): Variant;
290 Converts variant into an array of bytes.
291 @param Value a varaint to be converted.
292 @return a converted array of bytes.
294 function VarToBytes(const Value: Variant): TByteDynArray;
297 Converts Ansi SQL Date/Time to TDateTime
298 @param Value a date and time string.
299 @return a decoded TDateTime value.
301 function AnsiSQLDateToDateTime(const Value: string): TDateTime;
304 Converts Timestamp String to TDateTime
305 @param Value a timestamp string.
306 @return a decoded TDateTime value.
308 function TimestampStrToDateTime(const Value: string): TDateTime;
311 Converts TDateTime to Ansi SQL Date/Time
312 @param Value an encoded TDateTime value.
313 @return a date and time string.
315 function DateTimeToAnsiSQLDate(Value: TDateTime; WithMMSec: Boolean = False): string;
318 Converts an string into escape PostgreSQL format.
319 @param Value a regular string.
320 @return a string in PostgreSQL escape format.
322 function EncodeCString(const Value: string): string;
325 Converts an string from escape PostgreSQL format.
326 @param Value a string in PostgreSQL escape format.
327 @return a regular string.
329 function DecodeCString(const Value: string): string;
332 Replace chars in the string
333 @param Source a char to search.
334 @param Target a char to replace.
335 @param Str a source string.
336 @return a string with replaced chars.
338 function ReplaceChar(const Source, Target: Char; const Str: string): string;
341 Copy buffer to the pascal string
342 @param Buffer a buffer with data
343 @param Length a buffer length
344 @return a buffer content
346 function MemPas(Buffer: PChar; Length: LongInt): string;
349 Decodes a Full Version Value encoded with the format:
350 (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
351 into separated major, minor and subversion values
352 @param FullVersion an integer containing the Full Version to decode.
353 @param MajorVersion an integer containing the Major Version decoded.
354 @param MinorVersion an integer containing the Minor Version decoded.
355 @param SubVersion an integer contaning the Sub Version (revision) decoded.
357 procedure DecodeSQLVersioning(const FullVersion: Integer;
358 out MajorVersion: Integer; out MinorVersion: Integer;
359 out SubVersion: Integer);
362 Encodes major, minor and subversion (revision) values in this format:
363 (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
364 For example, 4.1.12 is returned as 4001012.
365 @param MajorVersion an integer containing the Major Version.
366 @param MinorVersion an integer containing the Minor Version.
367 @param SubVersion an integer containing the Sub Version (revision).
368 @return an integer containing the full version.
370 function EncodeSQLVersioning(const MajorVersion: Integer;
371 const MinorVersion: Integer; const SubVersion: Integer): Integer;
374 Formats a Zeos SQL Version format to X.Y.Z where:
378 @param SQLVersion an integer
379 @return Formated Zeos SQL Version Value.
381 function FormatSQLVersion( const SQLVersion: Integer ): String;
384 Arranges thousand and decimal separator to a System-defaults
385 @param the value which has to be converted and arranged
386 @return a valid floating value
388 function ZStrToFloat(Value: PAnsiChar): Extended; overload;
391 Arranges thousand and decimal separator to a System-defaults
392 @param the value which has to be converted and arranged
393 @return a valid floating value
395 function ZStrToFloat(Value: AnsiString): Extended; overload;
397 procedure ZSetString(const Src: PAnsiChar; var Dest: AnsiString); overload;
398 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: AnsiString); overload;
399 procedure ZSetString(const Src: PAnsiChar; var Dest: UTF8String); overload;
400 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: UTF8String); overload;
401 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: ZWideString); overload;
402 {$IFDEF WITH_RAWBYTESTRING}
403 procedure ZSetString(const Src: PAnsiChar; var Dest: RawByteString); overload;
404 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: RawByteString); overload;
409 uses ZMatchPattern, StrUtils {$IFDEF WITH_UNITANSISTRINGS}, AnsiStrings{$ENDIF};
412 Determines a position of a first delimiter.
413 @param Delimiters a string with possible delimiters.
414 @param Str a string to be checked.
415 @return a position of the first found delimiter or 0 if no delimiters was found.
417 function FirstDelimiter(const Delimiters, Str: string): Integer;
422 for I := 1 to Length(Delimiters) do
424 Index := Pos(Delimiters[I], Str);
425 if (Index > 0) and ((Index < Result) or (Result = 0)) then
431 Determines a position of a LAST delimiter.
432 @param Delimiters a string with possible delimiters.
433 @param Str a string to be checked.
434 @return a position of the last found delimiter or 0 if no delimiters was found.
436 function LastDelimiter(const Delimiters, Str: string): Integer;
441 for I := Length(Str) downto 1 do
443 Index := Pos(Str[I], Delimiters);
454 Compares two PWideChars without stopping at #0 (Unicode Version)
455 @param P1 first PWideChar
456 @param P2 seconds PWideChar
457 @return <code>True</code> if the memory at P1 and P2 are equal
459 function MemLCompUnicode(P1, P2: PWideChar; Len: Integer): Boolean;
461 while (Len > 0) and (P1^ = P2^) do
471 Compares two PAnsiChars without stopping at #0
472 @param P1 first PAnsiChar
473 @param P2 seconds PAnsiChar
474 @return <code>True</code> if the memory at P1 and P2 are equal
476 function MemLCompAnsi(P1, P2: PAnsiChar; Len: Integer): Boolean;
478 while (Len > 0) and (P1^ = P2^) do
488 Checks is the string starts with substring.
489 @param Str a string to be checked.
490 @param SubStr a string to test at the start of the Str.
491 @return <code>True</code> if Str started with SubStr;
493 function StartsWith(const Str, SubStr: ZWideString): Boolean;
497 LenSubStr := Length(SubStr);
500 else if LenSubStr <= Length(Str) then
501 Result := MemLCompUnicode(PWideChar(Str), PWideChar(SubStr), LenSubStr)
506 function StartsWith(const Str, SubStr: RawByteString): Boolean; overload;
510 LenSubStr := Length(SubStr);
514 if LenSubStr <= Length(Str) then
515 Result := MemLCompAnsi(PAnsiChar(Str), PAnsiChar(SubStr), LenSubStr)
521 Checks is the string ends with substring.
522 @param Str a string to be checked.
523 @param SubStr a string to test at the end of the Str.
524 @return <code>True</code> if Str ended with SubStr;
526 function EndsWith(const Str, SubStr: ZWideString): Boolean;
532 Result := False // act like Delphi's AnsiEndsStr()
535 LenSubStr := Length(SubStr);
536 LenStr := Length(Str);
537 if LenSubStr <= LenStr then
538 Result := MemLCompUnicode(PWideChar(Pointer(Str)) + LenStr - LenSubStr,
539 Pointer(SubStr), LenSubStr)
545 function EndsWith(const Str, SubStr: RawByteString): Boolean;
551 Result := False // act like Delphi's AnsiEndsStr()
554 LenSubStr := Length(SubStr);
555 LenStr := Length(Str);
556 if LenSubStr <= LenStr then
557 Result := MemLCompAnsi(PAnsiChar(Pointer(Str)) + LenStr - LenSubStr,
558 Pointer(SubStr), LenSubStr)
564 function ConvertMoneyToFloat(MoneyString: String): String;
568 if MoneyString = '' then
572 if CharInSet(Char(MoneyString[1]), ['0'..'9', '-']) then
573 Result := MoneyString
575 for i := 1 to Length(MoneyString) do
576 if CharInSet(Char(MoneyString[I]), ['0'..'9', '-']) then
580 Result := Copy(MoneyString, I, Length(MoneyString)-i+1);
581 if Pos(',', Result) > 0 then
582 if Pos('.', Result) > 0 then
584 Result := Copy(Result, 1, Pos(',', Result)-1);
585 while Pos('.', Result) > 0 do
586 Result := Copy(Result, 1, Pos('.', Result)-1)+Copy(Result, Pos('.', Result)+1, Length(Result)); //remove ThousandSeparator
587 Result := Result + '.'+Copy(MoneyString, Pos(',', MoneyString)+1, Length(MoneyString));
590 Result[Pos(',', Result)] := '.';
597 Converts SQL string into float value.
598 @param Str an SQL string with comma delimiter.
599 @param Def a default value if the string can not be converted.
600 @return a converted value or Def if conversion was failt.
602 {$IFDEF WITH_RAWBYTESTRING}
603 function SQLStrToFloatDef(Str: RawByteString; Def: Extended): Extended;
605 OldDecimalSeparator: Char;
606 OldThousandSeparator: Char;
613 OldDecimalSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator;
614 OldThousandSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator;
615 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := '.';
616 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := ',';
617 if not CharInSet(Char(String(Str)[1]), ['0'..'9', '-']) then
618 AString := ConvertMoneyToFloat(String(Str))
620 AString := String(Str);
621 Result := StrToFloatDef(AString, Def);
622 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
623 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := OldThousandSeparator;
628 function SQLStrToFloatDef(Str: String; Def: Extended): Extended;
630 OldDecimalSeparator: Char;
631 OldThousandSeparator: Char;
638 OldDecimalSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator;
639 OldThousandSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator;
640 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := '.';
641 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := ',';
642 if not CharInSet(Char(Str[1]), ['0'..'9', '-']) then
643 AString := ConvertMoneyToFloat(Str)
646 Result := StrToFloatDef(AString, Def);
647 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
648 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := OldThousandSeparator;
653 Converts SQL string into float value.
654 @param Str an SQL string with comma delimiter.
655 @return a converted value or Def if conversion was failt.
657 function SQLStrToFloat(const Str: AnsiString): Extended;
659 OldDecimalSeparator: Char;
661 OldDecimalSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator;
662 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := '.';
664 Result := StrToFloat(String(Str));
666 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
670 { Convert string buffer into pascal string }
672 function BufferToStr(Buffer: PWideChar; Length: LongInt): string;
676 if Assigned(Buffer) then
678 SetString(s, Buffer, Length div SizeOf(Char));
683 { Convert string buffer into pascal string }
685 function BufferToStr(Buffer: PAnsiChar; Length: LongInt): string;
688 if Assigned(Buffer) then
689 SetString(Result, Buffer, Length);
692 function BufferToBytes(Buffer: Pointer; Length: LongInt): TByteDynArray;
694 SetLength(Result, Length);
695 System.Move(Buffer^, Pointer(Result)^, Length);
699 Converts a string into boolean value.
700 @param Str a string value.
701 @return <code>True</code> is Str = 'Y'/'YES'/'T'/'TRUE'/<>0
703 function StrToBoolEx(Str: string): Boolean;
705 Str := UpperCase(Str);
706 Result := (Str = 'Y') or (Str = 'YES') or (Str = 'T') or (Str = 'TRUE')
707 or (StrToIntDef(Str, 0) <> 0);
711 Converts a boolean into string value.
712 @param Bool a boolean value.
713 @return <code>"True"</code> or <code>"False"</code>
715 function BoolToStrEx(Bool: Boolean): String;
724 Checks if the specified string can represent an IP address.
725 @param Str a string value.
726 @return <code>True</code> if the string can represent an IP address
727 or <code>False</code> otherwise.
729 function IsIpAddr(const Str: string): Boolean;
731 I, N, M, Pos, Val: Integer;
733 if IsMatch('*.*.*.*', Str) then
738 for I := 1 to Length(Str) do
744 {ticked #73/#24 patch }
745 Val := StrToIntDef(Copy(Str, Pos, I - Pos), -1);
746 if not ((Val > -1 ) and (Val < 256)) then
751 if CharInSet(Str[I], ['0'..'9']) then
754 Result := (M + N = Length(Str)) and (N = 3);
760 procedure SplitToStringList(List: TStrings; Str: string; const Delimiters: string);
765 DelimPos := FirstDelimiter(Delimiters, Str);
769 List.Add(Copy(Str, 1, DelimPos - 1));
770 Str := Copy(Str, DelimPos + 1, Length(Str) - DelimPos);
780 Splits string using the multiple chars.
781 @param Str the source string
782 @param Delimiters the delimiters string
783 @return the result list where plased delimited string
785 function SplitString(const Str, Delimiters: string): TStrings;
787 Result := TStringList.Create;
789 SplitToStringList(Result, Str, Delimiters);
797 Puts to list a splitted string using the multiple chars which replaces
798 the previous list content.
799 @param List a list with strings.
800 @param Str the source string
801 @param Delimiters the delimiters string
803 procedure PutSplitString(List: TStrings; const Str, Delimiters: string);
806 SplitToStringList(List, Str, Delimiters);
810 Appends to list a splitted string using the multiple chars.
811 @param List a list with strings.
812 @param Str the source string
813 @param Delimiters the delimiters string
815 procedure AppendSplitString(List: TStrings; const Str, Delimiters: string);
817 SplitToStringList(List, Str, Delimiters);
821 Composes a string from the specified strings list delimited with
823 @param List a list of strings.
824 @param Delimiter a delimiter string.
825 @return a composed string from the list.
827 function ComposeString(List: TStrings; const Delimiter: string): string;
829 i, Len, DelimLen: Integer;
833 DelimLen := Length(Delimiter);
835 if List.Count > 0 then
837 Inc(Len, Length(List[0]));
838 for i := 1 to List.Count - 1 do
839 Inc(Len, DelimLen + Length(List[i]));
841 SetLength(Result, Len);
842 P := Pointer(Result);
843 for i := 0 to List.Count - 1 do
845 if (i > 0) and (DelimLen > 0) then
847 Move(Pointer(Delimiter)^, P^, DelimLen * SizeOf(Char));
854 Move(Pointer(S)^, P^, Len * SizeOf(Char));
861 Converts a float value into SQL string with '.' delimiter.
862 @param Value a float value to be converted.
863 @return a converted string value.
865 function FloatToSQLStr(Value: Extended): string;
867 OldDecimalSeparator: Char;
869 OldDecimalSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator;
870 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := '.';
872 Result := FloatToStr(Value);
874 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
879 Split a single string using the delimiter, appending the resulting strings
880 to the List. (gto: New version, now unicode safe and without the bug which
881 adds a blank line before the last found string)
882 @param List a list to append the result.
883 @param Str the source string
884 @param Delimiters the delimiter string
886 procedure SplitToStringListEx(List: TStrings; const Str, Delimiter: string);
891 temp := Str + Delimiter;
893 i := List.Add(Copy(temp, 0, AnsiPos(Delimiter, temp) - 1));
894 Delete(temp, 1, Length(List[i] + Delimiter));
900 Puts to list a splitted string using the delimiter string which replaces
901 the previous list content.
902 @param List a list with strings.
903 @param Str the source string
904 @param Delimiters the delimiter string
906 procedure PutSplitStringEx(List: TStrings; const Str, Delimiter: string);
909 SplitToStringListEx(List, Str, Delimiter);
913 Splits string using the delimiter string.
914 @param Str the source string
915 @param Delimiters the delimiter string
916 @return the result list where plased delimited string
918 function SplitStringEx(const Str, Delimiter: string): TStrings;
920 Result := TStringList.Create;
922 SplitToStringListEx(Result, Str, Delimiter);
930 Appends to list a splitted string using the delimeter string.
931 @param List a list with strings.
932 @param Str the source string
933 @param Delimiters the delimiters string
935 procedure AppendSplitStringEx(List: TStrings; const Str, Delimiter: string);
937 SplitToStringListEx(List, Str, Delimiter);
941 Converts bytes into a AnsiString representation.
942 @param Value an array of bytes to be converted.
943 @return a converted AnsiString.
945 function BytesToStr(const Value: TByteDynArray): AnsiString;
947 SetString(Result, PAnsiChar(@Value[0]), Length(Value))
951 Converts AnsiString into an array of bytes.
952 @param Value a AnsiString to be converted.
953 @return a converted array of bytes.
955 function StrToBytes(const Value: AnsiString): TByteDynArray;
959 SetLength(Result, L);
961 Move(Value[1], Result[0], L)
964 {$IFDEF WITH_RAWBYTESTRING}
966 Converts a UTF8String into an array of bytes.
967 @param Value a UTF8String to be converted.
968 @return a converted array of bytes.
970 function StrToBytes(const Value: UTF8String): TByteDynArray;
974 SetLength(Result, L);
976 Move(Value[1], Result[0], L)
979 Converts a RawByteString into an array of bytes.
980 @param Value a RawByteString to be converted.
981 @return a converted array of bytes.
983 function StrToBytes(const Value: RawByteString): TByteDynArray;
987 SetLength(Result, L);
989 Move(Value[1], Result[0], L)
993 Converts a WideString into an array of bytes.
994 @param Value a String to be converted.
995 @return a converted array of bytes.
997 function StrToBytes(const Value: WideString): TByteDynArray;
1000 L := Length(Value)*2;
1001 SetLength(Result, L);
1003 Move(Value[1], Result[0], L)
1006 Converts a String into an array of bytes.
1007 @param Value a String to be converted.
1008 @return a converted array of bytes.
1010 {$IFDEF PWIDECHAR_IS_PUNICODECHAR}
1011 function StrToBytes(const Value: UnicodeString): TByteDynArray;
1014 L := Length(Value) * SizeOf(Char);
1015 SetLength(Result, L);
1017 Move(Value[1], Result[0], L)
1021 Converts bytes into a variant representation.
1022 @param Value an array of bytes to be converted.
1023 @return a converted variant.
1025 function BytesToVar(const Value: TByteDynArray): Variant;
1029 Result := VarArrayCreate([0, Length(Value) - 1], varByte);
1030 for I := 0 to Length(Value) - 1 do
1031 Result[I] := Value[I];
1035 Converts variant into an array of bytes.
1036 @param Value a varaint to be converted.
1037 @return a converted array of bytes.
1039 function VarToBytes(const Value: Variant): TByteDynArray;
1043 if not (VarIsArray(Value) and (VarArrayDimCount(Value) = 1) and
1044 ((VarType(Value) and VarTypeMask) = varByte)) then
1045 raise Exception.Create(SInvalidVarByteArray);
1047 SetLength(Result, VarArrayHighBound(Value, 1) + 1);
1048 for I := 0 to VarArrayHighBound(Value, 1) do
1049 Result[I] := Value[I];
1053 Converts Ansi SQL Date/Time (yyyy-mm-dd hh:nn:ss or yyyy-mm-dd hh:nn:ss.zzz)
1055 @param Value a date and time string.
1056 @return a decoded TDateTime value.
1058 function AnsiSQLDateToDateTime(const Value: string): TDateTime;
1060 Year, Month, Day, Hour, Min, Sec, MSec: Word;
1064 procedure ExtractTime(AString: String);
1065 var dotPos: Integer;
1067 Hour := StrToIntDef(Copy(AString, 1, 2), 0);
1068 Min := StrToIntDef(Copy(AString, 4, 2), 0);
1069 Sec := StrToIntDef(Copy(AString, 7, 2), 0);
1071 //it the time Length is bigger than 8, it can have milliseconds and it ...
1074 if Length(AString) > 8 then
1075 dotPos :=Pos ('.', AString);
1077 //if the dot are found, milliseconds are present.
1078 if dotPos > 0 then begin
1079 MSec := StrToIntDef(LeftStr(RightStr(AString,Length(AString)-dotPos)+'000',3),0);
1087 if Length(Temp) >= 10 then
1089 Year := StrToIntDef(Copy(Temp, 1, 4), 0);
1090 Month := StrToIntDef(Copy(Temp, 6, 2), 0);
1091 Day := StrToIntDef(Copy(Temp, 9, 2), 0);
1093 if (Year <> 0) and (Month <> 0) and (Day <> 0) then
1096 Result := EncodeDate(Year, Month, Day);
1101 Temp := RightStr(Temp, Length(Temp)-11);
1104 if (Length(Temp) >= 8) or ( not DateFound ) then
1112 Result := Result + EncodeTime(Hour, Min, Sec, MSec)
1114 Result := Result - EncodeTime(Hour, Min, Sec, MSec)
1121 Converts Timestamp String to TDateTime
1122 @param Value a timestamp string.
1123 @return a decoded TDateTime value.
1125 function TimestampStrToDateTime(const Value: string): TDateTime;
1127 Year, Month, Day, Hour, Min, Sec: Integer;
1128 StrLength, StrPos, StrPosPrev: Integer;
1130 function CharMatch( matchchars: string ): boolean;
1131 // try to match as much characters as possible
1133 StrPosPrev:= StrPos;
1135 while StrPos<=StrLength do
1136 if pos(Value[StrPos], matchchars) > 0 then
1147 StrLength := Length(Value);
1149 if not CharMatch('1234567890') then
1151 Year := StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1152 if not CharMatch('-/\') then
1154 if not CharMatch('1234567890') then
1156 Month:= StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1157 if not CharMatch('-/\') then
1159 if not CharMatch('1234567890') then
1161 Day:= StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1163 Result := EncodeDate(Year, Month, Day);
1167 if not CharMatch(' ') then
1169 if not CharMatch('1234567890') then
1171 Hour := StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1172 if not CharMatch('-/\') then
1174 if not CharMatch('1234567890') then
1176 Min:= StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1177 if not CharMatch('-/\') then
1179 if not CharMatch('1234567890') then
1181 Sec:= StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1183 Result := REsult + EncodeTime(Hour, Min, Sec,0);
1191 Converts TDateTime to Ansi SQL Date/Time
1192 @param Value an encoded TDateTime value.
1193 @return a date and time string.
1195 function DateTimeToAnsiSQLDate(Value: TDateTime; WithMMSec: Boolean = False): string;
1201 DecodeTime(Value,a,a,a,MSec);
1203 Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Value)
1205 Result := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Value);
1208 Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Value)
1214 Performs quick sort algorithm for the list.
1216 procedure TZSortedList.QuickSort(SortList: PPointerList; L, R: Integer;
1217 SCompare: TZListSortCompare);
1225 P := SortList^[(L + R) shr 1];
1227 while (I < R) And (SCompare(SortList^[I], P) < 0) do //check I against R too since the pointer can be nil
1229 while (J > L) And (SCompare(SortList^[J], P) > 0) do //check j against L too since the pointer can be nil
1234 SortList^[I] := SortList^[J];
1241 QuickSort(SortList, L, J, SCompare);
1247 Performs sorting for this list.
1248 @param Compare a comparison function.
1250 procedure TZSortedList.Sort(Compare: TZListSortCompare);
1252 if (List <> nil) and (Count > 0) then
1253 {$IFDEF DELPHI16_UP}
1254 QuickSort(@List, 0, Count - 1, Compare);
1256 QuickSort(List, 0, Count - 1, Compare);
1261 Converts an string into escape PostgreSQL format.
1262 @param Value a regular string.
1263 @return a string in PostgreSQL escape format.
1265 function EncodeCString(const Value: string): string;
1268 SrcLength, DestLength: Integer;
1269 SrcBuffer, DestBuffer: PChar;
1271 SrcLength := Length(Value);
1272 SrcBuffer := PChar(Value);
1274 for I := 1 to SrcLength do
1276 if CharInSet(SrcBuffer^, [#0]) then
1278 else if CharInSet(SrcBuffer^, ['"', '''', '\']) then
1285 SrcBuffer := PChar(Value);
1286 SetLength(Result, DestLength);
1287 DestBuffer := PChar(Result);
1289 for I := 1 to SrcLength do
1291 if CharInSet(SrcBuffer^, [#0]) then
1293 DestBuffer[0] := '\';
1294 DestBuffer[1] := Chr(Ord('0') + (Byte(SrcBuffer^) shr 6));
1295 DestBuffer[2] := Chr(Ord('0') + ((Byte(SrcBuffer^) shr 3) and $07));
1296 DestBuffer[3] := Chr(Ord('0') + (Byte(SrcBuffer^) and $07));
1299 else if CharInSet(SrcBuffer^, ['"', '''', '\']) then
1301 DestBuffer[0] := '\';
1302 DestBuffer[1] := SrcBuffer^;
1307 DestBuffer^ := SrcBuffer^;
1315 Converts an string from escape PostgreSQL format.
1316 @param Value a string in PostgreSQL escape format.
1317 @return a regular string.
1319 function DecodeCString(const Value: string): string;
1321 SrcLength, DestLength: Integer;
1322 SrcBuffer, DestBuffer: PChar;
1324 SrcLength := Length(Value);
1325 SrcBuffer := PChar(Value);
1326 SetLength(Result, SrcLength);
1328 DestBuffer := PChar(Result);
1330 while SrcLength > 0 do
1332 if SrcBuffer^ = '\' then
1335 if CharInSet(SrcBuffer^, ['0'..'9']) then
1337 DestBuffer^ := Chr(((Byte(SrcBuffer[0]) - Ord('0')) shl 6)
1338 or ((Byte(SrcBuffer[1]) - Ord('0')) shl 3)
1339 or ((Byte(SrcBuffer[2]) - Ord('0'))));
1346 'r': DestBuffer^ := #13;
1347 'n': DestBuffer^ := #10;
1348 't': DestBuffer^ := #9;
1350 DestBuffer^ := SrcBuffer^;
1358 DestBuffer^ := SrcBuffer^;
1365 SetLength(Result, DestLength);
1370 Replace chars in the string
1371 @param Source a char to search.
1372 @param Target a char to replace.
1373 @param Str a source string.
1374 @return a string with replaced chars.
1376 function ReplaceChar(const Source, Target: Char; const Str: string): string;
1382 UniqueString(Result);
1383 P := Pointer(Result);
1384 for i := 0 to Length(Str) - 1 do
1393 Copy buffer to the pascal string
1394 @param Buffer a buffer with data
1395 @param Length a buffer length
1396 @return a buffer content
1398 function MemPas(Buffer: PChar; Length: LongInt): string;
1401 if Assigned(Buffer) then
1402 SetString(Result, Buffer, Length);
1406 Decodes a full version value encoded with Zeos SQL format:
1407 (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
1408 into separated major, minor and subversion values
1409 @param FullVersion an integer containing the Full Version to decode.
1410 @param MajorVersion an integer containing the Major Version decoded.
1411 @param MinorVersion an integer containing the Minor Version decoded.
1412 @param SubVersion an integer contaning the Sub Version (revision) decoded.
1414 procedure DecodeSQLVersioning(const FullVersion: Integer;
1415 out MajorVersion: Integer; out MinorVersion: Integer;
1416 out SubVersion: Integer);
1418 MajorVersion := FullVersion div 1000000;
1419 MinorVersion := (FullVersion - (MajorVersion * 1000000)) div 1000;
1420 SubVersion := FullVersion-(MajorVersion*1000000)-(MinorVersion*1000);
1424 Encodes major, minor and subversion (revision) values in Zeos SQL format:
1425 (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
1426 For example, 4.1.12 is returned as 4001012.
1427 @param MajorVersion an integer containing the Major Version.
1428 @param MinorVersion an integer containing the Minor Version.
1429 @param SubVersion an integer containing the Sub Version (revision).
1430 @return an integer containing the full version.
1432 function EncodeSQLVersioning(const MajorVersion: Integer;
1433 const MinorVersion: Integer; const SubVersion: Integer): Integer;
1435 Result := (MajorVersion * 1000000) + (MinorVersion * 1000) + SubVersion;
1439 Formats a Zeos SQL Version format to X.Y.Z where:
1443 @param SQLVersion an integer
1444 @return Formated Zeos SQL Version Value.
1447 function FormatSQLVersion(const SQLVersion: Integer): string;
1449 MajorVersion, MinorVersion, SubVersion: Integer;
1451 DecodeSQLVersioning(SQLVersion, MajorVersion, MinorVersion, SubVersion);
1452 Result := IntToStr(MajorVersion)+'.'+IntToStr(MinorVersion)+'.'+IntToStr(SubVersion);
1456 Arranges thousand and decimal separator to a System-defaults
1457 @param the value which has to be converted and arranged
1458 @return a valid floating value
1460 function ZStrToFloat(Value: PAnsiChar): Extended;
1462 OldDecimalSeparator, OldThousandSeparator: Char;
1464 OldDecimalSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator;
1465 OldThousandSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator;
1467 if {$IFDEF WITH_ANSISTRINGPOS_DEPRECATED}AnsiStrings.{$ENDIF}AnsiStrPos(PAnsiChar(Value), PAnsiChar(AnsiString(OldDecimalSeparator))) = nil then
1468 if {$IFDEF WITH_ANSISTRINGPOS_DEPRECATED}AnsiStrings.{$ENDIF}AnsiStrPos(PAnsiChar(Value), PAnsiChar(AnsiString(OldThousandSeparator))) = nil then
1469 //No DecimalSeparator and no ThousandSeparator
1470 Result := StrToFloat(String(Value))
1473 //wrong DecimalSepartor
1474 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldThousandSeparator;
1475 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := OldDecimalSeparator;
1476 Result := StrToFloat(String(Value));
1479 if {$IFDEF WITH_ANSISTRINGPOS_DEPRECATED}AnsiStrings.{$ENDIF}AnsiStrPos(PAnsiChar(Value), PAnsiChar(AnsiString(OldThousandSeparator))) = nil then
1480 //default DecimalSepartor
1481 Result := StrToFloat(String(Value))
1483 if {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen({$IFDEF WITH_ANSISTRINGPOS_DEPRECATED}AnsiStrings.{$ENDIF}AnsiStrPos(PAnsiChar(Value), PAnsiChar(AnsiString(OldDecimalSeparator)))) <
1484 {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen({$IFDEF WITH_ANSISTRINGPOS_DEPRECATED}AnsiStrings.{$ENDIF}AnsiStrPos(PAnsiChar(Value), PAnsiChar(AnsiString(OldThousandSeparator)))) then
1485 //default DecimalSepartor and ThousandSeparator
1486 Result := StrToFloat(String(Value))
1489 //wrong DecimalSepartor and ThousandSeparator
1490 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldThousandSeparator;
1491 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := OldDecimalSeparator;
1492 Result := StrToFloat(String(Value));
1495 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
1496 {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := OldThousandSeparator;
1500 Arranges thousand and decimal separator to a System-defaults
1501 @param the value which has to be converted and arranged
1502 @return a valid floating value
1504 function ZStrToFloat(Value: AnsiString): Extended;
1506 Result := ZStrToFloat(PAnsiChar(Value));
1509 procedure ZSetString(const Src: PAnsiChar; var Dest: AnsiString);
1511 if Assigned(Src) then
1512 ZSetString(Src, {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(Src), Dest)
1517 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: AnsiString);
1519 if ( Len = 0 ) or ( Src = nil ) then
1523 SetLength(Dest, Len);
1524 Move(Src^, PAnsiChar(Dest)^, Len);
1528 procedure ZSetString(const Src: PAnsiChar; var Dest: UTF8String);
1530 if Assigned(Src) then
1531 ZSetString(Src, {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(Src), Dest)
1536 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: UTF8String);
1538 if ( Len = 0 ) or ( Src = nil ) then
1542 SetLength(Dest, Len);
1543 Move(Src^, PAnsiChar(Dest)^, Len);
1547 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: ZWideString); overload;
1549 if ( Len = 0 ) or ( Src = nil ) then
1553 SetLength(Dest, Len div 2);
1554 Move(Src^, PWideChar(Dest)^, Len);
1558 {$IFDEF WITH_RAWBYTESTRING}
1559 procedure ZSetString(const Src: PAnsiChar; var Dest: RawByteString);
1561 if Assigned(Src) then
1562 ZSetString(Src, {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(Src), Dest)
1567 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: RawByteString);
1569 if ( Len = 0 ) or ( Src = nil ) then
1573 SetLength(Dest, Len);
1574 Move(Src^, PAnsiChar(Dest)^, Len);