zeoslib  UNKNOWN
 All Files
ZSysUtils.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { System Utility Classes and Functions }
5 { }
6 { Originally written by Sergey Seroukhov }
7 { }
8 {*********************************************************}
9 
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
12 { }
13 { License Agreement: }
14 { }
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. }
20 { }
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. }
39 { }
40 { }
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) }
45 { }
46 { http://www.sourceforge.net/projects/zeoslib. }
47 { }
48 { }
49 { Zeos Development Group. }
50 {********************************************************@}
51 
52 unit ZSysUtils;
53 
54 interface
55 
56 {$I ZCore.inc}
57 
58 uses
59  Variants, Classes, {$IFDEF MSEgui}mclasses,{$ENDIF} SysUtils, Types,
60  ZMessages, ZCompatibility;
61 
62 type
63  {** Modified comaprison function. }
64  TZListSortCompare = function (Item1, Item2: Pointer): Integer of object;
65 
66  {** Modified list of pointers. }
67  TZSortedList = class (TList)
68  protected
69  procedure QuickSort(SortList: PPointerList; L, R: Integer;
70  SCompare: TZListSortCompare);
71  public
72  procedure Sort(Compare: TZListSortCompare);
73  end;
74 
75 {**
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.
80 }
81 function FirstDelimiter(const Delimiters, Str: string): Integer;
82 
83 {**
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.
88 }
89 function LastDelimiter(const Delimiters, Str: string): Integer;
90 
91 {**
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
96 }
97 function MemLCompUnicode(P1, P2: PWideChar; Len: Integer): Boolean;
98 
99 {**
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
104 }
105 function MemLCompAnsi(P1, P2: PAnsiChar; Len: Integer): Boolean;
106 
107 {**
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;
112 }
113 function StartsWith(const Str, SubStr: ZWideString): Boolean; overload;
114 function StartsWith(const Str, SubStr: RawByteString): Boolean; overload;
115 {**
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;
120 }
121 function EndsWith(const Str, SubStr: ZWideString): Boolean; overload;
122 function EndsWith(const Str, SubStr: RawByteString): Boolean; overload;
123 
124 {**
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.
129 }
130 {$IFDEF WITH_RAWBYTESTRING}
131 function SQLStrToFloatDef(Str: RawByteString; Def: Extended): Extended; overload;
132 {$ENDIF}
133 function SQLStrToFloatDef(Str: String; Def: Extended): Extended; overload;
134 
135 {**
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.
139 }
140 function SQLStrToFloat(const Str: AnsiString): Extended;
141 
142 {**
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.
147 }
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;
151 
152 {**
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
156 }
157 function StrToBoolEx(Str: string): Boolean;
158 
159 {**
160  Converts a boolean into string value.
161  @param Bool a boolean value.
162  @return <code>"True"</code> or <code>"False"</code>
163 }
164 function BoolToStrEx(Bool: Boolean): String;
165 
166 {**
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.
171 }
172 function IsIpAddr(const Str: string): Boolean;
173 
174 {**
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
179 }
180 function SplitString(const Str, Delimiters: string): TStrings;
181 
182 {**
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
188 }
189 procedure PutSplitString(List: TStrings; const Str, Delimiters: string);
190 
191 {**
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
196 }
197 procedure AppendSplitString(List: TStrings; const Str, Delimiters: string);
198 
199 {**
200  Composes a string from the specified strings list delimited with
201  a special character.
202  @param List a list of strings.
203  @param Delimiter a delimiter string.
204  @return a composed string from the list.
205 }
206 function ComposeString(List: TStrings; const Delimiter: string): string;
207 
208 {**
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.
212 }
213 function FloatToSQLStr(Value: Extended): string;
214 
215 {**
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
221 }
222 procedure PutSplitStringEx(List: TStrings; const Str, Delimiter: string);
223 
224 {**
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
229 }
230 function SplitStringEx(const Str, Delimiter: string): TStrings;
231 
232 {**
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
237 }
238 procedure AppendSplitStringEx(List: TStrings; const Str, Delimiter: string);
239 
240 {**
241  Converts bytes into a AnsiString representation.
242  @param Value an array of bytes to be converted.
243  @return a converted AnsiString.
244 }
245 function BytesToStr(const Value: TByteDynArray): AnsiString;
246 
247 {**
248  Converts AnsiString into an array of bytes.
249  @param Value a AnsiString to be converted.
250  @return a converted array of bytes.
251 }
252 function StrToBytes(const Value: AnsiString): TByteDynArray; overload;
253 
254 {$IFDEF WITH_RAWBYTESTRING}
255 {**
256  Converts a UTF8String into an array of bytes.
257  @param Value a UTF8String to be converted.
258  @return a converted array of bytes.
259 }
260 function StrToBytes(const Value: UTF8String): TByteDynArray; overload;
261 {**
262  Converts a UTF8String into an array of bytes.
263  @param Value a UTF8String to be converted.
264  @return a converted array of bytes.
265 }
266 function StrToBytes(const Value: RawByteString): TByteDynArray; overload;
267 {**
268  Converts a RawByteString into an array of bytes.
269  @param Value a RawByteString to be converted.
270  @return a converted array of bytes.
271 }
272 {$ENDIF}
273 function StrToBytes(const Value: WideString): TByteDynArray; overload;
274 {**
275  Converts a String into an array of bytes.
276  @param Value a String to be converted.
277  @return a converted array of bytes.
278 }
279 {$IFDEF PWIDECHAR_IS_PUNICODECHAR}
280 function StrToBytes(const Value: UnicodeString): TByteDynArray; overload;
281 {$ENDIF}
282 {**
283  Converts bytes into a variant representation.
284  @param Value an array of bytes to be converted.
285  @return a converted variant.
286 }
287 function BytesToVar(const Value: TByteDynArray): Variant;
288 
289 {**
290  Converts variant into an array of bytes.
291  @param Value a varaint to be converted.
292  @return a converted array of bytes.
293 }
294 function VarToBytes(const Value: Variant): TByteDynArray;
295 
296 {**
297  Converts Ansi SQL Date/Time to TDateTime
298  @param Value a date and time string.
299  @return a decoded TDateTime value.
300 }
301 function AnsiSQLDateToDateTime(const Value: string): TDateTime;
302 
303 {**
304  Converts Timestamp String to TDateTime
305  @param Value a timestamp string.
306  @return a decoded TDateTime value.
307 }
308 function TimestampStrToDateTime(const Value: string): TDateTime;
309 
310 {**
311  Converts TDateTime to Ansi SQL Date/Time
312  @param Value an encoded TDateTime value.
313  @return a date and time string.
314 }
315 function DateTimeToAnsiSQLDate(Value: TDateTime; WithMMSec: Boolean = False): string;
316 
317 {**
318  Converts an string into escape PostgreSQL format.
319  @param Value a regular string.
320  @return a string in PostgreSQL escape format.
321 }
322 function EncodeCString(const Value: string): string;
323 
324 {**
325  Converts an string from escape PostgreSQL format.
326  @param Value a string in PostgreSQL escape format.
327  @return a regular string.
328 }
329 function DecodeCString(const Value: string): string;
330 
331 {**
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.
337 }
338 function ReplaceChar(const Source, Target: Char; const Str: string): string;
339 
340 {**
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
345 }
346 function MemPas(Buffer: PChar; Length: LongInt): string;
347 
348 {**
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.
356 }
357 procedure DecodeSQLVersioning(const FullVersion: Integer;
358  out MajorVersion: Integer; out MinorVersion: Integer;
359  out SubVersion: Integer);
360 
361 {**
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.
369 }
370 function EncodeSQLVersioning(const MajorVersion: Integer;
371  const MinorVersion: Integer; const SubVersion: Integer): Integer;
372 
373 {**
374  Formats a Zeos SQL Version format to X.Y.Z where:
375  X = major_version
376  Y = minor_version
377  Z = sub version
378  @param SQLVersion an integer
379  @return Formated Zeos SQL Version Value.
380 }
381 function FormatSQLVersion( const SQLVersion: Integer ): String;
382 
383 {**
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
387 }
388 function ZStrToFloat(Value: PAnsiChar): Extended; overload;
389 
390 {**
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
394 }
395 function ZStrToFloat(Value: AnsiString): Extended; overload;
396 
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;
405 {$ENDIF}
406 
407 implementation
408 
409 uses ZMatchPattern, StrUtils {$IFDEF WITH_UNITANSISTRINGS}, AnsiStrings{$ENDIF};
410 
411 {**
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.
416 }
417 function FirstDelimiter(const Delimiters, Str: string): Integer;
418 var
419  I, Index: Integer;
420 begin
421  Result := 0;
422  for I := 1 to Length(Delimiters) do
423  begin
424  Index := Pos(Delimiters[I], Str);
425  if (Index > 0) and ((Index < Result) or (Result = 0)) then
426  Result := Index;
427  end;
428 end;
429 
430 {**
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.
435 }
436 function LastDelimiter(const Delimiters, Str: string): Integer;
437 var
438  I, Index: Integer;
439 begin
440  Result := 0;
441  for I := Length(Str) downto 1 do
442  begin
443  Index := Pos(Str[I], Delimiters);
444  if (Index > 0) then
445  begin
446  Result := I;
447  Break;
448  end;
449  end;
450 end;
451 
452 
453 {**
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
458 }
459 function MemLCompUnicode(P1, P2: PWideChar; Len: Integer): Boolean;
460 begin
461  while (Len > 0) and (P1^ = P2^) do
462  begin
463  Inc(P1);
464  Inc(P2);
465  Dec(Len);
466  end;
467  Result := Len = 0;
468 end;
469 
470 {**
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
475 }
476 function MemLCompAnsi(P1, P2: PAnsiChar; Len: Integer): Boolean;
477 begin
478  while (Len > 0) and (P1^ = P2^) do
479  begin
480  Inc(P1);
481  Inc(P2);
482  Dec(Len);
483  end;
484  Result := Len = 0;
485 end;
486 
487 {**
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;
492 }
493 function StartsWith(const Str, SubStr: ZWideString): Boolean;
494 var
495  LenSubStr: Integer;
496 begin
497  LenSubStr := Length(SubStr);
498  if SubStr = '' then
499  Result := True
500  else if LenSubStr <= Length(Str) then
501  Result := MemLCompUnicode(PWideChar(Str), PWideChar(SubStr), LenSubStr)
502  else
503  Result := False;
504 end;
505 
506 function StartsWith(const Str, SubStr: RawByteString): Boolean; overload;
507 var
508  LenSubStr: Integer;
509 begin
510  LenSubStr := Length(SubStr);
511  if SubStr = '' then
512  Result := True
513  else
514  if LenSubStr <= Length(Str) then
515  Result := MemLCompAnsi(PAnsiChar(Str), PAnsiChar(SubStr), LenSubStr)
516  else
517  Result := False;
518 end;
519 
520 {**
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;
525 }
526 function EndsWith(const Str, SubStr: ZWideString): Boolean;
527 var
528  LenSubStr: Integer;
529  LenStr: Integer;
530 begin
531  if SubStr = '' then
532  Result := False // act like Delphi's AnsiEndsStr()
533  else
534  begin
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)
540  else
541  Result := False;
542  end;
543 end;
544 
545 function EndsWith(const Str, SubStr: RawByteString): Boolean;
546 var
547  LenSubStr: Integer;
548  LenStr: Integer;
549 begin
550  if SubStr = '' then
551  Result := False // act like Delphi's AnsiEndsStr()
552  else
553  begin
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)
559  else
560  Result := False;
561  end;
562 end;
563 
564 function ConvertMoneyToFloat(MoneyString: String): String;
565 var
566  I: Integer;
567 begin
568  if MoneyString = '' then
569  Result := ''
570  else
571  begin
572  if CharInSet(Char(MoneyString[1]), ['0'..'9', '-']) then
573  Result := MoneyString
574  else
575  for i := 1 to Length(MoneyString) do
576  if CharInSet(Char(MoneyString[I]), ['0'..'9', '-']) then
577  begin
578  if I > 1 then
579  begin //Money type
580  Result := Copy(MoneyString, I, Length(MoneyString)-i+1);
581  if Pos(',', Result) > 0 then
582  if Pos('.', Result) > 0 then
583  begin
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));
588  end
589  else
590  Result[Pos(',', Result)] := '.';
591  end;
592  Break;
593  end;
594  end;
595 end;
596 {**
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.
601 }
602 {$IFDEF WITH_RAWBYTESTRING}
603 function SQLStrToFloatDef(Str: RawByteString; Def: Extended): Extended;
604 var
605  OldDecimalSeparator: Char;
606  OldThousandSeparator: Char;
607  AString: String;
608 begin
609  if Str = '' then
610  Result := Def
611  else
612  begin
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))
619  else
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;
624  end;
625 end;
626 {$ENDIF}
627 
628 function SQLStrToFloatDef(Str: String; Def: Extended): Extended;
629 var
630  OldDecimalSeparator: Char;
631  OldThousandSeparator: Char;
632  AString: String;
633 begin
634  if Str = '' then
635  Result := Def
636  else
637  begin
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)
644  else
645  AString := Str;
646  Result := StrToFloatDef(AString, Def);
647  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
648  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := OldThousandSeparator;
649  end;
650 end;
651 
652 {**
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.
656 }
657 function SQLStrToFloat(const Str: AnsiString): Extended;
658 var
659  OldDecimalSeparator: Char;
660 begin
661  OldDecimalSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator;
662  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := '.';
663  try
664  Result := StrToFloat(String(Str));
665  finally
666  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
667  end;
668 end;
669 
670 { Convert string buffer into pascal string }
671 
672 function BufferToStr(Buffer: PWideChar; Length: LongInt): string;
673 var s : Widestring;
674 begin
675  Result := '';
676  if Assigned(Buffer) then
677  begin
678  SetString(s, Buffer, Length div SizeOf(Char));
679  Result := s;
680  end;
681 end;
682 
683 { Convert string buffer into pascal string }
684 
685 function BufferToStr(Buffer: PAnsiChar; Length: LongInt): string;
686 begin
687  Result := '';
688  if Assigned(Buffer) then
689  SetString(Result, Buffer, Length);
690 end;
691 
692 function BufferToBytes(Buffer: Pointer; Length: LongInt): TByteDynArray;
693 begin
694  SetLength(Result, Length);
695  System.Move(Buffer^, Pointer(Result)^, Length);
696 end;
697 
698 {**
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
702 }
703 function StrToBoolEx(Str: string): Boolean;
704 begin
705  Str := UpperCase(Str);
706  Result := (Str = 'Y') or (Str = 'YES') or (Str = 'T') or (Str = 'TRUE')
707  or (StrToIntDef(Str, 0) <> 0);
708 end;
709 
710 {**
711  Converts a boolean into string value.
712  @param Bool a boolean value.
713  @return <code>"True"</code> or <code>"False"</code>
714 }
715 function BoolToStrEx(Bool: Boolean): String;
716 begin
717  if Bool then
718  Result := 'True'
719  else
720  Result := 'False';
721 end;
722 
723 {**
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.
728 }
729 function IsIpAddr(const Str: string): Boolean;
730 var
731  I, N, M, Pos, Val: Integer;
732 begin
733  if IsMatch('*.*.*.*', Str) then
734  begin
735  N := 0;
736  M := 0;
737  Pos := 1;
738  for I := 1 to Length(Str) do
739  begin
740  if I - Pos > 3 then
741  Break;
742  if Str[I] = '.' then
743  begin
744  {ticked #73/#24 patch }
745  Val := StrToIntDef(Copy(Str, Pos, I - Pos), -1);
746  if not ((Val > -1 ) and (Val < 256)) then
747  Break;
748  Inc(N);
749  Pos := I + 1;
750  end;
751  if CharInSet(Str[I], ['0'..'9']) then
752  Inc(M);
753  end;
754  Result := (M + N = Length(Str)) and (N = 3);
755  end
756  else
757  Result := False;
758 end;
759 
760 procedure SplitToStringList(List: TStrings; Str: string; const Delimiters: string);
761 var
762  DelimPos: Integer;
763 begin
764  repeat
765  DelimPos := FirstDelimiter(Delimiters, Str);
766  if DelimPos > 0 then
767  begin
768  if DelimPos > 1 then
769  List.Add(Copy(Str, 1, DelimPos - 1));
770  Str := Copy(Str, DelimPos + 1, Length(Str) - DelimPos);
771  end
772  else
773  Break;
774  until DelimPos <= 0;
775  if Str <> '' then
776  List.Add(Str);
777 end;
778 
779 {**
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
784 }
785 function SplitString(const Str, Delimiters: string): TStrings;
786 begin
787  Result := TStringList.Create;
788  try
789  SplitToStringList(Result, Str, Delimiters);
790  except
791  Result.Free;
792  raise;
793  end;
794 end;
795 
796 {**
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
802 }
803 procedure PutSplitString(List: TStrings; const Str, Delimiters: string);
804 begin
805  List.Clear;
806  SplitToStringList(List, Str, Delimiters);
807 end;
808 
809 {**
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
814 }
815 procedure AppendSplitString(List: TStrings; const Str, Delimiters: string);
816 begin
817  SplitToStringList(List, Str, Delimiters);
818 end;
819 
820 {**
821  Composes a string from the specified strings list delimited with
822  a special character.
823  @param List a list of strings.
824  @param Delimiter a delimiter string.
825  @return a composed string from the list.
826 }
827 function ComposeString(List: TStrings; const Delimiter: string): string;
828 var
829  i, Len, DelimLen: Integer;
830  S: string;
831  P: PChar;
832 begin
833  DelimLen := Length(Delimiter);
834  Len := 0;
835  if List.Count > 0 then
836  begin
837  Inc(Len, Length(List[0]));
838  for i := 1 to List.Count - 1 do
839  Inc(Len, DelimLen + Length(List[i]));
840  end;
841  SetLength(Result, Len);
842  P := Pointer(Result);
843  for i := 0 to List.Count - 1 do
844  begin
845  if (i > 0) and (DelimLen > 0) then
846  begin
847  Move(Pointer(Delimiter)^, P^, DelimLen * SizeOf(Char));
848  Inc(P, DelimLen);
849  end;
850  S := List[i];
851  Len := Length(S);
852  if Len > 0 then
853  begin
854  Move(Pointer(S)^, P^, Len * SizeOf(Char));
855  Inc(P, Len);
856  end;
857  end;
858 end;
859 
860 {**
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.
864 }
865 function FloatToSQLStr(Value: Extended): string;
866 var
867  OldDecimalSeparator: Char;
868 begin
869  OldDecimalSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator;
870  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := '.';
871  try
872  Result := FloatToStr(Value);
873  finally
874  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
875  end;
876 end;
877 
878 {**
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
885 }
886 procedure SplitToStringListEx(List: TStrings; const Str, Delimiter: string);
887 var
888  temp: string;
889  i: integer;
890 begin
891  temp := Str + Delimiter;
892  repeat
893  i := List.Add(Copy(temp, 0, AnsiPos(Delimiter, temp) - 1));
894  Delete(temp, 1, Length(List[i] + Delimiter));
895  until
896  temp = '';
897 end;
898 
899 {**
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
905 }
906 procedure PutSplitStringEx(List: TStrings; const Str, Delimiter: string);
907 begin
908  List.Clear;
909  SplitToStringListEx(List, Str, Delimiter);
910 end;
911 
912 {**
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
917 }
918 function SplitStringEx(const Str, Delimiter: string): TStrings;
919 begin
920  Result := TStringList.Create;
921  try
922  SplitToStringListEx(Result, Str, Delimiter);
923  except
924  Result.Free;
925  raise;
926  end;
927 end;
928 
929 {**
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
934 }
935 procedure AppendSplitStringEx(List: TStrings; const Str, Delimiter: string);
936 begin
937  SplitToStringListEx(List, Str, Delimiter);
938 end;
939 
940 {**
941  Converts bytes into a AnsiString representation.
942  @param Value an array of bytes to be converted.
943  @return a converted AnsiString.
944 }
945 function BytesToStr(const Value: TByteDynArray): AnsiString;
946 begin
947  SetString(Result, PAnsiChar(@Value[0]), Length(Value))
948 end;
949 
950 {**
951  Converts AnsiString into an array of bytes.
952  @param Value a AnsiString to be converted.
953  @return a converted array of bytes.
954 }
955 function StrToBytes(const Value: AnsiString): TByteDynArray;
956 var L: Integer;
957 begin
958  L := Length(Value);
959  SetLength(Result, L);
960  if Value <> '' then
961  Move(Value[1], Result[0], L)
962 end;
963 
964 {$IFDEF WITH_RAWBYTESTRING}
965 {**
966  Converts a UTF8String into an array of bytes.
967  @param Value a UTF8String to be converted.
968  @return a converted array of bytes.
969 }
970 function StrToBytes(const Value: UTF8String): TByteDynArray;
971 var L: Integer;
972 begin
973  L := Length(Value);
974  SetLength(Result, L);
975  if Value <> '' then
976  Move(Value[1], Result[0], L)
977 end;
978 {**
979  Converts a RawByteString into an array of bytes.
980  @param Value a RawByteString to be converted.
981  @return a converted array of bytes.
982 }
983 function StrToBytes(const Value: RawByteString): TByteDynArray;
984 var L: Integer;
985 begin
986  L := Length(Value);
987  SetLength(Result, L);
988  if Value <> '' then
989  Move(Value[1], Result[0], L)
990 end;
991 {$ENDIF}
992 {**
993  Converts a WideString into an array of bytes.
994  @param Value a String to be converted.
995  @return a converted array of bytes.
996 }
997 function StrToBytes(const Value: WideString): TByteDynArray;
998 var L: Integer;
999 begin
1000  L := Length(Value)*2;
1001  SetLength(Result, L);
1002  if Value <> '' then
1003  Move(Value[1], Result[0], L)
1004 end;
1005 {**
1006  Converts a String into an array of bytes.
1007  @param Value a String to be converted.
1008  @return a converted array of bytes.
1009 }
1010 {$IFDEF PWIDECHAR_IS_PUNICODECHAR}
1011 function StrToBytes(const Value: UnicodeString): TByteDynArray;
1012 var L: Integer;
1013 begin
1014  L := Length(Value) * SizeOf(Char);
1015  SetLength(Result, L);
1016  if Value <> '' then
1017  Move(Value[1], Result[0], L)
1018 end;
1019 {$ENDIF}
1020 {**
1021  Converts bytes into a variant representation.
1022  @param Value an array of bytes to be converted.
1023  @return a converted variant.
1024 }
1025 function BytesToVar(const Value: TByteDynArray): Variant;
1026 var
1027  I: Integer;
1028 begin
1029  Result := VarArrayCreate([0, Length(Value) - 1], varByte);
1030  for I := 0 to Length(Value) - 1 do
1031  Result[I] := Value[I];
1032 end;
1033 
1034 {**
1035  Converts variant into an array of bytes.
1036  @param Value a varaint to be converted.
1037  @return a converted array of bytes.
1038 }
1039 function VarToBytes(const Value: Variant): TByteDynArray;
1040 var
1041  I: Integer;
1042 begin
1043  if not (VarIsArray(Value) and (VarArrayDimCount(Value) = 1) and
1044  ((VarType(Value) and VarTypeMask) = varByte)) then
1045  raise Exception.Create(SInvalidVarByteArray);
1046 
1047  SetLength(Result, VarArrayHighBound(Value, 1) + 1);
1048  for I := 0 to VarArrayHighBound(Value, 1) do
1049  Result[I] := Value[I];
1050 end;
1051 
1052 {**
1053  Converts Ansi SQL Date/Time (yyyy-mm-dd hh:nn:ss or yyyy-mm-dd hh:nn:ss.zzz)
1054  to TDateTime
1055  @param Value a date and time string.
1056  @return a decoded TDateTime value.
1057 }
1058 function AnsiSQLDateToDateTime(const Value: string): TDateTime;
1059 var
1060  Year, Month, Day, Hour, Min, Sec, MSec: Word;
1061  Temp: string;
1062  DateFound: Boolean;
1063 
1064  procedure ExtractTime(AString: String);
1065  var dotPos: Integer;
1066  begin
1067  Hour := StrToIntDef(Copy(AString, 1, 2), 0);
1068  Min := StrToIntDef(Copy(AString, 4, 2), 0);
1069  Sec := StrToIntDef(Copy(AString, 7, 2), 0);
1070 
1071  //it the time Length is bigger than 8, it can have milliseconds and it ...
1072  dotPos := 0;
1073  MSec := 0;
1074  if Length(AString) > 8 then
1075  dotPos :=Pos ('.', AString);
1076 
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);
1080  end;
1081  end;
1082 begin
1083  Temp := Value;
1084  Result := 0;
1085  DateFound := False;
1086 
1087  if Length(Temp) >= 10 then
1088  begin
1089  Year := StrToIntDef(Copy(Temp, 1, 4), 0);
1090  Month := StrToIntDef(Copy(Temp, 6, 2), 0);
1091  Day := StrToIntDef(Copy(Temp, 9, 2), 0);
1092 
1093  if (Year <> 0) and (Month <> 0) and (Day <> 0) then
1094  begin
1095  try
1096  Result := EncodeDate(Year, Month, Day);
1097  DateFound := True;
1098  except
1099  end;
1100  end;
1101  Temp := RightStr(Temp, Length(Temp)-11);
1102  end;
1103 
1104  if (Length(Temp) >= 8) or ( not DateFound ) then
1105  begin
1106  if DateFound then
1107  ExtractTime(Temp)
1108  else
1109  ExtractTime(Value);
1110  try
1111  if Result >= 0 then
1112  Result := Result + EncodeTime(Hour, Min, Sec, MSec)
1113  else
1114  Result := Result - EncodeTime(Hour, Min, Sec, MSec)
1115  except
1116  end;
1117  end;
1118 end;
1119 
1120 {**
1121  Converts Timestamp String to TDateTime
1122  @param Value a timestamp string.
1123  @return a decoded TDateTime value.
1124 }
1125 function TimestampStrToDateTime(const Value: string): TDateTime;
1126 var
1127  Year, Month, Day, Hour, Min, Sec: Integer;
1128  StrLength, StrPos, StrPosPrev: Integer;
1129  //
1130  function CharMatch( matchchars: string ): boolean;
1131  // try to match as much characters as possible
1132  begin
1133  StrPosPrev:= StrPos;
1134  Result:= false;
1135  while StrPos<=StrLength do
1136  if pos(Value[StrPos], matchchars) > 0 then
1137  begin
1138  inc(StrPos);
1139  Result := true;
1140  end
1141  else
1142  break;
1143  end;
1144 begin
1145  Result := 0;
1146  StrPos:= 1;
1147  StrLength := Length(Value);
1148 
1149  if not CharMatch('1234567890') then
1150  exit; // year
1151  Year := StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1152  if not CharMatch('-/\') then
1153  exit;
1154  if not CharMatch('1234567890') then
1155  exit; // month
1156  Month:= StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1157  if not CharMatch('-/\') then
1158  exit;
1159  if not CharMatch('1234567890') then
1160  exit; // day
1161  Day:= StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1162  try
1163  Result := EncodeDate(Year, Month, Day);
1164  except
1165  end;
1166  //
1167  if not CharMatch(' ') then
1168  exit;
1169  if not CharMatch('1234567890') then
1170  exit; // hour
1171  Hour := StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1172  if not CharMatch('-/\') then
1173  exit;
1174  if not CharMatch('1234567890') then
1175  exit; // minute
1176  Min:= StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1177  if not CharMatch('-/\') then
1178  exit;
1179  if not CharMatch('1234567890') then
1180  exit; // second
1181  Sec:= StrToIntDef(Copy(Value, StrPosPrev, StrPos-StrPosPrev), 0);
1182  try
1183  Result := REsult + EncodeTime(Hour, Min, Sec,0);
1184  except
1185  end;
1186 
1187 end;
1188 
1189 
1190 {**
1191  Converts TDateTime to Ansi SQL Date/Time
1192  @param Value an encoded TDateTime value.
1193  @return a date and time string.
1194 }
1195 function DateTimeToAnsiSQLDate(Value: TDateTime; WithMMSec: Boolean = False): string;
1196 var
1197  a, MSec:Word;
1198 begin
1199  if WithMMSec then
1200  begin
1201  DecodeTime(Value,a,a,a,MSec);
1202  if MSec=0 then
1203  Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Value)
1204  else
1205  Result := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Value);
1206  end
1207  else
1208  Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Value)
1209 end;
1210 
1211 { TZSortedList }
1212 
1213 {**
1214  Performs quick sort algorithm for the list.
1215 }
1216 procedure TZSortedList.QuickSort(SortList: PPointerList; L, R: Integer;
1217  SCompare: TZListSortCompare);
1218 var
1219  I, J: Integer;
1220  P, T: Pointer;
1221 begin
1222  repeat
1223  I := L;
1224  J := R;
1225  P := SortList^[(L + R) shr 1];
1226  repeat
1227  while (I < R) And (SCompare(SortList^[I], P) < 0) do //check I against R too since the pointer can be nil
1228  Inc(I);
1229  while (J > L) And (SCompare(SortList^[J], P) > 0) do //check j against L too since the pointer can be nil
1230  Dec(J);
1231  if I <= J then
1232  begin
1233  T := SortList^[I];
1234  SortList^[I] := SortList^[J];
1235  SortList^[J] := T;
1236  Inc(I);
1237  Dec(J);
1238  end;
1239  until I > J;
1240  if L < J then
1241  QuickSort(SortList, L, J, SCompare);
1242  L := I;
1243  until I >= R;
1244 end;
1245 
1246 {**
1247  Performs sorting for this list.
1248  @param Compare a comparison function.
1249 }
1250 procedure TZSortedList.Sort(Compare: TZListSortCompare);
1251 begin
1252  if (List <> nil) and (Count > 0) then
1253  {$IFDEF DELPHI16_UP}
1254  QuickSort(@List, 0, Count - 1, Compare);
1255  {$ELSE}
1256  QuickSort(List, 0, Count - 1, Compare);
1257  {$ENDIF}
1258 end;
1259 
1260 {**
1261  Converts an string into escape PostgreSQL format.
1262  @param Value a regular string.
1263  @return a string in PostgreSQL escape format.
1264 }
1265 function EncodeCString(const Value: string): string;
1266 var
1267  I: Integer;
1268  SrcLength, DestLength: Integer;
1269  SrcBuffer, DestBuffer: PChar;
1270 begin
1271  SrcLength := Length(Value);
1272  SrcBuffer := PChar(Value);
1273  DestLength := 0;
1274  for I := 1 to SrcLength do
1275  begin
1276  if CharInSet(SrcBuffer^, [#0]) then
1277  Inc(DestLength, 4)
1278  else if CharInSet(SrcBuffer^, ['"', '''', '\']) then
1279  Inc(DestLength, 2)
1280  else
1281  Inc(DestLength);
1282  Inc(SrcBuffer);
1283  end;
1284 
1285  SrcBuffer := PChar(Value);
1286  SetLength(Result, DestLength);
1287  DestBuffer := PChar(Result);
1288 
1289  for I := 1 to SrcLength do
1290  begin
1291  if CharInSet(SrcBuffer^, [#0]) then
1292  begin
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));
1297  Inc(DestBuffer, 4);
1298  end
1299  else if CharInSet(SrcBuffer^, ['"', '''', '\']) then
1300  begin
1301  DestBuffer[0] := '\';
1302  DestBuffer[1] := SrcBuffer^;
1303  Inc(DestBuffer, 2);
1304  end
1305  else
1306  begin
1307  DestBuffer^ := SrcBuffer^;
1308  Inc(DestBuffer);
1309  end;
1310  Inc(SrcBuffer);
1311  end;
1312 end;
1313 
1314 {**
1315  Converts an string from escape PostgreSQL format.
1316  @param Value a string in PostgreSQL escape format.
1317  @return a regular string.
1318 }
1319 function DecodeCString(const Value: string): string;
1320 var
1321  SrcLength, DestLength: Integer;
1322  SrcBuffer, DestBuffer: PChar;
1323 begin
1324  SrcLength := Length(Value);
1325  SrcBuffer := PChar(Value);
1326  SetLength(Result, SrcLength);
1327  DestLength := 0;
1328  DestBuffer := PChar(Result);
1329 
1330  while SrcLength > 0 do
1331  begin
1332  if SrcBuffer^ = '\' then
1333  begin
1334  Inc(SrcBuffer);
1335  if CharInSet(SrcBuffer^, ['0'..'9']) then
1336  begin
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'))));
1340  Inc(SrcBuffer, 3);
1341  Dec(SrcLength, 4);
1342  end
1343  else
1344  begin
1345  case SrcBuffer^ of
1346  'r': DestBuffer^ := #13;
1347  'n': DestBuffer^ := #10;
1348  't': DestBuffer^ := #9;
1349  else
1350  DestBuffer^ := SrcBuffer^;
1351  end;
1352  Inc(SrcBuffer);
1353  Dec(SrcLength, 2);
1354  end
1355  end
1356  else
1357  begin
1358  DestBuffer^ := SrcBuffer^;
1359  Inc(SrcBuffer);
1360  Dec(SrcLength);
1361  end;
1362  Inc(DestBuffer);
1363  Inc(DestLength);
1364  end;
1365  SetLength(Result, DestLength);
1366 end;
1367 
1368 
1369 {**
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.
1375 }
1376 function ReplaceChar(const Source, Target: Char; const Str: string): string;
1377 var
1378  P: PChar;
1379  I:Integer;
1380 begin
1381  Result := Str;
1382  UniqueString(Result);
1383  P := Pointer(Result);
1384  for i := 0 to Length(Str) - 1 do
1385  begin
1386  if P^ = Source then
1387  P^ := Target;
1388  Inc(P);
1389  end;
1390 end;
1391 
1392 {**
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
1397 }
1398 function MemPas(Buffer: PChar; Length: LongInt): string;
1399 begin
1400  Result := '';
1401  if Assigned(Buffer) then
1402  SetString(Result, Buffer, Length);
1403 end;
1404 
1405 {**
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.
1413 }
1414 procedure DecodeSQLVersioning(const FullVersion: Integer;
1415  out MajorVersion: Integer; out MinorVersion: Integer;
1416  out SubVersion: Integer);
1417 begin
1418  MajorVersion := FullVersion div 1000000;
1419  MinorVersion := (FullVersion - (MajorVersion * 1000000)) div 1000;
1420  SubVersion := FullVersion-(MajorVersion*1000000)-(MinorVersion*1000);
1421 end;
1422 
1423 {**
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.
1431 }
1432 function EncodeSQLVersioning(const MajorVersion: Integer;
1433  const MinorVersion: Integer; const SubVersion: Integer): Integer;
1434 begin
1435  Result := (MajorVersion * 1000000) + (MinorVersion * 1000) + SubVersion;
1436 end;
1437 
1438 {**
1439  Formats a Zeos SQL Version format to X.Y.Z where:
1440  X = major_version
1441  Y = minor_version
1442  Z = sub version
1443  @param SQLVersion an integer
1444  @return Formated Zeos SQL Version Value.
1445 }
1446 
1447 function FormatSQLVersion(const SQLVersion: Integer): string;
1448 var
1449  MajorVersion, MinorVersion, SubVersion: Integer;
1450 begin
1451  DecodeSQLVersioning(SQLVersion, MajorVersion, MinorVersion, SubVersion);
1452  Result := IntToStr(MajorVersion)+'.'+IntToStr(MinorVersion)+'.'+IntToStr(SubVersion);
1453 end;
1454 
1455 {**
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
1459 }
1460 function ZStrToFloat(Value: PAnsiChar): Extended;
1461 var
1462  OldDecimalSeparator, OldThousandSeparator: Char;
1463 begin
1464  OldDecimalSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator;
1465  OldThousandSeparator := {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator;
1466 
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))
1471  else
1472  begin
1473  //wrong DecimalSepartor
1474  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldThousandSeparator;
1475  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := OldDecimalSeparator;
1476  Result := StrToFloat(String(Value));
1477  end
1478  else
1479  if {$IFDEF WITH_ANSISTRINGPOS_DEPRECATED}AnsiStrings.{$ENDIF}AnsiStrPos(PAnsiChar(Value), PAnsiChar(AnsiString(OldThousandSeparator))) = nil then
1480  //default DecimalSepartor
1481  Result := StrToFloat(String(Value))
1482  else
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))
1487  else
1488  begin
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));
1493  end;
1494 
1495  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}DecimalSeparator := OldDecimalSeparator;
1496  {$IFDEF WITH_FORMATSETTINGS}FormatSettings.{$ENDIF}ThousandSeparator := OldThousandSeparator;
1497 end;
1498 
1499 {**
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
1503 }
1504 function ZStrToFloat(Value: AnsiString): Extended;
1505 begin
1506  Result := ZStrToFloat(PAnsiChar(Value));
1507 end;
1508 
1509 procedure ZSetString(const Src: PAnsiChar; var Dest: AnsiString);
1510 begin
1511  if Assigned(Src) then
1512  ZSetString(Src, {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(Src), Dest)
1513  else
1514  Dest := '';
1515 end;
1516 
1517 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: AnsiString);
1518 begin
1519  if ( Len = 0 ) or ( Src = nil ) then
1520  Dest := ''
1521  else
1522  begin
1523  SetLength(Dest, Len);
1524  Move(Src^, PAnsiChar(Dest)^, Len);
1525  end;
1526 end;
1527 
1528 procedure ZSetString(const Src: PAnsiChar; var Dest: UTF8String);
1529 begin
1530  if Assigned(Src) then
1531  ZSetString(Src, {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(Src), Dest)
1532  else
1533  Dest := '';
1534 end;
1535 
1536 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: UTF8String);
1537 begin
1538  if ( Len = 0 ) or ( Src = nil ) then
1539  Dest := ''
1540  else
1541  begin
1542  SetLength(Dest, Len);
1543  Move(Src^, PAnsiChar(Dest)^, Len);
1544  end;
1545 end;
1546 
1547 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: ZWideString); overload;
1548 begin
1549  if ( Len = 0 ) or ( Src = nil ) then
1550  Dest := ''
1551  else
1552  begin
1553  SetLength(Dest, Len div 2);
1554  Move(Src^, PWideChar(Dest)^, Len);
1555  end;
1556 end;
1557 
1558 {$IFDEF WITH_RAWBYTESTRING}
1559 procedure ZSetString(const Src: PAnsiChar; var Dest: RawByteString);
1560 begin
1561  if Assigned(Src) then
1562  ZSetString(Src, {$IFDEF WITH_STRLEN_DEPRECATED}AnsiStrings.{$ENDIF}StrLen(Src), Dest)
1563  else
1564  Dest := '';
1565 end;
1566 
1567 procedure ZSetString(const Src: PAnsiChar; const Len: Cardinal; var Dest: RawByteString);
1568 begin
1569  if ( Len = 0 ) or ( Src = nil ) then
1570  Dest := ''
1571  else
1572  begin
1573  SetLength(Dest, Len);
1574  Move(Src^, PAnsiChar(Dest)^, Len);
1575  end;
1576 end;
1577 {$ENDIF}
1578 
1579 end.