00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { PostgreSQL Database Connectivity Classes }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { and Sergey Merkuriev }
00008 { }
00009 {*********************************************************}
00010
00011 {@********************************************************}
00012 { Copyright (c) 1999-2006 Zeos Development Group }
00013 { }
00014 { License Agreement: }
00015 { }
00016 { This library is distributed in the hope that it will be }
00017 { useful, but WITHOUT ANY WARRANTY; without even the }
00018 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00019 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00020 { Public License for more details. }
00021 { }
00022 { The source code of the ZEOS Libraries and packages are }
00023 { distributed under the Library GNU General Public }
00024 { License (see the file COPYING / COPYING.ZEOS) }
00025 { with the following modification: }
00026 { As a special exception, the copyright holders of this }
00027 { library give you permission to link this library with }
00028 { independent modules to produce an executable, }
00029 { regardless of the license terms of these independent }
00030 { modules, and to copy and distribute the resulting }
00031 { executable under terms of your choice, provided that }
00032 { you also meet, for each linked independent module, }
00033 { the terms and conditions of the license of that module. }
00034 { An independent module is a module which is not derived }
00035 { from or based on this library. If you modify this }
00036 { library, you may extend this exception to your version }
00037 { of the library, but you are not obligated to do so. }
00038 { If you do not wish to do so, delete this exception }
00039 { statement from your version. }
00040 { }
00041 { }
00042 { The project web site is located on: }
00043 { http:
00044 { http:
00045 { svn:
00046 { }
00047 { http:
00048 { http:
00049 { }
00050 { }
00051 { }
00052 { Zeos Development Group. }
00053 {********************************************************@}
00054
00055 unit ZDbcPostgreSqlUtils;
00056
00057 interface
00058
00059 {$I ZDbc.inc}
00060
00061 uses
00062 Classes, SysUtils, ZDbcIntfs, ZPlainPostgreSqlDriver,
00063 ZDbcPostgreSql, ZDbcLogging;
00064
00065 {**
00066 Indicate what field type is a number (integer, float and etc.)
00067 @param the SQLType field type value
00068 @result true if field type number
00069 }
00070 function IsNumber(Value: TZSQLType): Boolean;
00071
00072 {**
00073 Return ZSQLType from PostgreSQL type name
00074 @param Connection a connection to PostgreSQL
00075 @param The TypeName is PostgreSQL type name
00076 @return The ZSQLType type
00077 }
00078 function PostgreSQLToSQLType(Connection: IZPostgreSQLConnection;
00079 TypeName: string): TZSQLType; overload;
00080
00081 {**
00082 Another version of PostgreSQLToSQLType()
00083 - comparing integer should be faster than AnsiString?
00084 Return ZSQLType from PostgreSQL type name
00085 @param Connection a connection to PostgreSQL
00086 @param TypeOid is PostgreSQL type OID
00087 @return The ZSQLType type
00088 }
00089 function PostgreSQLToSQLType(Connection: IZPostgreSQLConnection;
00090 TypeOid: Integer): TZSQLType; overload;
00091
00092 {**
00093 Converts an string into escape PostgreSQL format.
00094 @param Value a regular string.
00095 @return a string in PostgreSQL escape format.
00096 }
00097 function EncodeString(Value: string): string; overload;
00098
00099 {**
00100 add by Perger -> based on SourceForge:
00101 [ 1520587 ] Fix for 1484704: bytea corrupted on post when not using utf8,
00102 file: 1484704.patch
00103
00104 Converts a binary string into escape PostgreSQL format.
00105 @param Value a binary stream.
00106 @return a string in PostgreSQL binary string escape format.
00107 }
00108 function EncodeBinaryString(Value: string): string;
00109
00110 {**
00111 Determine the character code in terms of enumerated number.
00112 @param InputString the input string.
00113 @return the character code in terms of enumerated number.
00114 }
00115 function pg_CS_code(const InputString: string): TZPgCharactersetType;
00116
00117 {**
00118 Encode string which probably consists of multi-byte characters.
00119 Characters ' (apostraphy), low value (value zero), and \ (back slash) are encoded. Since we have noticed that back slash is the second byte of some BIG5 characters (each of them is two bytes in length), we need a characterset aware encoding function.
00120 @param CharactersetCode the characterset in terms of enumerate code.
00121 @param Value the regular string.
00122 @return the encoded string.
00123 }
00124 function EncodeString(CharactersetCode: TZPgCharactersetType; Value: string): string; overload;
00125
00126 {**
00127 Converts an string from escape PostgreSQL format.
00128 @param Value a string in PostgreSQL escape format.
00129 @return a regular string.
00130 }
00131 function DecodeString(Value: string): string;
00132
00133 {**
00134 Checks for possible sql errors.
00135 @param Connection a reference to database connection to execute Rollback.
00136 @param PlainDriver a PostgreSQL plain driver.
00137 @param Handle a PostgreSQL connection reference.
00138 @param LogCategory a logging category.
00139 @param LogMessage a logging message.
00140 @param ResultHandle the Handle to the Result
00141 }
00142
00143 procedure CheckPostgreSQLError(Connection: IZConnection;
00144 PlainDriver: IZPostgreSQLPlainDriver;
00145 Handle: PZPostgreSQLConnect; LogCategory: TZLoggingCategory;
00146 LogMessage: string;
00147 ResultHandle: PZPostgreSQLResult);
00148
00149
00150 {**
00151 Resolve problem with minor version in PostgreSql bettas
00152 @param Value a minor version string like "4betta2"
00153 @return a miror version number
00154 }
00155 function GetMinorVersion(Value: string): Word;
00156
00157 implementation
00158
00159 uses ZMessages;
00160
00161 type
00162
00163 pg_CS=record
00164 name: string;
00165 code: TZPgCharactersetType;
00166 end;
00167
00168 const
00169
00170 CS_Table: array [0..38] of pg_CS =
00171 (
00172 (name:'SQL_ASCII'; code: csSQL_ASCII),
00173 (name:'EUC_JP'; code: csEUC_JP),
00174 (name:'EUC_CN'; code: csEUC_CN),
00175 (name:'EUC_KR'; code: csEUC_KR),
00176 (name:'EUC_TW'; code: csEUC_TW),
00177 (name:'JOHAB'; code: csJOHAB),
00178 (name:'UTF8'; code: csUTF8),
00179 (name:'MULE_INTERNAL'; code: csMULE_INTERNAL),
00180 (name:'LATIN1'; code: csLATIN1),
00181 (name:'LATIN2'; code: csLATIN2),
00182 (name:'LATIN3'; code: csLATIN3),
00183 (name:'LATIN4'; code: csLATIN4),
00184 (name:'LATIN5'; code: csLATIN5),
00185 (name:'LATIN6'; code: csLATIN6),
00186 (name:'LATIN7'; code: csLATIN7),
00187 (name:'LATIN8'; code: csLATIN8),
00188 (name:'LATIN9'; code: csLATIN9),
00189 (name:'LATIN10'; code: csLATIN10),
00190 (name:'WIN1256'; code: csWIN1256),
00191 (name:'WIN1258'; code: csWIN1258), { since 8.1 }
00192 (name:'WIN874'; code: csWIN874),
00193 (name:'KOI8'; code: csKOI8R),
00194 (name:'WIN1251'; code: csWIN1251),
00195 (name:'WIN866'; code: csWIN866), { since 8.1 }
00196 (name:'ISO_8859_5'; code: csISO_8859_5),
00197 (name:'ISO_8859_6'; code: csISO_8859_6),
00198 (name:'ISO_8859_7'; code: csISO_8859_7),
00199 (name:'ISO_8859_8'; code: csISO_8859_8),
00200 (name:'SJIS'; code: csSJIS),
00201 (name:'BIG5'; code: csBIG5),
00202 (name:'GBK'; code: csGBK),
00203 (name:'UHC'; code: csUHC),
00204 (name:'WIN1250'; code: csWIN1250),
00205 (name:'GB18030'; code: csGB18030),
00206 (name:'UNICODE'; code: csUNICODE_PODBC),
00207 (name:'TCVN'; code: csTCVN),
00208 (name:'ALT'; code: csALT),
00209 (name:'WIN'; code: csWIN),
00210 (name:'OTHER'; code: csOTHER)
00211 );
00212
00213 {**
00214 Return ZSQLType from PostgreSQL type name
00215 @param Connection a connection to PostgreSQL
00216 @param The TypeName is PostgreSQL type name
00217 @return The ZSQLType type
00218 }
00219 function PostgreSQLToSQLType(Connection: IZPostgreSQLConnection;
00220 TypeName: string): TZSQLType;
00221 begin
00222 TypeName := LowerCase(TypeName);
00223 if (TypeName = 'interval') or (TypeName = 'char')
00224 or (TypeName = 'varchar') or (TypeName = 'bit') or (TypeName = 'varbit') then
00225 Result := stString
00226 else if TypeName = 'text' then
00227 Result := stAsciiStream
00228 else if TypeName = 'oid' then
00229 begin
00230 if Connection.IsOidAsBlob() then
00231 Result := stBinaryStream
00232 else Result := stInteger;
00233 end
00234 else if TypeName = 'name' then
00235 Result := stString
00236 else if TypeName = 'cidr' then
00237 Result := stString
00238 else if TypeName = 'inet' then
00239 Result := stString
00240 else if TypeName = 'macaddr' then
00241 Result := stString
00242 else if TypeName = 'int2' then
00243 Result := stShort
00244 else if TypeName = 'int4' then
00245 Result := stInteger
00246 else if TypeName = 'int8' then
00247 Result := stLong
00248 else if TypeName = 'float4' then
00249 Result := stFloat
00250 else if (TypeName = 'float8') or (TypeName = 'decimal')
00251 or (TypeName = 'numeric') then
00252 Result := stDouble
00253 else if TypeName = 'money' then
00254 Result := stDouble
00255 else if TypeName = 'bool' then
00256 Result := stBoolean
00257 else if TypeName = 'date' then
00258 Result := stDate
00259 else if TypeName = 'time' then
00260 Result := stTime
00261 else if (TypeName = 'datetime') or (TypeName = 'timestamp')
00262 or (TypeName = 'timestamptz') or (TypeName = 'abstime') then
00263 Result := stTimestamp
00264 else if TypeName = 'regproc' then
00265 Result := stString
00266 else if TypeName = 'bytea' then
00267 begin
00268 if Connection.IsOidAsBlob then
00269 Result := stBytes
00270 else Result := stBinaryStream;
00271 end
00272 else if TypeName = 'bpchar' then
00273 Result := stString
00274 else if (TypeName = 'int2vector') or (TypeName = 'oidvector')
00275 or (TypeName = '_aclitem') then
00276 Result := stAsciiStream
00277 else if (TypeName <> '') and (TypeName[1] = '_') then // ARRAY TYPES
00278 Result := stAsciiStream
00279 else
00280 Result := stUnknown;
00281 end;
00282
00283 {**
00284 Another version of PostgreSQLToSQLType()
00285 - comparing integer should be faster than AnsiString.
00286 Return ZSQLType from PostgreSQL type name
00287 @param Connection a connection to PostgreSQL
00288 @param TypeOid is PostgreSQL type OID
00289 @return The ZSQLType type
00290 }
00291 function PostgreSQLToSQLType(Connection: IZPostgreSQLConnection;
00292 TypeOid: Integer): TZSQLType; overload;
00293 begin
00294 case TypeOid of
00295 1186,18,1043: Result := stString; { interval/char/varchar }
00296 25: Result := stAsciiStream; { text }
00297 26: { oid }
00298 begin
00299 if Connection.IsOidAsBlob() then
00300 Result := stBinaryStream
00301 else Result := stInteger;
00302 end;
00303 19: Result := stString; { name }
00304 21: Result := stShort; { int2 }
00305 23: Result := stInteger; { int4 }
00306 20: Result := stLong; { int8 }
00307 700: Result := stFloat; { float4 }
00308 701,1700: Result := stDouble; { float8/numeric. no 'decimal' any more }
00309 790: Result := stFloat; { money }
00310 16: Result := stBoolean; { bool }
00311 1082: Result := stDate; { date }
00312 1083: Result := stTime; { time }
00313 1114,1184,702: Result := stTimestamp; { timestamp,timestamptz/abstime. no 'datetime' any more}
00314 1560,1562: Result := stString; {bit/ bit varying string}
00315 24: Result := stString; { regproc }
00316 17: { bytea }
00317 begin
00318 if Connection.IsOidAsBlob then
00319 Result := stBytes
00320 else Result := stBinaryStream;
00321 end;
00322 1042: Result := stString; { bpchar }
00323 22,30: Result := stAsciiStream; { int2vector/oidvector. no '_aclitem' }
00324 651, 1000..1028: Result := stAsciiStream;
00325 else
00326 Result := stUnknown;
00327 end;
00328 end;
00329
00330 {**
00331 Indicate what field type is a number (integer, float and etc.)
00332 @param the SQLType field type value
00333 @result true if field type number
00334 }
00335 function IsNumber(Value: TZSQLType): Boolean;
00336 begin
00337 Result := Value in [stByte, stShort, stInteger, stLong,
00338 stFloat, stDouble, stBigDecimal];
00339 end;
00340
00341 {**
00342 Converts an string into escape PostgreSQL format.
00343 @param Value a regular string.
00344 @return a string in PostgreSQL escape format.
00345 }
00346 function EncodeString(Value: string): string;
00347 var
00348 I: Integer;
00349 SrcLength, DestLength: Integer;
00350 SrcBuffer, DestBuffer: PChar;
00351 begin
00352 SrcLength := Length(Value);
00353 SrcBuffer := PChar(Value);
00354 DestLength := 2;
00355 for I := 1 to SrcLength do
00356 begin
00357 if SrcBuffer^ in [#0, '''', '\'] then
00358 Inc(DestLength, 4)
00359 else Inc(DestLength);
00360 Inc(SrcBuffer);
00361 end;
00362
00363 SrcBuffer := PChar(Value);
00364 SetLength(Result, DestLength);
00365 DestBuffer := PChar(Result);
00366 DestBuffer^ := '''';
00367 Inc(DestBuffer);
00368
00369 for I := 1 to SrcLength do
00370 begin
00371 if SrcBuffer^ in [#0, '''', '\'] then
00372 begin
00373 DestBuffer[0] := '\';
00374 DestBuffer[1] := Chr(Ord('0') + (Byte(SrcBuffer^) shr 6));
00375 DestBuffer[2] := Chr(Ord('0') + ((Byte(SrcBuffer^) shr 3) and $07));
00376 DestBuffer[3] := Chr(Ord('0') + (Byte(SrcBuffer^) and $07));
00377 Inc(DestBuffer, 4);
00378 end
00379 else
00380 begin
00381 DestBuffer^ := SrcBuffer^;
00382 Inc(DestBuffer);
00383 end;
00384 Inc(SrcBuffer);
00385 end;
00386 DestBuffer^ := '''';
00387 end;
00388
00389 {**
00390 Determine the character code in terms of enumerated number.
00391 @param InputString the input string.
00392 @return the character code in terms of enumerated number.
00393 }
00394 function pg_CS_code(const InputString: string): TZPgCharactersetType;
00395 var
00396 i,len: integer;
00397 begin
00398 Result := csOTHER;
00399
00400 i := 0;
00401 while CS_Table[i].code <> csOTHER do
00402 begin
00403 if UpperCase(InputString) = UpperCase(CS_Table[i].name) then
00404 begin
00405 Result := CS_Table[i].code;
00406 break;
00407 end;
00408 Inc(i);
00409 end;
00410
00411 if Result = csOTHER then { No exact match. Look for the closest match. }
00412 begin
00413 i := 0;
00414 len := 0;
00415 while CS_Table[i].code <> csOTHER do
00416 begin
00417 if Pos(CS_Table[i].name, InputString) > 0 then
00418 begin
00419 if Length(CS_Table[i].name) >= len then
00420 begin
00421 len := Length(CS_Table[i].name);
00422 Result := CS_Table[i].code;
00423 end;
00424 end;
00425 Inc(i);
00426 end;
00427 end;
00428 end;
00429
00430 function pg_CS_stat(stat: integer; character: integer;
00431 CharactersetCode: TZPgCharactersetType): integer;
00432 begin
00433 if character = 0 then
00434 stat := 0;
00435
00436 case CharactersetCode of
00437 csUTF8, csUNICODE_PODBC:
00438 begin
00439 if (stat < 2) and (character >= $80) then
00440 begin
00441 if character >= $fc then
00442 stat := 6
00443 else if character >= $f8 then
00444 stat := 5
00445 else if character >= $f0 then
00446 stat := 4
00447 else if character >= $e0 then
00448 stat := 3
00449 else if character >= $c0 then
00450 stat := 2;
00451 end
00452 else if (stat > 2) and (character > $7f) then
00453 Dec(stat)
00454 else
00455 stat := 0;
00456 end;
00457 { Shift-JIS Support. }
00458 csSJIS:
00459 begin
00460 if (stat < 2)
00461 and (character > $80)
00462 and not ((character > $9f) and (character < $e0)) then
00463 stat := 2
00464 else if stat = 2 then
00465 stat := 1
00466 else
00467 stat := 0;
00468 end;
00469 { Chinese Big5 Support. }
00470 csBIG5:
00471 begin
00472 if (stat < 2) and (character > $A0) then
00473 stat := 2
00474 else if stat = 2 then
00475 stat := 1
00476 else
00477 stat := 0;
00478 end;
00479 { Chinese GBK Support. }
00480 csGBK:
00481 begin
00482 if (stat < 2) and (character > $7F) then
00483 stat := 2
00484 else if stat = 2 then
00485 stat := 1
00486 else
00487 stat := 0;
00488 end;
00489
00490 { Korian UHC Support. }
00491 csUHC:
00492 begin
00493 if (stat < 2) and (character > $7F) then
00494 stat := 2
00495 else if stat = 2 then
00496 stat := 1
00497 else
00498 stat := 0;
00499 end;
00500
00501 { EUC_JP Support }
00502 csEUC_JP:
00503 begin
00504 if (stat < 3) and (character = $8f) then { JIS X 0212 }
00505 stat := 3
00506 else
00507 if (stat <> 2)
00508 and ((character = $8e) or
00509 (character > $a0)) then { Half Katakana HighByte & Kanji HighByte }
00510 stat := 2
00511 else if stat = 2 then
00512 stat := 1
00513 else
00514 stat := 0;
00515 end;
00516
00517 { EUC_CN, EUC_KR, JOHAB Support }
00518 csEUC_CN, csEUC_KR, csJOHAB:
00519 begin
00520 if (stat < 2) and (character > $a0) then
00521 stat := 2
00522 else if stat = 2 then
00523 stat := 1
00524 else
00525 stat := 0;
00526 end;
00527 csEUC_TW:
00528 begin
00529 if (stat < 4) and (character = $8e) then
00530 stat := 4
00531 else if (stat = 4) and (character > $a0) then
00532 stat := 3
00533 else if ((stat = 3) or (stat < 2)) and (character > $a0) then
00534 stat := 2
00535 else if stat = 2 then
00536 stat := 1
00537 else
00538 stat := 0;
00539 end;
00540 { Chinese GB18030 support.Added by Bill Huang <bhuang@redhat.com> <bill_huanghb@ybb.ne.jp> }
00541 csGB18030:
00542 begin
00543 if (stat < 2) and (character > $80) then
00544 stat := 2
00545 else if stat = 2 then
00546 begin
00547 if (character >= $30) and (character <= $39) then
00548 stat := 3
00549 else
00550 stat := 1;
00551 end
00552 else if stat = 3 then
00553 begin
00554 if (character >= $30) and (character <= $39) then
00555 stat := 1
00556 else
00557 stat := 3;
00558 end
00559 else
00560 stat := 0;
00561 end;
00562 else
00563 stat := 0;
00564 end;
00565 Result := stat;
00566 end;
00567
00568 {**
00569 Encode string which probably consists of multi-byte characters.
00570 Characters ' (apostraphy), low value (value zero), and \ (back slash) are encoded. Since we have noticed that back slash is the second byte of some BIG5 characters (each of them is two bytes in length), we need a characterset aware encoding function.
00571 @param CharactersetCode the characterset in terms of enumerate code.
00572 @param Value the regular string.
00573 @return the encoded string.
00574 }
00575 function EncodeString(CharactersetCode: TZPgCharactersetType; Value: string): string;
00576 var
00577 I, LastState: Integer;
00578 SrcLength, DestLength: Integer;
00579 SrcBuffer, DestBuffer: PChar;
00580 begin
00581 SrcLength := Length(Value);
00582 SrcBuffer := PChar(Value);
00583 DestLength := 2;
00584 LastState := 0;
00585 for I := 1 to SrcLength do
00586 begin
00587 LastState := pg_CS_stat(LastState,integer(SrcBuffer^),CharactersetCode);
00588 if (SrcBuffer^ in [#0, '''']) or ((SrcBuffer^ = '\') and (LastState = 0)) then
00589 Inc(DestLength, 4)
00590 else Inc(DestLength);
00591 Inc(SrcBuffer);
00592 end;
00593
00594 SrcBuffer := PChar(Value);
00595 SetLength(Result, DestLength);
00596 DestBuffer := PChar(Result);
00597 DestBuffer^ := '''';
00598 Inc(DestBuffer);
00599
00600 LastState := 0;
00601 for I := 1 to SrcLength do
00602 begin
00603 LastState := pg_CS_stat(LastState,integer(SrcBuffer^),CharactersetCode);
00604 if (SrcBuffer^ in [#0, '''']) or ((SrcBuffer^ = '\') and (LastState = 0)) then
00605 begin
00606 DestBuffer[0] := '\';
00607 DestBuffer[1] := Chr(Ord('0') + (Byte(SrcBuffer^) shr 6));
00608 DestBuffer[2] := Chr(Ord('0') + ((Byte(SrcBuffer^) shr 3) and $07));
00609 DestBuffer[3] := Chr(Ord('0') + (Byte(SrcBuffer^) and $07));
00610 Inc(DestBuffer, 4);
00611 end
00612 else
00613 begin
00614 DestBuffer^ := SrcBuffer^;
00615 Inc(DestBuffer);
00616 end;
00617 Inc(SrcBuffer);
00618 end;
00619 DestBuffer^ := '''';
00620 end;
00621
00622
00623 {**
00624 add by Perger -> based on SourceForge:
00625 [ 1520587 ] Fix for 1484704: bytea corrupted on post when not using utf8,
00626 file: 1484704.patch
00627
00628 Converts a binary string into escape PostgreSQL format.
00629 @param Value a binary stream.
00630 @return a string in PostgreSQL binary string escape format.
00631 }
00632 function EncodeBinaryString(Value: string): string;
00633 var
00634 I: Integer;
00635 SrcLength, DestLength: Integer;
00636 SrcBuffer, DestBuffer: PChar;
00637 begin
00638 SrcLength := Length(Value);
00639 SrcBuffer := PChar(Value);
00640 DestLength := 2;
00641 for I := 1 to SrcLength do
00642 begin
00643 if (Byte(SrcBuffer^) < 32) or (Byte(SrcBuffer^) > 126)
00644 or (SrcBuffer^ in ['''', '\']) then
00645 Inc(DestLength, 5)
00646 else Inc(DestLength);
00647 Inc(SrcBuffer);
00648 end;
00649
00650 SrcBuffer := PChar(Value);
00651 SetLength(Result, DestLength);
00652 DestBuffer := PChar(Result);
00653 DestBuffer^ := '''';
00654 Inc(DestBuffer);
00655
00656 for I := 1 to SrcLength do
00657 begin
00658 if (Byte(SrcBuffer^) < 32) or (Byte(SrcBuffer^) > 126)
00659 or (SrcBuffer^ in ['''', '\']) then
00660 begin
00661 DestBuffer[0] := '\';
00662 DestBuffer[1] := '\';
00663 DestBuffer[2] := Chr(Ord('0') + (Byte(SrcBuffer^) shr 6));
00664 DestBuffer[3] := Chr(Ord('0') + ((Byte(SrcBuffer^) shr 3) and $07));
00665 DestBuffer[4] := Chr(Ord('0') + (Byte(SrcBuffer^) and $07));
00666 Inc(DestBuffer, 5);
00667 end
00668 else
00669 begin
00670 DestBuffer^ := SrcBuffer^;
00671 Inc(DestBuffer);
00672 end;
00673 Inc(SrcBuffer);
00674 end;
00675 DestBuffer^ := '''';
00676 end;
00677
00678 {**
00679 Converts an string from escape PostgreSQL format.
00680 @param Value a string in PostgreSQL escape format.
00681 @return a regular string.
00682 }
00683 function DecodeString(Value: string): string;
00684 var
00685 SrcLength, DestLength: Integer;
00686 SrcBuffer, DestBuffer: PChar;
00687 begin
00688 SrcLength := Length(Value);
00689 SrcBuffer := PChar(Value);
00690 SetLength(Result, SrcLength);
00691 DestLength := 0;
00692 DestBuffer := PChar(Result);
00693
00694 while SrcLength > 0 do
00695 begin
00696 if SrcBuffer^ = '\' then
00697 begin
00698 Inc(SrcBuffer);
00699 if SrcBuffer^ in ['\', ''''] then
00700 begin
00701 DestBuffer^ := SrcBuffer^;
00702 Inc(SrcBuffer);
00703 Dec(SrcLength, 2);
00704 end
00705 else
00706 begin
00707 DestBuffer^ := Chr(((Byte(SrcBuffer[0]) - Ord('0')) shl 6)
00708 or ((Byte(SrcBuffer[1]) - Ord('0')) shl 3)
00709 or ((Byte(SrcBuffer[2]) - Ord('0'))));
00710 Inc(SrcBuffer, 3);
00711 Dec(SrcLength, 4);
00712 end;
00713 end
00714 else
00715 begin
00716 DestBuffer^ := SrcBuffer^;
00717 Inc(SrcBuffer);
00718 Dec(SrcLength);
00719 end;
00720 Inc(DestBuffer);
00721 Inc(DestLength);
00722 end;
00723 SetLength(Result, DestLength);
00724 end;
00725
00726 {**
00727 Checks for possible sql errors.
00728 @param Connection a reference to database connection to execute Rollback.
00729 @param PlainDriver a PostgreSQL plain driver.
00730 @param Handle a PostgreSQL connection reference.
00731 @param LogCategory a logging category.
00732 @param LogMessage a logging message.
00733 //FirmOS 22.02.06
00734 @param ResultHandle the Handle to the Result
00735 }
00736 procedure CheckPostgreSQLError(Connection: IZConnection;
00737 PlainDriver: IZPostgreSQLPlainDriver;
00738 Handle: PZPostgreSQLConnect; LogCategory: TZLoggingCategory;
00739 LogMessage: string;
00740 ResultHandle: PZPostgreSQLResult);
00741
00742 var ErrorMessage: string;
00743 //FirmOS
00744 StatusCode:String;
00745 begin
00746 if Assigned(Handle) then
00747 ErrorMessage := Trim(StrPas(PlainDriver.GetErrorMessage(Handle)))
00748 else ErrorMessage := '';
00749 if ErrorMessage<>'' then begin
00750 if Assigned(ResultHandle) then begin
00751 { StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SEVERITY)));
00752 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_MESSAGE_PRIMARY)));
00753 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_MESSAGE_DETAIL)));
00754 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_MESSAGE_HINT)));
00755 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_STATEMENT_POSITION)));
00756 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_INTERNAL_POSITION)));
00757 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_INTERNAL_QUERY)));
00758 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_CONTEXT)));
00759 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SOURCE_FILE)));
00760 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SOURCE_LINE)));
00761 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SOURCE_FUNCTION)));
00762 }
00763 StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SQLSTATE)));
00764 end else begin
00765 StatusCode:='';
00766 end;
00767 end;
00768
00769
00770
00771 if ErrorMessage <> '' then
00772 begin
00773 if Assigned(Connection) and Connection.GetAutoCommit then
00774 Connection.Rollback;
00775
00776 DriverManager.LogError(LogCategory, PlainDriver.GetProtocol, LogMessage, 0, ErrorMessage);
00777 if ResultHandle <> nil then PlainDriver.Clear(ResultHandle);
00778 if PlainDriver.GetStatus(Handle) = CONNECTION_BAD then
00779 PlainDriver.Finish(Handle);
00780 raise EZSQLException.CreateWithStatus(StatusCode,Format(SSQLError1, [ErrorMessage]));
00781 end;
00782 end;
00783
00784 {**
00785 Resolve problem with minor version in PostgreSql bettas
00786 @param Value a minor version string like "4betta2"
00787 @return a miror version number
00788 }
00789 function GetMinorVersion(Value: string): Word;
00790 var
00791 I: integer;
00792 Temp: string;
00793 begin
00794 Temp := '';
00795 for I := 1 to Length(Value) do
00796 if Value[I] in ['0'..'9'] then
00797 Temp := Temp + Value[I]
00798 else
00799 Break;
00800 Result := StrToIntDef(Temp, 0);
00801 end;
00802
00803 end.