zeoslib  UNKNOWN
 All Files
ZDbcPostgreSql.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 { }
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 ZDbcPostgreSql;
53 
54 interface
55 
56 {$I ZDbc.inc}
57 
58 uses
59  Types, Classes, {$IFDEF MSEgui}mclasses,{$ENDIF} SysUtils,
60  {$IF defined(DELPHI) and defined(MSWINDOWS)}Windows,{$IFEND}
61  ZDbcIntfs, ZDbcConnection, ZPlainPostgreSqlDriver, ZDbcLogging, ZTokenizer,
62  ZGenericSqlAnalyser, ZURL, ZCompatibility;
63 
64 type
65 
66  {** Implements PostgreSQL Database Driver. }
67  {$WARNINGS OFF}
68  TZPostgreSQLDriver = class(TZAbstractDriver)
69  public
70  constructor Create; override;
71  function Connect(const Url: TZURL): IZConnection; override;
72  function GetMajorVersion: Integer; override;
73  function GetMinorVersion: Integer; override;
74 
75  function GetTokenizer: IZTokenizer; override;
76  function GetStatementAnalyser: IZStatementAnalyser; override;
77  end;
78  {$WARNINGS ON}
79 
80 type
81  PZPGTableInfo = ^TZPGTableInfo;
82  TZPGTableInfo = record
83  OID: Oid;
84  Name: String;
85  Schema: String;
86  ColNames: Array of String;
87  ColCount: Integer;
88  end;
89 
90  { TZPGTableInfoCache }
91 
92  TZPGTableInfoCache = class(TZCodePagedObject)
93  protected
94  FTblInfo: Array of TZPGTableInfo;
95  FPlainDriver: Pointer;
96  FHandle: PZPostgreSQLConnect;
97  function LoadTblInfo(const TblOid: Oid; out Index: Integer; ZPGTableInfo: PZPGTableInfo): Boolean;
98  function GetTblPos(const TblOid: Oid): Integer;
99  public
100  constructor Create(const ConSettings: PZConSettings;
101  const Handle: PZPostgreSQLConnect; const PlainDriver: IZPostgreSQLPlainDriver);
102  function GetTableInfo(const TblOid: Oid; CurrentFieldCount: Integer): PZPGTableInfo;
103  procedure Clear;
104  end;
105 
106  {** Defines a PostgreSQL specific connection. }
107  IZPostgreSQLConnection = interface(IZConnection)
108  ['{8E62EA93-5A49-4F20-928A-0EA44ABCE5DB}']
109 
110  function IsOidAsBlob: Boolean;
111  function Is_bytea_output_hex: Boolean;
112 
113  function GetTypeNameByOid(Id: Oid): string;
114  function GetPlainDriver: IZPostgreSQLPlainDriver;
115  function GetConnectionHandle: PZPostgreSQLConnect;
116  function GetServerMajorVersion: Integer;
117  function GetServerMinorVersion: Integer;
118  function EncodeBinary(const Value: RawByteString): RawByteString; overload;
119  function EncodeBinary(const Value: TByteDynArray): RawByteString; overload;
120  procedure RegisterPreparedStmtName(const value: String);
121  procedure UnregisterPreparedStmtName(const value: String);
122  function ClientSettingsChanged: Boolean;
123  function GetUndefinedVarcharAsStringLength: Integer;
124  function GetTableInfo(const TblOid: Oid; CurrentFieldCount: Integer): PZPGTableInfo;
125  function CheckFieldVisibility: Boolean;
126  end;
127 
128  {** Implements PostgreSQL Database Connection. }
129 
130  { TZPostgreSQLConnection }
131 
132  TZPostgreSQLConnection = class(TZAbstractConnection, IZPostgreSQLConnection)
133  private
134  FStandardConformingStrings: Boolean;
135  FHandle: PZPostgreSQLConnect;
136  FBeginRequired: Boolean;
137  FTypeList: TStrings;
138  FOidAsBlob: Boolean;
139  FServerMajorVersion: Integer;
140  FServerMinorVersion: Integer;
141  FServerSubVersion: Integer;
142  FNoticeProcessor: TZPostgreSQLNoticeProcessor;
143  FPreparedStmts: TStrings;
144  FClientSettingsChanged: Boolean;
145  FTableInfoCache: TZPGTableInfoCache;
146  FIs_bytea_output_hex: Boolean;
147  FCheckFieldVisibility: Boolean;
148  FNoTableInfoCache: Boolean;
149  protected
150  procedure InternalCreate; override;
151  function GetUndefinedVarcharAsStringLength: Integer;
152  function GetTableInfo(const TblOid: Oid; CurrentFieldCount: Integer): PZPGTableInfo;
153  function BuildConnectStr: AnsiString;
154  procedure StartTransactionSupport;
155  procedure LoadServerVersion;
156  procedure OnPropertiesChange(Sender: TObject); override;
157  procedure SetStandardConformingStrings(const Value: Boolean);
158  function EncodeBinary(const Value: RawByteString): RawByteString; overload;
159  function EncodeBinary(const Value: TByteDynArray): RawByteString; overload;
160  procedure RegisterPreparedStmtName(const value: String);
161  procedure UnregisterPreparedStmtName(const value: String);
162  function ClientSettingsChanged: Boolean;
163  public
164  destructor Destroy; override;
165 
166  function CreateRegularStatement(Info: TStrings): IZStatement; override;
167  function CreatePreparedStatement(const SQL: string; Info: TStrings):
168  IZPreparedStatement; override;
169  function CreateCallableStatement(const SQL: string; Info: TStrings):
170  IZCallableStatement; override;
171 
172  function CreateSequence(const Sequence: string; BlockSize: Integer): IZSequence; override;
173 
174  procedure Commit; override;
175  procedure Rollback; override;
176  //2Phase Commit Support initially for PostgresSQL (firmos) 21022006
177  procedure PrepareTransaction(const transactionid: string);override;
178  procedure CommitPrepared(const transactionid:string);override;
179  procedure RollbackPrepared(const transactionid:string);override;
180 
181  procedure Open; override;
182  procedure Close; override;
183 
184  procedure SetTransactionIsolation(Level: TZTransactIsolationLevel); override;
185 
186  function IsOidAsBlob: Boolean;
187  function Is_bytea_output_hex: Boolean;
188  function CheckFieldVisibility: Boolean;
189 
190  function GetTypeNameByOid(Id: Oid): string;
191  function GetPlainDriver: IZPostgreSQLPlainDriver;
192  function GetConnectionHandle: PZPostgreSQLConnect;
193 
194  function GetHostVersion: Integer; override;
195  function GetServerMajorVersion: Integer;
196  function GetServerMinorVersion: Integer;
197  function GetServerSubVersion: Integer;
198 
199  function PingServer: Integer; override;
200  function EscapeString(Value: RawByteString): RawByteString; override;
201  function GetBinaryEscapeString(const Value: RawByteString): String; overload; override;
202  function GetBinaryEscapeString(const Value: TByteDynArray): String; overload; override;
203  function GetEscapeString(const Value: ZWideString): ZWideString; overload; override;
204  function GetEscapeString(const Value: RawByteString): RawByteString; overload; override;
205  function GetServerSetting(const AName: string): string;
206  procedure SetServerSetting(const AName, AValue: string);
207  {$IFDEF ZEOS_TEST_ONLY}
208  constructor Create(const ZUrl: TZURL);
209  {$ENDIF}
210  end;
211 
212  {** Implements a Postgres sequence. }
213  TZPostgreSQLSequence = class(TZAbstractSequence)
214  public
215  function GetCurrentValue: Int64; override;
216  function GetNextValue: Int64; override;
217  function GetCurrentValueSQL:String;override;
218  function GetNextValueSQL:String;override;
219  end;
220 
221 
222 var
223  {** The common driver manager object. }
224  PostgreSQLDriver: IZDriver;
225 
226 implementation
227 
228 uses
229  ZMessages, ZSysUtils, ZDbcUtils, ZDbcPostgreSqlStatement,
230  ZDbcPostgreSqlUtils, ZDbcPostgreSqlMetadata, ZPostgreSqlToken,
231  ZPostgreSqlAnalyser, ZEncoding;
232 
233 const
234  FON = String('ON');
235  standard_conforming_strings = String('standard_conforming_strings');
236 
237 procedure DefaultNoticeProcessor(arg: Pointer; message: PAnsiChar); cdecl;
238 begin
239 DriverManager.LogMessage(lcOther,'Postgres NOTICE',String(message));
240 end;
241 
242 { TZPGTableInfoCache }
243 function TZPGTableInfoCache.LoadTblInfo(const TblOid: Oid;
244  out Index: Integer; ZPGTableInfo: PZPGTableInfo): Boolean;
245 var
246  SQL: String;
247  TblInfo: PZPGTableInfo;
248  RawOid: String;
249  QueryHandle: PZPostgreSQLResult;
250  I: Integer;
251  function GetInt(const Row, Col: Integer): Integer;
252  begin
253  Result := StrToInt(String(IZPostgreSQLPlainDriver(FPlainDriver).GetValue(QueryHandle, Row, Col)));
254  end;
255 
256  function GetString(const Row, Col: Integer): String;
257  {$IFDEF UNICODE}
258  var
259  RawTemp: RawByteString;
260  {$ENDIF}
261  begin
262  {$IFDEF UNICODE}
263  ZSetString(IZPostgreSQLPlainDriver(FPlainDriver).GetValue(QueryHandle, Row, Col),
264  IZPostgreSQLPlainDriver(FPlainDriver).GetLength(QueryHandle, Row, Col), RawTemp);
265  Result := ZDbcUnicodeString(RawTemp);
266  {$ELSE}
267  SetString(Result, IZPostgreSQLPlainDriver(FPlainDriver).GetValue(QueryHandle, Row, Col),
268  IZPostgreSQLPlainDriver(FPlainDriver).GetLength(QueryHandle, Row, Col));
269  {$ENDIF}
270  end;
271 begin
272  RawOID := IntToStr(TblOid);
273 
274  SQL := 'select pc.relname, pns.nspname, pa.attnum, pa.attname from ' +
275  'pg_catalog.pg_class pc ' +
276  'join pg_catalog.pg_namespace pns on pc.relnamespace = pns.oid ' +
277  'join pg_catalog.pg_attribute pa on pa.attrelid = pc.oid ' +
278  'where pc.oid = ' + RawOID + ' and pa.attnum > 0';
279 
280  QueryHandle := IZPostgreSQLPlainDriver(FPlainDriver).ExecuteQuery(FHandle, PAnsichar(ZPlainString(SQL)));
281  CheckPostgreSQLError(nil, IZPostgreSQLPlainDriver(FPlainDriver), FHandle, lcExecute, SQL, QueryHandle);
282  DriverManager.LogMessage(lcExecute, IZPostgreSQLPlainDriver(FPlainDriver).GetProtocol, SQL);
283 
284  Result := IZPostgreSQLPlainDriver(FPlainDriver).GetRowCount(QueryHandle) > 0;
285  if Result then
286  begin
287  if ZPGTableInfo <> nil then //just overwrite all values
288  tblInfo := ZPGTableInfo
289  else
290  begin //we need a new cache
291  SetLength(FTblInfo, Length(FTblInfo) +1);
292  Index := High(FTblInfo);
293  TblInfo := @FTblInfo[Index];
294  end;
295  TblInfo^.OID := TblOid;
296  TblInfo^.Name := GetString(0, 0);
297  TblInfo^.Schema := GetString(0, 1);
298  TblInfo^.ColCount := IZPostgreSQLPlainDriver(FPlainDriver).GetRowCount(QueryHandle);
299  SetLength(TblInfo^.ColNames, TblInfo^.ColCount);
300 
301  for I := 0 to TblInfo^.ColCount - 1 do
302  TblInfo^.ColNames[GetInt(I, 2)-1] := GetString(i, 3);
303  IZPostgreSQLPlainDriver(FPlainDriver).Clear(QueryHandle);
304  end
305  else
306  Index := -1;
307 end;
308 
309 function TZPGTableInfoCache.GetTblPos(const TblOid: Oid): Integer;
310 var
311  x: Integer;
312 begin
313  Result := -1;
314  if TblOid <> InvalidOid then
315  for x := 0 to Length(FTblInfo) - 1 do
316  if FTblInfo[x].OID = TblOid then
317  begin
318  Result := x;
319  Break;
320  end;
321 end;
322 
323 constructor TZPGTableInfoCache.Create(const ConSettings: PZConSettings;
324  const Handle: PZPostgreSQLConnect; const PlainDriver: IZPostgreSQLPlainDriver);
325 begin
326  Self.ConSettings := ConSettings;
327  FPlainDriver := Pointer(PlainDriver);
328  FHandle := Handle;
329 
330  Clear;
331 end;
332 
333 function TZPGTableInfoCache.GetTableInfo(const TblOid: Oid;
334  CurrentFieldCount: Integer): PZPGTableInfo;
335 var Idx: Integer;
336 begin
337  Idx := GetTblPos(TblOid);
338  if (Idx = -1) then
339  if (TblOid <> InvalidOid) and (LoadTblInfo(TblOid, Idx, nil)) then
340  Result := @FTblInfo[Idx]
341  else
342  Result := nil
343  else
344  begin
345  Result := @FTblInfo[Idx];
346  if Result^.ColCount <> CurrentFieldCount then //something changed ?
347  LoadTblInfo(TblOid, Idx, Result); //refresh all data
348  end;
349 end;
350 
351 procedure TZPGTableInfoCache.Clear;
352 begin
353  SetLength(FTblInfo, 0);
354 end;
355 
356 { TZPostgreSQLDriver }
357 
358 {**
359  Constructs this object with default properties.
360 }
361 constructor TZPostgreSQLDriver.Create;
362 begin
363  inherited Create;
364  AddSupportedProtocol(AddPlainDriverToCache(TZPostgreSQL9PlainDriver.Create, 'postgresql'));
365  AddSupportedProtocol(AddPlainDriverToCache(TZPostgreSQL7PlainDriver.Create));
366  AddSupportedProtocol(AddPlainDriverToCache(TZPostgreSQL8PlainDriver.Create));
367  AddSupportedProtocol(AddPlainDriverToCache(TZPostgreSQL9PlainDriver.Create));
368 end;
369 
370 {**
371  Attempts to make a database connection to the given URL.
372  The driver should return "null" if it realizes it is the wrong kind
373  of driver to connect to the given URL. This will be common, as when
374  the JDBC driver manager is asked to connect to a given URL it passes
375  the URL to each loaded driver in turn.
376 
377  <P>The driver should raise a SQLException if it is the right
378  driver to connect to the given URL, but has trouble connecting to
379  the database.
380 
381  <P>The java.util.Properties argument can be used to passed arbitrary
382  string tag/value pairs as connection arguments.
383  Normally at least "user" and "password" properties should be
384  included in the Properties.
385 
386  @param url the URL of the database to which to connect
387  @param info a list of arbitrary string tag/value pairs as
388  connection arguments. Normally at least a "user" and
389  "password" property should be included.
390  @return a <code>Connection</code> object that represents a
391  connection to the URL
392 }
393 {$WARNINGS OFF}
394 function TZPostgreSQLDriver.Connect(const Url: TZURL): IZConnection;
395 begin
396  Result := TZPostgreSQLConnection.Create(Url);
397 end;
398 {$WARNINGS ON}
399 
400 {**
401  Gets the driver's major version number. Initially this should be 1.
402  @return this driver's major version number
403 }
404 function TZPostgreSQLDriver.GetMajorVersion: Integer;
405 begin
406  Result := 1;
407 end;
408 
409 {**
410  Gets the driver's minor version number. Initially this should be 0.
411  @return this driver's minor version number
412 }
413 function TZPostgreSQLDriver.GetMinorVersion: Integer;
414 begin
415  Result := 3;
416 end;
417 
418 {**
419  Gets a SQL syntax tokenizer.
420  @returns a SQL syntax tokenizer object.
421 }
422 function TZPostgreSQLDriver.GetTokenizer: IZTokenizer;
423 begin
424  Result := TZPostgreSQLTokenizer.Create; { thread save! Allways return a new Tokenizer! }
425 end;
426 
427 {**
428  Creates a statement analyser object.
429  @returns a statement analyser object.
430 }
431 function TZPostgreSQLDriver.GetStatementAnalyser: IZStatementAnalyser;
432 begin
433  Result := TZPostgreSQLStatementAnalyser.Create; { thread save! Allways return a new Analyser! }
434 end;
435 
436 { TZPostgreSQLConnection }
437 
438 {**
439  Constructs this object and assignes the main properties.
440 }
441 procedure TZPostgreSQLConnection.InternalCreate;
442 begin
443  FMetaData := TZPostgreSQLDatabaseMetadata.Create(Self, Url);
444  FPreparedStmts := nil;
445  FTableInfoCache := nil;
446 
447  { Sets a default PostgreSQL port }
448  if Self.Port = 0 then
449  Self.Port := 5432;
450 
451  { Define connect options. }
452  if Info.Values['beginreq'] <> '' then
453  FBeginRequired := StrToBoolEx(Info.Values['beginreq'])
454  else
455  FBeginRequired := True;
456 
457  TransactIsolationLevel := tiNone;
458 
459  { Processes connection properties. }
460  if Info.Values['oidasblob'] <> '' then
461  FOidAsBlob := StrToBoolEx(Info.Values['oidasblob'])
462  else
463  FOidAsBlob := False;
464 
465  FUndefinedVarcharAsStringLength := StrToIntDef(Info.Values['Undefined_Varchar_AsString_Length'], 0);
466  FCheckFieldVisibility := StrToBoolEx(Info.Values['CheckFieldVisibility']);
467  FNoTableInfoCache := StrToBoolEx(Info.Values['NoTableInfoCache']);
468  OnPropertiesChange(nil);
469 
470  FNoticeProcessor := DefaultNoticeProcessor;
471 end;
472 
473 
474 function TZPostgreSQLConnection.GetUndefinedVarcharAsStringLength: Integer;
475 begin
476  Result := FUndefinedVarcharAsStringLength;
477 end;
478 
479 function TZPostgreSQLConnection.GetTableInfo(const TblOid: Oid; CurrentFieldCount: Integer): PZPGTableInfo;
480 begin
481  if FNoTableInfoCache then
482  Result := nil
483  else
484  Result := FTableInfoCache.GetTableInfo(TblOid, CurrentFieldCount);
485 end;
486 
487 {**
488  Destroys this object and cleanups the memory.
489 }
490 destructor TZPostgreSQLConnection.Destroy;
491 begin
492  if FTypeList <> nil then FreeAndNil(FTypeList);
493  inherited Destroy;
494  if FTableInfoCache <> nil then FreeAndNil(FTableInfoCache);
495  if FPreparedStmts <> nil then FreeAndNil(FPreparedStmts);
496 end;
497 
498 {**
499  Builds a connection string for PostgreSQL.
500  @return a built connection string.
501 }
502 function TZPostgreSQLConnection.BuildConnectStr: AnsiString;
503 var
504  ConnectTimeout: Integer;
505  // backslashes and single quotes must be escaped with backslashes
506  function EscapeValue(AValue: String): String;
507  begin
508  Result := StringReplace(AValue, '\', '\\', [rfReplaceAll]);
509  Result := StringReplace(Result, '''', '\''', [rfReplaceAll]);
510  end;
511 
512  //parameters should be separated by whitespace
513  procedure AddParamToResult(AParam, AValue: String);
514  begin
515  if Result <> '' then
516  Result := Result + ' ';
517 
518  Result := Result + AnsiString(AParam+'='+QuotedStr(EscapeValue(AValue)));
519  end;
520 begin
521  //Init the result to empty string.
522  Result := '';
523  //Entering parameters from the ZConnection
524  If IsIpAddr(HostName) then
525  AddParamToResult('hostaddr', HostName)
526  else
527  AddParamToResult('host', HostName);
528 
529  AddParamToResult('port', IntToStr(Port));
530  AddParamToResult('dbname', Database);
531  if user <> '' then begin
532  AddParamToResult('user', User);
533  AddParamToResult('password', Password);
534  end;
535 
536  If Info.Values['sslmode'] <> '' then
537  begin
538  // the client (>= 7.3) sets the ssl mode for this connection
539  // (possible values are: require, prefer, allow, disable)
540  AddParamToResult('sslmode', Info.Values['sslmode']);
541  end
542  else if Info.Values['requiressl'] <> '' then
543  begin
544  // the client (< 7.3) sets the ssl encription for this connection
545  // (possible values are: 0,1)
546  AddParamToResult('requiressl', Info.Values['requiressl']);
547  end;
548 
549  if Info.Values['sslcompression'] <> '' then AddParamToResult('sslcompression', Info.Values['sslcompression']);
550  if Info.Values['sslcert'] <> '' then AddParamToResult('sslcert', Info.Values['sslcert']);
551  if Info.Values['sslkey'] <> '' then AddParamToResult('sslkey', Info.Values['sslkey']);
552  if Info.Values['sslrootcert'] <> '' then AddParamToResult('sslrootcert', Info.Values['sslrootcert']);
553  if Info.Values['sslcrl'] <> '' then AddParamToResult('sslcrl', Info.Values['sslcrl']);
554 
555  { Sets a connection timeout. }
556  ConnectTimeout := StrToIntDef(Info.Values['timeout'], -1);
557  if ConnectTimeout >= 0 then
558  AddParamToResult('connect_timeout', IntToStr(ConnectTimeout));
559 
560  { Sets the application name }
561  if Info.Values['application_name'] <> '' then
562  AddParamToResult('application_name', Info.Values['application_name']);
563 
564 end;
565 
566 {**
567  Checks is oid should be treated as Large Object.
568  @return <code>True</code> if oid should represent a Large Object.
569 }
570 function TZPostgreSQLConnection.IsOidAsBlob: Boolean;
571 begin
572  Result := FOidAsBlob;
573 end;
574 
575 {**
576  Checks is bytea_output hex.
577  @return <code>True</code> if hex is set.
578 }
579 function TZPostgreSQLConnection.Is_bytea_output_hex: Boolean;
580 begin
581  Result := FIs_bytea_output_hex;
582 end;
583 
584 {**
585  Checks if DataBaseMetaData should check FieldVisibility too.
586  @return <code>True</code> if user did set it.
587 }
588 function TZPostgreSQLConnection.CheckFieldVisibility: Boolean;
589 begin
590  Result := FCheckFieldVisibility;
591 end;
592 
593 {**
594  Starts a transaction support.
595 }
596 procedure TZPostgreSQLConnection.StartTransactionSupport;
597 var
598  QueryHandle: PZPostgreSQLResult;
599  SQL: String;
600 begin
601  if TransactIsolationLevel <> tiNone then
602  begin
603  if FBeginRequired then
604  begin
605  SQL := 'BEGIN';
606  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(AnsiString(SQL)));
607  CheckPostgreSQLError(nil, GetPlainDriver, FHandle, lcExecute, SQL,QueryHandle);
608  GetPlainDriver.Clear(QueryHandle);
609  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
610  end;
611 
612  if TransactIsolationLevel = tiReadCommitted then
613  begin
614  SQL := 'SET TRANSACTION ISOLATION LEVEL READ COMMITTED';
615  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(AnsiString(SQL)));
616  CheckPostgreSQLError(nil, GetPlainDriver, FHandle, lcExecute, SQL,QueryHandle);
617  GetPlainDriver.Clear(QueryHandle);
618  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
619  end
620  else if TransactIsolationLevel = tiSerializable then
621  begin
622  SQL := 'SET TRANSACTION ISOLATION LEVEL SERIALIZABLE';
623  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(AnsiString(SQL)));
624  CheckPostgreSQLError(nil, GetPlainDriver, FHandle, lcExecute, SQL,QueryHandle);
625  GetPlainDriver.Clear(QueryHandle);
626  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
627  end
628  else
629  raise EZSQLException.Create(SIsolationIsNotSupported);
630  end;
631 end;
632 
633 {**
634  Encodes a Binary-AnsiString to a PostgreSQL format
635  @param Value the Binary String
636  @result the encoded String
637 }
638 function TZPostgreSQLConnection.EncodeBinary(const Value: TByteDynArray): RawByteString;
639 var Temp: RawByteString;
640 begin
641  ZSetString(PAnsiChar(Value), Length(Value), Temp);
642  Result := EncodeBinary(Temp);
643 end;
644 {**
645  Encodes a Binary-AnsiString to a PostgreSQL format
646  @param Value the Binary String
647  @result the encoded String
648 }
649 function TZPostgreSQLConnection.EncodeBinary(const Value: RawByteString): RawByteString;
650 begin
651  if ( Self.GetServerMajorVersion > 7 ) or
652  ((GetServerMajorVersion = 7) and (GetServerMinorVersion >= 3)) then
653  Result := GetPlainDriver.EncodeBYTEA(Value, GetConnectionHandle)
654  else
655  Result := ZDbcPostgreSqlUtils.EncodeBinaryString(Value);
656 end;
657 
658 procedure TZPostgreSQLConnection.RegisterPreparedStmtName(const value: String);
659 begin
660  FPreparedStmts.Add(Value);
661 end;
662 
663 procedure TZPostgreSQLConnection.UnregisterPreparedStmtName(const value: String);
664 var Index: Integer;
665 begin
666  Index := FPreparedStmts.IndexOf(Value);
667  if Index > -1 then
668  FPreparedStmts.Delete(Index);
669 end;
670 
671 function TZPostgreSQLConnection.ClientSettingsChanged: Boolean;
672 begin
673  Result := FClientSettingsChanged;
674 end;
675 {**
676  Opens a connection to database server with specified parameters.
677 }
678 procedure TZPostgreSQLConnection.Open;
679 
680 var
681  SCS, LogMessage, TempClientCodePage: string;
682 begin
683  if not Closed then
684  Exit;
685 
686  LogMessage := Format('CONNECT TO "%s" AS USER "%s"', [Database, User]);
687 
688  { Connect to PostgreSQL database. }
689  FHandle := GetPlainDriver.ConnectDatabase(PAnsiChar(BuildConnectStr));
690  try
691  if GetPlainDriver.GetStatus(FHandle) = CONNECTION_BAD then
692  begin
693  CheckPostgreSQLError(nil, GetPlainDriver, FHandle,
694  lcConnect, LogMessage,nil)
695  end
696  else
697  DriverManager.LogMessage(lcConnect, PlainDriver.GetProtocol, LogMessage);
698 
699  { Set the notice processor (default = nil)}
700  GetPlainDriver.SetNoticeProcessor(FHandle,FNoticeProcessor,nil);
701 
702  { Gets the current codepage }
703  TempClientCodePage := GetPlainDriver.ValidateCharEncoding(GetPlainDriver.GetClientEncoding(FHandle)).Name;
704 
705  { Sets a client codepage if necessary }
706  if ( FClientCodePage <> '' ) and (TempClientCodePage <> FClientCodePage) then
707  SetServerSetting('CLIENT_ENCODING', FClientCodePage);
708 
709  { Turn on transaction mode }
710  StartTransactionSupport;
711  inherited Open;
712 
713  { Gets the current codepage if it wasn't set..}
714  if ( FClientCodePage = '') then
715  CheckCharEncoding(TempClientCodePage)
716  else
717  begin
718  CheckCharEncoding(FClientCodePage);
719  FClientSettingsChanged := True;
720  end;
721 
722  if FPreparedStmts = nil then
723  FPreparedStmts := TStringList.Create;
724  if FTableInfoCache = nil then
725  FTableInfoCache := TZPGTableInfoCache.Create(ConSettings, FHandle, GetPlainDriver);
726 
727  { sets standard_conforming_strings according to Properties if available }
728  SCS := Info.Values[standard_conforming_strings];
729  if SCS <> '' then
730  begin
731  SetServerSetting(standard_conforming_strings, SCS);
732  FClientSettingsChanged := True;
733  end;
734  FIs_bytea_output_hex := UpperCase(GetServerSetting('''bytea_output''')) = 'HEX';
735 
736  finally
737  if self.IsClosed and (Self.FHandle <> nil) then
738  begin
739  GetPlainDriver.Finish(Self.FHandle);
740  Self.FHandle := nil;
741  end;
742  end;
743 end;
744 
745 procedure TZPostgreSQLConnection.PrepareTransaction(const transactionid: string);
746 var
747  QueryHandle: PZPostgreSQLResult;
748  SQL: String;
749 begin
750  if (TransactIsolationLevel <> tiNone) and not Closed then
751  begin
752  SQL:='PREPARE TRANSACTION '''+copy(transactionid,1,200)+'''';
753  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(ZPlainString(SQL)));
754  CheckPostgreSQLError(nil, GetPlainDriver, FHandle, lcExecute, SQL,QueryHandle);
755  GetPlainDriver.Clear(QueryHandle);
756  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
757  StartTransactionSupport;
758  end;
759 end;
760 
761 {**
762  Creates a <code>Statement</code> object for sending
763  SQL statements to the database.
764  SQL statements without parameters are normally
765  executed using Statement objects. If the same SQL statement
766  is executed many times, it is more efficient to use a
767  <code>PreparedStatement</code> object.
768  <P>
769  Result sets created using the returned <code>Statement</code>
770  object will by default have forward-only type and read-only concurrency.
771 
772  @param Info a statement parameters.
773  @return a new Statement object
774 }
775 function TZPostgreSQLConnection.CreateRegularStatement(Info: TStrings):
776  IZStatement;
777 begin
778  if IsClosed then
779  Open;
780  Result := TZPostgreSQLStatement.Create(GetPlainDriver, Self, Info);
781 end;
782 
783 {**
784  Creates a <code>PreparedStatement</code> object for sending
785  parameterized SQL statements to the database.
786 
787  A SQL statement with or without IN parameters can be
788  pre-compiled and stored in a PreparedStatement object. This
789  object can then be used to efficiently execute this statement
790  multiple times.
791 
792  <P><B>Note:</B> This method is optimized for handling
793  parametric SQL statements that benefit from precompilation. If
794  the driver supports precompilation,
795  the method <code>prepareStatement</code> will send
796  the statement to the database for precompilation. Some drivers
797  may not support precompilation. In this case, the statement may
798  not be sent to the database until the <code>PreparedStatement</code> is
799  executed. This has no direct effect on users; however, it does
800  affect which method throws certain SQLExceptions.
801 
802  Result sets created using the returned PreparedStatement will have
803  forward-only type and read-only concurrency, by default.
804 
805  @param sql a SQL statement that may contain one or more '?' IN
806  parameter placeholders
807  @param Info a statement parameters.
808  @return a new PreparedStatement object containing the
809  pre-compiled statement
810 }
811 function TZPostgreSQLConnection.CreatePreparedStatement(
812  const SQL: string; Info: TStrings): IZPreparedStatement;
813 begin
814  if IsClosed then
815  Open;
816 
817  {$IFDEF ZEOS_TEST_ONLY}
818  Case GetTestMode of
819  0:
820  {$ENDIF}
821  if GetServerMajorVersion >= 8 then
822  Result := TZPostgreSQLCAPIPreparedStatement.Create(GetPlainDriver, Self, SQL, Info)
823  else
824  Result := TZPostgreSQLClassicPreparedStatement.Create(GetPlainDriver, Self, SQL, Info);
825  {$IFDEF ZEOS_TEST_ONLY}
826  1: Result := TZPostgreSQLClassicPreparedStatement.Create(GetPlainDriver, Self, SQL, Info);
827  2: Result := TZPostgreSQLEmulatedPreparedStatement.Create(GetPlainDriver, Self, SQL, Info);
828  end;
829  {$ENDIF}
830 end;
831 
832 
833 {**
834  Creates a <code>CallableStatement</code> object for calling
835  database stored procedures (functions in PostgreSql).
836  The <code>CallableStatement</code> object provides
837  methods for setting up its IN and OUT parameters, and
838  methods for executing the call to a stored procedure.
839 
840  <P><B>Note:</B> This method is optimized for handling stored
841  procedure call statements. Some drivers may send the call
842  statement to the database when the method <code>prepareCall</code>
843  is done; others
844  may wait until the <code>CallableStatement</code> object
845  is executed. This has no
846  direct effect on users; however, it does affect which method
847  throws certain SQLExceptions.
848 
849  Result sets created using the returned CallableStatement will have
850  forward-only type and read-only concurrency, by default.
851 
852  @param sql a SQL statement that may contain one or more '?'
853  parameter placeholders. Typically this statement is a JDBC
854  function call escape string.
855  @param Info a statement parameters.
856  @return a new CallableStatement object containing the
857  pre-compiled SQL statement
858 }
859 function TZPostgreSQLConnection.CreateCallableStatement(
860  const SQL: string; Info: TStrings): IZCallableStatement;
861 begin
862  if IsClosed then
863  Open;
864  Result := TZPostgreSQLCallableStatement.Create(Self, SQL, Info);
865 end;
866 
867 {**
868  Makes all changes made since the previous
869  commit/rollback permanent and releases any database locks
870  currently held by the Connection. This method should be
871  used only when auto-commit mode has been disabled.
872  @see #setAutoCommit
873 }
874 procedure TZPostgreSQLConnection.Commit;
875 var
876  QueryHandle: PZPostgreSQLResult;
877  SQL: String;
878 begin
879  if (TransactIsolationLevel <> tiNone) and not Closed then
880  begin
881  SQL := 'COMMIT';
882  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(AnsiString(SQL)));
883  CheckPostgreSQLError(nil, GetPlainDriver, FHandle, lcExecute, SQL,QueryHandle);
884  GetPlainDriver.Clear(QueryHandle);
885  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
886 
887  StartTransactionSupport;
888  end;
889 end;
890 
891 procedure TZPostgreSQLConnection.CommitPrepared(const transactionid: string);
892 var
893  QueryHandle: PZPostgreSQLResult;
894  SQL: String;
895 begin
896  if (TransactIsolationLevel = tiNone) and not Closed then
897  begin
898  SQL := 'COMMIT PREPARED '''+copy(transactionid,1,200)+'''';
899  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(AnsiString(SQL)));
900  CheckPostgreSQLError(nil, GetPlainDriver, FHandle, lcExecute, SQL,QueryHandle);
901  GetPlainDriver.Clear(QueryHandle);
902  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
903  StartTransactionSupport;
904  end;
905 end;
906 
907 {**
908  Drops all changes made since the previous
909  commit/rollback and releases any database locks currently held
910  by this Connection. This method should be used only when auto-
911  commit has been disabled.
912  @see #setAutoCommit
913 }
914 procedure TZPostgreSQLConnection.Rollback;
915 var
916  QueryHandle: PZPostgreSQLResult;
917  SQL: String;
918 begin
919  if (TransactIsolationLevel <> tiNone) and not Closed then
920  begin
921  SQL := 'ROLLBACK';
922  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(AnsiString(SQL)));
923  CheckPostgreSQLError(nil, GetPlainDriver, FHandle, lcExecute, SQL,QueryHandle);
924  GetPlainDriver.Clear(QueryHandle);
925  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
926 
927  StartTransactionSupport;
928  end;
929 end;
930 
931 procedure TZPostgreSQLConnection.RollbackPrepared(const transactionid: string);
932 var
933  QueryHandle: PZPostgreSQLResult;
934  SQL: string;
935 begin
936  if (TransactIsolationLevel = tiNone) and not Closed then
937  begin
938  SQL := 'ROLLBACK PREPARED '''+copy(transactionid,1,200)+'''';
939  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(AnsiString(SQL)));
940  CheckPostgreSQLError(nil, GetPlainDriver, FHandle, lcExecute, SQL,QueryHandle);
941  GetPlainDriver.Clear(QueryHandle);
942  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
943  StartTransactionSupport;
944  end;
945 end;
946 
947 {**
948  Releases a Connection's database and JDBC resources
949  immediately instead of waiting for
950  them to be automatically released.
951 
952  <P><B>Note:</B> A Connection is automatically closed when it is
953  garbage collected. Certain fatal errors also result in a closed
954  Connection.
955 }
956 procedure TZPostgreSQLConnection.Close;
957 var
958  LogMessage: string;
959  I: Integer;
960 begin
961  if ( Closed ) or (not Assigned(PlainDriver)) then
962  Exit;
963 
964  for i := 0 to FPreparedStmts.Count -1 do
965  begin
966  LogMessage := 'DEALLOCATE "'+FPreparedStmts[i]+'";';
967  GetPlainDriver.ExecuteQuery(FHandle, Pointer(LogMessage));
968  end;
969  FPreparedStmts.Clear;
970  FTableInfoCache.Clear;
971 
972  GetPlainDriver.Finish(FHandle);
973  FHandle := nil;
974  LogMessage := Format('DISCONNECT FROM "%s"', [Database]);
975  DriverManager.LogMessage(lcDisconnect, PlainDriver.GetProtocol, LogMessage);
976  inherited Close;
977 end;
978 
979 {**
980  Sets a new transact isolation level.
981  @param Level a new transact isolation level.
982 }
983 procedure TZPostgreSQLConnection.SetTransactionIsolation(
984  Level: TZTransactIsolationLevel);
985 var
986  QueryHandle: PZPostgreSQLResult;
987  SQL: String;
988 begin
989  if not (Level in [tiNone, tiReadCommitted, tiSerializable]) then
990  raise EZSQLException.Create(SIsolationIsNotSupported);
991 
992  if (TransactIsolationLevel <> tiNone) and not Closed then
993  begin
994  SQL := 'END';
995  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(AnsiString(SQL)));
996  CheckPostgreSQLError(nil, GetPlainDriver, FHandle, lcExecute, SQL,QueryHandle);
997  GetPlainDriver.Clear(QueryHandle);
998  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
999  end;
1000 
1001  inherited SetTransactionIsolation(Level);
1002 
1003  if not Closed then
1004  StartTransactionSupport;
1005 end;
1006 
1007 {**
1008  Gets a reference to PostgreSQL connection handle.
1009  @return a reference to PostgreSQL connection handle.
1010 }
1011 function TZPostgreSQLConnection.GetConnectionHandle: PZPostgreSQLConnect;
1012 begin
1013  Result := FHandle;
1014 end;
1015 
1016 {**
1017  Gets a PostgreSQL plain driver interface.
1018  @return a PostgreSQL plain driver interface.
1019 }
1020 function TZPostgreSQLConnection.GetPlainDriver: IZPostgreSQLPlainDriver;
1021 begin
1022  Result := PlainDriver as IZPostgreSQLPlainDriver;
1023 end;
1024 
1025 {**
1026  Gets a type name by it's oid number.
1027  @param Id a type oid number.
1028  @return a type name or empty string if there was no such type found.
1029 }
1030 function TZPostgreSQLConnection.GetTypeNameByOid(Id: Oid): string;
1031 var
1032  I, Index: Integer;
1033  QueryHandle: PZPostgreSQLResult;
1034  SQL: PAnsiChar;
1035  TypeCode, BaseTypeCode: Integer;
1036  TypeName: string;
1037  LastVersion, IsEnum: boolean;
1038 begin
1039  if Closed then
1040  Open;
1041 
1042  if (GetServerMajorVersion < 7 ) or
1043  ((GetServerMajorVersion = 7) and (GetServerMinorVersion < 3)) then
1044  LastVersion := True
1045  else
1046  LastVersion := False;
1047 
1048  { Fill the list with existed types }
1049  if not Assigned(FTypeList) then
1050  begin
1051  if LastVersion then
1052  SQL := 'SELECT oid, typname FROM pg_type WHERE oid<10000'
1053  else
1054  SQL := 'SELECT oid, typname, typbasetype,typtype FROM pg_type' +
1055  ' WHERE (typtype = ''b'' and oid < 10000) OR typtype = ''p'' OR typtype = ''e'' OR typbasetype<>0 ORDER BY oid';
1056 
1057  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, SQL);
1058  CheckPostgreSQLError(Self, GetPlainDriver, FHandle, lcExecute, String(SQL),QueryHandle);
1059  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, String(SQL));
1060 
1061  FTypeList := TStringList.Create;
1062  for I := 0 to GetPlainDriver.GetRowCount(QueryHandle)-1 do
1063  begin
1064  TypeCode := StrToIntDef(String(
1065  GetPlainDriver.GetValue(QueryHandle, I, 0)), 0);
1066  isEnum := LowerCase(String(GetPlainDriver.GetValue(QueryHandle, I, 3))) = 'e';
1067  if isEnum then
1068  TypeName := 'enum'
1069  else
1070  TypeName := String(GetPlainDriver.GetValue(QueryHandle, I, 1));
1071 
1072  if LastVersion then
1073  BaseTypeCode := 0
1074  else
1075  BaseTypeCode := StrToIntDef(String(
1076  GetPlainDriver.GetValue(QueryHandle, I, 2)), 0);
1077 
1078  if BaseTypeCode <> 0 then
1079  begin
1080  Index := FTypeList.IndexOfObject(TObject(BaseTypeCode));
1081  if Index >= 0 then
1082  TypeName := FTypeList[Index]
1083  else
1084  TypeName := '';
1085  end;
1086  FTypeList.AddObject(TypeName, TObject(TypeCode));
1087  end;
1088  GetPlainDriver.Clear(QueryHandle);
1089  end;
1090 
1091  I := FTypeList.IndexOfObject(TObject(Id));
1092  if I >= 0 then
1093  Result := FTypeList[I]
1094  else
1095  Result := '';
1096 end;
1097 
1098 {**
1099  Gets the host's full version number. Initially this should be 0.
1100  The format of the version returned must be XYYYZZZ where
1101  X = Major version
1102  YYY = Minor version
1103  ZZZ = Sub version
1104  @return this server's full version number
1105 }
1106 function TZPostgreSQLConnection.GetHostVersion: Integer;
1107 begin
1108  Result := GetServerMajorVersion*1000000+GetServerMinorversion*1000+GetServerSubversion;
1109 end;
1110 
1111 {**
1112  Gets a server major version.
1113  @return a server major version number.
1114 }
1115 function TZPostgreSQLConnection.GetServerMajorVersion: Integer;
1116 begin
1117  if (FServerMajorVersion = 0) and (FServerMinorVersion = 0) then
1118  LoadServerVersion;
1119  Result := FServerMajorVersion;
1120 end;
1121 
1122 {**
1123  Gets a server minor version.
1124  @return a server minor version number.
1125 }
1126 function TZPostgreSQLConnection.GetServerMinorVersion: Integer;
1127 begin
1128  if (FServerMajorVersion = 0) and (FServerMinorVersion = 0) then
1129  LoadServerVersion;
1130  Result := FServerMinorVersion;
1131 end;
1132 
1133 {**
1134  Gets a server sub version.
1135  @return a server sub version number.
1136 }
1137 function TZPostgreSQLConnection.GetServerSubVersion: Integer;
1138 begin
1139  if (FServerMajorVersion = 0) and (FServerMinorVersion = 0) then
1140  LoadServerVersion;
1141  Result := FServerSubVersion;
1142 end;
1143 
1144 {**
1145  Loads a server major and minor version numbers.
1146 }
1147 procedure TZPostgreSQLConnection.LoadServerVersion;
1148 var
1149  Temp: string;
1150  List: TStrings;
1151  QueryHandle: PZPostgreSQLResult;
1152  SQL: PAnsiChar;
1153 begin
1154  if Closed then
1155  Open;
1156  SQL := 'SELECT version()';
1157  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, SQL);
1158  CheckPostgreSQLError(Self, GetPlainDriver, FHandle, lcExecute, String(SQL),QueryHandle);
1159  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, String(SQL));
1160 
1161  Temp := String(GetPlainDriver.GetValue(QueryHandle, 0, 0));
1162  GetPlainDriver.Clear(QueryHandle);
1163 
1164  List := TStringList.Create;
1165  try
1166  { Splits string by space }
1167  PutSplitString(List, Temp, ' ');
1168  { first - PostgreSQL, second X.Y.Z}
1169  Temp := List.Strings[1];
1170  { Splits string by dot }
1171  PutSplitString(List, Temp, '.');
1172 
1173  FServerMajorVersion := StrToIntDef(List.Strings[0], 0);
1174  if List.Count > 1 then
1175  FServerMinorVersion := GetMinorVersion(List.Strings[1])
1176  else
1177  FServerMinorVersion := 0;
1178  if List.Count > 2 then
1179  FServerSubVersion := GetMinorVersion(List.Strings[2])
1180  else
1181  FServerSubVersion := 0;
1182  finally
1183  List.Free;
1184  end;
1185 end;
1186 
1187 {**
1188 Ping Current Connection's server, if client was disconnected,
1189 the connection is resumed.
1190 @return 0 if succesfull or error code if any error occurs
1191 }
1192 function TZPostgreSQLConnection.PingServer: Integer;
1193 const
1194  PING_ERROR_ZEOSCONNCLOSED = -1;
1195 var
1196  Closing: boolean;
1197  res: PZPostgreSQLResult;
1198  isset: boolean;
1199 begin
1200  Result := PING_ERROR_ZEOSCONNCLOSED;
1201  Closing := FHandle = nil;
1202  if Not(Closed or Closing) then
1203  begin
1204  res := GetPlainDriver.ExecuteQuery(FHandle,'');
1205  isset := assigned(res);
1206  GetPlainDriver.Clear(res);
1207  if isset and (GetPlainDriver.GetStatus(FHandle) = CONNECTION_OK) then
1208  Result := 0
1209  else
1210  try
1211  GetPlainDriver.Reset(FHandle);
1212  res := GetPlainDriver.ExecuteQuery(FHandle,'');
1213  isset := assigned(res);
1214  GetPlainDriver.Clear(res);
1215  if isset and (GetPlainDriver.GetStatus(FHandle) = CONNECTION_OK) then
1216  Result := 0;
1217  except
1218  Result := 1;
1219  end;
1220  end;
1221 end;
1222 
1223 function TZPostgreSQLConnection.EscapeString(Value: RawByteString): RawByteString;
1224 begin
1225  Result := PlainDriver.EscapeString(Self.FHandle, Value, ConSettings)
1226 end;
1227 {**
1228  Creates a sequence generator object.
1229  @param Sequence a name of the sequence generator.
1230  @param BlockSize a number of unique keys requested in one trip to SQL server.
1231  @returns a created sequence object.
1232 }
1233 function TZPostgreSQLConnection.CreateSequence(const Sequence: string;
1234  BlockSize: Integer): IZSequence;
1235 begin
1236  Result := TZPostgreSQLSequence.Create(Self, Sequence, BlockSize);
1237 end;
1238 
1239 {**
1240  EgonHugeist:
1241  Returns the BinaryString in a Tokenizer-detectable kind
1242  If the Tokenizer don't need to predetect it Result = BinaryString
1243  @param Value represents the Binary-String
1244  @param EscapeMarkSequence represents a Tokenizer detectable EscapeSequence (Len >= 3)
1245  @result the detectable Binary String
1246 }
1247 function TZPostgreSQLConnection.GetBinaryEscapeString(const Value: RawByteString): String;
1248 begin
1249  Result := String(EncodeBinary(Value));
1250  if GetAutoEncodeStrings then
1251  Result := GetDriver.GetTokenizer.GetEscapeString(Result);
1252 end;
1253 
1254 {**
1255  EgonHugeist:
1256  Returns the BinaryString in a Tokenizer-detectable kind
1257  If the Tokenizer don't need to predetect it Result = BinaryString
1258  @param Value represents the Binary-String
1259  @param EscapeMarkSequence represents a Tokenizer detectable EscapeSequence (Len >= 3)
1260  @result the detectable Binary String
1261 }
1262 function TZPostgreSQLConnection.GetBinaryEscapeString(const Value: TByteDynArray): String;
1263 var Tmp: RawByteString;
1264 begin
1265  ZSetString(PAnsiChar(Value), Length(Value), Tmp);
1266  Result := String(EncodeBinary(Tmp));
1267  if GetAutoEncodeStrings then
1268  Result := GetDriver.GetTokenizer.GetEscapeString(Result);
1269 end;
1270 
1271 {**
1272  EgonHugeist:
1273  Returns a String in a Tokenizer-detectable kind
1274  If the Tokenizer don't need to predetect it Result = BinaryString
1275  @param Value represents the String
1276  @param EscapeMarkSequence represents a Tokenizer detectable EscapeSequence (Len >= 3)
1277  @result the detectable Postrgres-compatible String
1278 }
1279 function TZPostgreSQLConnection.GetEscapeString(const Value: ZWideString): ZWideString;
1280 begin
1281  Result := GetPlainDriver.EscapeString(FHandle, Value, ConSettings);
1282  if GetAutoEncodeStrings then
1283  Result := GetDriver.GetTokenizer.GetEscapeString(Result);
1284 end;
1285 
1286 function TZPostgreSQLConnection.GetEscapeString(const Value: RawByteString): RawByteString;
1287 begin
1288  Result := GetPlainDriver.EscapeString(FHandle, Value, ConSettings);
1289  {$IFNDEF UNICODE}
1290  if GetAutoEncodeStrings then
1291  Result := GetDriver.GetTokenizer.GetEscapeString(Result);
1292  {$ENDIF}
1293 end;
1294 
1295 {**
1296  Gets a current setting of run-time parameter.
1297  @param AName a parameter name.
1298  @result a parmeter value retrieved from server.
1299 }
1300 function TZPostgreSQLConnection.GetServerSetting(const AName: string): string;
1301 var
1302  SQL: string;
1303  QueryHandle: PZPostgreSQLResult;
1304 begin
1305  SQL := Format('select setting from pg_settings where name = %s', [AName]);
1306  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar({$IFDEF UNICODE}AnsiString{$ENDIF}(SQL)));
1307  CheckPostgreSQLError(Self, GetPlainDriver, FHandle, lcExecute, SQL, QueryHandle);
1308  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
1309 
1310  Result := String(GetPlainDriver.GetValue(QueryHandle, 0, 0));
1311  GetPlainDriver.Clear(QueryHandle);
1312 end;
1313 
1314 procedure TZPostgreSQLConnection.OnPropertiesChange(Sender: TObject);
1315 var
1316  SCS: string;
1317 begin
1318  inherited OnPropertiesChange(Sender);
1319 
1320  { Define standard_conforming_strings setting}
1321  SCS := Trim(Info.Values[standard_conforming_strings]);
1322  if SCS <> '' then
1323  SetStandardConformingStrings(UpperCase(SCS) = FON)
1324  else
1325  SetStandardConformingStrings(GetPlainDriver.GetStandardConformingStrings);
1326 end;
1327 
1328 {**
1329  Sets current setting of run-time parameter.
1330  String values should be already quoted.
1331  @param AName a parameter name.
1332  @param AValue a new parameter value.
1333 }
1334 procedure TZPostgreSQLConnection.SetServerSetting(const AName, AValue: string);
1335 var
1336  SQL: string;
1337  QueryHandle: PZPostgreSQLResult;
1338 begin
1339  SQL := Format('SET %s = %s', [AName, AValue]);
1340  QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, PAnsiChar(AnsiString(SQL)));
1341  CheckPostgreSQLError(Self, GetPlainDriver, FHandle, lcExecute, SQL, QueryHandle);
1342  DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, SQL);
1343 
1344  GetPlainDriver.Clear(QueryHandle);
1345 end;
1346 
1347 {$IFDEF ZEOS_TEST_ONLY}
1348 constructor TZPostgreSQLConnection.Create(const ZUrl: TZURL);
1349 begin
1350  inherited Create(ZUrl);
1351 end;
1352 {$ENDIF}
1353 
1354 procedure TZPostgreSQLConnection.SetStandardConformingStrings(const Value: Boolean);
1355 begin
1356  FStandardConformingStrings := Value;
1357  ( Self.GetDriver.GetTokenizer as IZPostgreSQLTokenizer ).SetStandardConformingStrings(FStandardConformingStrings);
1358 end;
1359 
1360 
1361 { TZPostgreSQLSequence }
1362 {**
1363  Gets the current unique key generated by this sequence.
1364  @param the last generated unique key.
1365 }
1366 function TZPostgreSQLSequence.GetCurrentValue: Int64;
1367 var
1368  Statement: IZStatement;
1369  ResultSet: IZResultSet;
1370 begin
1371  Statement := Connection.CreateStatement;
1372  ResultSet := Statement.ExecuteQuery(
1373  Format('SELECT CURRVAL(''%s'')', [Name]));
1374  if ResultSet.Next then
1375  Result := ResultSet.GetLong(1)
1376  else
1377  Result := inherited GetCurrentValue;
1378  ResultSet.Close;
1379  Statement.Close;
1380 end;
1381 
1382 {**
1383  Gets the next unique key generated by this sequence.
1384  @param the next generated unique key.
1385 }
1386 function TZPostgreSQLSequence.GetCurrentValueSQL: String;
1387 begin
1388  result:=Format(' CURRVAL(''%s'') ', [Name]);
1389 end;
1390 
1391 function TZPostgreSQLSequence.GetNextValue: Int64;
1392 var
1393  Statement: IZStatement;
1394  ResultSet: IZResultSet;
1395 begin
1396  Statement := Connection.CreateStatement;
1397  ResultSet := Statement.ExecuteQuery(
1398  Format('SELECT NEXTVAL(''%s'')', [Name]));
1399  if ResultSet.Next then
1400  Result := ResultSet.GetLong(1)
1401  else
1402  Result := inherited GetNextValue;
1403  ResultSet.Close;
1404  Statement.Close;
1405 end;
1406 
1407 function TZPostgreSQLSequence.GetNextValueSQL: String;
1408 begin
1409  result:=Format(' NEXTVAL(''%s'') ', [Name]);
1410 end;
1411 
1412 initialization
1413  PostgreSQLDriver := TZPostgreSQLDriver.Create;
1414  DriverManager.RegisterDriver(PostgreSQLDriver);
1415 finalization
1416  if DriverManager <> nil then
1417  DriverManager.DeregisterDriver(PostgreSQLDriver);
1418  PostgreSQLDriver := nil;
1419 end.
1420