00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { System Utility Classes and Functions }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZSysUtils;
00055
00056 interface
00057
00058 {$I ZCore.inc}
00059
00060 uses
00061 {$IFNDEF VER130BELOW}
00062 Variants,
00063 {$ELSE}
00064 {$IFDEF FPC}
00065 Variants,
00066 {$ENDIF}
00067 {$ENDIF}
00068 ZMessages, ZCompatibility, Classes, SysUtils;
00069
00070 type
00071 {** Modified comaprison function. }
00072 TZListSortCompare = function (Item1, Item2: Pointer): Integer of object;
00073
00074 {** Modified list of pointers. }
00075 TZSortedList = class (TList)
00076 protected
00077 procedure QuickSort(SortList: PPointerList; L, R: Integer;
00078 SCompare: TZListSortCompare);
00079 public
00080 procedure Sort(Compare: TZListSortCompare);
00081 end;
00082
00083 {$IFDEF VER130BELOW}
00084 const
00085 NullAsStringValue: string = '';
00086 {$ENDIF}
00087
00088 {**
00089 Determines a position of a first delimiter.
00090 @param Delimiters a string with possible delimiters.
00091 @param Str a string to be checked.
00092 @return a position of the first found delimiter or 0 if no delimiters was found.
00093 }
00094 function FirstDelimiter(const Delimiters, Str: string): Integer;
00095
00096 {**
00097 Determines a position of a LAST delimiter.
00098 @param Delimiters a string with possible delimiters.
00099 @param Str a string to be checked.
00100 @return a position of the last found delimiter or 0 if no delimiters was found.
00101 }
00102 function LastDelimiter(const Delimiters, Str: string): Integer;
00103
00104 {**
00105 Compares two PChars without stopping at #0
00106 @param P1 first PChar
00107 @param P2 seconds PChar
00108 @return <code>True</code> if the memory at P1 and P2 are equal
00109 }
00110 function MemLComp(P1, P2: PChar; Len: Integer): Boolean;
00111
00112 {**
00113 Checks is the string starts with substring.
00114 @param Str a string to be checked.
00115 @param SubStr a string to test at the start of the Str.
00116 @return <code>True</code> if Str started with SubStr;
00117 }
00118 function StartsWith(const Str, SubStr: string): Boolean;
00119
00120 {**
00121 Checks is the string ends with substring.
00122 @param Str a string to be checked.
00123 @param SubStr a string to test at the end of the Str.
00124 @return <code>True</code> if Str ended with SubStr;
00125 }
00126 function EndsWith(const Str, SubStr: string): Boolean;
00127
00128 {**
00129 Converts SQL string into float value.
00130 @param Str an SQL string with comma delimiter.
00131 @param Def a default value if the string can not be converted.
00132 @return a converted value or Def if conversion was failt.
00133 }
00134 function SQLStrToFloatDef(Str: string; Def: Extended): Extended;
00135
00136 {**
00137 Converts SQL string into float value.
00138 @param Str an SQL string with comma delimiter.
00139 @return a converted value or Def if conversion was failt.
00140 }
00141 function SQLStrToFloat(const Str: string): Extended;
00142
00143 {**
00144 Converts a character buffer into pascal string.
00145 @param Buffer a character buffer pointer.
00146 @param Length a buffer length.
00147 @return a string retrived from the buffer.
00148 }
00149 function BufferToStr(Buffer: PChar; Length: LongInt): string;
00150
00151 {**
00152 Converts a string into boolean value.
00153 @param Str a string value.
00154 @return <code>True</code> is Str = 'Y'/'YES'/'T'/'TRUE'/<>0
00155 }
00156 function StrToBoolEx(Str: string): Boolean;
00157
00158 {**
00159 Converts a boolean into string value.
00160 @param Bool a boolean value.
00161 @return <code>"True"</code> or <code>"False"</code>
00162 }
00163 function BoolToStrEx(Bool: Boolean): String;
00164
00165 {**
00166 Checks if the specified string can represent an IP address.
00167 @param Str a string value.
00168 @return <code>True</code> if the string can represent an IP address
00169 or <code>False</code> otherwise.
00170 }
00171 function IsIpAddr(const Str: string): Boolean;
00172
00173 {**
00174 Splits string using the multiple chars.
00175 @param Str the source string
00176 @param Delimiters the delimiters string
00177 @return the result list where plased delimited string
00178 }
00179 function SplitString(const Str, Delimiters: string): TStrings;
00180
00181 {**
00182 Puts to list a splitted string using the multiple chars which replaces
00183 the previous list content.
00184 @param List a list with strings.
00185 @param Str the source string
00186 @param Delimiters the delimiters string
00187 }
00188 procedure PutSplitString(List: TStrings; const Str, Delimiters: string);
00189
00190 {**
00191 Appends to list a splitted string using the multiple chars.
00192 @param List a list with strings.
00193 @param Str the source string
00194 @param Delimiters the delimiters string
00195 }
00196 procedure AppendSplitString(List: TStrings; const Str, Delimiters: string);
00197
00198 {**
00199 Composes a string from the specified strings list delimited with
00200 a special character.
00201 @param List a list of strings.
00202 @param Delimiter a delimiter string.
00203 @return a composed string from the list.
00204 }
00205 function ComposeString(List: TStrings; const Delimiter: string): string;
00206
00207 {**
00208 Converts a float value into SQL string with '.' delimiter.
00209 @param Value a float value to be converted.
00210 @return a converted string value.
00211 }
00212 function FloatToSQLStr(Value: Extended): string;
00213
00214 {**
00215 Puts to list a splitted string using the delimiter string which replaces
00216 the previous list content.
00217 @param List a list with strings.
00218 @param Str the source string
00219 @param Delimiters the delimiter string
00220 }
00221 procedure PutSplitStringEx(List: TStrings; const Str, Delimiter: string);
00222
00223 {**
00224 Splits string using the delimiter string.
00225 @param Str the source string
00226 @param Delimiters the delimiter string
00227 @return the result list where plased delimited string
00228 }
00229 function SplitStringEx(const Str, Delimiter: string): TStrings;
00230
00231 {**
00232 Appends to list a splitted string using the delimeter string.
00233 @param List a list with strings.
00234 @param Str the source string
00235 @param Delimiters the delimiters string
00236 }
00237 procedure AppendSplitStringEx(List: TStrings; const Str, Delimiter: string);
00238
00239 {**
00240 Converts bytes into a string representation.
00241 @param Value an array of bytes to be converted.
00242 @return a converted string.
00243 }
00244 function BytesToStr(const Value: TByteDynArray): string;
00245
00246 {**
00247 Converts string into an array of bytes.
00248 @param Value a string to be converted.
00249 @return a converted array of bytes.
00250 }
00251 function StrToBytes(const Value: string): TByteDynArray;
00252
00253 {**
00254 Converts bytes into a variant representation.
00255 @param Value an array of bytes to be converted.
00256 @return a converted variant.
00257 }
00258 function BytesToVar(const Value: TByteDynArray): Variant;
00259
00260 {**
00261 Converts variant into an array of bytes.
00262 @param Value a varaint to be converted.
00263 @return a converted array of bytes.
00264 }
00265 function VarToBytes(const Value: Variant): TByteDynArray;
00266
00267 {$IFDEF VER130BELOW}
00268 {**
00269 Convert variant value to WideString
00270 @value Value a variant to be converted
00271 @return a converted WideString value
00272 }
00273 function VarToWideStr(const Value: Variant): WideString;
00274
00275 {**
00276 Convert variant value to WideString
00277 @value Value a variant to be converted
00278 @value Default a default value if convertion is not possible
00279 @return a converted WideString value
00280 }
00281 function VarToWideStrDef(const Value: Variant; const Default: WideString): WideString;
00282
00283 {**
00284 Convert string value to float value
00285 @value V a string value to be converted
00286 @value Default a default value if convertion is not possible
00287 @return a converted Extended value
00288 }
00289 function StrToFloatDef(const S: string; const Default: Extended): Extended;
00290 {$ENDIF}
00291
00292 {**
00293 Converts Ansi SQL Date/Time to TDateTime
00294 @param Value a date and time string.
00295 @return a decoded TDateTime value.
00296 }
00297 function AnsiSQLDateToDateTime(const Value: string): TDateTime;
00298
00299 {**
00300 Converts Timestamp String to TDateTime
00301 @param Value a timestamp string.
00302 @return a decoded TDateTime value.
00303 }
00304 function TimestampStrToDateTime(const Value: string): TDateTime;
00305
00306 {**
00307 Converts TDateTime to Ansi SQL Date/Time
00308 @param Value an encoded TDateTime value.
00309 @return a date and time string.
00310 }
00311 function DateTimeToAnsiSQLDate(Value: TDateTime): string;
00312
00313 {**
00314 Converts an string into escape PostgreSQL format.
00315 @param Value a regular string.
00316 @return a string in PostgreSQL escape format.
00317 }
00318 function EncodeCString(const Value: string): string;
00319
00320 {**
00321 Converts an string from escape PostgreSQL format.
00322 @param Value a string in PostgreSQL escape format.
00323 @return a regular string.
00324 }
00325 function DecodeCString(const Value: string): string;
00326
00327 {**
00328 Replace chars in the string
00329 @param Source a char to search.
00330 @param Target a char to replace.
00331 @param Str a source string.
00332 @return a string with replaced chars.
00333 }
00334 function ReplaceChar(const Source, Target: Char; const Str: string): string;
00335
00336 {**
00337 Copy buffer to the pascal string
00338 @param Buffer a buffer with data
00339 @param Length a buffer length
00340 @return a buffer content
00341 }
00342 function MemPas(Buffer: PChar; Length: LongInt): string;
00343
00344 {**
00345 Decodes a Full Version Value encoded with the format:
00346 (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
00347 into separated major, minor and subversion values
00348 @param FullVersion an integer containing the Full Version to decode.
00349 @param MajorVersion an integer containing the Major Version decoded.
00350 @param MinorVersion an integer containing the Minor Version decoded.
00351 @param SubVersion an integer contaning the Sub Version (revision) decoded.
00352 }
00353 procedure DecodeSQLVersioning(const FullVersion: Integer;
00354 out MajorVersion: Integer; out MinorVersion: Integer;
00355 out SubVersion: Integer);
00356
00357 {**
00358 Encodes major, minor and subversion (revision) values in this format:
00359 (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
00360 For example, 4.1.12 is returned as 4001012.
00361 @param MajorVersion an integer containing the Major Version.
00362 @param MinorVersion an integer containing the Minor Version.
00363 @param SubVersion an integer containing the Sub Version (revision).
00364 @return an integer containing the full version.
00365 }
00366 function EncodeSQLVersioning(const MajorVersion: Integer;
00367 const MinorVersion: Integer; const SubVersion: Integer): Integer;
00368
00369 {**
00370 Formats a Zeos SQL Version format to X.Y.Z where:
00371 X = major_version
00372 Y = minor_version
00373 Z = sub version
00374 @param SQLVersion an integer
00375 @return Formated Zeos SQL Version Value.
00376 }
00377 function FormatSQLVersion( const SQLVersion: Integer ): String;
00378
00379 implementation
00380
00381 uses ZMatchPattern;
00382
00383 {**
00384 Determines a position of a first delimiter.
00385 @param Delimiters a string with possible delimiters.
00386 @param Str a string to be checked.
00387 @return a position of the first found delimiter or 0 if no delimiters was found.
00388 }
00389 function FirstDelimiter(const Delimiters, Str: string): Integer;
00390 var
00391 I, Index: Integer;
00392 begin
00393 Result := 0;
00394 for I := 1 to Length(Delimiters) do
00395 begin
00396 Index := Pos(Delimiters[I], Str);
00397 if (Index > 0) and ((Index < Result) or (Result = 0)) then
00398 Result := Index;
00399 end;
00400 end;
00401
00402 {**
00403 Determines a position of a LAST delimiter.
00404 @param Delimiters a string with possible delimiters.
00405 @param Str a string to be checked.
00406 @return a position of the last found delimiter or 0 if no delimiters was found.
00407 }
00408 function LastDelimiter(const Delimiters, Str: string): Integer;
00409 var
00410 I, Index: Integer;
00411 begin
00412 Result := 0;
00413 for I := Length(Str) downto 1 do
00414 begin
00415 Index := Pos(Str[I], Delimiters);
00416 if (Index > 0) then
00417 begin
00418 Result := I;
00419 Break;
00420 end;
00421 end;
00422 end;
00423
00424 {**
00425 Compares two PChars without stopping at #0
00426 @param P1 first PChar
00427 @param P2 seconds PChar
00428 @return <code>True</code> if the memory at P1 and P2 are equal
00429 }
00430 function MemLComp(P1, P2: PChar; Len: Integer): Boolean;
00431 begin
00432 while (Len > 0) and (P1^ = P2^) do
00433 begin
00434 Inc(P1);
00435 Inc(P2);
00436 Dec(Len);
00437 end;
00438 Result := Len = 0;
00439 end;
00440
00441 {**
00442 Checks is the string starts with substring.
00443 @param Str a string to be checked.
00444 @param SubStr a string to test at the start of the Str.
00445 @return <code>True</code> if Str started with SubStr;
00446 }
00447 function StartsWith(const Str, SubStr: string): Boolean;
00448 var
00449 LenSubStr: Integer;
00450 begin
00451 LenSubStr := Length(SubStr);
00452 if SubStr = '' then
00453 Result := True
00454 else
00455 if LenSubStr <= Length(Str) then
00456
00457 Result := MemLComp(PChar(Str), PChar(SubStr), LenSubStr)
00458 else
00459 Result := False;
00460 end;
00461
00462 {**
00463 Checks is the string ends with substring.
00464 @param Str a string to be checked.
00465 @param SubStr a string to test at the end of the Str.
00466 @return <code>True</code> if Str ended with SubStr;
00467 }
00468 function EndsWith(const Str, SubStr: string): Boolean;
00469 var
00470 LenSubStr: Integer;
00471 LenStr: Integer;
00472 begin
00473 if SubStr = '' then
00474 Result := False
00475 else
00476 begin
00477 LenSubStr := Length(SubStr);
00478 LenStr := Length(Str);
00479 if LenSubStr <= LenStr then
00480
00481 Result := MemLComp(PChar(Pointer(Str)) + LenStr - LenSubStr, Pointer(SubStr), LenSubStr)
00482 else
00483 Result := False;
00484 end;
00485 end;
00486
00487 {**
00488 Converts SQL string into float value.
00489 @param Str an SQL string with comma delimiter.
00490 @param Def a default value if the string can not be converted.
00491 @return a converted value or Def if conversion was failt.
00492 }
00493 function SQLStrToFloatDef(Str: string; Def: Extended): Extended;
00494 var
00495 OldDecimalSeparator: Char;
00496 begin
00497 OldDecimalSeparator := DecimalSeparator;
00498 DecimalSeparator := '.';
00499 if Pos('$', Str) = 1 then
00500 Str := Copy(Str, 2, Pred(Length(Str)));
00501 If Str = '' then
00502 Result := Def
00503 else
00504 Result := StrToFloatDef(Str, Def);
00505 DecimalSeparator := OldDecimalSeparator;
00506 end;
00507
00508 {**
00509 Converts SQL string into float value.
00510 @param Str an SQL string with comma delimiter.
00511 @return a converted value or Def if conversion was failt.
00512 }
00513 function SQLStrToFloat(const Str: string): Extended;
00514 var
00515 OldDecimalSeparator: Char;
00516 begin
00517 OldDecimalSeparator := DecimalSeparator;
00518 DecimalSeparator := '.';
00519 try
00520 Result := StrToFloat(Str);
00521 finally
00522 DecimalSeparator := OldDecimalSeparator;
00523 end;
00524 end;
00525
00526 { Convert string buffer into pascal string }
00527 function BufferToStr(Buffer: PChar; Length: LongInt): string;
00528 begin
00529 Result := '';
00530 if Assigned(Buffer) then
00531 SetString(Result, Buffer, Length);
00532 end;
00533
00534 {**
00535 Converts a string into boolean value.
00536 @param Str a string value.
00537 @return <code>True</code> is Str = 'Y'/'YES'/'T'/'TRUE'/<>0
00538 }
00539 function StrToBoolEx(Str: string): Boolean;
00540 begin
00541 Str := UpperCase(Str);
00542 Result := (Str = 'Y') or (Str = 'YES') or (Str = 'T') or (Str = 'TRUE')
00543 or (StrToIntDef(Str, 0) <> 0);
00544 end;
00545
00546 {**
00547 Converts a boolean into string value.
00548 @param Bool a boolean value.
00549 @return <code>"True"</code> or <code>"False"</code>
00550 }
00551 function BoolToStrEx(Bool: Boolean): String;
00552 begin
00553 if Bool then
00554 Result := 'True'
00555 else
00556 Result := 'False';
00557 end;
00558
00559 {**
00560 Checks if the specified string can represent an IP address.
00561 @param Str a string value.
00562 @return <code>True</code> if the string can represent an IP address
00563 or <code>False</code> otherwise.
00564 }
00565 function IsIpAddr(const Str: string): Boolean;
00566 var
00567 I, N, M, Pos: Integer;
00568 begin
00569 if IsMatch('*.*.*.*', Str) then
00570 begin
00571 N := 0;
00572 M := 0;
00573 Pos := 1;
00574 for I := 1 to Length(Str) do
00575 begin
00576 if I - Pos > 3 then
00577 Break;
00578 if Str[I] = '.' then begin
00579 if StrToInt(Copy(Str, Pos, I - Pos)) > 255 then
00580 Break;
00581 Inc(N);
00582 Pos := I + 1;
00583 end;
00584 if Str[I] in ['0'..'9'] then Inc(M);
00585 end;
00586 Result := (M + N = Length(Str)) and (N = 3);
00587 end else
00588 Result := False;
00589 end;
00590
00591 procedure SplitToStringList(List: TStrings; Str: string; const Delimiters: string);
00592 var
00593 DelimPos: Integer;
00594 begin
00595 repeat
00596 DelimPos := FirstDelimiter(Delimiters, Str);
00597 if DelimPos > 0 then
00598 begin
00599 if DelimPos > 1 then
00600 List.Add(Copy(Str, 1, DelimPos - 1));
00601 Str := Copy(Str, DelimPos + 1, Length(Str) - DelimPos);
00602 end else
00603 Break;
00604 until DelimPos <= 0;
00605 if Str <> '' then
00606 List.Add(Str);
00607 end;
00608
00609 {**
00610 Splits string using the multiple chars.
00611 @param Str the source string
00612 @param Delimiters the delimiters string
00613 @return the result list where plased delimited string
00614 }
00615 function SplitString(const Str, Delimiters: string): TStrings;
00616 begin
00617 Result := TStringList.Create;
00618 try
00619 SplitToStringList(Result, Str, Delimiters);
00620 except
00621 Result.Free;
00622 raise;
00623 end;
00624 end;
00625
00626 {**
00627 Puts to list a splitted string using the multiple chars which replaces
00628 the previous list content.
00629 @param List a list with strings.
00630 @param Str the source string
00631 @param Delimiters the delimiters string
00632 }
00633 procedure PutSplitString(List: TStrings; const Str, Delimiters: string);
00634 begin
00635 List.Clear;
00636 SplitToStringList(List, Str, Delimiters);
00637 end;
00638
00639 {**
00640 Appends to list a splitted string using the multiple chars.
00641 @param List a list with strings.
00642 @param Str the source string
00643 @param Delimiters the delimiters string
00644 }
00645 procedure AppendSplitString(List: TStrings; const Str, Delimiters: string);
00646 begin
00647 SplitToStringList(List, Str, Delimiters);
00648 end;
00649
00650 {**
00651 Composes a string from the specified strings list delimited with
00652 a special character.
00653 @param List a list of strings.
00654 @param Delimiter a delimiter string.
00655 @return a composed string from the list.
00656 }
00657 function ComposeString(List: TStrings; const Delimiter: string): string;
00658 var
00659 i, Len, DelimLen: Integer;
00660 S: string;
00661 P: PChar;
00662 begin
00663 DelimLen := Length(Delimiter);
00664 Len := 0;
00665 if List.Count > 0 then
00666 begin
00667 Inc(Len, Length(List[0]));
00668 for i := 1 to List.Count - 1 do
00669 Inc(Len, DelimLen + Length(List[i]));
00670 end;
00671 SetLength(Result, Len);
00672 P := Pointer(Result);
00673 for i := 0 to List.Count - 1 do
00674 begin
00675 if (i > 0) and (DelimLen > 0) then
00676 begin
00677 Move(Pointer(Delimiter)^, P^, DelimLen * SizeOf(Char));
00678 Inc(P, DelimLen);
00679 end;
00680 S := List[i];
00681 Len := Length(S);
00682 if Len > 0 then
00683 begin
00684 Move(Pointer(S)^, P^, Len * SizeOf(Char));
00685 Inc(P, Len);
00686 end;
00687 end;
00688 end;
00689
00690 {**
00691 Converts a float value into SQL string with '.' delimiter.
00692 @param Value a float value to be converted.
00693 @return a converted string value.
00694 }
00695 function FloatToSQLStr(Value: Extended): string;
00696 var
00697 OldDecimalSeparator: Char;
00698 begin
00699 OldDecimalSeparator := DecimalSeparator;
00700 DecimalSeparator := '.';
00701 try
00702 Result := FloatToStr(Value);
00703 finally
00704 DecimalSeparator := OldDecimalSeparator;
00705 end;
00706 end;
00707
00708 procedure SplitToStringListEx(List: TStrings; const Str, Delimiter: string);
00709 var
00710 Pos: integer;
00711 Temp: string;
00712 begin
00713 Temp := Str;
00714 repeat
00715 Pos := AnsiPos(Delimiter, Temp);
00716 List.Add(Copy(Temp, 1, Pos - 1));
00717 Delete(Temp, 1, Pos + Length(Delimiter) - 1);
00718 until Pos = 0;
00719 if Temp <> '' then
00720 List.Add(Temp);
00721 end;
00722
00723 {**
00724 Puts to list a splitted string using the delimiter string which replaces
00725 the previous list content.
00726 @param List a list with strings.
00727 @param Str the source string
00728 @param Delimiters the delimiter string
00729 }
00730 procedure PutSplitStringEx(List: TStrings; const Str, Delimiter: string);
00731 begin
00732 List.Clear;
00733 SplitToStringListEx(List, Str, Delimiter);
00734 end;
00735
00736 {**
00737 Splits string using the delimiter string.
00738 @param Str the source string
00739 @param Delimiters the delimiter string
00740 @return the result list where plased delimited string
00741 }
00742 function SplitStringEx(const Str, Delimiter: string): TStrings;
00743 begin
00744 Result := TStringList.Create;
00745 try
00746 SplitToStringListEx(Result, Str, Delimiter);
00747 except
00748 Result.Free;
00749 raise;
00750 end;
00751 end;
00752
00753 {**
00754 Appends to list a splitted string using the delimeter string.
00755 @param List a list with strings.
00756 @param Str the source string
00757 @param Delimiters the delimiters string
00758 }
00759 procedure AppendSplitStringEx(List: TStrings; const Str, Delimiter: string);
00760 begin
00761 SplitToStringListEx(List, Str, Delimiter);
00762 end;
00763
00764 {**
00765 Converts bytes into a string representation.
00766 @param Value an array of bytes to be converted.
00767 @return a converted string.
00768 }
00769 function BytesToStr(const Value: TByteDynArray): string;
00770 begin
00771 SetString(Result, PChar(@Value[0]), Length(Value))
00772 end;
00773
00774 {**
00775 Converts string into an array of bytes.
00776 @param Value a string to be converted.
00777 @return a converted array of bytes.
00778 }
00779 function StrToBytes(const Value: string): TByteDynArray;
00780 begin
00781 SetLength(Result, Length(Value));
00782 if Value <> '' then
00783 Move(Value[1], Result[0], Length(Value))
00784 end;
00785
00786 {**
00787 Converts bytes into a variant representation.
00788 @param Value an array of bytes to be converted.
00789 @return a converted variant.
00790 }
00791 function BytesToVar(const Value: TByteDynArray): Variant;
00792 var
00793 I: Integer;
00794 begin
00795 Result := VarArrayCreate([0, Length(Value) - 1], varByte);
00796 for I := 0 to Length(Value) - 1 do
00797 Result[I] := Value[I];
00798 end;
00799
00800 {**
00801 Converts variant into an array of bytes.
00802 @param Value a varaint to be converted.
00803 @return a converted array of bytes.
00804 }
00805 function VarToBytes(const Value: Variant): TByteDynArray;
00806 var
00807 I: Integer;
00808 begin
00809 if not (VarIsArray(Value) and (VarArrayDimCount(Value) = 1) and
00810 ((VarType(Value) and VarTypeMask) = varByte)) then
00811 raise Exception.Create(SInvalidVarByteArray);
00812
00813 SetLength(Result, VarArrayHighBound(Value, 1) + 1);
00814 for I := 0 to VarArrayHighBound(Value, 1) do
00815 Result[I] := Value[I];
00816 end;
00817
00818 {$IFDEF VER130BELOW}
00819 {**
00820 Convert variant value to WideString
00821 @value V a variant to be converted
00822 @return a converted WideString value
00823 }
00824 function VarToWideStr(const Value: Variant): WideString;
00825 begin
00826 Result := VarToWideStrDef(Value, NullAsStringValue);
00827 end;
00828
00829 {**
00830 Convert variant value to WideString
00831 @value Value a variant to be converted
00832 @value Default a default value if convertion is not possible
00833 @return a converted WideString value
00834 }
00835 function VarToWideStrDef(const Value: Variant; const Default: WideString): WideString;
00836 begin
00837 if not VarIsNull(Value) then
00838 Result := Value
00839 else
00840 Result := Default;
00841 end;
00842
00843 {**
00844 Convert string value to float value
00845 @value V a string value to be converted
00846 @value Default a default value if convertion is not possible
00847 @return a converted Extended value
00848 }
00849 function StrToFloatDef(const S: string; const Default: Extended): Extended;
00850 begin
00851 Result := Default;
00852 if not TextToFloat(PChar(S), Result, fvExtended) then
00853 Result := Default;
00854 end;
00855 {$ENDIF}
00856
00857 {**
00858 Converts Ansi SQL Date/Time to TDateTime
00859 @param Value a date and time string.
00860 @return a decoded TDateTime value.
00861 }
00862 function AnsiSQLDateToDateTime(const Value: string): TDateTime;
00863 var
00864 Year, Month, Day, Hour, Min, Sec: Word;
00865 Temp: string;
00866 begin
00867 Temp := Value;
00868 Result := 0;
00869 if Length(Temp) >= 10 then
00870 begin
00871 Year := StrToIntDef(Copy(Temp, 1, 4), 0);
00872 Month := StrToIntDef(Copy(Temp, 6, 2), 0);
00873 Day := StrToIntDef(Copy(Temp, 9, 2), 0);
00874
00875 if (Year <> 0) and (Month <> 0) and (Day <> 0) then
00876 begin
00877 try
00878 Result := EncodeDate(Year, Month, Day);
00879 except
00880 end;
00881 end;
00882 Temp := Copy(Temp, 12, 8);
00883 end;
00884 if Length(Temp) >= 8 then
00885 begin
00886 Hour := StrToIntDef(Copy(Temp, 1, 2), 0);
00887 Min := StrToIntDef(Copy(Temp, 4, 2), 0);
00888 Sec := StrToIntDef(Copy(Temp, 7, 2), 0);
00889 try
00890 if Result >= 0 then
00891 Result := Result + EncodeTime(Hour, Min, Sec, 0)
00892 else Result := Result - EncodeTime(Hour, Min, Sec, 0)
00893 except
00894 end;
00895 end;
00896 end;
00897
00898 {**
00899 Converts Timestamp String to TDateTime
00900 @param Value a timestamp string.
00901 @return a decoded TDateTime value.
00902 }
00903 function TimestampStrToDateTime(const Value: string): TDateTime;
00904 var
00905 Year, Month, Day, Hour, Min, Sec: Integer;
00906 StrLength, StrPos: Integer;
00907 begin
00908 Month := 0;
00909 Day := 0;
00910 Hour := 0;
00911 Min := 0;
00912 Sec := 0;
00913 Result := 0;
00914
00915 StrLength := Length(Value);
00916 if (StrLength = 14) or (StrLength = 8) then
00917 begin
00918 StrPos := 5;
00919 Year := StrToIntDef(Copy(Value, 1, 4), 0);
00920 end
00921 else
00922 begin
00923 StrPos := 3;
00924 Year := StrToIntDef(Copy(Value, 1, 2), 0);
00925 end;
00926
00927 if StrLength > 2 then {Add Month}
00928 begin
00929 Month := StrToIntDef(Copy(Value, StrPos, 2), 0);
00930 if StrLength > 4 then {Add Day}
00931 begin
00932 Day := StrToIntDef(Copy(Value, StrPos + 2, 2), 0);
00933 if StrLength > 6 then {Add Hour}
00934 begin
00935 Hour := StrToIntDef(Copy(Value, StrPos + 4, 2), 0);
00936 if StrLength > 8 then {Add Minute}
00937 begin
00938 Min := StrToIntDef(Copy(Value, StrPos + 6, 2), 0);
00939 if StrLength > 10 then {Add Second}
00940 Sec := StrToIntDef(Copy(Value, StrPos + 8, 2), 0);
00941 end;
00942 end;
00943 end;
00944 end;
00945
00946 if (Year <> 0) and (Month <> 0) and (Day <> 0) then
00947 begin
00948 try
00949 Result := EncodeDate(Year, Month, Day)
00950 except
00951 end;
00952 end;
00953
00954 try
00955 Result := Result + EncodeTime(Hour, Min, Sec, 0);
00956 except
00957 end;
00958 end;
00959
00960 {**
00961 Converts TDateTime to Ansi SQL Date/Time
00962 @param Value an encoded TDateTime value.
00963 @return a date and time string.
00964 }
00965 function DateTimeToAnsiSQLDate(Value: TDateTime): string;
00966 begin
00967 Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Value);
00968 end;
00969
00970 { TZSortedList }
00971
00972 {**
00973 Performs quick sort algorithm for the list.
00974 }
00975 procedure TZSortedList.QuickSort(SortList: PPointerList; L, R: Integer;
00976 SCompare: TZListSortCompare);
00977 var
00978 I, J: Integer;
00979 P, T: Pointer;
00980 begin
00981 repeat
00982 I := L;
00983 J := R;
00984 P := SortList^[(L + R) shr 1];
00985 repeat
00986 while SCompare(SortList^[I], P) < 0 do
00987 Inc(I);
00988 while SCompare(SortList^[J], P) > 0 do
00989 Dec(J);
00990 if I <= J then
00991 begin
00992 T := SortList^[I];
00993 SortList^[I] := SortList^[J];
00994 SortList^[J] := T;
00995 Inc(I);
00996 Dec(J);
00997 end;
00998 until I > J;
00999 if L < J then
01000 QuickSort(SortList, L, J, SCompare);
01001 L := I;
01002 until I >= R;
01003 end;
01004
01005 {**
01006 Performs sorting for this list.
01007 @param Compare a comparison function.
01008 }
01009 procedure TZSortedList.Sort(Compare: TZListSortCompare);
01010 begin
01011 if (List <> nil) and (Count > 0) then
01012 QuickSort(List, 0, Count - 1, Compare);
01013 end;
01014
01015 {**
01016 Converts an string into escape PostgreSQL format.
01017 @param Value a regular string.
01018 @return a string in PostgreSQL escape format.
01019 }
01020 function EncodeCString(const Value: string): string;
01021 var
01022 I: Integer;
01023 SrcLength, DestLength: Integer;
01024 SrcBuffer, DestBuffer: PChar;
01025 begin
01026 SrcLength := Length(Value);
01027 SrcBuffer := PChar(Value);
01028 DestLength := 0;
01029 for I := 1 to SrcLength do
01030 begin
01031 if SrcBuffer^ in [#0] then
01032 Inc(DestLength, 4)
01033 else if SrcBuffer^ in ['"', '''', '\'] then
01034 Inc(DestLength, 2)
01035 else Inc(DestLength);
01036 Inc(SrcBuffer);
01037 end;
01038
01039 SrcBuffer := PChar(Value);
01040 SetLength(Result, DestLength);
01041 DestBuffer := PChar(Result);
01042
01043 for I := 1 to SrcLength do
01044 begin
01045 if SrcBuffer^ in [#0] then
01046 begin
01047 DestBuffer[0] := '\';
01048 DestBuffer[1] := Chr(Ord('0') + (Byte(SrcBuffer^) shr 6));
01049 DestBuffer[2] := Chr(Ord('0') + ((Byte(SrcBuffer^) shr 3) and $07));
01050 DestBuffer[3] := Chr(Ord('0') + (Byte(SrcBuffer^) and $07));
01051 Inc(DestBuffer, 4);
01052 end
01053 else if SrcBuffer^ in ['"', '''', '\'] then
01054 begin
01055 DestBuffer[0] := '\';
01056 DestBuffer[1] := SrcBuffer^;
01057 Inc(DestBuffer, 2);
01058 end
01059 else
01060 begin
01061 DestBuffer^ := SrcBuffer^;
01062 Inc(DestBuffer);
01063 end;
01064 Inc(SrcBuffer);
01065 end;
01066 end;
01067
01068 {**
01069 Converts an string from escape PostgreSQL format.
01070 @param Value a string in PostgreSQL escape format.
01071 @return a regular string.
01072 }
01073 function DecodeCString(const Value: string): string;
01074 var
01075 SrcLength, DestLength: Integer;
01076 SrcBuffer, DestBuffer: PChar;
01077 begin
01078 SrcLength := Length(Value);
01079 SrcBuffer := PChar(Value);
01080 SetLength(Result, SrcLength);
01081 DestLength := 0;
01082 DestBuffer := PChar(Result);
01083
01084 while SrcLength > 0 do
01085 begin
01086 if SrcBuffer^ = '\' then
01087 begin
01088 Inc(SrcBuffer);
01089 if SrcBuffer^ in ['0'..'9'] then
01090 begin
01091 DestBuffer^ := Chr(((Byte(SrcBuffer[0]) - Ord('0')) shl 6)
01092 or ((Byte(SrcBuffer[1]) - Ord('0')) shl 3)
01093 or ((Byte(SrcBuffer[2]) - Ord('0'))));
01094 Inc(SrcBuffer, 3);
01095 Dec(SrcLength, 4);
01096 end
01097 else
01098 begin
01099 case SrcBuffer^ of
01100 'r': DestBuffer^ := #13;
01101 'n': DestBuffer^ := #10;
01102 't': DestBuffer^ := #9;
01103 else DestBuffer^ := SrcBuffer^;
01104 end;
01105 Inc(SrcBuffer);
01106 Dec(SrcLength, 2);
01107 end
01108 end
01109 else
01110 begin
01111 DestBuffer^ := SrcBuffer^;
01112 Inc(SrcBuffer);
01113 Dec(SrcLength);
01114 end;
01115 Inc(DestBuffer);
01116 Inc(DestLength);
01117 end;
01118 SetLength(Result, DestLength);
01119 end;
01120
01121
01122 {**
01123 Replace chars in the string
01124 @param Source a char to search.
01125 @param Target a char to replace.
01126 @param Str a source string.
01127 @return a string with replaced chars.
01128 }
01129 function ReplaceChar(const Source, Target: Char; const Str: string): string;
01130 var
01131 P: PChar;
01132 I:Integer;
01133 begin
01134 Result := Str;
01135 UniqueString(Result);
01136 P := Pointer(Result);
01137 for i := 0 to Length(Str) - 1 do
01138 begin
01139 if P^ = Source then
01140 P^ := Target;
01141 Inc(P);
01142 end;
01143 end;
01144
01145 {**
01146 Copy buffer to the pascal string
01147 @param Buffer a buffer with data
01148 @param Length a buffer length
01149 @return a buffer content
01150 }
01151 function MemPas(Buffer: PChar; Length: LongInt): string;
01152 begin
01153 Result := '';
01154 if Assigned(Buffer) then
01155 SetString(Result, Buffer, Length);
01156 end;
01157
01158 {**
01159 Decodes a full version value encoded with Zeos SQL format:
01160 (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
01161 into separated major, minor and subversion values
01162 @param FullVersion an integer containing the Full Version to decode.
01163 @param MajorVersion an integer containing the Major Version decoded.
01164 @param MinorVersion an integer containing the Minor Version decoded.
01165 @param SubVersion an integer contaning the Sub Version (revision) decoded.
01166 }
01167 procedure DecodeSQLVersioning(const FullVersion: Integer;
01168 out MajorVersion: Integer; out MinorVersion: Integer;
01169 out SubVersion: Integer);
01170 begin
01171 MajorVersion := FullVersion DIV 1000000;
01172 MinorVersion := (FullVersion-(MajorVersion*1000000)) DIV 1000;
01173 SubVersion := FullVersion-(MajorVersion*1000000)-(MinorVersion*1000);
01174 end;
01175
01176 {**
01177 Encodes major, minor and subversion (revision) values in Zeos SQL format:
01178 (major_version * 1,000,000) + (minor_version * 1,000) + sub_version
01179 For example, 4.1.12 is returned as 4001012.
01180 @param MajorVersion an integer containing the Major Version.
01181 @param MinorVersion an integer containing the Minor Version.
01182 @param SubVersion an integer containing the Sub Version (revision).
01183 @return an integer containing the full version.
01184 }
01185 function EncodeSQLVersioning(const MajorVersion: Integer;
01186 const MinorVersion: Integer; const SubVersion: Integer): Integer;
01187 begin
01188 Result := (MajorVersion * 1000000) + (MinorVersion * 1000) + SubVersion;
01189 end;
01190
01191 {**
01192 Formats a Zeos SQL Version format to X.Y.Z where:
01193 X = major_version
01194 Y = minor_version
01195 Z = sub version
01196 @param SQLVersion an integer
01197 @return Formated Zeos SQL Version Value.
01198 }
01199 function FormatSQLVersion( const SQLVersion: Integer ): String;
01200 var MajorVersion, MinorVersion, SubVersion: Integer;
01201 begin
01202 DecodeSQLVersioning(SQLVersion, MajorVersion, MinorVersion, SubVersion);
01203 Result := IntToStr(MajorVersion)+'.'+IntToStr(MinorVersion)+'.'+IntToStr(SubVersion);
01204 end;
01205
01206 end.