zeoslib  UNKNOWN
 All Files
ZDbcPostgreSqlUtils.pas
Go to the documentation of this file.
1 {*********************************************************}
2 { }
3 { Zeos Database Objects }
4 { PostgreSQL Database Connectivity Classes }
5 { }
6 { Originally written by Sergey Seroukhov }
7 { and Sergey Merkuriev }
8 { }
9 {*********************************************************}
10 
11 {@********************************************************}
12 { Copyright (c) 1999-2012 Zeos Development Group }
13 { }
14 { License Agreement: }
15 { }
16 { This library is distributed in the hope that it will be }
17 { useful, but WITHOUT ANY WARRANTY; without even the }
18 { implied warranty of MERCHANTABILITY or FITNESS FOR }
19 { A PARTICULAR PURPOSE. See the GNU Lesser General }
20 { Public License for more details. }
21 { }
22 { The source code of the ZEOS Libraries and packages are }
23 { distributed under the Library GNU General Public }
24 { License (see the file COPYING / COPYING.ZEOS) }
25 { with the following modification: }
26 { As a special exception, the copyright holders of this }
27 { library give you permission to link this library with }
28 { independent modules to produce an executable, }
29 { regardless of the license terms of these independent }
30 { modules, and to copy and distribute the resulting }
31 { executable under terms of your choice, provided that }
32 { you also meet, for each linked independent module, }
33 { the terms and conditions of the license of that module. }
34 { An independent module is a module which is not derived }
35 { from or based on this library. If you modify this }
36 { library, you may extend this exception to your version }
37 { of the library, but you are not obligated to do so. }
38 { If you do not wish to do so, delete this exception }
39 { statement from your version. }
40 { }
41 { }
42 { The project web site is located on: }
43 { http://zeos.firmos.at (FORUM) }
44 { http://sourceforge.net/p/zeoslib/tickets/ (BUGTRACKER)}
45 { svn://svn.code.sf.net/p/zeoslib/code-0/trunk (SVN) }
46 { }
47 { http://www.sourceforge.net/projects/zeoslib. }
48 { }
49 { }
50 { Zeos Development Group. }
51 {********************************************************@}
52 
53 unit ZDbcPostgreSqlUtils;
54 
55 interface
56 
57 {$I ZDbc.inc}
58 
59 uses
60  Classes, {$IFDEF MSEgui}mclasses,{$ENDIF} SysUtils,
61  ZDbcIntfs, ZPlainPostgreSqlDriver, ZDbcPostgreSql, ZDbcLogging,
62  ZCompatibility, ZVariant;
63 
64 {**
65  Indicate what field type is a number (integer, float and etc.)
66  @param the SQLType field type value
67  @result true if field type number
68 }
69 function IsNumber(Value: TZSQLType): Boolean;
70 
71 {**
72  Return ZSQLType from PostgreSQL type name
73  @param Connection a connection to PostgreSQL
74  @param The TypeName is PostgreSQL type name
75  @return The ZSQLType type
76 }
77 function PostgreSQLToSQLType(Connection: IZPostgreSQLConnection;
78  TypeName: string): TZSQLType; overload;
79 
80 {**
81  Another version of PostgreSQLToSQLType()
82  - comparing integer should be faster than AnsiString?
83  Return ZSQLType from PostgreSQL type name
84  @param Connection a connection to PostgreSQL
85  @param TypeOid is PostgreSQL type OID
86  @return The ZSQLType type
87 }
88 function PostgreSQLToSQLType(const ConSettings: PZConSettings;
89  const OIDAsBlob: Boolean; const TypeOid: Integer): TZSQLType; overload;
90 
91 {**
92  Return PostgreSQL type name from ZSQLType
93  @param The ZSQLType type
94  @return The Postgre TypeName
95 }
96 function SQLTypeToPostgreSQL(SQLType: TZSQLType; IsOidAsBlob: Boolean): string;
97 
98 {**
99  add by Perger -> based on SourceForge:
100  [ 1520587 ] Fix for 1484704: bytea corrupted on post when not using utf8,
101  file: 1484704.patch
102 
103  Converts a binary string into escape PostgreSQL format.
104  @param Value a binary stream.
105  @return a string in PostgreSQL binary string escape format.
106 }
107 function EncodeBinaryString(const Value: AnsiString): AnsiString;
108 
109 {**
110  Encode string which probably consists of multi-byte characters.
111  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.
112  @param CharactersetCode the characterset in terms of enumerate code.
113  @param Value the regular string.
114  @return the encoded string.
115 }
116 function PGEscapeString(Handle: Pointer; const Value: RawByteString;
117  ConSettings: PZConSettings; WasEncoded: Boolean = False): RawByteString;
118 
119 {**
120  Converts an string from escape PostgreSQL format.
121  @param Value a string in PostgreSQL escape format.
122  @return a regular string.
123 }
124 function DecodeString(const Value: AnsiString): AnsiString;
125 
126 {**
127  Checks for possible sql errors.
128  @param Connection a reference to database connection to execute Rollback.
129  @param PlainDriver a PostgreSQL plain driver.
130  @param Handle a PostgreSQL connection reference.
131  @param LogCategory a logging category.
132  @param LogMessage a logging message.
133  @param ResultHandle the Handle to the Result
134 }
135 
136 function CheckPostgreSQLError(Connection: IZConnection;
137  PlainDriver: IZPostgreSQLPlainDriver;
138  Handle: PZPostgreSQLConnect; LogCategory: TZLoggingCategory;
139  const LogMessage: string;
140  ResultHandle: PZPostgreSQLResult): String;
141 
142 
143 {**
144  Resolve problem with minor version in PostgreSql bettas
145  @param Value a minor version string like "4betta2"
146  @return a miror version number
147 }
148 function GetMinorVersion(const Value: string): Word;
149 
150 {**
151  Prepares an SQL parameter for the query.
152  @param ParameterIndex the first parameter is 1, the second is 2, ...
153  @return a string representation of the parameter.
154 }
155 function PGPrepareAnsiSQLParam(Value: TZVariant; Connection: IZPostgreSQLConnection;
156  PlainDriver: IZPostgreSQLPlainDriver; const ChunkSize: Cardinal;
157  const InParamType: TZSQLType; const oidasblob, DateTimePrefix, QuotedNumbers: Boolean;
158  ConSettings: PZConSettings): RawByteString;
159 
160 implementation
161 
162 uses ZMessages, ZDbcPostgreSqlResultSet, ZEncoding, ZDbcPostgreSqlStatement;
163 
164 {**
165  Return ZSQLType from PostgreSQL type name
166  @param Connection a connection to PostgreSQL
167  @param The TypeName is PostgreSQL type name
168  @return The ZSQLType type
169 }
170 function PostgreSQLToSQLType(Connection: IZPostgreSQLConnection;
171  TypeName: string): TZSQLType;
172 begin
173  TypeName := LowerCase(TypeName);
174  if (TypeName = 'interval') or (TypeName = 'char') or (TypeName = 'bpchar')
175  or (TypeName = 'varchar') or (TypeName = 'bit') or (TypeName = 'varbit')
176  then//EgonHugeist: Highest Priority Client_Character_set!!!!
177  if (Connection.GetConSettings.CPType = cCP_UTF16) then
178  Result := stUnicodeString
179  else
180  Result := stString
181  else if TypeName = 'text' then
182  Result := stAsciiStream
183  else if TypeName = 'oid' then
184  begin
185  if Connection.IsOidAsBlob() then
186  Result := stBinaryStream
187  else
188  Result := stInteger;
189  end
190  else if TypeName = 'name' then
191  Result := stString
192  else if TypeName = 'enum' then
193  Result := stString
194  else if TypeName = 'cidr' then
195  Result := stString
196  else if TypeName = 'inet' then
197  Result := stString
198  else if TypeName = 'macaddr' then
199  Result := stString
200  else if TypeName = 'int2' then
201  Result := stShort
202  else if TypeName = 'int4' then
203  Result := stInteger
204  else if TypeName = 'int8' then
205  Result := stLong
206  else if TypeName = 'float4' then
207  Result := stFloat
208  else if (TypeName = 'float8') or (TypeName = 'decimal')
209  or (TypeName = 'numeric') then
210  Result := stDouble
211  else if TypeName = 'money' then
212  Result := stDouble
213  else if TypeName = 'bool' then
214  Result := stBoolean
215  else if TypeName = 'date' then
216  Result := stDate
217  else if TypeName = 'time' then
218  Result := stTime
219  else if (TypeName = 'datetime') or (TypeName = 'timestamp')
220  or (TypeName = 'timestamptz') or (TypeName = 'abstime') then
221  Result := stTimestamp
222  else if TypeName = 'regproc' then
223  Result := stString
224  else if TypeName = 'bytea' then
225  begin
226  if Connection.IsOidAsBlob then
227  Result := stBytes
228  else
229  Result := stBinaryStream;
230  end
231  else if (TypeName = 'int2vector') or (TypeName = 'oidvector') then
232  Result := stAsciiStream
233  else if (TypeName <> '') and (TypeName[1] = '_') then // ARRAY TYPES
234  Result := stAsciiStream
235  else
236  Result := stUnknown;
237 
238  if (Connection.GetConSettings.CPType = cCP_UTF16) then
239  if Result = stAsciiStream then
240  Result := stUnicodeStream;
241 end;
242 
243 {**
244  Another version of PostgreSQLToSQLType()
245  - comparing integer should be faster than AnsiString.
246  Return ZSQLType from PostgreSQL type name
247  @param Connection a connection to PostgreSQL
248  @param TypeOid is PostgreSQL type OID
249  @return The ZSQLType type
250 }
251 function PostgreSQLToSQLType(const ConSettings: PZConSettings;
252  const OIDAsBlob: Boolean; const TypeOid: Integer): TZSQLType; overload;
253 begin
254  case TypeOid of
255  1186,18,1042,1043: { interval/char/bpchar/varchar }
256  if (ConSettings.CPType = cCP_UTF16) then
257  Result := stUnicodeString
258  else
259  Result := stString;
260  25: Result := stAsciiStream; { text }
261  26: { oid }
262  begin
263  if OidAsBlob then
264  Result := stBinaryStream
265  else
266  Result := stInteger;
267  end;
268  19: Result := stString; { name }
269  21: Result := stShort; { int2 }
270  23: Result := stInteger; { int4 }
271  20: Result := stLong; { int8 }
272  650: Result := stString; { cidr }
273  869: Result := stString; { inet }
274  829: Result := stString; { macaddr }
275  700: Result := stFloat; { float4 }
276  701,1700: Result := stDouble; { float8/numeric. no 'decimal' any more }
277  790: Result := stDouble; { money }
278  16: Result := stBoolean; { bool }
279  1082: Result := stDate; { date }
280  1083: Result := stTime; { time }
281  1114,1184,702: Result := stTimestamp; { timestamp,timestamptz/abstime. no 'datetime' any more}
282  1560,1562: Result := stString; {bit/ bit varying string}
283  24: Result := stString; { regproc }
284  1034: Result := stAsciiStream; {aclitem[]}
285  17: { bytea }
286  begin
287  if OidAsBlob then
288  Result := stBytes
289  else
290  Result := stBinaryStream;
291  end;
292  22,30: Result := stAsciiStream; { int2vector/oidvector. no '_aclitem' }
293  143,629,651,719,791,1000..1028,1040,1041,1115,1182,1183,1185,1187,1231,1263,
294  1270,1561,1563,2201,2207..2211,2949,2951,3643,3644,3645,3735,3770 : { other array types }
295  Result := stAsciiStream;
296  else
297  Result := stUnknown;
298  end;
299 
300  if (ConSettings.CPType = cCP_UTF16) then
301  if Result = stAsciiStream then
302  Result := stUnicodeStream;
303 end;
304 
305 function SQLTypeToPostgreSQL(SQLType: TZSQLType; IsOidAsBlob: boolean): string;
306 begin
307  case SQLType of
308  stBoolean: Result := 'bool';
309  stByte, stShort, stInteger, stLong: Result := 'int';
310  stFloat, stDouble, stBigDecimal: Result := 'numeric';
311  stString, stUnicodeString, stAsciiStream, stUnicodeStream: Result := 'text';
312  stDate: Result := 'date';
313  stTime: Result := 'time';
314  stTimestamp: Result := 'timestamp';
315  stBinaryStream, stBytes:
316  if IsOidAsBlob then
317  Result := 'oid'
318  else
319  Result := 'bytea';
320  end;
321 end;
322 
323 {**
324  Indicate what field type is a number (integer, float and etc.)
325  @param the SQLType field type value
326  @result true if field type number
327 }
328 function IsNumber(Value: TZSQLType): Boolean;
329 begin
330  Result := Value in [stByte, stShort, stInteger, stLong,
331  stFloat, stDouble, stBigDecimal];
332 end;
333 
334 {**
335  Encode string which probably consists of multi-byte characters.
336  Characters ' (apostraphy), low value (value zero), and \ (back slash) are encoded.
337  Since we have noticed that back slash is the second byte of some BIG5 characters
338  (each of them is two bytes in length), we need a characterset aware encoding function.
339  @param CharactersetCode the characterset in terms of enumerate code.
340  @param Value the regular string.
341  @return the encoded string.
342 }
343 function PGEscapeString(Handle: Pointer; const Value: RawByteString;
344  ConSettings: PZConSettings; WasEncoded: Boolean = False): RawByteString;
345 var
346  I, LastState: Integer;
347  SrcLength, DestLength: Integer;
348  SrcBuffer, DestBuffer: PAnsiChar;
349 
350  function pg_CS_stat(stat: integer; character: integer;
351  CharactersetCode: TZPgCharactersetType): integer;
352  begin
353  if character = 0 then
354  stat := 0;
355 
356  case CharactersetCode of
357  csUTF8, csUNICODE_PODBC:
358  begin
359  if (stat < 2) and (character >= $80) then
360  begin
361  if character >= $fc then
362  stat := 6
363  else if character >= $f8 then
364  stat := 5
365  else if character >= $f0 then
366  stat := 4
367  else if character >= $e0 then
368  stat := 3
369  else if character >= $c0 then
370  stat := 2;
371  end
372  else
373  if (stat > 2) and (character > $7f) then
374  Dec(stat)
375  else
376  stat := 0;
377  end;
378  { Shift-JIS Support. }
379  csSJIS:
380  begin
381  if (stat < 2)
382  and (character > $80)
383  and not ((character > $9f) and (character < $e0)) then
384  stat := 2
385  else if stat = 2 then
386  stat := 1
387  else
388  stat := 0;
389  end;
390  { Chinese Big5 Support. }
391  csBIG5:
392  begin
393  if (stat < 2) and (character > $A0) then
394  stat := 2
395  else if stat = 2 then
396  stat := 1
397  else
398  stat := 0;
399  end;
400  { Chinese GBK Support. }
401  csGBK:
402  begin
403  if (stat < 2) and (character > $7F) then
404  stat := 2
405  else if stat = 2 then
406  stat := 1
407  else
408  stat := 0;
409  end;
410 
411  { Korian UHC Support. }
412  csUHC:
413  begin
414  if (stat < 2) and (character > $7F) then
415  stat := 2
416  else if stat = 2 then
417  stat := 1
418  else
419  stat := 0;
420  end;
421 
422  { EUC_JP Support }
423  csEUC_JP:
424  begin
425  if (stat < 3) and (character = $8f) then { JIS X 0212 }
426  stat := 3
427  else
428  if (stat <> 2)
429  and ((character = $8e) or
430  (character > $a0)) then { Half Katakana HighByte & Kanji HighByte }
431  stat := 2
432  else if stat = 2 then
433  stat := 1
434  else
435  stat := 0;
436  end;
437 
438  { EUC_CN, EUC_KR, JOHAB Support }
439  csEUC_CN, csEUC_KR, csJOHAB:
440  begin
441  if (stat < 2) and (character > $a0) then
442  stat := 2
443  else if stat = 2 then
444  stat := 1
445  else
446  stat := 0;
447  end;
448  csEUC_TW:
449  begin
450  if (stat < 4) and (character = $8e) then
451  stat := 4
452  else if (stat = 4) and (character > $a0) then
453  stat := 3
454  else if ((stat = 3) or (stat < 2)) and (character > $a0) then
455  stat := 2
456  else if stat = 2 then
457  stat := 1
458  else
459  stat := 0;
460  end;
461  { Chinese GB18030 support.Added by Bill Huang <bhuang@redhat.com> <bill_huanghb@ybb.ne.jp> }
462  csGB18030:
463  begin
464  if (stat < 2) and (character > $80) then
465  stat := 2
466  else if stat = 2 then
467  begin
468  if (character >= $30) and (character <= $39) then
469  stat := 3
470  else
471  stat := 1;
472  end
473  else if stat = 3 then
474  begin
475  if (character >= $30) and (character <= $39) then
476  stat := 1
477  else
478  stat := 3;
479  end
480  else
481  stat := 0;
482  end;
483  else
484  stat := 0;
485  end;
486  Result := stat;
487  end;
488 
489 begin
490  SrcLength := Length(Value);
491  SrcBuffer := PAnsiChar(Value);
492  DestLength := 2;
493  LastState := 0;
494  for I := 1 to SrcLength do
495  begin
496  LastState := pg_CS_stat(LastState,integer(SrcBuffer^),
497  TZPgCharactersetType(ConSettings.ClientCodePage.ID));
498  if CharInSet(SrcBuffer^, [#0, '''']) or ((SrcBuffer^ = '\') and (LastState = 0)) then
499  Inc(DestLength, 4)
500  else
501  Inc(DestLength);
502  Inc(SrcBuffer);
503  end;
504 
505  SrcBuffer := PAnsiChar(Value);
506  SetLength(Result, DestLength);
507  DestBuffer := PAnsiChar(Result);
508  DestBuffer^ := '''';
509  Inc(DestBuffer);
510 
511  LastState := 0;
512  for I := 1 to SrcLength do
513  begin
514  LastState := pg_CS_stat(LastState,integer(SrcBuffer^),
515  TZPgCharactersetType(ConSettings.ClientCodePage.ID));
516  if CharInSet(SrcBuffer^, [#0, '''']) or ((SrcBuffer^ = '\') and (LastState = 0)) then
517  begin
518  DestBuffer[0] := '\';
519  DestBuffer[1] := AnsiChar(Ord('0') + (Byte(SrcBuffer^) shr 6));
520  DestBuffer[2] := AnsiChar(Ord('0') + ((Byte(SrcBuffer^) shr 3) and $07));
521  DestBuffer[3] := AnsiChar(Ord('0') + (Byte(SrcBuffer^) and $07));
522  Inc(DestBuffer, 4);
523  end
524  else
525  begin
526  DestBuffer^ := SrcBuffer^;
527  Inc(DestBuffer);
528  end;
529  Inc(SrcBuffer);
530  end;
531  DestBuffer^ := '''';
532 end;
533 
534 
535 {**
536  add by Perger -> based on SourceForge:
537  [ 1520587 ] Fix for 1484704: bytea corrupted on post when not using utf8,
538  file: 1484704.patch
539 
540  Converts a binary string into escape PostgreSQL format.
541  @param Value a binary stream.
542  @return a string in PostgreSQL binary string escape format.
543 }
544 function EncodeBinaryString(const Value: AnsiString): AnsiString;
545 var
546  I: Integer;
547  SrcLength, DestLength: Integer;
548  SrcBuffer, DestBuffer: PAnsiChar;
549 begin
550  SrcLength := Length(Value);
551  SrcBuffer := PAnsiChar(Value);
552  DestLength := 2;
553  for I := 1 to SrcLength do
554  begin
555  if (Byte(SrcBuffer^) < 32) or (Byte(SrcBuffer^) > 126)
556  or CharInSet(SrcBuffer^, ['''', '\']) then
557  Inc(DestLength, 5)
558  else
559  Inc(DestLength);
560  Inc(SrcBuffer);
561  end;
562 
563  SrcBuffer := PAnsiChar(Value);
564  SetLength(Result, DestLength);
565  DestBuffer := PAnsiChar(Result);
566  DestBuffer^ := '''';
567  Inc(DestBuffer);
568 
569  for I := 1 to SrcLength do
570  begin
571  if (Byte(SrcBuffer^) < 32) or (Byte(SrcBuffer^) > 126)
572  or CharInSet(SrcBuffer^, ['''', '\']) then
573  begin
574  DestBuffer[0] := '\';
575  DestBuffer[1] := '\';
576  DestBuffer[2] := AnsiChar(Ord('0') + (Byte(SrcBuffer^) shr 6));
577  DestBuffer[3] := AnsiChar(Ord('0') + ((Byte(SrcBuffer^) shr 3) and $07));
578  DestBuffer[4] := AnsiChar(Ord('0') + (Byte(SrcBuffer^) and $07));
579  Inc(DestBuffer, 5);
580  end
581  else
582  begin
583  DestBuffer^ := SrcBuffer^;
584  Inc(DestBuffer);
585  end;
586  Inc(SrcBuffer);
587  end;
588  DestBuffer^ := '''';
589 end;
590 
591 {**
592  Converts an string from escape PostgreSQL format.
593  @param Value a string in PostgreSQL escape format.
594  @return a regular string.
595 }
596 function DecodeString(const Value: AnsiString): AnsiString;
597 var
598  SrcLength, DestLength: Integer;
599  SrcBuffer, DestBuffer: PAnsiChar;
600 begin
601  SrcLength := Length(Value);
602  SrcBuffer := PAnsiChar(Value);
603  SetLength(Result, SrcLength);
604  DestLength := 0;
605  DestBuffer := PAnsiChar(Result);
606 
607  while SrcLength > 0 do
608  begin
609  if SrcBuffer^ = '\' then
610  begin
611  Inc(SrcBuffer);
612  if CharInSet(SrcBuffer^, ['\', '''']) then
613  begin
614  DestBuffer^ := SrcBuffer^;
615  Inc(SrcBuffer);
616  Dec(SrcLength, 2);
617  end
618  else
619  begin
620  DestBuffer^ := AnsiChar(((Byte(SrcBuffer[0]) - Ord('0')) shl 6)
621  or ((Byte(SrcBuffer[1]) - Ord('0')) shl 3)
622  or ((Byte(SrcBuffer[2]) - Ord('0'))));
623  Inc(SrcBuffer, 3);
624  Dec(SrcLength, 4);
625  end;
626  end
627  else
628  begin
629  DestBuffer^ := SrcBuffer^;
630  Inc(SrcBuffer);
631  Dec(SrcLength);
632  end;
633  Inc(DestBuffer);
634  Inc(DestLength);
635  end;
636  SetLength(Result, DestLength);
637 end;
638 
639 {**
640  Checks for possible sql errors.
641  @param Connection a reference to database connection to execute Rollback.
642  @param PlainDriver a PostgreSQL plain driver.
643  @param Handle a PostgreSQL connection reference.
644  @param LogCategory a logging category.
645  @param LogMessage a logging message.
646  //FirmOS 22.02.06
647  @param ResultHandle the Handle to the Result
648 }
649 function CheckPostgreSQLError(Connection: IZConnection;
650  PlainDriver: IZPostgreSQLPlainDriver;
651  Handle: PZPostgreSQLConnect; LogCategory: TZLoggingCategory;
652  const LogMessage: string;
653  ResultHandle: PZPostgreSQLResult): String;
654 var
655  ErrorMessage: string;
656 //FirmOS
657  ConnectionLost: boolean;
658 
659  function GetMessage(AMessage: PAnsiChar): String;
660  begin
661  if Assigned(Connection) then
662  Result := Trim(PlainDriver.ZDbcString(AMessage, Connection.GetConSettings))
663  else
664  {$IFDEF UNICODE}
665  Result := Trim(UTF8ToString(AMessage));
666  {$ELSE}
667  {$IFDEF DELPHI}
668  Result := Trim(Utf8ToAnsi(AMessage));
669  {$ELSE}
670  Result := Trim(AMessage);
671  {$ENDIF}
672  {$ENDIF}
673  end;
674 begin
675  if Assigned(Handle) then
676  ErrorMessage := GetMessage(PlainDriver.GetErrorMessage(Handle))
677  else
678  ErrorMessage := '';
679 
680  if ErrorMessage <> '' then
681  begin
682  if Assigned(ResultHandle) then
683 { StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SEVERITY)));
684  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_MESSAGE_PRIMARY)));
685  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_MESSAGE_DETAIL)));
686  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_MESSAGE_HINT)));
687  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_STATEMENT_POSITION)));
688  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_INTERNAL_POSITION)));
689  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_INTERNAL_QUERY)));
690  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_CONTEXT)));
691  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SOURCE_FILE)));
692  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SOURCE_LINE)));
693  StatusCode := Trim(StrPas(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SOURCE_FUNCTION)));
694 }
695  Result := GetMessage(PlainDriver.GetResultErrorField(ResultHandle,PG_DIAG_SQLSTATE))
696  else
697  Result := '';
698  end;
699 
700 
701 
702  if ErrorMessage <> '' then
703  begin
704  ConnectionLost := (PlainDriver.GetStatus(Handle) = CONNECTION_BAD);
705 
706  if Assigned(Connection) then begin
707  if Connection.GetAutoCommit and not ConnectionLost then Connection.Rollback;
708  DriverManager.LogError(LogCategory, PlainDriver.GetProtocol, LogMessage,
709  0, ErrorMessage);
710  end else begin
711  DriverManager.LogError(LogCategory, 'some PostgreSQL protocol', LogMessage,
712  0, ErrorMessage);
713  end;
714 
715  if ResultHandle <> nil then PlainDriver.Clear(ResultHandle);
716 
717  if not ( ConnectionLost and ( LogCategory = lcUnprepStmt ) ) then
718  if not (Result = '42P18') then
719  raise EZSQLException.CreateWithStatus(Result,Format(SSQLError1, [ErrorMessage]));
720  end;
721 end;
722 
723 {**
724  Resolve problem with minor version in PostgreSql bettas
725  @param Value a minor version string like "4betta2"
726  @return a miror version number
727 }
728 function GetMinorVersion(const Value: string): Word;
729 var
730  I: integer;
731  Temp: string;
732 begin
733  Temp := '';
734  for I := 1 to Length(Value) do
735  if CharInSet(Value[I], ['0'..'9']) then
736  Temp := Temp + Value[I]
737  else
738  Break;
739  Result := StrToIntDef(Temp, 0);
740 end;
741 
742 {**
743  Prepares an SQL parameter for the query.
744  @param ParameterIndex the first parameter is 1, the second is 2, ...
745  @return a string representation of the parameter.
746 }
747 function PGPrepareAnsiSQLParam(Value: TZVariant; Connection: IZPostgreSQLConnection;
748  PlainDriver: IZPostgreSQLPlainDriver; const ChunkSize: Cardinal;
749  const InParamType: TZSQLType; const oidasblob, DateTimePrefix, QuotedNumbers: Boolean;
750  ConSettings: PZConSettings): RawByteString;
751 var
752  TempBlob: IZBlob;
753  TempStream: TStream;
754  WriteTempBlob: IZPostgreSQLBlob;
755 begin
756  if DefVarManager.IsNull(Value) then
757  Result := 'NULL'
758  else
759  begin
760  case InParamType of
761  stBoolean:
762  if SoftVarManager.GetAsBoolean(Value) then
763  Result := 'TRUE'
764  else
765  Result := 'FALSE';
766  stByte, stShort, stInteger, stLong, stBigDecimal, stFloat, stDouble:
767  begin
768  Result := RawByteString(SoftVarManager.GetAsString(Value));
769  if QuotedNumbers then Result := #39+Result+#39;
770  end;
771  stBytes:
772  Result := Connection.EncodeBinary(SoftVarManager.GetAsBytes(Value));
773  stString:
774  if PlainDriver.SupportsStringEscaping(Connection.ClientSettingsChanged) then
775  Result := PlainDriver.EscapeString(Connection.GetConnectionHandle,
776  PlainDriver.ZPlainString(SoftVarManager.GetAsString(Value), ConSettings), ConSettings, True)
777  else
778  Result := ZDbcPostgreSqlUtils.PGEscapeString(Connection.GetConnectionHandle,
779  PlainDriver.ZPlainString(SoftVarManager.GetAsString(Value), ConSettings), ConSettings, True);
780  stUnicodeString:
781  if PlainDriver.SupportsStringEscaping(Connection.ClientSettingsChanged) then
782  Result := PlainDriver.EscapeString(Connection.GetConnectionHandle,
783  PlainDriver.ZPlainString(SoftVarManager.GetAsUnicodeString(Value), ConSettings), ConSettings, True)
784  else
785  Result := ZDbcPostgreSqlUtils.PGEscapeString(Connection.GetConnectionHandle,
786  PlainDriver.ZPlainString(SoftVarManager.GetAsUnicodeString(Value), ConSettings), ConSettings, True);
787  stDate:
788  begin
789  Result := RawByteString(#39+FormatDateTime('yyyy-mm-dd',
790  SoftVarManager.GetAsDateTime(Value))+#39);
791  if DateTimePrefix then Result := Result + '::date';
792  end;
793  stTime:
794  begin
795  Result := RawByteString(#39+FormatDateTime('hh":"mm":"ss"."zzz',
796  SoftVarManager.GetAsDateTime(Value))+#39);
797  if DateTimePrefix then Result := Result + '::time';
798  end;
799  stTimestamp:
800  begin
801  Result := RawByteString(#39+FormatDateTime('yyyy-mm-dd hh":"mm":"ss"."zzz',
802  SoftVarManager.GetAsDateTime(Value))+#39);
803  if DateTimePrefix then Result := Result + '::timestamp';
804  end;
805  stAsciiStream, stUnicodeStream, stBinaryStream:
806  begin
807  TempBlob := DefVarManager.GetAsInterface(Value) as IZBlob;
808  if not TempBlob.IsEmpty then
809  begin
810  case InParamType of
811  stBinaryStream:
812  if (Connection.IsOidAsBlob) or oidasblob then
813  begin
814  TempStream := TempBlob.GetStream;
815  try
816  WriteTempBlob := TZPostgreSQLBlob.Create(PlainDriver, nil, 0,
817  Connection.GetConnectionHandle, 0, ChunkSize);
818  WriteTempBlob.SetStream(TempStream);
819  WriteTempBlob.WriteBlob;
820  Result := RawByteString(IntToStr(WriteTempBlob.GetBlobOid));
821  finally
822  WriteTempBlob := nil;
823  TempStream.Free;
824  end;
825  end
826  else
827  Result := Connection.EncodeBinary(TempBlob.GetString);
828  stAsciiStream, stUnicodeStream:
829  if PlainDriver.SupportsStringEscaping(Connection.ClientSettingsChanged) then
830  Result := PlainDriver.EscapeString(
831  Connection.GetConnectionHandle,
832  GetValidatedAnsiStringFromBuffer(TempBlob.GetBuffer,
833  TempBlob.Length, TempBlob.WasDecoded, ConSettings),
834  ConSettings, True)
835  else
836  Result := ZDbcPostgreSqlUtils.PGEscapeString(
837  Connection.GetConnectionHandle,
838  GetValidatedAnsiStringFromBuffer(TempBlob.GetBuffer,
839  TempBlob.Length, TempBlob.WasDecoded, ConSettings),
840  ConSettings, True);
841  end; {case..}
842  end
843  else
844  Result := 'NULL';
845  TempBlob := nil;
846  end; {if not TempBlob.IsEmpty then}
847  end;
848  end;
849 end;
850 
851 
852 end.