1 {*********************************************************}
3 { Zeos Database Objects }
4 { PostgreSQL Database Connectivity Classes }
6 { Originally written by Sergey Seroukhov }
8 {*********************************************************}
10 {@********************************************************}
11 { Copyright (c) 1999-2012 Zeos Development Group }
13 { License Agreement: }
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. }
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. }
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) }
46 { http://www.sourceforge.net/projects/zeoslib. }
49 { Zeos Development Group. }
50 {********************************************************@}
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;
66 {** Implements PostgreSQL Database Driver. }
68 TZPostgreSQLDriver = class(TZAbstractDriver)
70 constructor Create; override;
71 function Connect(const Url: TZURL): IZConnection; override;
72 function GetMajorVersion: Integer; override;
73 function GetMinorVersion: Integer; override;
75 function GetTokenizer: IZTokenizer; override;
76 function GetStatementAnalyser: IZStatementAnalyser; override;
81 PZPGTableInfo = ^TZPGTableInfo;
82 TZPGTableInfo = record
86 ColNames: Array of String;
90 { TZPGTableInfoCache }
92 TZPGTableInfoCache = class(TZCodePagedObject)
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;
100 constructor Create(const ConSettings: PZConSettings;
101 const Handle: PZPostgreSQLConnect; const PlainDriver: IZPostgreSQLPlainDriver);
102 function GetTableInfo(const TblOid: Oid; CurrentFieldCount: Integer): PZPGTableInfo;
106 {** Defines a PostgreSQL specific connection. }
107 IZPostgreSQLConnection = interface(IZConnection)
108 ['{8E62EA93-5A49-4F20-928A-0EA44ABCE5DB}']
110 function IsOidAsBlob: Boolean;
111 function Is_bytea_output_hex: Boolean;
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;
128 {** Implements PostgreSQL Database Connection. }
130 { TZPostgreSQLConnection }
132 TZPostgreSQLConnection = class(TZAbstractConnection, IZPostgreSQLConnection)
134 FStandardConformingStrings: Boolean;
135 FHandle: PZPostgreSQLConnect;
136 FBeginRequired: 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;
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;
164 destructor Destroy; override;
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;
172 function CreateSequence(const Sequence: string; BlockSize: Integer): IZSequence; override;
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;
181 procedure Open; override;
182 procedure Close; override;
184 procedure SetTransactionIsolation(Level: TZTransactIsolationLevel); override;
186 function IsOidAsBlob: Boolean;
187 function Is_bytea_output_hex: Boolean;
188 function CheckFieldVisibility: Boolean;
190 function GetTypeNameByOid(Id: Oid): string;
191 function GetPlainDriver: IZPostgreSQLPlainDriver;
192 function GetConnectionHandle: PZPostgreSQLConnect;
194 function GetHostVersion: Integer; override;
195 function GetServerMajorVersion: Integer;
196 function GetServerMinorVersion: Integer;
197 function GetServerSubVersion: Integer;
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);
212 {** Implements a Postgres sequence. }
213 TZPostgreSQLSequence = class(TZAbstractSequence)
215 function GetCurrentValue: Int64; override;
216 function GetNextValue: Int64; override;
217 function GetCurrentValueSQL:String;override;
218 function GetNextValueSQL:String;override;
223 {** The common driver manager object. }
224 PostgreSQLDriver: IZDriver;
229 ZMessages, ZSysUtils, ZDbcUtils, ZDbcPostgreSqlStatement,
230 ZDbcPostgreSqlUtils, ZDbcPostgreSqlMetadata, ZPostgreSqlToken,
231 ZPostgreSqlAnalyser, ZEncoding;
235 standard_conforming_strings = String('standard_conforming_strings');
237 procedure DefaultNoticeProcessor(arg: Pointer; message: PAnsiChar); cdecl;
239 DriverManager.LogMessage(lcOther,'Postgres NOTICE',String(message));
242 { TZPGTableInfoCache }
243 function TZPGTableInfoCache.LoadTblInfo(const TblOid: Oid;
244 out Index: Integer; ZPGTableInfo: PZPGTableInfo): Boolean;
247 TblInfo: PZPGTableInfo;
249 QueryHandle: PZPostgreSQLResult;
251 function GetInt(const Row, Col: Integer): Integer;
253 Result := StrToInt(String(IZPostgreSQLPlainDriver(FPlainDriver).GetValue(QueryHandle, Row, Col)));
256 function GetString(const Row, Col: Integer): String;
259 RawTemp: RawByteString;
263 ZSetString(IZPostgreSQLPlainDriver(FPlainDriver).GetValue(QueryHandle, Row, Col),
264 IZPostgreSQLPlainDriver(FPlainDriver).GetLength(QueryHandle, Row, Col), RawTemp);
265 Result := ZDbcUnicodeString(RawTemp);
267 SetString(Result, IZPostgreSQLPlainDriver(FPlainDriver).GetValue(QueryHandle, Row, Col),
268 IZPostgreSQLPlainDriver(FPlainDriver).GetLength(QueryHandle, Row, Col));
272 RawOID := IntToStr(TblOid);
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';
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);
284 Result := IZPostgreSQLPlainDriver(FPlainDriver).GetRowCount(QueryHandle) > 0;
287 if ZPGTableInfo <> nil then //just overwrite all values
288 tblInfo := ZPGTableInfo
290 begin //we need a new cache
291 SetLength(FTblInfo, Length(FTblInfo) +1);
292 Index := High(FTblInfo);
293 TblInfo := @FTblInfo[Index];
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);
301 for I := 0 to TblInfo^.ColCount - 1 do
302 TblInfo^.ColNames[GetInt(I, 2)-1] := GetString(i, 3);
303 IZPostgreSQLPlainDriver(FPlainDriver).Clear(QueryHandle);
309 function TZPGTableInfoCache.GetTblPos(const TblOid: Oid): Integer;
314 if TblOid <> InvalidOid then
315 for x := 0 to Length(FTblInfo) - 1 do
316 if FTblInfo[x].OID = TblOid then
323 constructor TZPGTableInfoCache.Create(const ConSettings: PZConSettings;
324 const Handle: PZPostgreSQLConnect; const PlainDriver: IZPostgreSQLPlainDriver);
326 Self.ConSettings := ConSettings;
327 FPlainDriver := Pointer(PlainDriver);
333 function TZPGTableInfoCache.GetTableInfo(const TblOid: Oid;
334 CurrentFieldCount: Integer): PZPGTableInfo;
337 Idx := GetTblPos(TblOid);
339 if (TblOid <> InvalidOid) and (LoadTblInfo(TblOid, Idx, nil)) then
340 Result := @FTblInfo[Idx]
345 Result := @FTblInfo[Idx];
346 if Result^.ColCount <> CurrentFieldCount then //something changed ?
347 LoadTblInfo(TblOid, Idx, Result); //refresh all data
351 procedure TZPGTableInfoCache.Clear;
353 SetLength(FTblInfo, 0);
356 { TZPostgreSQLDriver }
359 Constructs this object with default properties.
361 constructor TZPostgreSQLDriver.Create;
364 AddSupportedProtocol(AddPlainDriverToCache(TZPostgreSQL9PlainDriver.Create, 'postgresql'));
365 AddSupportedProtocol(AddPlainDriverToCache(TZPostgreSQL7PlainDriver.Create));
366 AddSupportedProtocol(AddPlainDriverToCache(TZPostgreSQL8PlainDriver.Create));
367 AddSupportedProtocol(AddPlainDriverToCache(TZPostgreSQL9PlainDriver.Create));
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.
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
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.
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
394 function TZPostgreSQLDriver.Connect(const Url: TZURL): IZConnection;
396 Result := TZPostgreSQLConnection.Create(Url);
401 Gets the driver's major version number. Initially this should be 1.
402 @return this driver's major version number
404 function TZPostgreSQLDriver.GetMajorVersion: Integer;
410 Gets the driver's minor version number. Initially this should be 0.
411 @return this driver's minor version number
413 function TZPostgreSQLDriver.GetMinorVersion: Integer;
419 Gets a SQL syntax tokenizer.
420 @returns a SQL syntax tokenizer object.
422 function TZPostgreSQLDriver.GetTokenizer: IZTokenizer;
424 Result := TZPostgreSQLTokenizer.Create; { thread save! Allways return a new Tokenizer! }
428 Creates a statement analyser object.
429 @returns a statement analyser object.
431 function TZPostgreSQLDriver.GetStatementAnalyser: IZStatementAnalyser;
433 Result := TZPostgreSQLStatementAnalyser.Create; { thread save! Allways return a new Analyser! }
436 { TZPostgreSQLConnection }
439 Constructs this object and assignes the main properties.
441 procedure TZPostgreSQLConnection.InternalCreate;
443 FMetaData := TZPostgreSQLDatabaseMetadata.Create(Self, Url);
444 FPreparedStmts := nil;
445 FTableInfoCache := nil;
447 { Sets a default PostgreSQL port }
448 if Self.Port = 0 then
451 { Define connect options. }
452 if Info.Values['beginreq'] <> '' then
453 FBeginRequired := StrToBoolEx(Info.Values['beginreq'])
455 FBeginRequired := True;
457 TransactIsolationLevel := tiNone;
459 { Processes connection properties. }
460 if Info.Values['oidasblob'] <> '' then
461 FOidAsBlob := StrToBoolEx(Info.Values['oidasblob'])
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);
470 FNoticeProcessor := DefaultNoticeProcessor;
474 function TZPostgreSQLConnection.GetUndefinedVarcharAsStringLength: Integer;
476 Result := FUndefinedVarcharAsStringLength;
479 function TZPostgreSQLConnection.GetTableInfo(const TblOid: Oid; CurrentFieldCount: Integer): PZPGTableInfo;
481 if FNoTableInfoCache then
484 Result := FTableInfoCache.GetTableInfo(TblOid, CurrentFieldCount);
488 Destroys this object and cleanups the memory.
490 destructor TZPostgreSQLConnection.Destroy;
492 if FTypeList <> nil then FreeAndNil(FTypeList);
494 if FTableInfoCache <> nil then FreeAndNil(FTableInfoCache);
495 if FPreparedStmts <> nil then FreeAndNil(FPreparedStmts);
499 Builds a connection string for PostgreSQL.
500 @return a built connection string.
502 function TZPostgreSQLConnection.BuildConnectStr: AnsiString;
504 ConnectTimeout: Integer;
505 // backslashes and single quotes must be escaped with backslashes
506 function EscapeValue(AValue: String): String;
508 Result := StringReplace(AValue, '\', '\\', [rfReplaceAll]);
509 Result := StringReplace(Result, '''', '\''', [rfReplaceAll]);
512 //parameters should be separated by whitespace
513 procedure AddParamToResult(AParam, AValue: String);
516 Result := Result + ' ';
518 Result := Result + AnsiString(AParam+'='+QuotedStr(EscapeValue(AValue)));
521 //Init the result to empty string.
523 //Entering parameters from the ZConnection
524 If IsIpAddr(HostName) then
525 AddParamToResult('hostaddr', HostName)
527 AddParamToResult('host', HostName);
529 AddParamToResult('port', IntToStr(Port));
530 AddParamToResult('dbname', Database);
531 if user <> '' then begin
532 AddParamToResult('user', User);
533 AddParamToResult('password', Password);
536 If Info.Values['sslmode'] <> '' then
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']);
542 else if Info.Values['requiressl'] <> '' then
544 // the client (< 7.3) sets the ssl encription for this connection
545 // (possible values are: 0,1)
546 AddParamToResult('requiressl', Info.Values['requiressl']);
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']);
555 { Sets a connection timeout. }
556 ConnectTimeout := StrToIntDef(Info.Values['timeout'], -1);
557 if ConnectTimeout >= 0 then
558 AddParamToResult('connect_timeout', IntToStr(ConnectTimeout));
560 { Sets the application name }
561 if Info.Values['application_name'] <> '' then
562 AddParamToResult('application_name', Info.Values['application_name']);
567 Checks is oid should be treated as Large Object.
568 @return <code>True</code> if oid should represent a Large Object.
570 function TZPostgreSQLConnection.IsOidAsBlob: Boolean;
572 Result := FOidAsBlob;
576 Checks is bytea_output hex.
577 @return <code>True</code> if hex is set.
579 function TZPostgreSQLConnection.Is_bytea_output_hex: Boolean;
581 Result := FIs_bytea_output_hex;
585 Checks if DataBaseMetaData should check FieldVisibility too.
586 @return <code>True</code> if user did set it.
588 function TZPostgreSQLConnection.CheckFieldVisibility: Boolean;
590 Result := FCheckFieldVisibility;
594 Starts a transaction support.
596 procedure TZPostgreSQLConnection.StartTransactionSupport;
598 QueryHandle: PZPostgreSQLResult;
601 if TransactIsolationLevel <> tiNone then
603 if FBeginRequired then
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);
612 if TransactIsolationLevel = tiReadCommitted then
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);
620 else if TransactIsolationLevel = tiSerializable then
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);
629 raise EZSQLException.Create(SIsolationIsNotSupported);
634 Encodes a Binary-AnsiString to a PostgreSQL format
635 @param Value the Binary String
636 @result the encoded String
638 function TZPostgreSQLConnection.EncodeBinary(const Value: TByteDynArray): RawByteString;
639 var Temp: RawByteString;
641 ZSetString(PAnsiChar(Value), Length(Value), Temp);
642 Result := EncodeBinary(Temp);
645 Encodes a Binary-AnsiString to a PostgreSQL format
646 @param Value the Binary String
647 @result the encoded String
649 function TZPostgreSQLConnection.EncodeBinary(const Value: RawByteString): RawByteString;
651 if ( Self.GetServerMajorVersion > 7 ) or
652 ((GetServerMajorVersion = 7) and (GetServerMinorVersion >= 3)) then
653 Result := GetPlainDriver.EncodeBYTEA(Value, GetConnectionHandle)
655 Result := ZDbcPostgreSqlUtils.EncodeBinaryString(Value);
658 procedure TZPostgreSQLConnection.RegisterPreparedStmtName(const value: String);
660 FPreparedStmts.Add(Value);
663 procedure TZPostgreSQLConnection.UnregisterPreparedStmtName(const value: String);
666 Index := FPreparedStmts.IndexOf(Value);
668 FPreparedStmts.Delete(Index);
671 function TZPostgreSQLConnection.ClientSettingsChanged: Boolean;
673 Result := FClientSettingsChanged;
676 Opens a connection to database server with specified parameters.
678 procedure TZPostgreSQLConnection.Open;
681 SCS, LogMessage, TempClientCodePage: string;
686 LogMessage := Format('CONNECT TO "%s" AS USER "%s"', [Database, User]);
688 { Connect to PostgreSQL database. }
689 FHandle := GetPlainDriver.ConnectDatabase(PAnsiChar(BuildConnectStr));
691 if GetPlainDriver.GetStatus(FHandle) = CONNECTION_BAD then
693 CheckPostgreSQLError(nil, GetPlainDriver, FHandle,
694 lcConnect, LogMessage,nil)
697 DriverManager.LogMessage(lcConnect, PlainDriver.GetProtocol, LogMessage);
699 { Set the notice processor (default = nil)}
700 GetPlainDriver.SetNoticeProcessor(FHandle,FNoticeProcessor,nil);
702 { Gets the current codepage }
703 TempClientCodePage := GetPlainDriver.ValidateCharEncoding(GetPlainDriver.GetClientEncoding(FHandle)).Name;
705 { Sets a client codepage if necessary }
706 if ( FClientCodePage <> '' ) and (TempClientCodePage <> FClientCodePage) then
707 SetServerSetting('CLIENT_ENCODING', FClientCodePage);
709 { Turn on transaction mode }
710 StartTransactionSupport;
713 { Gets the current codepage if it wasn't set..}
714 if ( FClientCodePage = '') then
715 CheckCharEncoding(TempClientCodePage)
718 CheckCharEncoding(FClientCodePage);
719 FClientSettingsChanged := True;
722 if FPreparedStmts = nil then
723 FPreparedStmts := TStringList.Create;
724 if FTableInfoCache = nil then
725 FTableInfoCache := TZPGTableInfoCache.Create(ConSettings, FHandle, GetPlainDriver);
727 { sets standard_conforming_strings according to Properties if available }
728 SCS := Info.Values[standard_conforming_strings];
731 SetServerSetting(standard_conforming_strings, SCS);
732 FClientSettingsChanged := True;
734 FIs_bytea_output_hex := UpperCase(GetServerSetting('''bytea_output''')) = 'HEX';
737 if self.IsClosed and (Self.FHandle <> nil) then
739 GetPlainDriver.Finish(Self.FHandle);
745 procedure TZPostgreSQLConnection.PrepareTransaction(const transactionid: string);
747 QueryHandle: PZPostgreSQLResult;
750 if (TransactIsolationLevel <> tiNone) and not Closed then
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;
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.
769 Result sets created using the returned <code>Statement</code>
770 object will by default have forward-only type and read-only concurrency.
772 @param Info a statement parameters.
773 @return a new Statement object
775 function TZPostgreSQLConnection.CreateRegularStatement(Info: TStrings):
780 Result := TZPostgreSQLStatement.Create(GetPlainDriver, Self, Info);
784 Creates a <code>PreparedStatement</code> object for sending
785 parameterized SQL statements to the database.
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
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.
802 Result sets created using the returned PreparedStatement will have
803 forward-only type and read-only concurrency, by default.
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
811 function TZPostgreSQLConnection.CreatePreparedStatement(
812 const SQL: string; Info: TStrings): IZPreparedStatement;
817 {$IFDEF ZEOS_TEST_ONLY}
821 if GetServerMajorVersion >= 8 then
822 Result := TZPostgreSQLCAPIPreparedStatement.Create(GetPlainDriver, Self, SQL, Info)
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);
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.
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>
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.
849 Result sets created using the returned CallableStatement will have
850 forward-only type and read-only concurrency, by default.
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
859 function TZPostgreSQLConnection.CreateCallableStatement(
860 const SQL: string; Info: TStrings): IZCallableStatement;
864 Result := TZPostgreSQLCallableStatement.Create(Self, SQL, Info);
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.
874 procedure TZPostgreSQLConnection.Commit;
876 QueryHandle: PZPostgreSQLResult;
879 if (TransactIsolationLevel <> tiNone) and not Closed then
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);
887 StartTransactionSupport;
891 procedure TZPostgreSQLConnection.CommitPrepared(const transactionid: string);
893 QueryHandle: PZPostgreSQLResult;
896 if (TransactIsolationLevel = tiNone) and not Closed then
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;
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.
914 procedure TZPostgreSQLConnection.Rollback;
916 QueryHandle: PZPostgreSQLResult;
919 if (TransactIsolationLevel <> tiNone) and not Closed then
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);
927 StartTransactionSupport;
931 procedure TZPostgreSQLConnection.RollbackPrepared(const transactionid: string);
933 QueryHandle: PZPostgreSQLResult;
936 if (TransactIsolationLevel = tiNone) and not Closed then
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;
948 Releases a Connection's database and JDBC resources
949 immediately instead of waiting for
950 them to be automatically released.
952 <P><B>Note:</B> A Connection is automatically closed when it is
953 garbage collected. Certain fatal errors also result in a closed
956 procedure TZPostgreSQLConnection.Close;
961 if ( Closed ) or (not Assigned(PlainDriver)) then
964 for i := 0 to FPreparedStmts.Count -1 do
966 LogMessage := 'DEALLOCATE "'+FPreparedStmts[i]+'";';
967 GetPlainDriver.ExecuteQuery(FHandle, Pointer(LogMessage));
969 FPreparedStmts.Clear;
970 FTableInfoCache.Clear;
972 GetPlainDriver.Finish(FHandle);
974 LogMessage := Format('DISCONNECT FROM "%s"', [Database]);
975 DriverManager.LogMessage(lcDisconnect, PlainDriver.GetProtocol, LogMessage);
980 Sets a new transact isolation level.
981 @param Level a new transact isolation level.
983 procedure TZPostgreSQLConnection.SetTransactionIsolation(
984 Level: TZTransactIsolationLevel);
986 QueryHandle: PZPostgreSQLResult;
989 if not (Level in [tiNone, tiReadCommitted, tiSerializable]) then
990 raise EZSQLException.Create(SIsolationIsNotSupported);
992 if (TransactIsolationLevel <> tiNone) and not Closed then
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);
1001 inherited SetTransactionIsolation(Level);
1004 StartTransactionSupport;
1008 Gets a reference to PostgreSQL connection handle.
1009 @return a reference to PostgreSQL connection handle.
1011 function TZPostgreSQLConnection.GetConnectionHandle: PZPostgreSQLConnect;
1017 Gets a PostgreSQL plain driver interface.
1018 @return a PostgreSQL plain driver interface.
1020 function TZPostgreSQLConnection.GetPlainDriver: IZPostgreSQLPlainDriver;
1022 Result := PlainDriver as IZPostgreSQLPlainDriver;
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.
1030 function TZPostgreSQLConnection.GetTypeNameByOid(Id: Oid): string;
1033 QueryHandle: PZPostgreSQLResult;
1035 TypeCode, BaseTypeCode: Integer;
1037 LastVersion, IsEnum: boolean;
1042 if (GetServerMajorVersion < 7 ) or
1043 ((GetServerMajorVersion = 7) and (GetServerMinorVersion < 3)) then
1046 LastVersion := False;
1048 { Fill the list with existed types }
1049 if not Assigned(FTypeList) then
1052 SQL := 'SELECT oid, typname FROM pg_type WHERE oid<10000'
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';
1057 QueryHandle := GetPlainDriver.ExecuteQuery(FHandle, SQL);
1058 CheckPostgreSQLError(Self, GetPlainDriver, FHandle, lcExecute, String(SQL),QueryHandle);
1059 DriverManager.LogMessage(lcExecute, PlainDriver.GetProtocol, String(SQL));
1061 FTypeList := TStringList.Create;
1062 for I := 0 to GetPlainDriver.GetRowCount(QueryHandle)-1 do
1064 TypeCode := StrToIntDef(String(
1065 GetPlainDriver.GetValue(QueryHandle, I, 0)), 0);
1066 isEnum := LowerCase(String(GetPlainDriver.GetValue(QueryHandle, I, 3))) = 'e';
1070 TypeName := String(GetPlainDriver.GetValue(QueryHandle, I, 1));
1075 BaseTypeCode := StrToIntDef(String(
1076 GetPlainDriver.GetValue(QueryHandle, I, 2)), 0);
1078 if BaseTypeCode <> 0 then
1080 Index := FTypeList.IndexOfObject(TObject(BaseTypeCode));
1082 TypeName := FTypeList[Index]
1086 FTypeList.AddObject(TypeName, TObject(TypeCode));
1088 GetPlainDriver.Clear(QueryHandle);
1091 I := FTypeList.IndexOfObject(TObject(Id));
1093 Result := FTypeList[I]
1099 Gets the host's full version number. Initially this should be 0.
1100 The format of the version returned must be XYYYZZZ where
1104 @return this server's full version number
1106 function TZPostgreSQLConnection.GetHostVersion: Integer;
1108 Result := GetServerMajorVersion*1000000+GetServerMinorversion*1000+GetServerSubversion;
1112 Gets a server major version.
1113 @return a server major version number.
1115 function TZPostgreSQLConnection.GetServerMajorVersion: Integer;
1117 if (FServerMajorVersion = 0) and (FServerMinorVersion = 0) then
1119 Result := FServerMajorVersion;
1123 Gets a server minor version.
1124 @return a server minor version number.
1126 function TZPostgreSQLConnection.GetServerMinorVersion: Integer;
1128 if (FServerMajorVersion = 0) and (FServerMinorVersion = 0) then
1130 Result := FServerMinorVersion;
1134 Gets a server sub version.
1135 @return a server sub version number.
1137 function TZPostgreSQLConnection.GetServerSubVersion: Integer;
1139 if (FServerMajorVersion = 0) and (FServerMinorVersion = 0) then
1141 Result := FServerSubVersion;
1145 Loads a server major and minor version numbers.
1147 procedure TZPostgreSQLConnection.LoadServerVersion;
1151 QueryHandle: PZPostgreSQLResult;
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));
1161 Temp := String(GetPlainDriver.GetValue(QueryHandle, 0, 0));
1162 GetPlainDriver.Clear(QueryHandle);
1164 List := TStringList.Create;
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, '.');
1173 FServerMajorVersion := StrToIntDef(List.Strings[0], 0);
1174 if List.Count > 1 then
1175 FServerMinorVersion := GetMinorVersion(List.Strings[1])
1177 FServerMinorVersion := 0;
1178 if List.Count > 2 then
1179 FServerSubVersion := GetMinorVersion(List.Strings[2])
1181 FServerSubVersion := 0;
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
1192 function TZPostgreSQLConnection.PingServer: Integer;
1194 PING_ERROR_ZEOSCONNCLOSED = -1;
1197 res: PZPostgreSQLResult;
1200 Result := PING_ERROR_ZEOSCONNCLOSED;
1201 Closing := FHandle = nil;
1202 if Not(Closed or Closing) then
1204 res := GetPlainDriver.ExecuteQuery(FHandle,'');
1205 isset := assigned(res);
1206 GetPlainDriver.Clear(res);
1207 if isset and (GetPlainDriver.GetStatus(FHandle) = CONNECTION_OK) then
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
1223 function TZPostgreSQLConnection.EscapeString(Value: RawByteString): RawByteString;
1225 Result := PlainDriver.EscapeString(Self.FHandle, Value, ConSettings)
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.
1233 function TZPostgreSQLConnection.CreateSequence(const Sequence: string;
1234 BlockSize: Integer): IZSequence;
1236 Result := TZPostgreSQLSequence.Create(Self, Sequence, BlockSize);
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
1247 function TZPostgreSQLConnection.GetBinaryEscapeString(const Value: RawByteString): String;
1249 Result := String(EncodeBinary(Value));
1250 if GetAutoEncodeStrings then
1251 Result := GetDriver.GetTokenizer.GetEscapeString(Result);
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
1262 function TZPostgreSQLConnection.GetBinaryEscapeString(const Value: TByteDynArray): String;
1263 var Tmp: RawByteString;
1265 ZSetString(PAnsiChar(Value), Length(Value), Tmp);
1266 Result := String(EncodeBinary(Tmp));
1267 if GetAutoEncodeStrings then
1268 Result := GetDriver.GetTokenizer.GetEscapeString(Result);
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
1279 function TZPostgreSQLConnection.GetEscapeString(const Value: ZWideString): ZWideString;
1281 Result := GetPlainDriver.EscapeString(FHandle, Value, ConSettings);
1282 if GetAutoEncodeStrings then
1283 Result := GetDriver.GetTokenizer.GetEscapeString(Result);
1286 function TZPostgreSQLConnection.GetEscapeString(const Value: RawByteString): RawByteString;
1288 Result := GetPlainDriver.EscapeString(FHandle, Value, ConSettings);
1290 if GetAutoEncodeStrings then
1291 Result := GetDriver.GetTokenizer.GetEscapeString(Result);
1296 Gets a current setting of run-time parameter.
1297 @param AName a parameter name.
1298 @result a parmeter value retrieved from server.
1300 function TZPostgreSQLConnection.GetServerSetting(const AName: string): string;
1303 QueryHandle: PZPostgreSQLResult;
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);
1310 Result := String(GetPlainDriver.GetValue(QueryHandle, 0, 0));
1311 GetPlainDriver.Clear(QueryHandle);
1314 procedure TZPostgreSQLConnection.OnPropertiesChange(Sender: TObject);
1318 inherited OnPropertiesChange(Sender);
1320 { Define standard_conforming_strings setting}
1321 SCS := Trim(Info.Values[standard_conforming_strings]);
1323 SetStandardConformingStrings(UpperCase(SCS) = FON)
1325 SetStandardConformingStrings(GetPlainDriver.GetStandardConformingStrings);
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.
1334 procedure TZPostgreSQLConnection.SetServerSetting(const AName, AValue: string);
1337 QueryHandle: PZPostgreSQLResult;
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);
1344 GetPlainDriver.Clear(QueryHandle);
1347 {$IFDEF ZEOS_TEST_ONLY}
1348 constructor TZPostgreSQLConnection.Create(const ZUrl: TZURL);
1350 inherited Create(ZUrl);
1354 procedure TZPostgreSQLConnection.SetStandardConformingStrings(const Value: Boolean);
1356 FStandardConformingStrings := Value;
1357 ( Self.GetDriver.GetTokenizer as IZPostgreSQLTokenizer ).SetStandardConformingStrings(FStandardConformingStrings);
1361 { TZPostgreSQLSequence }
1363 Gets the current unique key generated by this sequence.
1364 @param the last generated unique key.
1366 function TZPostgreSQLSequence.GetCurrentValue: Int64;
1368 Statement: IZStatement;
1369 ResultSet: IZResultSet;
1371 Statement := Connection.CreateStatement;
1372 ResultSet := Statement.ExecuteQuery(
1373 Format('SELECT CURRVAL(''%s'')', [Name]));
1374 if ResultSet.Next then
1375 Result := ResultSet.GetLong(1)
1377 Result := inherited GetCurrentValue;
1383 Gets the next unique key generated by this sequence.
1384 @param the next generated unique key.
1386 function TZPostgreSQLSequence.GetCurrentValueSQL: String;
1388 result:=Format(' CURRVAL(''%s'') ', [Name]);
1391 function TZPostgreSQLSequence.GetNextValue: Int64;
1393 Statement: IZStatement;
1394 ResultSet: IZResultSet;
1396 Statement := Connection.CreateStatement;
1397 ResultSet := Statement.ExecuteQuery(
1398 Format('SELECT NEXTVAL(''%s'')', [Name]));
1399 if ResultSet.Next then
1400 Result := ResultSet.GetLong(1)
1402 Result := inherited GetNextValue;
1407 function TZPostgreSQLSequence.GetNextValueSQL: String;
1409 result:=Format(' NEXTVAL(''%s'') ', [Name]);
1413 PostgreSQLDriver := TZPostgreSQLDriver.Create;
1414 DriverManager.RegisterDriver(PostgreSQLDriver);
1416 if DriverManager <> nil then
1417 DriverManager.DeregisterDriver(PostgreSQLDriver);
1418 PostgreSQLDriver := nil;