
//////////////////////////////////////////////////
//  PostgreSQL Data Access Components
//  Copyright © 2008-2014 Devart. All right reserved.
//////////////////////////////////////////////////

{$IFNDEF CLR}

{$I PgDac.inc}
unit PgClassesUni;

{$ENDIF}

interface

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  Classes, SysConst, SysUtils, SyncObjs, Types,
  Variants, FMTBcd, {$IFNDEF FPC}SqlTimSt,{$ENDIF}
{$IFDEF VER12P}
{$IFNDEF NEXTGEN}
  AnsiStrings,
{$ENDIF}
{$ENDIF}
{$IFDEF CLR}
  System.Runtime.InteropServices, System.Text, WinUtils,
{$ELSE}
  CLRClasses,
{$ENDIF}
  CRTypes, CRParser, MemData, CRAccess, CRVio,
{$IFNDEF LITE}
  CRDataTypeMap,
{$ENDIF}
{$IFNDEF UNIDACPRO}
  PgCall, PgSQLNet, PgSQLProtocol, PgError;
{$ELSE}
  PgCallUni, PgSQLNetUni, PgSQLProtocolUni, PgErrorUni;
{$ENDIF}

const
  dtVoid = 100;
  dtPgName = 101;
  dtPgChar = 102;
  dtFixedChar = 103;
  dtNumeric = 105;
  dtPgSingle = 106;
  dtOID = 107;
  dtPgLargeObject = 108;

  dtPgDate = 109;
  dtPgTime = 110;
  dtPgTimeStamp = 111;
  dtPgInterval = 112;
  dtPgTimeStampTZ = 113;
  dtPgTimeTZ = 114;

  dtPgPoint    = 115;
  dtPgLSeg     = 116;
  dtPgBox      = 117;
  dtPgPath     = 118;
  dtPgPolygon  = 119;
  dtPgCircle   = 120;


  prPgSQLBase = 1000;

  prSchema             = prPgSQLBase + 1;
  prUseUnicode         = prPgSQLBase + 2;
  prCharset            = prPgSQLBase + 3;
  prEnablePgTimeStamps = prPgSQLBase + 5;
  prIntervalAsString   = prPgSQLBase + 6;
  prEnableGeometrics   = prPgSQLBase + 7;
  prEnableComposites   = prPgSQLBase + 8;
  prSimpleQueryExecute = prPgSQLBase + 9;
  prOIDAsInt           = prPgSQLBase + 10;
  prCacheBlobs         = prPgSQLBase + 11;
  prDeferredBlobRead   = prPgSQLBase + 12;
  prCommandTimeout     = prPgSQLBase + 13;
  prCursorAsString     = prPgSQLBase + 14;
  prUnknownAsString    = prPgSQLBase + 15;
  prAutoClose          = prPgSQLBase + 16;
  prProtocolVersion    = prPgSQLBase + 17;
  prSSL_Mode           = prPgSQLBase + 18;
  prSSL_CACert         = prPgSQLBase + 19;
  prSSL_Cert           = prPgSQLBase + 20;
  prSSL_Key            = prPgSQLBase + 21;
  prSSL_CipherList     = prPgSQLBase + 22;
  prFieldsAsText       = prPgSQLBase + 23;
  prBufferSize         = prPgSQLBase + 25;
  prTextMode           = prPgSQLBase + 26;
  prUseParamTypes      = prPgSQLBase + 27;
  prCursorWithHold     = prPgSQLBase + 28;
  prApplicationName    = prPgSQLBase + 29;
  prBCDPrecision       = prPgSQLBase + 30;
  prEnableDomains      = prPgSQLBase + 31;
  prDistinctParams     = prPgSQLBase + 32;

  MaxNumericWords = 250;

{$HPPEMIT 'struct TParamPlaceHolder;'}
{$HPPEMIT 'struct TEventInfo;'}
{$HPPEMIT 'class TPgSQLParamDesc;'}

type
  TPgSQLTypes = class;
  TPgSQLCommand = class;
  TPgSQLRecordSet = class;
  TPgCursor = class;
  TPgSQLFieldDesc = class;
{$IFNDEF LITE}
  TPgSQLNotificationsHandler = class;
  TPgSQLNotificationsThread = class;
{$ENDIF}

  TProtocolVersion = (pv20, pv30);

  TPgSQLNotificationEvent = procedure (const Name: string; const PID: integer; const Message: string) of object;

  TSSLMode = (smDisable, smRequire, smPrefer, smAllow);

  _TStringArray = array of string;

  TPgSQLConnection = class(TCRConnection)
  private
    FDatabase: string;
    FPort: Integer;
    FProtocolVersion: TProtocolVersion;
    FConnectionTimeout: integer;
    FApplicationName: string;
    FSSL_Mode: TSSLMode;
    FSSL_CACert: string;
    FSSL_Cert: string;
    FSSL_Key: string;
    FSSL_CipherList: string;
    FUseUnicode: boolean;
    FCharset: string;
    FSchema: string;
    FMultipleSchema: boolean;
    FSchemas: _TStringArray;
    FCachedSchema: string;
    FEnablePgTimeStamps: boolean;
    FIntervalAsString: boolean;
    FEnableGeometrics: boolean;
    FEnableComposites: boolean;
    FEnableDomains: boolean;

    FProtocol: TPgSQLProtocol;
    FCommand: TPgSQLCommand;
    FTypes: TPgSQLTypes;
    FFetchConnection: TPgSQLConnection;
  {$IFNDEF LITE}
    FAuxConnection: TPgSQLConnection;
    FNotificationsHandler: TPgSQLNotificationsHandler;
  {$ENDIF}
    FInTransaction: boolean;
    FIntegerDateTimes: boolean;
    FByteaOutputAsHex: boolean;
    FFetchConCount: integer;
    FBCDPrecision, FBCDScale: integer;
  {$IFNDEF CLR}
    FIPVersion: TIPVersion;
  {$ENDIF}
    FLastInsertId: integer;

    FOnNotice: TPgProtocolNoticeEvent;
    FOnNotification: TPgSQLNotificationEvent;

    procedure ProcessInternalException(E: EPgError; Component: TObject);

    procedure PrepareFetchConnection;
    procedure ReleaseFetchConnection;
  {$IFNDEF LITE}
    procedure CheckAuxConnection;
  {$ENDIF}
    procedure SetClientEncoding;
    procedure GetIntegerDateTimes;
    procedure GetByteaOutput;

    procedure DoOnNotice(Errors: TPgErrors);
    procedure DoOnNotification(const Name: string; const PID: integer; const Message: string);

    function GetSchemaNamesForSQL(Flag: integer): string;

  protected
    property EnableBCD;
  {$IFNDEF FPC}
    property EnableFMTBCD;
  {$ENDIF}

  public
    constructor Create; override;
    destructor Destroy; override;

    function GetCommandClass: TCRCommandClass; override;
    function GetTransactionClass: TCRTransactionClass; override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; out Value: variant): boolean; override;

    function CheckIsValid: boolean; override;
  {$IFNDEF LITE}
    procedure ReturnToPool; override;
  {$ENDIF}

    procedure Connect(const ConnectString: string); override;
    procedure Disconnect; override;
    procedure Ping; override;

    procedure Assign(Source: TCRConnection); override;
    procedure AssignConnect(Source: TCRConnection); override;

    function GetServerVersion: string; override;
    function GetServerVersionFull: string; override;
    function GetClientVersion: string; override;
    function GetMajorServerVersion: integer;
    function GetMinorServerVersion: integer;
    function VersionIsEqualOrHigher(MajorVer, MinorVer: integer): boolean;

    function GetProcessID: integer;
    function GetProtocolVersion: TProtocolVersion;
    function GetProtocol: TPgSQLProtocol;
    function GetTypes: TPgSQLTypes;
    function GetCurrentSchema: string;
    procedure SetCurrentSchema(Value: string);
    function GetCachedSchema: string;
    function GetInTransaction: boolean;
  {$IFNDEF LITE}
    function GetNotificationsHandler: TPgSQLNotificationsHandler;
  {$ENDIF}

    function CanChangeDatabase: boolean; override;

    function CreateCommand: TPgSQLCommand;
    function GetCommand: TPgSQLCommand;
    procedure ExecCommand(const SQL: string);

    procedure BreakExec;

    property OnNotice: TPgProtocolNoticeEvent read FOnNotice write FOnNotice;
    property OnNotification: TPgSQLNotificationEvent read FOnNotification write FOnNotification;
  end;

  TPgSQLTransaction = class(TCRTransaction)
  public
    procedure StartTransaction; override;
    procedure Commit; override;
    procedure Rollback; override;

    procedure Savepoint(const Name: string); override;
    procedure ReleaseSavepoint(const Name: string); override;
    procedure RollbackToSavepoint(const Name: string); override;
  end;

  TPgSQLTypes = class
  private
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FConnection: TPgSQLConnection;
  {$IFNDEF LITE}
    FUnknownTypes: TThreadList;
    FTypes: TThreadList;

    function IsUnknownType(TypeCode: integer): boolean;
    function FindType(TypeCode: integer; TypeClass: TClass): TObjectType; overload;
    function FindType(const TypeName: string; TypeClass: TClass): TObjectType; overload;
    function GetType(TypeCode: integer; TypeClass: TClass): TObjectType; overload;
    function GetType(const TypeName: string; TypeClass: TClass): TObjectType; overload;
  {$ENDIF}

  public
    constructor Create(Connection: TPgSQLConnection);
    destructor Destroy; override;

    procedure DecodeTypeLength(TypeOID: Integer; TypeModifier: Integer; var Length, Scale: Integer);
    procedure DetectDataType(TypeOID: integer; {$IFNDEF LITE}FetchConverter: TFetchConverter;{$ENDIF}
      var DataType, SubDataType: word; var Length, Scale, Size: integer;
      var Fixed: boolean; var ObjectType: TObjectType;
      LongStrings, FlatBuffers, OIDAsInt, EnableBCD, EnableFMTBCD,
      CursorAsString, UnknownAsString, FieldsAsText: boolean);
    function GetInternalType(TypeCode: integer; var ObjectType: TObjectType):word;
    function DataTypeToOID(DataType, SubDataType: word): integer;
  {$IFNDEF LITE}
    function GetDomainType(TypeCode: integer): TObjectType;
    function GetRowType(TypeCode: integer): TObjectType; overload;
    function GetRowType(const TypeName: string): TObjectType; overload;
  {$ENDIF}
  end;

  TPgSQLParamDesc = class(TParamDesc)
  private
  {$IFDEF LITE}
    FTypeOID: integer;
  {$ENDIF}
  public
    function GetAsCursor: TPgCursor;
    procedure SetAsCursor(Value: TPgCursor);
  end;

  TPgSQLInfo = class(TSQLInfo)
  protected
    function HasOnlyLexem: boolean; override;
    procedure ParseExtColumnName(Parser: TSQLParser; var Code: integer; var Str: string); override;
  public
    function IdentCase: TIdentCase; override;
    function QuoteSchemasIfNeed(const Value: string; var Values: _TStringArray): string;
  end;

  TPgSQLFieldDesc = class(TCRFieldDesc)
  private
    FIsTextMode: boolean;
    FTableOID: integer;
    FTableCol: smallint;
  public
    property TableOID: integer read FTableOID write FTableOID;
    property TableCol: smallint read FTableCol write FTableCol;
  end;

  TPgCursor = class(TCRCursor)
  private
    FStmtHandle: TPgSQLStatement;

    procedure CreateStatement;
    procedure FreeStatement;
  protected
    FState: TCursorState;

  public
    constructor Create;
    destructor Destroy; override;

    function CanFetch: boolean; override;
    property State: TCursorState read FState;
  end;

  TParamPlaceHolder = record
    Position: integer;
    EndPosition: integer;
    ParamRef: TPgSQLParamDesc;
  end;

  TParamPlaceHolders = array of TParamPlaceHolder;

  TProcParamsInfo = record
    RetTypeOID: integer;
    IsReturnSet: boolean;
    TypeOIDs: TIntegerDynArray;
    Modes, Names: _TStringArray;
    Schema: string;
  end;

  TPgSQLCommand = class(TCRCommand)
  private
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FConnection: TPgSQLConnection;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FUsedConnection: TPgSQLConnection;
    {$IFDEF AUTOREFCOUNT}[weak]{$ENDIF}
    FRecordSet: TPgSQLRecordSet;
    FCommandTimeout: integer;
    FOIDAsInt: boolean;
    FFieldsAsText: boolean;
    FUseParamTypes: boolean;
    FDistinctParams: boolean;

    FPlaceHolders: TParamPlaceHolders;
    FPlaceHoldersCount: integer;

    FCursor: TPgCursor;
    FCursorRef: TPgCursor;
    FNextCursorRef: TPgCursor;
    FNativePreparation: boolean;

    FParsedStmtType: TParsedStmtType;

    FForceSimpleProtocol: boolean;

    FLastInsertOID: Int64;
    FRowsAffected: integer;

    FInParamsCount: integer;
    FInParamRefs: array of TPgSQLParamDesc;
    FOutParamsCount: integer;

    function GetFormatCode(DataType: Word; TypeModifier, Scale: integer; IsField: boolean): integer;

    function UseSimpleProtocol: boolean;
    function GetUsedConnection: TPgSQLConnection;
    procedure CheckConnection;

    function GetFinalSQL: string;

    procedure MakeSPParam(const Name: string; Oid: integer; Direction: char);
    procedure GetProcParamsInfo(const Schema, Name: string; Overload: integer;
      var ParamsInfo: TProcParamsInfo);

    function NativeCursor: boolean;
    function OutParamsReturn: boolean;
    function RowsReturn: boolean;
    function GetParsedStmtType: TParsedStmtType;

  protected
    // simple (Text) protocol
    function GetFinalSQLWithParamValues: string;

    // binary protocol
    procedure CallbackBindParamValue(Dest: TPgSQLNet; ParamNo: integer; const ItemDesc: TPgSQLItemDesc);
    procedure PerformPrepare(const SQL: string; ParsedSQLType: TParsedStmtType; const ParamTypes: TIntegerDynArray);
    procedure PerformUnprepare;
    procedure PerformBindExecute;
    procedure PerformClosePortal;

    procedure InternalExecute;
    procedure DescribeFields;
    procedure DescribeParams;
    procedure ReadOutParams;
    procedure SplitParams;
    procedure ResetParams;

    property EnableBCD;
  {$IFDEF VER6P}
  {$IFNDEF FPC}
    property EnableFMTBCD;
  {$ENDIF}
  {$ENDIF}

  public
    constructor Create; override;
    destructor Destroy; override;

    class function GetSQLInfoClass: TSQLInfoClass; override;
    class function GetParserClass: TSQLParserClass; override;
  {$IFNDEF LITE}
    class function GetMapRulesClass: TCRMapRulesClass; override;
  {$ENDIF}

    function GetParamDescType: TParamDescClass; override;

    procedure ClearPlaceHolders;
    procedure AddPlaceHolder(Position, EndPosition: integer; ParamRef: TPgSQLParamDesc);
    function AddParam: TParamDesc; override;
    function GetParam(Index: integer): TPgSQLParamDesc;
    function ParseSQL(const SQL: string; Params: TParamDescs; ReplaceAll: boolean = True; const RenamePrefix: string = ''): string; override;
    procedure InitProcParams(const Name: string; Overload: integer);
    function CreateProcCall(const Name: string; NeedDescribe: boolean; IsQuery: boolean): string; override;

    function GetPrepared: boolean; override;
    procedure Prepare; override;
    procedure Unprepare; override;
    procedure Execute(Iters: integer = 1); override;
    procedure Close; override;

    procedure SetConnection(Value: TCRConnection); override;

    function GetCursorState: TCursorState; override;
    procedure SetCursorState(Value: TCursorState); override;

    function GetCursor: TCRCursor; override;
    procedure SetCursor(Value: TCRCursor); override;
    function GetFirstCursor(): TPgCursor;
    function GetNextCursor(): TPgCursor;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; out Value: variant): boolean; override;
    procedure BreakExec; override;
  end;

  TCreateFieldObjectFunc = function(DataType: word): TSharedObject of Object;

  TPgSQLRecordSet = class(TCRRecordSet)
  private
    FCommand: TPgSQLCommand;
    FFetchCursor: TPgCursor;
    FCreateFieldObjectFunc: TCreateFieldObjectFunc;
    FDescribeExecute: boolean;
    FNeedExtFieldsInfo: boolean;
    FRowsFetched: integer;

    FCacheBlobs: boolean;
    FDeferredBlobRead: boolean;
    FCursorAsString: boolean;
    FUnknownAsString: boolean;
    FCursorWithHold: boolean;
    FNoFetchData: boolean;

    procedure SetCommandType;
    procedure ReceiveFetchBuffer(Source: TPgSQLNet; Size: integer; FetchBlock: IntPtr;
      Row, Col: integer);
    procedure GetExtFieldsInfo;

  protected
    procedure CreateCommand; override;
    procedure SetCommand(Value: TCRCommand); override;
    function UsedConnection: TPgSQLConnection;

    function InternalGetObject(Field: TFieldDesc; RecBuf: IntPtr): TSharedObject;

    procedure InternalPrepare; override;
    procedure InternalUnPrepare; override;
    procedure InitFetchCursor;

    function NeedInitFieldsOnFetch: boolean; override;
    procedure CreateFieldDescs; override;
  {$IFNDEF LITE}
    function InternalCompareFieldValue(ValuePtr: IntPtr; ValueType: Word; FieldBuf: IntPtr; FieldType: Word; FieldLength: Integer; HasParent: boolean; IsFixed: boolean; const Options: TCompareOptions): integer; override;
  {$ENDIF}

    procedure InternalOpen(DisableInitFields: boolean = False); override;
    procedure InternalClose; override;

  { Fetch }
    procedure FetchBlock(Block: PBlockHeader; FetchBack: boolean; out RowsObtained: Integer); override;
    procedure ProcessFetchedBlock(Block: PBlockHeader; FetchBack: boolean); override;
    function ProcessFetchedException(E: Exception): boolean; override;
    function NeedUnPrepareAfterFetch: boolean; override;

    property IsFetchAll: boolean read FFetchAll;
  public
    constructor Create; override;
    destructor Destroy; override;

  { Fetch }
    procedure FetchAll; override;
    function CanDisconnect: boolean; override;

  { Open/Close }
    procedure ExecCommand; override;
    function IsFullReopen: boolean; override;
    procedure Reopen; override;

  { Fields }
    procedure DetectIdentityField; override;
    function GetFieldDescType: TFieldDescClass; override;
    procedure PutFieldData(Field: TFieldDesc; FieldBuf: IntPtr; Source: IntPtr; NeedConvert: boolean; IsDatabaseValue: boolean = False); override;
    class function IsBlobDataType(DataType: word): boolean; override;
    class function IsComplexDataType(DataType: word): boolean; override;

  { Records }
    procedure CreateComplexField(RecBuf: IntPtr; Field: TFieldDesc); override;
    class procedure InternalCreateComplexField(RecBuf: IntPtr; Connection: TPgSQLConnection;
      Offset: integer; DataType: word; SubDataType: word; ObjectType: TObjectType;
      CreateFieldObjectFunc: TCreateFieldObjectFunc; CacheBlobs: boolean);
    procedure FreeComplexField(RecBuf: IntPtr; Field: TFieldDesc); override;
  {$IFNDEF LITE}
    procedure CopyComplexField(Source: IntPtr; Dest: IntPtr; Field: TFieldDesc); override;
    function GetSortOptions(SortColumn: TSortColumn): TCompareOptions; override;
    function GetNull(Field: TFieldDesc; RecBuf: IntPtr): boolean; override;
 {$ENDIF}

  { Navigation }
    procedure SetToEnd; override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; out Value: variant): boolean; override;

    property OnCreateFieldObject: TCreateFieldObjectFunc read FCreateFieldObjectFunc write FCreateFieldObjectFunc;
  end;

{ TPgSQLMetaData }

  TPgSQLMetaData = class (TCRMetaData)
  protected
    function GetConnection: TPgSQLConnection;
    function CreateRecordSet: TCRRecordSet; override;

    function InternalGetMetaData(const MetaDataKind: string; Restrictions: TStrings): TData; override;
    procedure InternalGetMetaDataKindsList(List: TStringList); override;
    procedure InternalGetRestrictionsList(List: TStringList; const MetaDataKind: string); override;

    function GetTables(Restrictions: TStrings): TData; override;
    function GetColumns(Restrictions: TStrings): TData; override;
    function GetProcedures(Restrictions: TStrings): TData; override;
  {$IFNDEF LITE}
    procedure CreateProcedureParametersFields; override;
    function GetProcedureParameters(Restrictions: TStrings): TData; override;
  {$ENDIF}
    function GetIndexes(Restrictions: TStrings): TData; override;
    function GetIndexColumns(Restrictions: TStrings): TData; override;
    function GetConstraints(Restrictions: TStrings): TData; override;

    function GetDataTypes(Restrictions: TStrings): TData; override;
    function GetDatabases(Restrictions: TStrings): TData; override;
    function GetUsers(Restrictions: TStrings): TData; override;
    function GetSequences(Restrictions: TStrings): TData;
    function GetSchemas(Restrictions: TStrings): TData;
  end;

{ TPgBufferConverter }

  TPgBufferConverter = class
  public
    { Writing }
  {$IFNDEF FPC}
    class procedure VarToFmtBcd(const Value: variant; var Bcd: TBcd);
  {$ENDIF}
    class procedure VarToPgDate(const Value: variant;
      var PgDate: TSharedObject; var NeedFree: boolean);
    class procedure VarToPgTime(const Value: variant; WithTimeZone: boolean;
      var PgTime: TSharedObject; var NeedFree: boolean);
    class procedure VarToPgTimeStamp(const Value: variant;
      var PgTimeStamp: TSharedObject; var NeedFree: boolean);
    class procedure VarToPgInterval(const Value: variant;
      var PgInterval: TSharedObject; var NeedFree: boolean);
    class procedure VarToOID(const Value: variant; var OID: integer);
  {$IFNDEF LITE}
    class procedure VarToPgGeometric(const Value: variant; DataType: word;
      var PgGeometric: TSharedObject; var NeedFree: boolean);
    class procedure VarToPgRow(const Value: variant; ObjectType: TObjectType;
      var PgRow: TDBObject; var NeedFree: boolean);
  {$ENDIF}
    class procedure VarToCursor(const Value: variant; var CursorName: string);

    { Reading }
    class procedure ReadString(Source: TPgSQLNet; Size: integer; Dest: IntPtr; Trim: boolean);
    class procedure ReadWideString(Source: TPgSQLNet; Size: integer; Dest: IntPtr; Trim: boolean);
    class procedure ReadMemo(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadWideMemo(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadPgCursor(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
      Connection: TPgSQLConnection);
    class procedure ReadGuid(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
  end;

{ TPgBinaryConverter }

  TPgNumeric = record
    NDigits: integer;
    Weight: integer;
    Sign: integer;
    DScale: integer;
    Digits: array [0 .. MaxNumericWords - 1] of word;
    StartPos: integer;
  end;

  TPgBinaryConverter = class (TPgBufferConverter)
  private
    class procedure ReadSingle(Source: TPgSQLNet; Dest: IntPtr);
    class procedure ReadNumeric(Source: TPgSQLNet; Dest: IntPtr);
    class procedure ReadNumericAsInt(Source: TPgSQLNet; Dest: IntPtr; DataType: Word);

    class procedure StringToNumeric(const Value: string; var Numeric: TPgNumeric);
    class procedure IntToNumeric(Value: Int64; var Numeric: TPgNumeric);
    class procedure DoubleToNumeric(Value: double; var Numeric: TPgNumeric);
    class procedure BcdToNumeric(BCD: TBCD; var Numeric: TPgNumeric);
    class procedure StripNumeric(var Numeric: TPgNumeric);

  public
    class procedure WriteValue(Value: Variant; Dest: TPgSQLNet;
      DataType, SubDataType: word; ObjectType: TObjectType; Connection: TPgSQLConnection);
    class procedure WriteSmallInt(Value: Variant; Dest: TPgSQLNet);
    class procedure WriteInteger(Value: Variant; Dest: TPgSQLNet);
    class procedure WriteBigInt(Value: Variant; Dest: TPgSQLNet);
    class procedure WriteDouble(Value: Variant; Dest: TPgSQLNet);
    class procedure WriteSingle(Value: Variant; Dest: TPgSQLNet);
    class procedure WriteNumeric(Value: Variant; Dest: TPgSQLNet);
    class procedure WriteCurrency(Value: Variant; Dest: TPgSQLNet;
      Connection: TPgSQLConnection);
    class procedure WriteBoolean(Value: Variant; Dest: TPgSQLNet);
    class procedure WriteString(Value: Variant; Dest: TPgSQLNet; UseUnicode: boolean);
    class procedure WriteWideString(Value: Variant; Dest: TPgSQLNet; UseUnicode: boolean);
    class procedure WriteOID(Value: Variant; Dest: TPgSQLNet);
    class procedure WriteDate(Value: Variant; Dest: TPgSQLNet);
    class procedure WriteTime(Value: Variant; Dest: TPgSQLNet;
      IntegerDateTimes, WithTimeZone: boolean);
    class procedure WriteTimeStamp(Value: Variant; Dest: TPgSQLNet;
      IntegerDateTimes, WithTimeZone: boolean);
    class procedure WriteInterval(Value: Variant; Dest: TPgSQLNet;
      IntegerDateTimes: boolean);
    class procedure WriteGuid(Value: Variant; Dest: TPgSQLNet);
  {$IFNDEF LITE}
    class procedure WritePgGeometric(Value: Variant; Dest: TPgSQLNet;
      DataType: word);
    class procedure WritePgRow(Value: Variant; Dest: TPgSQLNet;
      ObjectType: TObjectType; Connection: TPgSQLConnection);
  {$ENDIF}

    class procedure ReadValue(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
      DataType, SubDataType: word; Trim: boolean; Connection: TPgSQLConnection);
    class procedure ReadInt16(Source: TPgSQLNet; Dest: IntPtr; SubDataType: Word);
    class procedure ReadInt32(Source: TPgSQLNet; Dest: IntPtr; SubDataType: Word);
    class procedure ReadInt64(Source: TPgSQLNet; Dest: IntPtr; SubDataType: Word);
    class procedure ReadDouble(Source: TPgSQLNet; Dest: IntPtr; SubDataType: Word);
    class procedure ReadBCD(Source: TPgSQLNet; Dest: IntPtr);
  {$IFNDEF FPC}
    class procedure ReadFMTBCD(Source: TPgSQLNet; Dest: IntPtr);
  {$ENDIF}
    class procedure ReadCurrency(Source: TPgSQLNet; Dest: IntPtr; Connection: TPgSQLConnection);
    class procedure ReadBoolean(Source: TPgSQLNet; Dest: IntPtr);
    class procedure ReadBlob(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadPgLargeObject(Source: TPgSQLNet; Dest: IntPtr);
    class procedure ReadDate(Source: TPgSQLNet; Dest: IntPtr);
    class procedure ReadTime(Source: TPgSQLNet; Dest: IntPtr;
      IntegerDateTimes, WithTimeZone: boolean);
    class procedure ReadDateTime(Source: TPgSQLNet; Dest: IntPtr;
      IntegerDateTimes, WithTimeZone: boolean);
  {$IFNDEF LITE}
    class procedure ReadPgDate(Source: TPgSQLNet; Dest: IntPtr);
    class procedure ReadPgTime(Source: TPgSQLNet; Dest: IntPtr;
      IntegerDateTimes, WithTimeZone: boolean);
    class procedure ReadPgTimeStamp(Source: TPgSQLNet; Dest: IntPtr;
      IntegerDateTimes, WithTimeZone: boolean);
    class procedure ReadPgInterval(Source: TPgSQLNet; Dest: IntPtr;
      IntegerDateTimes: boolean);
    class procedure ReadPgGeometric(Source: TPgSQLNet; Size: integer;
      Dest: IntPtr; DataType: word);
    class procedure ReadPgRow(Source: TPgSQLNet; Dest: IntPtr;
      Trim: boolean; Connection: TPgSQLConnection);
  {$ENDIF}
  end;

{ TPgTextConverter }

  TPgTextConverter = class (TPgBufferConverter)
  public
    class function GetInt64(Source: TPgSQLNet; Size: integer): Int64;
    class function EscapeString(const Value: string;
      StringQuote, ByteaQuote, LoaderQuote: boolean; EscapeSign: boolean): string;

    class function ValueToText(const Value: variant; DataType: word; SubDataType: Word;
      UseUnicode: boolean; Quote: boolean; LoaderQuote: boolean; EscapeSign: boolean): string;
    class function BooleanToText(const Value: variant): string;
    class function BlobToText(const Value: variant; UseUnicode: boolean): string;
    class function DateToText(const Value: variant): string;
    class function TimeToText(const Value: variant; HasTimeZone: boolean): string;
    class function TimeStampToText(const Value: variant; HasTimeZone: boolean): string;
    class function IntervalToText(const Value: variant): string;
    class function LargeObjectToText(const Value: variant): string;
    class function GUIDToText(const Value: variant): string;
  {$IFNDEF LITE}
    class function PgGeometricToText(const Value: variant; DataType: word): string;
    class function PgRowToText(const Value: variant): string;
  {$ENDIF}
    class function CursorToText(const Value: variant; UseUnicode: boolean): string;

    class procedure ReadValue(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
      DataType, SubDataType: word; Trim: boolean; Connection: TPgSQLConnection);
    class procedure ReadWideString(Source: TPgSQLNet; Size: integer; Dest: IntPtr; Trim: boolean; UseUnicode: boolean);
    class procedure ReadInt16(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadInt32(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadInt64(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadDouble(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadBCD(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
  {$IFNDEF FPC}
    class procedure ReadFMTBCD(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
  {$ENDIF}
    class procedure ReadCurrency(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadBoolean(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadBlob(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadBlobAsHex(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadPgLargeObject(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadDate(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadTime(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadDateTime(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
  {$IFNDEF LITE}
    class procedure ReadPgDate(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadPgTime(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
      WithTimeZone: boolean);
    class procedure ReadPgTimeStamp(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
      WithTimeZone: boolean);
    class procedure ReadPgInterval(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadPgGeometric(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
    class procedure ReadPgRow(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
  {$ENDIF}
  end;

{$IFNDEF LITE}

{ TPgSQLAlerter }

  TPgSQLAlerter = class(TCRAlerter)
  private
    FOnEvent: TPgSQLNotificationEvent;

  protected
    procedure DoOnEvent(const EventName: string; const PID: integer; const Message: string);

  public
    constructor Create; override;
    destructor Destroy; override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; var Value: variant): boolean; override;

    procedure SendEvent(const EventName, Message: string); override;
    procedure Start; override;
    procedure Stop; override;

    property OnEvent: TPgSQLNotificationEvent read FOnEvent write FOnEvent;
  end;

{ TPgSQLNotificationsHandler }

  TEventInfo = record
    EventName: string;
    Callbacks: array of TPgSQLNotificationEvent;
  end;

  TPgSQLNotification = class
  public
    PID: integer;
    Name: string;
    Message: string;
  end;

  TPgSQLNotificationsHandler = class
  private
    FBaseConnection: TPgSQLConnection;
    FConnection: TPgSQLConnection;
    FEvents: array of TEventInfo;
    FThread: TPgSQLNotificationsThread;
{$IFDEF MSWINDOWS}
    FGCHandle: IntPtr;
{$ELSE}
    FLastNotification: TPgSQLNotification;
{$ENDIF}
    FLockConnection: TCriticalSection;
    FConnectionIsLocked: boolean;
    FAllowLockEvent: TEvent;

    function EventIndex(const Name: string): integer;
    procedure Start;
    procedure Stop;
    procedure Listen(const Name: string);
    procedure Unlisten(const Name: string);
    procedure LockConnection;
{$IFDEF MSWINDOWS}
    function GetGCHandle: IntPtr;
{$ELSE}
    procedure DoNotification;
{$ENDIF}
    procedure ProcessNotification(const Name: string; const PID: integer; const Message: string);
    procedure DoOnNotification(NotificationPID: Integer; const NotificationName: string; const NotificationMsg: string);
    
{$IFDEF MSWINDOWS}
    property GCHandle: IntPtr read GetGCHandle;
{$ENDIF}

  public
    constructor Create(BaseConnection: TPgSQLConnection);
    destructor Destroy; override;

    procedure RegisterEvents(Events: TStrings; Callback: TPgSQLNotificationEvent);
    procedure UnregisterEvents(Events: TStrings; CallbackObject: TObject);
  end;

  TPgSQLNotificationsThread = class (TThread)
  private
    FHandler: TPgSQLNotificationsHandler;
  protected
    procedure Execute; override;
  end;

{ TPgSQLLoaderColumn }

  TPgSQLLoaderColumn = class(TCRLoaderColumn)
  private
    FSubDataType: integer;
    FRowType: TObjectType;
    FRowTypeName: string;

  public
    property SubDataType: integer read FSubDataType write FSubDataType;
    property RowTypeName: string read FRowTypeName write FRowTypeName;
  end;

{ TPgSQLLoader }

  TPgSQLLoader = class(TCRLoader)
  private
    FConnection: TPgSQLConnection;
    FCommand: TPgSQLCommand;
    FRowValues: array of variant;
    FPrepared: boolean;
    FBlockOpened: boolean;
    FBufferSize: integer;
    FTextMode: boolean;
    FIsTextMode: boolean;
    FNet: TPgSQLNet;

  protected
    class function GetRecordSetClass: TCRRecordSetClass; override;
    procedure SetConnection(Value: TCRConnection); override;
    procedure FillColumn(Column: TCRLoaderColumn; FieldDesc: TFieldDesc); override;

    procedure LoadRow;
    procedure WriteHeader;
    procedure BeginDataBlock;
    procedure EndDataBlock;

    procedure DoAfterLoadRow;
    function IsPutColumnDataAllowed: boolean; override;
  public
    constructor Create; override;
    destructor Destroy; override;

    function SetProp(Prop: integer; const Value: variant): boolean; override;
    function GetProp(Prop: integer; var Value: variant): boolean; override;

    class function GetColumnClass: TCRLoaderColumnClass; override;
    procedure Reset; override;
    procedure Prepare; override;
    procedure DoLoad; override;
    procedure Finish; override;
    procedure PutColumnData(Col: integer; Row: integer; const Value: variant); override;
  end;

{$ENDIF}

var
  PgSQLInfo: TPgSQLInfo;
  BCDPrecision: string = '';

const
  DefValProtocol = pv30;
  DefValSSLMode = smDisable;

const
  DACProductName = 'PgDAC';


implementation

uses
  Math,
{$IFDEF MSWINDOWS}
  Messages, Registry,
{$ENDIF}
  CRFunctions, MemUtils, DAConsts,
{$IFNDEF UNIDACPRO}
  PgConsts, {$IFNDEF LITE}PgDataTypeMap,{$ENDIF} PgParser, PgObjects;
{$ELSE}
  PgConstsUni, PgDataTypeMapUni, PgParserUni, PgObjectsUni;
{$ENDIF}


{$IFNDEF LITE}
{$IFDEF MSWINDOWS}
var
  hUtilWindow: HWND;
{$ENDIF}
{$ENDIF}

function CheckTypeCorrespondence(SourceType: Word; DestType: Word): boolean;
begin
  case SourceType of
    dtMemo, dtWideMemo:
      Result := (DestType = SourceType) or
        (DestType in [dtBlob, dtMemo, dtWideMemo, dtString, dtWideString]);
    dtBlob:
      Result := DestType in [dtBlob, dtMemo, dtWideMemo];
    dtPgDate, dtPgTime, dtPgTimeStamp, dtPgTimeStampTZ,
    dtPgInterval,
    dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle,
    dtObject:
      Result := DestType = SourceType;
  else
    Result := True;
  end;
end;

procedure GetPrecAndScale(const Value: string; var Precision, Scale: integer);
var
  P: integer;
begin
  Precision := 0;
  Scale := 0;
  if Trim(Value) = '' then
    Exit;
  P := Pos(',', Value);
  if P > 0 then begin
    Precision := StrToInt(Trim(Copy(Value, 1, P - 1)));
    Scale := StrToInt(Trim(Copy(Value, P + 1, Integer(Length(Value) - P))));
  end
  else begin
    Precision := StrToInt(Trim(Value));
    Scale := 0;
  end;
end;

{ TPgBufferConverter}

const
  MaxDecimalWords = 8;
  DecimalArray : array [0 .. MaxDecimalWords - 1] of double = (
    1,
    10000,
    100000000,
    1000000000000,
    10000000000000000,
    100000000000000000000.0,
    1000000000000000000000000.0,
    10000000000000000000000000000.0);

  DecimalArrayInt : array [0 .. 4] of Int64 = (
    1,
    10000,
    100000000,
    1000000000000,
    10000000000000000);

  DecimalArrayBCD : array [0 .. 3] of Int64 = (
    10000,
    100000000,
    1000000000000,
    10000000000000000);

  NUMERIC_POS = $0000;
  NUMERIC_NEG = $4000;
  DEC_DIGITS  = 4;

{$IFNDEF FPC}
class procedure TPgBufferConverter.VarToFmtBcd(const Value: variant; var Bcd: TBcd);
var
  i64: int64;
begin
  case VarType(Value) of
    varSmallint, varInteger, varByte, varWord, varShortInt:
      Bcd := IntegerToBcd(Value);
    varLongWord, varInt64: begin
      i64 := Value;
      Bcd := StrToBcd(IntToStr(i64));
    end;
    varSingle, varDouble, varCurrency:
      Bcd := DoubleToBcd(Value);
  else
    if VarIsStr(Value) then
      Bcd := StrToBcd(Value)
    else
    if VarType(Value) = VarFMTBcd then
      Bcd := VarToBcd(Value)
    else
      raise EConvertError.Create(SCannotConvertType);
  end;
end;
{$ENDIF}

class procedure TPgBufferConverter.VarToPgDate(const Value: variant;
  var PgDate: TSharedObject; var NeedFree: boolean);
var
  Days: integer;
  Date: TDateTime;
  Obj: TObject;
  ts: TCustomPgTimeStamp;
begin
  PgDate := nil;
  NeedFree := False;
  try
    case VarType(Value) of
      varDate, varDouble: begin
        ts := TPgDate.Create;
        PgDate := ts;
        NeedFree := True;
        Date := Value;
        TPgDate.FromDateTime(Date, Days);
        ts.Days := Days;
      end;
      {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
      {$IFDEF CLR}
        Obj := Value;
      {$ELSE}
        Obj := TObject(TVarData(Value).VPointer);
      {$ENDIF}
        if not IsClass(Obj, TCustomPgTimeStamp) then
          raise Exception.Create(SCannotConvertType);
        PgDate := TCustomPgTimeStamp(Obj);
      end;
    else
    {$IFNDEF FPC}
      if VarType(Value) = VarSQLTimeStamp then begin
        ts := TPgDate.Create;
        PgDate := ts;
        NeedFree := True;
        TPgDate.FromSQLTimeStamp(VarToSqlTimeStamp(Value), Days);
        ts.Days := Days;
      end
      else
    {$ENDIF}
      if VarIsStr(Value) then begin
        ts := TPgDate.Create;
        PgDate := ts;
        NeedFree := True;
        TPgDate.FromString(VarToStr(Value), Days, False);
        ts.Days := Days;
      end
      else
        raise Exception.Create(SCannotConvertType);
    end;
  except
    if NeedFree then
      PgDate.Free;
    raise;
  end;
end;

class procedure TPgBufferConverter.VarToPgTime(const Value: variant; WithTimeZone: boolean;
  var PgTime: TSharedObject; var NeedFree: boolean);
var
  Ticks: int64;
  TimeZoneOffset: integer;
  Date: TDateTime;
  Obj: TObject;
  ts: TPgTime;
begin
  PgTime := nil;
  NeedFree := False;
  try
    case VarType(Value) of
      varDate, varDouble: begin
        ts := TPgTime.Create;
        PgTime := ts;
        NeedFree := True;
        Date := Value;
        TPgTime.FromDateTime(Date, Ticks);
        ts.Ticks := Ticks;
      {$IFNDEF UNIX}
        if WithTimeZone then
          ts.TimeZoneOffset := GetUtcOffset(Now);
      {$ENDIF}
      end;
      {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
      {$IFDEF CLR}
        Obj := Value;
      {$ELSE}
        Obj := TObject(TVarData(Value).VPointer);
      {$ENDIF}
        if not IsClass(Obj, TCustomPgTimeStamp) then
          raise Exception.Create(SCannotConvertType);
        PgTime := TCustomPgTimeStamp(Obj);
      end;
    else
    {$IFNDEF FPC}
      if VarType(Value) = VarSQLTimeStamp then begin
        ts := TPgTime.Create;
        PgTime := ts;
        NeedFree := True;
        TPgTime.FromSQLTimeStamp(VarToSqlTimeStamp(Value), Ticks);
        ts.Ticks := Ticks;
        if WithTimeZone then
          ts.TimeZoneOffset := GetUtcOffset(Now);
      end
      else
    {$ENDIF}
      if VarIsStr(Value) then begin
        ts := TPgTime.Create;
        PgTime := ts;
        NeedFree := True;
        TPgTime.FromString(VarToStr(Value), Ticks, TimeZoneOffset, False);
        ts.Ticks := Ticks;
        ts.TimeZoneOffset := TimeZoneOffset;
      end
      else
        raise Exception.Create(SCannotConvertType);
    end;
  except
    if NeedFree then
      PgTime.Free;
    raise;
  end;
end;

class procedure TPgBufferConverter.VarToPgTimeStamp(const Value: variant;
  var PgTimeStamp: TSharedObject; var NeedFree: boolean);
var
  Days: integer;
  Ticks: int64;
  Date: TDateTime;
  Obj: TObject;
  ts: TCustomPgTimeStamp;
begin
  PgTimeStamp := nil;
  NeedFree := False;
  try
    case VarType(Value) of
      varDate, varDouble: begin
        ts := TPgTimeStamp.Create;
        PgTimeStamp := ts;
        NeedFree := True;
        Date := Value;
        TPgTimeStamp.FromDateTime(Date, Days, Ticks);
        ts.Days := Days;
        ts.Ticks := Ticks;
      end;
      {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
      {$IFDEF CLR}
        Obj := Value;
      {$ELSE}
        Obj := TObject(TVarData(Value).VPointer);
      {$ENDIF}
        if not IsClass(Obj, TCustomPgTimeStamp) then
          raise Exception.Create(SCannotConvertType);
        PgTimeStamp := TCustomPgTimeStamp(Obj);
      end;
    else
    {$IFNDEF FPC}
      if VarType(Value) = VarSQLTimeStamp then begin
        ts := TPgTimeStamp.Create;
        PgTimeStamp := ts;
        NeedFree := True;
        TPgTimeStamp.FromSQLTimeStamp(VarToSqlTimeStamp(Value), Days, Ticks);
        ts.Days := Days;
        ts.Ticks := Ticks;
      end
      else
    {$ENDIF}
      if VarIsStr(Value) then begin
        ts := TPgTimeStamp.Create;
        PgTimeStamp := ts;
        NeedFree := True;
        TPgTimeStamp.FromString(VarToStr(Value), Days, Ticks, False);
        ts.Days := Days;
        ts.Ticks := Ticks;
      end
      else
        raise Exception.Create(SCannotConvertType);
    end;
  except
    if NeedFree then
      PgTimeStamp.Free;
    raise;
  end;
end;

class procedure TPgBufferConverter.VarToPgInterval(const Value: variant;
  var PgInterval: TSharedObject; var NeedFree: boolean);
var
  Months, Days: integer;
  Seconds: double;
  Obj: TObject;
  Int: TPgInterval;
begin
  PgInterval := nil;
  NeedFree := False;
  try
    case VarType(Value) of
      {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
      {$IFDEF CLR}
        Obj := Value;
      {$ELSE}
        Obj := TObject(TVarData(Value).VPointer);
      {$ENDIF}
        if not IsClass(Obj, TPgInterval) then
          raise Exception.Create(SCannotConvertType);
        PgInterval := TPgInterval(Obj);
      end;
    else
      if VarIsStr(Value) then begin
        Int := TPgInterval.Create;
        PgInterval := Int;
        NeedFree := True;
        TPgInterval.FromString(VarToStr(Value), Months, Days, Seconds);
        Int.MonthsFull := Months;
        Int.Days := Days;
        Int.SecondsFull := Seconds;
      end
      else
        raise Exception.Create(SCannotConvertType);
    end;
  except
    if NeedFree then
      PgInterval.Free;
    raise;
  end;
end;

class procedure TPgBufferConverter.VarToOID(const Value: variant; var OID: integer);
var
  Obj: TObject;
  Lob: TPgSQLLargeObject;
begin
  case VarType(Value) of
    {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
    {$IFDEF CLR}
      Obj := Value;
    {$ELSE}
      Obj := TObject(TVarData(Value).VPointer);
    {$ENDIF}
      if not IsClass(Obj, TPgSQLLargeObject) then
        raise Exception.Create(SCannotConvertType);
      Lob := TPgSQLLargeObject(Obj);
      OID := Lob.OID;
    end;
  else
    OID := Value;
  end;
end;

{$IFNDEF LITE}
class procedure TPgBufferConverter.VarToPgGeometric(const Value: variant; DataType: word;
  var PgGeometric: TSharedObject; var NeedFree: boolean);
var
  Obj: TObject;
begin
  PgGeometric := nil;
  NeedFree := False;
  try
    case VarType(Value) of
      {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
      {$IFDEF CLR}
        Obj := Value;
      {$ELSE}
        Obj := TObject(TVarData(Value).VPointer);
      {$ENDIF}
        if not IsClass(Obj, TPgGeometric) then
          raise Exception.Create(SCannotConvertType);

        PgGeometric := TPgGeometric(Obj);
      end;
    else
      if VarIsStr(Value) then begin
        case DataType of
          dtPgPoint:
            PgGeometric := TPgPoint.Create;
          dtPgLSeg:
            PgGeometric := TPgLSeg.Create;
          dtPgBox:
            PgGeometric := TPgBox.Create;
          dtPgPath:
            PgGeometric := TPgPath.Create;
          dtPgPolygon:
            PgGeometric := TPgPolygon.Create;
          dtPgCircle:
            PgGeometric := TPgCircle.Create;
        else
          Assert(False);
        end;
        NeedFree := True;
        TPgGeometric(PgGeometric).AsString := Value;
      end
      else
        raise Exception.Create(SCannotConvertType);
    end;
  except
    if NeedFree then
      PgGeometric.Free;
    raise;
  end;
end;

class procedure TPgBufferConverter.VarToPgRow(const Value: variant; ObjectType: TObjectType;
  var PgRow: TDBObject; var NeedFree: boolean);
var
  Obj: TObject;
begin
  PgRow := nil;
  NeedFree := False;
  try
    case VarType(Value) of
      {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
      {$IFDEF CLR}
        Obj := Value;
      {$ELSE}
        Obj := TObject(TVarData(Value).VPointer);
      {$ENDIF}
        if not IsClass(Obj, TPgRow) then
          raise Exception.Create(SCannotConvertType);

        PgRow := TPgRow(Obj);
        if (ObjectType <> nil) and (PgRow.ObjectType <> ObjectType) then
          raise Exception.Create(SCannotConvertType);
      end;
    else
      if VarIsStr(Value) then begin
        Assert(ObjectType <> nil);
        PgRow := TPgRow.Create(TPgRowType(ObjectType));
        NeedFree := True;
        TPgRow(PgRow).AsString := Value;
      end
      else
        raise Exception.Create(SCannotConvertType);
    end;
  except
    if NeedFree then
      PgRow.Free;
    raise;
  end;
end;
{$ENDIF NDEF LITE}

class procedure TPgBufferConverter.VarToCursor(const Value: variant; var CursorName: string);
var
  Obj: TObject;
  Cursor: TPgRefCursor;
begin
  case VarType(Value) of
    {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
    {$IFDEF CLR}
      Obj := Value;
    {$ELSE}
      Obj := TObject(TVarData(Value).VPointer);
    {$ENDIF}
      if not IsClass(Obj, TPgRefCursor) then
        raise Exception.Create(SCannotConvertType);
      Cursor := TPgRefCursor(Obj);
      CursorName := Cursor.CursorName;
    end;
  else
    CursorName := VarToStr(Value);
  end;
end;

class procedure TPgBufferConverter.ReadString(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
  Trim: boolean);
var
  EndPtr: IntPtr;
begin
  Source.ReadAnsiString(Dest, Size);
  if Trim then begin
    EndPtr := PtrOffset(Dest, Size - sizeof(AnsiChar));
    while (PtrCompare(EndPtr, Dest) >= 0) and
    {$IFDEF CLR}
      (Marshal.ReadByte(EndPtr) = Byte(' '))
    {$ELSE}
      (PByte(EndPtr)^ = Byte(' '))
    {$ENDIF}
    do
      EndPtr := PtrOffset(EndPtr, - sizeof(AnsiChar));
    Marshal.WriteByte(EndPtr, 1, 0);
  end;
end;

class procedure TPgBufferConverter.ReadWideString(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
  Trim: boolean);
var
  EndPtr: IntPtr;
begin
  Size := Source.ReadWideString(Dest, Size);
  if Trim then begin
    EndPtr := PtrOffset(Dest, Size - sizeof(WideChar));
    while (PtrCompare(EndPtr, Dest) >= 0) and
    {$IFDEF CLR}
      (Marshal.ReadInt16(EndPtr) = Int16(WideChar(' ')))
    {$ELSE}
      (PWord(EndPtr)^ = Word(WideChar(' ')))
    {$ENDIF}
    do
      EndPtr := PtrOffset(EndPtr, - sizeof(WideChar));
    Marshal.WriteInt16(EndPtr, sizeof(WideChar), 0);
  end;
end;

class procedure TPgBufferConverter.ReadMemo(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  Blob: TBlob;
  Piece: PPieceHeader;
  BlobData: IntPtr;
begin
  if Size = 0 then
    Exit;

  Blob := TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  Blob.AllocPiece(Piece, Size);
  try
    BlobData := PtrOffset(Piece, SizeOf(TPieceHeader));
    Source.ReadAnsiString(BlobData, Size, False);
    Piece.Used := Size;
    Blob.AppendPiece(Piece);
  except
    Blob.FreePiece(Piece);
  end;
end;

class procedure TPgBufferConverter.ReadWideMemo(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  Blob: TBlob;
  Piece: PPieceHeader;
  BlobData: IntPtr;
begin
  if Size = 0 then
    Exit;
    
  Blob := TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  Blob.AllocPiece(Piece, Size * 2);
  try
    BlobData := PtrOffset(Piece, SizeOf(TPieceHeader));
    Piece.Used := Source.ReadWideString(BlobData, Size, False);
    Blob.CompressPiece(Piece);
    Blob.AppendPiece(Piece);
  except
    Blob.FreePiece(Piece);
  end;
end;

class procedure TPgBufferConverter.ReadPgCursor(Source: TPgSQLNet; Size: integer;
  Dest: IntPtr; Connection: TPgSQLConnection);
var
  Cursor: TPgRefCursor;
  CursorName: string;
begin
  Cursor := TPgRefCursor(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  CursorName := Source.ReadString(Size);
  Cursor.Assign(Connection, CursorName);
end;

class procedure TPgBufferConverter.ReadGuid(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
begin
  Source.ReadAnsiString(Dest, Size);
end;

{ TPgBinaryConverter }

class procedure TPgBinaryConverter.WriteValue(Value: Variant; Dest: TPgSQLNet;
  DataType, SubDataType: word; ObjectType: TObjectType; Connection: TPgSQLConnection);
begin
  if VarIsNull(Value) or VarIsEmpty(Value) or (DataType = dtCursor) then
    Dest.WriteInt32(-1)
  else begin
    // PgLoader support
    case DataType of
      dtNumeric: begin
        DataType := dtFloat;
        SubDataType := dtNumeric;
      end;
      dtPgTimeTZ: begin
        DataType := dtTime;
        SubDataType := dtPgTimeTZ;
      end;
      dtPgTimeStampTZ: begin
        DataType := dtDateTime;
        SubDataType := dtPgTimeStampTZ;
      end;
    end;

    Dest.EnterSizeBlock;
    try
      case DataType of
        dtSmallInt:
          WriteSmallInt(Value, Dest);
        dtInteger:
          if SubDataType = dtOID then
            WriteOID(Value, Dest)
          else
            WriteInteger(Value, Dest);
        dtLargeInt:
          WriteBigInt(Value, Dest);
        dtFloat, dtBCD{$IFNDEF FPC}, dtFMTBCD{$ENDIF}:
          case SubDataType of
            dtPgSingle:
              WriteSingle(Value, Dest);
            dtNumeric:
              WriteNumeric(Value, Dest);
          {$IFDEF LITE}
            dtLargeint:
              WriteBigInt(Value, Dest);
          {$ENDIF}
          else
            WriteDouble(Value, Dest);
          end;
        dtCurrency:
          WriteCurrency(Value, Dest, Connection);
        dtBoolean:
          WriteBoolean(Value, Dest);
        dtString, dtExtString, dtMemo, dtBlob:
          WriteString(Value, Dest, Connection.FUseUnicode);
        dtWideString, dtExtWideString, dtWideMemo:
          WriteWideString(Value, Dest, Connection.FUseUnicode);
        dtDate, dtPgDate:
          WriteDate(Value, Dest);
        dtTime, dtPgTime, dtPgTimeTZ:
          WriteTime(Value, Dest, Connection.FIntegerDateTimes, SubDataType = dtPgTimeTZ);
        dtDateTime, dtPgTimeStamp, dtPgTimeStampTZ:
          WriteTimeStamp(Value, Dest, Connection.FIntegerDateTimes, SubDataType = dtPgTimeStampTZ);
        dtPgInterval:
          WriteInterval(Value, Dest, Connection.FIntegerDateTimes);
        dtPgLargeObject:
          WriteOID(Value, Dest);
        dtGuid:
          WriteGuid(Value, Dest);
      {$IFNDEF LITE}
        dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
          WritePgGeometric(Value, Dest, DataType);
        dtObject:
          WritePgRow(Value, Dest, ObjectType, Connection);
      {$ENDIF}
      end;
    finally
      Dest.LeaveSizeBlock;
    end;
  end;
end;

class procedure TPgBinaryConverter.WriteSmallInt(Value: Variant; Dest: TPgSQLNet);
begin
  Dest.WriteInt16(Value);
end;

class procedure TPgBinaryConverter.WriteInteger(Value: Variant; Dest: TPgSQLNet);
begin
  Dest.WriteInt32(Value);
end;

class procedure TPgBinaryConverter.WriteBigInt(Value: Variant; Dest: TPgSQLNet);
begin
  Dest.WriteInt64(Value);
end;

class procedure TPgBinaryConverter.WriteDouble(Value: Variant; Dest: TPgSQLNet);
begin
  Dest.WriteDouble(Value);
end;

class procedure TPgBinaryConverter.WriteSingle(Value: Variant; Dest: TPgSQLNet);
begin
  Dest.WriteSingle(Value);
end;

class procedure TPgBinaryConverter.StringToNumeric(const Value: string; var Numeric: TPgNumeric);
var
  p: integer;

  procedure InvalidString;
  begin
    raise EConvertError.CreateFmt('Invalid NUMERIC string: ''%s''', [Value]);
  end;

  procedure CheckLength;
  begin
    if p > Length(Value) then
      InvalidString;
  end;

  function IsDigit(c: char): boolean;
  begin
    Result := (c >= '0') and (c <= '9');
  end;

const
  MaxDigits = 1000;
var
  HaveDp: boolean;
  Digits: array [0 .. MaxDigits + 8 - 1] of byte;
  i, j, DWeight, DScale, DDigits, Exp, Offset, NDigits: integer;
begin
  p := 1;
  while (p <= Length(Value)) and (Value[p] = ' ') do
    Inc(p);

  CheckLength;
  Numeric.Sign := NUMERIC_POS;
  case Value[p] of
    '+':
      Inc(p);
    '-': begin
      Numeric.Sign := NUMERIC_NEG;
      Inc(p);
    end;
  end;

  CheckLength;
  HaveDp := False;
  if (Value[p] = '.') or (Value[p] = {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator) then begin
    HaveDp := True;
    Inc(p);
  end;

  CheckLength;
  if not IsDigit(Value[p]) then
    InvalidString;

  Digits[0] := 0;
  Digits[1] := 0;
  Digits[2] := 0;
  Digits[3] := 0;
  i := DEC_DIGITS;
  DWeight := -1;
  DScale := 0;

  while p <= Length(Value) do begin
    if IsDigit(Value[p]) then begin
      Digits[i] := Ord(Value[p]) - Ord('0');
      Inc(i);
      Inc(p);
      if HaveDp then
        Inc(DScale)
      else
        Inc(DWeight);
    end
    else
    if (Value[p] = '.') or (Value[p] = {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator) then begin
      if HaveDp then
        InvalidString;
      HaveDp := True;
      Inc(p);
    end
    else
      break;
  end;

  DDigits := i - DEC_DIGITS;
  Digits[i] := 0;
  Digits[i + 1] := 0;
  Digits[i + 2] := 0;

  if (p <= Length(Value)) and ((Value[p] = 'e') or (Value[p] = 'E')) then begin
    Inc(p);
    i := p;
    if (i <= Length(Value)) and ((Value[i] = '+') or (Value[i] = '-')) then
      Inc(i);
    while (i <= Length(Value)) and IsDigit(Value[i]) do
      Inc(i);
    if i = p then
      InvalidString;
    exp := StrToInt(Copy(Value, p, i - p));
    p := i;
    DWeight := DWeight + exp;
    DScale := DScale - exp;
    if DScale < 0 then
      DScale := 0;
  end;

  while p <= Length(Value) do begin
    if Value[p] <> ' ' then
      InvalidString;
    Inc(p);
  end;

  if DWeight >= 0 then
    Numeric.Weight := (DWeight + 1 + DEC_DIGITS - 1) div DEC_DIGITS - 1
  else
    Numeric.Weight := -((-DWeight - 1) div DEC_DIGITS + 1);

  Offset := (Numeric.Weight + 1) * DEC_DIGITS - (DWeight + 1);
  NDigits := (DDigits + Offset + DEC_DIGITS - 1) div DEC_DIGITS;
  Numeric.NDigits := NDigits;
  Numeric.DScale := DScale;
  Numeric.StartPos := 0;

  i := DEC_DIGITS - Offset;
  j := 0;
  while NDigits > 0 do begin
    Numeric.Digits[j] := ((Digits[i] * 10 + Digits[i + 1]) * 10 +
      Digits[i + 2]) * 10 + Digits[i + 3];
    i := i + DEC_DIGITS;
    Inc(j);
    Dec(NDigits);
  end;
end;

class procedure TPgBinaryConverter.IntToNumeric(Value: Int64; var Numeric: TPgNumeric);
var
  i, j: integer;
  w: word;
begin
  // Detect negation & size
  if Value < 0 then begin
    Numeric.Sign := NUMERIC_NEG;
    Value := -Value;
  end
  else
    Numeric.Sign := NUMERIC_POS;

  i := 0;
{$IFNDEF CLR}
  // for Int32 use Integer instead of Int64 for performance improving
  if Int64Rec(Value).Hi = $0 then begin
    j := Value;
    while j <> 0 do begin
      w := j mod 10000;
      Numeric.Digits[i] := w;
      j := j div 10000;
      Inc(i);
    end;
  end
  else
{$ENDIF}
    while Value <> 0 do begin
      w := Value mod 10000;
      Numeric.Digits[i] := w;
      Value := Value div 10000;
      Inc(i);
    end;

  // Save zero value
  if i = 0 then begin
    Numeric.Digits[i] := 0;
    Inc(i);
  end;

  // Reverse array
  for j := 0 to (i div 2) - 1 do begin
    w := Numeric.Digits[j];
    Numeric.Digits[j] := Numeric.Digits[i - j - 1];
    Numeric.Digits[i - j - 1] := w;
  end;

  Numeric.NDigits := i;
  Numeric.DScale := 0;
  Numeric.StartPos := 0;
  Numeric.Weight := i - 1;
end;

class procedure TPgBinaryConverter.DoubleToNumeric(Value: double; var Numeric: TPgNumeric);
{$IFNDEF CLR}
const
  DecMultiplier: array[0..3] of word = (1, 10, 100, 1000);
var
  i, j: integer;
  b: byte;
  w: word;
  e: Extended;
  FloatRec: TFloatRec;
  Digit: Integer;
{$ELSE}
var
  str: string;
{$ENDIF}
begin
{$IFNDEF CLR}
  // Convert to decimal
  e := Value;
  FloatToDecimal(FloatRec, e, fvExtended, 15, 9999);

  // Detect negation
  if FloatRec.Negative then
    Numeric.Sign := NUMERIC_NEG
  else
    Numeric.Sign := NUMERIC_POS;

  Numeric.NDigits := 0;
  Numeric.DScale := 0;
  Numeric.StartPos := 0;

  // Save integer part
  i := 0;
  j := 0;
  w := 0;
  while i < FloatRec.Exponent do begin
    b := Byte(FloatRec.Digits[i]);
    if b > 0 then begin
      b := b - Byte('0');
      Inc(i);
    end
    else
      Dec(FloatRec.Exponent);
    Digit := (FloatRec.Exponent - i) and $03;
    w := w + b * DecMultiplier[(FloatRec.Exponent - i) and $03];
    if (Digit = 0) or (i = FloatRec.Exponent) then begin
      Numeric.Digits[j] := w;
      Inc(Numeric.NDigits);
      Inc(j);
      w := 0;
    end;
  end;

  // Save zero value
  if i = 0 then begin
    Numeric.Digits[j] := 0;
    Inc(Numeric.NDigits);
    Inc(j);
  end;

  // Save float part
  i := FloatRec.Exponent;
  w := 0;
  while i <= 20 do begin
    if i >= 0 then begin
      b := Byte(FloatRec.Digits[i]);
      if b = 0 then
        break;
      b := b - Byte('0')
    end
    else
      b := 0;
    Digit := (FloatRec.Exponent - i + 3) and $03;
    Inc(i);
    w := w + b * DecMultiplier[Digit];
    Inc(Numeric.DScale);
    if (Digit = 0) or (i = 20) or ((i >= 0) and (FloatRec.Digits[i] = {$IFDEF VER17P}0{$ELSE}#0{$ENDIF})) then begin
      Numeric.Digits[j] := w;
      Inc(Numeric.NDigits);
      Inc(j);
      w := 0;
    end;
  end;

  Numeric.Weight := Numeric.NDigits - (Numeric.DScale + 3) div 4 - 1;
{$ELSE}
  str := FloatToStr(Value);
  StringToNumeric(str, Numeric);
{$ENDIF}
end;

class procedure TPgBinaryConverter.BcdToNumeric(BCD: TBCD; var Numeric: TPgNumeric);
const
  DecMultiplier: array[0..3] of word = (1, 10, 100, 1000);
var
  i, j: integer;
  b: byte;
  w: word;
  Digit, IntDigits: integer;
begin
  // Detect negation
  if IsBcdNegative(BCD) then
    Numeric.Sign := NUMERIC_NEG
  else
    Numeric.Sign := NUMERIC_POS;

  IntDigits := BCD.Precision - BCD.SignSpecialPlaces and $3F;
  Numeric.NDigits := 0;
  Numeric.DScale := 0;
  Numeric.StartPos := 0;

  // Save integer part
  i := 0;
  j := 0;
  w := 0;
  while i < IntDigits do begin
    b := BCD.Fraction[i shr 1];
    if i and 1  = 0 then
      b := b shr 4
    else
      b := b and $0F;
    Inc(i);
    Digit := (IntDigits - i) and $03;
    w := w + b * DecMultiplier[Digit];
    if Digit = 0 then begin
      Numeric.Digits[j] := w;
      Inc(Numeric.NDigits);
      Inc(j);
      w := 0;
    end;
  end;

  // Save zero value
  if i = 0 then begin
    Numeric.Digits[j] := 0;
    Inc(Numeric.NDigits);
    Inc(j);
  end;

  // Save float part
  while i < BCD.Precision do begin
    b := BCD.Fraction[i shr 1];
    if i and 1  = 0 then
      b := b shr 4
    else
      b := b and $0F;
    Digit := (IntDigits - i + 3) and $03;
    Inc(i);
    w := w + b * DecMultiplier[Digit];
    Inc(Numeric.DScale);
    if (Digit = 0) or (i = BCD.Precision) then begin
      Numeric.Digits[j] := w;
      Inc(Numeric.NDigits);
      Inc(j);
      w := 0;
    end;
  end;

  Numeric.Weight := Numeric.NDigits - (Numeric.DScale + 3) div 4 - 1;
end;

class procedure TPgBinaryConverter.StripNumeric(var Numeric: TPgNumeric);
var
  p, c: integer;
begin
  p := Numeric.StartPos;
  while (p < Numeric.StartPos + Numeric.NDigits) and (Numeric.Digits[p] = 0) do
    Inc(p);

  c := p - Numeric.StartPos;
  Numeric.Weight := Numeric.Weight - c;
  Numeric.NDigits := Numeric.NDigits - c;
  Numeric.StartPos := p;

  p := Numeric.StartPos + Numeric.NDigits - 1;
  while (p >= Numeric.StartPos) and (Numeric.Digits[p] = 0) do
    Dec(p);

  Numeric.NDigits := p - Numeric.StartPos + 1;

  if Numeric.NDigits = 0 then begin
    Numeric.Sign := NUMERIC_POS;
    Numeric.Weight := 0;
  end;
end;

class procedure TPgBinaryConverter.WriteNumeric(Value: Variant; Dest: TPgSQLNet);
var
  Numeric: TPgNumeric;
  d: Double;
  i: Integer;
  i64: Int64;
begin
  case VarType(Value) of
    varSingle, varDouble: begin
      d := Value;
      DoubleToNumeric(d, Numeric);
    end;
    varSmallint,varInteger,varByte,varWord,varShortInt:
      IntToNumeric(Integer(Value), Numeric);
    varLongWord, varInt64: begin
      i64 := Value;
      IntToNumeric(i64, Numeric);
    end;
    varCurrency:
      StringToNumeric(CurrToStr(Value), Numeric);
  else
    if VarIsStr(Value) then
      StringToNumeric(Value, Numeric)
  {$IFNDEF FPC}
    else
    if VarType(Value) = VarFMTBcd then
      BcdToNumeric(VarToBcd(Value), Numeric)
  {$ENDIF}
    else
      raise Exception.Create(SCannotConvertType);
  end;

  StripNumeric(Numeric);

  Dest.WriteWord(Numeric.NDigits);
  Dest.WriteInt16(Numeric.Weight);
  Dest.WriteWord(Numeric.Sign);
  Dest.WriteWord(Numeric.DScale);

  for i := Numeric.StartPos to Numeric.StartPos + Numeric.NDigits - 1 do
    Dest.WriteWord(Numeric.Digits[i]);
end;

class procedure TPgBinaryConverter.WriteCurrency(Value: Variant; Dest: TPgSQLNet;
  Connection: TPgSQLConnection);
var
  c: Currency;
begin
  c := Value;
  if Connection.VersionIsEqualOrHigher(8,3) then
    Dest.WriteInt64(Round(c * 100))
  else
    Dest.WriteInt32(Round(c * 100));
end;

class procedure TPgBinaryConverter.WriteBoolean(Value: Variant; Dest: TPgSQLNet);
var
  b: boolean;
begin
  b := Value;

  Dest.WriteByte(Byte(b));
end;

class procedure TPgBinaryConverter.WriteString(Value: Variant; Dest: TPgSQLNet; UseUnicode: boolean);
var
  sa: AnsiString;
  Obj: TObject;
  Blob: TBlob;
  Piece: PPieceHeader;
  BlobData: IntPtr;
{$IFNDEF CLR}
  lb, hb: integer;
{$ENDIF}
begin
  case VarType(Value) of
    {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
    {$IFDEF CLR}
      Obj := Value;
    {$ELSE}
      Obj := TObject(TVarData(Value).VPointer);
    {$ENDIF}
      if not IsClass(Obj, TBlob) then
        raise Exception.Create(SCannotConvertType);
      Blob := TBlob(Obj);
      if Blob.IsUnicode then begin
        sa := Blob.AsAnsiString;
        Dest.WriteBytes(TValueArr(sa), 0, LengthA(sa));
        exit;
      end;
      Piece := Blob.FirstPiece;
      while IntPtr(Piece) <> nil do begin
        BlobData := PtrOffset(Piece, SizeOf(TPieceHeader));
        Dest.WriteBytes(BlobData, 0, Piece.Used);
        Piece := Piece.Next;
      end;
    end;
  {$IFNDEF CLR}
    varArray or varByte: begin
      if VarArrayDimCount(Value) <> 1 then
        raise Exception.Create(SCannotConvertType);
      lb := VarArrayLowBound(Value, 1);
      hb := VarArrayHighBound(Value, 1);
      BlobData := VarArrayLock(Value);
      try
        Dest.WriteBytes(TValueArr(BlobData), 0, hb - lb + 1);
      finally
        VarArrayUnlock(Value);
      end;
    end;
  {$ENDIF}
  else
    if VarIsStr(Value) then
      if UseUnicode then
        sa := CRFunctions.Utf8Encode(WideString(Value))
      else
        sa := AnsiString(Value)
    else
      if UseUnicode then
        sa := CRFunctions.Utf8Encode(WideString(VarToStr(Value)))
      else
        sa := AnsiString(VarToStr(Value));

    Dest.WriteBytes(TValueArr(sa), 0, LengthA(sa));
  end;
end;

class procedure TPgBinaryConverter.WriteWideString(Value: Variant; Dest: TPgSQLNet; UseUnicode: boolean);
var
  sa: AnsiString;
  Obj: TObject;
  Blob: TBlob;
  Piece: PPieceHeader;
  BlobData: IntPtr;
  Utf8Buf: TBytes;
  Count: integer;
{$IFNDEF CLR}
  MaxLen: integer;
  lb, hb: integer;
{$ELSE}
  Chars: array of char;
{$ENDIF}
begin
  case VarType(Value) of
    {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
    {$IFDEF CLR}
      Obj := Value;
    {$ELSE}
      Obj := TObject(TVarData(Value).VPointer);
    {$ENDIF}
      if not IsClass(Obj, TBlob) then
        raise Exception.Create(SCannotConvertType);
      Blob := TBlob(Obj);
      if not Blob.IsUnicode then begin
        sa := CRFunctions.UTF8Encode(Blob.AsWideString);
        Dest.WriteBytes(TValueArr(sa), 0, LengthA(sa));
        exit;
      end;
      Piece := Blob.FirstPiece;
      while IntPtr(Piece) <> nil do begin
        BlobData := PtrOffset(Piece, SizeOf(TPieceHeader));
      {$IFNDEF CLR}
        MaxLen := Piece.Used div 2 * 3 + 1;
        if Length(Utf8Buf) < MaxLen then
          SetLength(Utf8Buf, MaxLen);
        Count := {$IFNDEF NEXTGEN}CRFunctions.{$ENDIF}UnicodeToUtf8(TValueArr(Utf8Buf), MaxLen, BlobData, Piece.Used div 2);
      {$ELSE}
        SetLength(Chars, Piece.Used div 2);
        Marshal.Copy(BlobData, Chars, 0, Piece.Used div 2);
        Utf8Buf := Encoding.UTF8.GetBytes(String(Chars));
        Count := Length(Utf8Buf);
      {$ENDIF}
        if Count > 0 then
          Dest.WriteBytes(TValueArr(Utf8Buf), 0, Count - 1);
        Piece := Piece.Next;
      end;
    end;
  {$IFNDEF CLR}
    varArray or varByte: begin
      if VarArrayDimCount(Value) <> 1 then
        raise Exception.Create(SCannotConvertType);
      lb := VarArrayLowBound(Value, 1);
      hb := VarArrayHighBound(Value, 1);
      BlobData := VarArrayLock(Value);
      try
        Dest.WriteBytes(TValueArr(BlobData), 0, hb - lb + 1);
      finally
        VarArrayUnlock(Value);
      end;
    end;
  {$ENDIF}
  else
    if VarIsStr(Value) then
      if UseUnicode then
        sa := CRFunctions.UTF8Encode(WideString(Value))
      else
        sa := AnsiString(Value)
    else
      if UseUnicode then
        sa := CRFunctions.UTF8Encode(WideString(VarToStr(Value)))
      else
        sa := AnsiString(VarToStr(Value));

    Dest.WriteBytes(TValueArr(sa), 0, LengthA(sa));
  end;
end;

class procedure TPgBinaryConverter.WriteOID(Value: Variant; Dest: TPgSQLNet);
var
  OID: integer;
begin
  VarToOID(Value, OID);
  Dest.WriteInt32(OID);
end;

class procedure TPgBinaryConverter.WriteDate(Value: Variant; Dest: TPgSQLNet);
var
  Obj: TSharedObject;
  ts: TCustomPgTimeStamp;
  NeedFree: boolean;
begin
  VarToPgDate(Value, Obj, NeedFree);
  try
    ts := TCustomPgTimeStamp(Obj);
    Dest.WriteInt32(ts.Days);
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

class procedure TPgBinaryConverter.WriteTime(Value: Variant; Dest: TPgSQLNet;
  IntegerDateTimes, WithTimeZone: boolean);
var
  Obj: TSharedObject;
  ts: TCustomPgTimeStamp;
  NeedFree: boolean;
begin
  VarToPgTime(Value, WithTimeZone, Obj, NeedFree);
  try
    ts := TCustomPgTimeStamp(Obj);

    if IntegerDateTimes then
      Dest.WriteInt64(ts.Ticks)
    else
      Dest.WriteDouble(ts.Ticks / McSecsPerSec);

    if WithTimeZone then
      Dest.WriteInt32(-ts.TimeZoneOffset);
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

class procedure TPgBinaryConverter.WriteTimeStamp(Value: Variant; Dest: TPgSQLNet;
  IntegerDateTimes, WithTimeZone: boolean);
var
  Obj: TSharedObject;
  ts: TCustomPgTimeStamp;
  NeedFree: boolean;
  Days: integer;
  Ticks: int64;
begin
  VarToPgTimeStamp(Value, Obj, NeedFree);
  try
    ts := TCustomPgTimeStamp(Obj);
    Days := ts.Days;
    Ticks := ts.Ticks;

  {$IFNDEF UNIX}
    if WithTimeZone and (Ticks <> High(Int64)) and (Ticks <> Low(Int64)) then
      LocalTimeToUTCTime(Days, Ticks);
  {$ENDIF}

    if IntegerDateTimes then begin
      if (Ticks = High(Int64)) or (Ticks = Low(Int64)) then
        Dest.WriteInt64(Ticks)
      else
        Dest.WriteInt64(Days * McSecsPerDay + Ticks)
    end
    else begin
      if Ticks = High(Int64) then
        Dest.WriteDouble(Infinity)
      else
      if Ticks = Low(Int64) then
        Dest.WriteDouble(-Infinity)
      else
        Dest.WriteDouble(Days * (SecsPerDay + 0.0) + Ticks / McSecsPerSec);
    end;
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

class procedure TPgBinaryConverter.WriteInterval(Value: Variant; Dest: TPgSQLNet;
  IntegerDateTimes: boolean);
var
  Obj: TSharedObject;
  Int: TPgInterval;
  NeedFree: boolean;
begin
  VarToPgInterval(Value, Obj, NeedFree);
  try
    Int := TPgInterval(Obj);

    if IntegerDateTimes then
      Dest.WriteInt64(Round(Int.SecondsFull * McSecsPerSec))
    else
      Dest.WriteDouble(Int.SecondsFull);

    Dest.WriteInt32(Int.Days);
    Dest.WriteInt32(Int.MonthsFull);
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

class procedure TPgBinaryConverter.WriteGuid(Value: Variant; Dest: TPgSQLNet);
begin
  Dest.WriteBytes(Encoding.Default.GetBytes(VarToStr(Value)));
end;

{$IFNDEF LITE}
class procedure TPgBinaryConverter.WritePgGeometric(Value: Variant; Dest: TPgSQLNet;
  DataType: word);

  procedure WritePoint(Point: TPgPoint);
  begin
    Dest.WriteDouble(Point.X);
    Dest.WriteDouble(Point.Y); 
  end;

var
  i: integer;
  Obj: TSharedObject;
  PgGeometric: TPgGeometric;
  NeedFree: boolean;
begin
  VarToPgGeometric(Value, DataType, Obj, NeedFree);
  try
    PgGeometric := TPgGeometric(Obj);

    case DataType of
      dtPgPoint:
        WritePoint(TPgPoint(PgGeometric));
      dtPgLSeg:
        with TPgLSeg(PgGeometric) do begin
          WritePoint(StartPoint);
          WritePoint(EndPoint);
        end;
      dtPgBox:
        with TPgBox(PgGeometric) do begin
          WritePoint(LowerLeft);
          WritePoint(UpperRight);
        end;
      dtPgPath:
        with TPgPath(PgGeometric) do begin
          if IsClosedPath then
            i := 1
          else
            i := 0;
          Dest.WriteByte(i);
          Dest.WriteInt32(Count);
          for i := 0 to Count - 1 do
            WritePoint(Points[i]);
        end;
      dtPgPolygon:
        with TPgPolygon(PgGeometric) do begin
          Dest.WriteInt32(Count);
          for i := 0 to Count - 1 do
            WritePoint(Points[i]);
        end;
      dtPgCircle:
        with TPgCircle(PgGeometric) do begin
          WritePoint(Center);
          Dest.WriteDouble(Radius);
        end;
    end;
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

class procedure TPgBinaryConverter.WritePgRow(Value: Variant; Dest: TPgSQLNet;
  ObjectType: TObjectType; Connection: TPgSQLConnection);
var
  Obj: TDBObject;
  Row: TPgRow;
  NeedFree: boolean;
  i: integer;
  Attr: TPgAttribute;
  AttrValue: variant;
begin
  VarToPgRow(Value, ObjectType, Obj, NeedFree);
  try
    Row := TPgRow(Obj);
    Dest.WriteInt32(ObjectType.AttributeCount);
    for i := 0 to ObjectType.AttributeCount - 1 do begin
      Attr := TPgAttribute(ObjectType.Attributes[i]);

      Dest.WriteInt32(Attr.TypeOID);

      AttrValue := Row.AttrValueEx(Attr.Name, True);
      WriteValue(AttrValue, Dest, Attr.DataType, Attr.SubDataType, Attr.ObjectType,
        Connection);
    end;
  finally
    if NeedFree then
      Obj.Free;
  end;
end;
{$ENDIF NDEF LITE}

class procedure TPgBinaryConverter.ReadValue(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
  DataType, SubDataType: word; Trim: boolean; Connection: TPgSQLConnection);
begin
  case DataType of
    dtSmallint:
      ReadInt16(Source, Dest, SubDataType);
    dtInteger:
      ReadInt32(Source, Dest, SubDataType);
    dtInt64:
      ReadInt64(Source, Dest, SubDataType);
    dtBoolean:
      ReadBoolean(Source, Dest);
    dtFloat:
      ReadDouble(Source, Dest, SubDataType);
    dtBCD:
      ReadBCD(Source, Dest);
  {$IFNDEF FPC}
    dtFMTBCD:
      ReadFMTBCD(Source, Dest);
  {$ENDIF}
    dtCurrency:
      ReadCurrency(Source, Dest, Connection);
    dtString, dtExtString:
      ReadString(Source, Size, Dest, Trim);
    dtWideString, dtExtWideString:
      ReadWideString(Source, Size, Dest, Trim);
    dtDate:
      ReadDate(Source, Dest);
    dtTime:
      ReadTime(Source, Dest, Connection.FIntegerDateTimes, SubDataType = dtPgTimeTZ);
    dtDateTime:
      ReadDateTime(Source, Dest, Connection.FIntegerDateTimes, SubDataType = dtPgTimeStampTZ);
  {$IFNDEF LITE}
    dtPgDate:
      ReadPgDate(Source, Dest);
    dtPgTime:
      ReadPgTime(Source, Dest, Connection.FIntegerDateTimes, SubDataType = dtPgTimeTZ);
    dtPgTimeStamp, dtPgTimeStampTZ:
      ReadPgTimeStamp(Source, Dest, Connection.FIntegerDateTimes, SubDataType = dtPgTimeStampTZ);
    dtPgInterval:
      ReadPgInterval(Source, Dest, Connection.FIntegerDateTimes);
  {$ENDIF}
    dtMemo:
      ReadMemo(Source, Size, Dest);
    dtWideMemo:
      ReadWideMemo(Source, Size, Dest);
    dtBlob:
      ReadBlob(Source, Size, Dest);
    dtPgLargeObject:
      ReadPgLargeObject(Source, Dest);
    dtGuid:
      ReadGuid(Source, Size, Dest);
  {$IFNDEF LITE}
    dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
      ReadPgGeometric(Source, Size, Dest, DataType);
    dtObject:
      ReadPgRow(Source, Dest, Trim, Connection);
    dtCursor:
      ReadPgCursor(Source, Size, Dest, Connection);
  {$ENDIF}
  end;
end;

class procedure TPgBinaryConverter.ReadInt16(Source: TPgSQLNet; Dest: IntPtr; SubDataType: Word);
begin
  case SubDataType of
    dtNumeric:
      ReadNumericAsInt(Source, Dest, dtInt16);
  else
    Marshal.WriteInt16(Dest, Source.ReadInt16);
  end;
end;

class procedure TPgBinaryConverter.ReadInt32(Source: TPgSQLNet; Dest: IntPtr; SubDataType: Word);
begin
  case SubDataType of
    dtNumeric:
      ReadNumericAsInt(Source, Dest, dtInt32);
  else
    Marshal.WriteInt32(Dest, Source.ReadInt32);
  end;
end;

class procedure TPgBinaryConverter.ReadInt64(Source: TPgSQLNet; Dest: IntPtr; SubDataType: Word);
begin
  case SubDataType of
    dtNumeric:
      ReadNumericAsInt(Source, Dest, dtInt64);
  else
    Marshal.WriteInt64(Dest, Source.ReadInt64);
  end;
end;

class procedure TPgBinaryConverter.ReadDouble(Source: TPgSQLNet; Dest: IntPtr; SubDataType: word);
begin
  case SubDataType of
    dtNumeric:
      ReadNumeric(Source, Dest);
    dtPgSingle:
      ReadSingle(Source, Dest);
  {$IFDEF LITE}
    dtLargeint:
      Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Source.ReadInt64));
  {$ENDIF}
  else
    Marshal.WriteByte(Dest, 7, Source.ReadByte);
    Marshal.WriteByte(Dest, 6, Source.ReadByte);
    Marshal.WriteByte(Dest, 5, Source.ReadByte);
    Marshal.WriteByte(Dest, 4, Source.ReadByte);
    Marshal.WriteByte(Dest, 3, Source.ReadByte);
    Marshal.WriteByte(Dest, 2, Source.ReadByte);
    Marshal.WriteByte(Dest, 1, Source.ReadByte);
    Marshal.WriteByte(Dest, 0, Source.ReadByte);
  end;
end;

class procedure TPgBinaryConverter.ReadBCD(Source: TPgSQLNet; Dest: IntPtr);
var
  i, c, a: integer;
  WordCount: integer;
  Weight, Sign: integer;
  Value: int64;
  w: word;
begin
  WordCount := Source.ReadWord;
  Weight := Source.ReadInt16;
  Sign := Source.ReadWord;
  Source.ReadWord; // read scale

  Value := 0;
  if WordCount > 0 then begin
    i := 0;
    while i <= Weight do begin
      w := Source.ReadWord;
      if Weight - i <= High(DecimalArrayBCD) then begin
        if Weight - i = High(DecimalArrayBCD) then
          w := w mod 100;
        Value := Value + w * DecimalArrayBCD[Weight - i];
      end;
      Inc(i);
      if i = WordCount then
        break;
    end;

    if i < WordCount then begin
      c := i;
      if Weight < 0 then
        a := -Weight
      else
        a := 1;

      for i := a to WordCount - Weight - 1 do begin
        w := Source.ReadWord;
        if i = 1 then
          Value := Value + w;
        Inc(c);
        if c = WordCount then
          break;
      end;
    end;

    if Sign > 0 then
      Value := -Value;
  end;
  Marshal.WriteInt64(Dest, Value)
end;

{$IFNDEF FPC}
class procedure TPgBinaryConverter.ReadFMTBCD(Source: TPgSQLNet; Dest: IntPtr);
var
  i, c, a, Prec, IntDigits: integer;
  WordCount: integer;
  Weight, Sign: integer;
{$IFNDEF CLR}
  Value: TBcd;
{$ELSE}
  Value: TBytes;
{$ENDIF}
  w: word;

  procedure SaveDigit(Val: byte);
  var
    p: integer;
  begin
    p := Prec div 2;
    if not Odd(Prec) then
      Val := Val shl 4;

    {$IFNDEF CLR}
      Value.Fraction[p] := Value.Fraction[p] or Val;
    {$ELSE}
      Value[p + 2] := Value[p + 2] or Val;
    {$ENDIF}
    Inc(Prec);
  end;

  procedure Save2Digits(Val: byte; RemoveZero: boolean);
  var
    hd, ld: byte;
  begin
    hd := Val div 10;
    ld := Val mod 10;

    if not (RemoveZero and (Prec = 0) and (hd = 0)) then
      SaveDigit(hd);

    SaveDigit(ld);
  end;

  procedure Save4Digits(Val: word; RemoveZero: boolean);
  var
    hd, ld: byte;
  begin
    hd := Val div 100;
    ld := Val mod 100;

    if not (RemoveZero and (Prec = 0) and (hd = 0)) then
      Save2Digits(hd, RemoveZero);

    Save2Digits(ld, RemoveZero);
  end;

  procedure RemoveTrailZeros;
  var
    p: integer;
    Val: byte;
  begin
    while Prec > IntDigits do begin
      p := (Prec - 1) div 2;
      Val := Value{$IFNDEF CLR}.Fraction[p]{$ELSE}[p + 2]{$ENDIF};
      if Odd(Prec) then
        Val := Val shr 4
      else
        Val := Val and $0F;

      if Val = 0 then
        Dec(Prec)
      else
        break;
    end;
  end;

begin
  WordCount := Source.ReadWord;
  Weight := Source.ReadInt16;
  Sign := Source.ReadWord;
  Source.ReadWord; // read scale

{$IFNDEF CLR}
  System.FillChar(Value, SizeOfTBcd, 0);
{$ELSE}
  SetLength(Value, SizeOfTBcd);
{$ENDIF}
  Prec := 0;
  IntDigits := 0;
  if WordCount > 0 then begin
    i := 0;
    while i <= Weight do begin
      w := Source.ReadWord;
      if Weight - i < 16 then
        Save4Digits(w, True);
      Inc(i);
      if i = WordCount then begin
        Inc(Prec, (Weight - i + 1) * 4);
        break;
      end;
    end;

    IntDigits := Prec;

    if i < WordCount then begin
      c := i;
      if Weight < 0 then
        a := -Weight
      else
        a := 1;

      Prec := Prec + (a - 1) * 4;

      for i := a to WordCount - Weight - 1 do begin
        w := Source.ReadWord;
        if Prec <= 63 then
          Save4Digits(w, False);
        Inc(c);
        if c = WordCount then
          break;
      end;

      RemoveTrailZeros;
    end;
  end
  else begin
    Prec := 1;
    IntDigits := 1;
  end;

{$IFNDEF CLR}
  Value.Precision := Prec;
  Value.SignSpecialPlaces := Prec - IntDigits;
  if Sign > 0 then
    Value.SignSpecialPlaces := Value.SignSpecialPlaces or $80;
  PBcd(Dest)^ := Value;
{$ELSE}
  Value[0] := Prec;
  Value[1] := Prec - IntDigits;
  if Sign > 0 then
    Value[1] := Value[1] or $80;
  Marshal.Copy(Value, 0, Dest, SizeOfTBcd);
{$ENDIF}
end;
{$ENDIF}

class procedure TPgBinaryConverter.ReadCurrency(Source: TPgSQLNet; Dest: IntPtr;
  Connection: TPgSQLConnection);
var
  d: double;
begin
  if Connection.VersionIsEqualOrHigher(8,3) then
    d := Source.ReadInt64 / 100
  else
    d := Source.ReadInt32 / 100;
  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(d));
end;

class procedure TPgBinaryConverter.ReadSingle(Source: TPgSQLNet; Dest: IntPtr);
var
  i: integer;
  d: double;
begin
  i := Source.ReadInt32;
{$IFNDEF CLR}
  d := PSingle(@i)^;
{$ELSE}
  d := BitConverter.ToSingle(BitConverter.GetBytes(i), 0);
{$ENDIF}

  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(d));
end;

class procedure TPgBinaryConverter.ReadNumeric(Source: TPgSQLNet; Dest: IntPtr);
var
  i, c, a: integer;
  WordCount: integer;
  Weight, Sign: integer;
  Value: double;
  w: word;
begin
  WordCount := Source.ReadWord;
  Weight := Source.ReadInt16;
  Sign := Source.ReadWord;
  Source.ReadWord; // read scale

  Value := 0;
  if WordCount > 0 then begin
    i := 0;
    while i <= Weight do begin
      w := Source.ReadWord;
      Value := Value + w * DecimalArray[Weight - i];
      Inc(i);
      if i = WordCount then
        break;
    end;

    if i < WordCount then begin
      c := i;
      if Weight < 0 then
        a := -Weight
      else
        a := 1;

      for i := a to WordCount - Weight - 1 do begin
        w := Source.ReadWord;
        if i < MaxDecimalWords then
          Value := Value + w / DecimalArray[i];
        Inc(c);
        if c = WordCount then
          break;
      end;
    end;

    if Sign > 0 then
      Value := -Value;
  end;
  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Value));
end;

class procedure TPgBinaryConverter.ReadNumericAsInt(Source: TPgSQLNet; Dest: IntPtr; DataType: Word);
var
  i: integer;
  WordCount: integer;
  Weight, Sign: integer;
  Value: int64;
  w: word;
begin
  WordCount := Source.ReadWord;
  Weight := Source.ReadInt16;
  Sign := Source.ReadWord;
  Source.ReadWord; // read scale

  Value := 0;
  if WordCount > 0 then begin
    i := 0;
    while i <= Weight do begin
      w := Source.ReadWord;
      if Weight - i <= High(DecimalArrayInt) then begin
        if Weight - i = High(DecimalArrayInt) then
          w := w mod 100;
        Value := Value + w * DecimalArrayInt[Weight - i];
      end;
      Inc(i);
      if i = WordCount then
        break;
    end;

    if i < WordCount then
      raise EInvalidCast.Create(SInvalidCast);

    if Sign > 0 then
      Value := -Value;
  end;

  case DataType of
    dtSmallint:
      Marshal.WriteInt16(Dest, Value);
    dtInteger:
      Marshal.WriteInt32(Dest, Value);
    dtLargeint:
      Marshal.WriteInt64(Dest, Value);
  else
    raise EInvalidCast.Create(SInvalidCast);
  end;
end;

class procedure TPgBinaryConverter.ReadBoolean(Source: TPgSQLNet; Dest: IntPtr);
begin
  Marshal.WriteInt16(Dest, Source.ReadByte);
end;

class procedure TPgBinaryConverter.ReadBlob(Source: TPgSQLNet; Size: integer;
  Dest: IntPtr);
var
  Blob: TBlob;
  BlobData: IntPtr;
  Piece: PPieceHeader;
begin
  if Size = 0 then
    Exit;

  Blob := TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  Blob.AllocPiece(Piece, Size);
  try
    BlobData := PtrOffset(Piece, SizeOf(TPieceHeader));
    Source.ReadBytes(BlobData, 0, Size);
    Piece.Used := Size;
    Blob.AppendPiece(Piece);
  except
    Blob.FreePiece(Piece);
  end;
end;

class procedure TPgBinaryConverter.ReadPgLargeObject(Source: TPgSQLNet; Dest: IntPtr);
var
  Obj: TPgSQLLargeObject;
begin
  Obj := TPgSQLLargeObject(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  Obj.OID := Source.ReadInt32;
  TPgObjectsUtils.LargeObjectResetOldOID(Obj);
end;

class procedure TPgBinaryConverter.ReadDate(Source: TPgSQLNet; Dest: IntPtr);
var
  Days: integer;
  Date: TDateTime;
begin
  Days := Source.ReadInt32;
  Date := PostgresBaseDate + Days;
  if Date < MinDateTime then
    Date := MinDateTime;

  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Date));
end;

class procedure TPgBinaryConverter.ReadTime(Source: TPgSQLNet; Dest: IntPtr;
  IntegerDateTimes, WithTimeZone: boolean);
var
  Seconds: double;
  Date: TDateTime;
begin
  if IntegerDateTimes then
    Seconds := Source.ReadInt64 / 1E6
  else
    Seconds := Source.ReadDouble;

  Date := Seconds / SecsPerDay;

  if WithTimeZone then
    Source.ReadInt32; // time zone (seconds)

  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Date));
end;

class procedure TPgBinaryConverter.ReadDateTime(Source: TPgSQLNet; Dest: IntPtr;
  IntegerDateTimes, WithTimeZone: boolean);
var
  t: Int64;
  Seconds: double;
  Date: TDateTime;
begin
  if IntegerDateTimes then begin
    t := Source.ReadInt64;
    if t = High(Int64) then
      Seconds := Infinity
    else
    if t = Low(Int64) then
      Seconds := -Infinity
    else
      Seconds := t / 1000000;
  end
  else
    Seconds := Source.ReadDouble;

  if Seconds = Infinity then
    Date := MaxDateTime
  else
  if Seconds = -Infinity then
    Date := MinDateTime
  else begin
    Date := AddTimeSpan(PostgresBaseDate, Seconds / SecsPerDay);
    if Date < MinDateTime then
      Date := MinDateTime
  {$IFNDEF UNIX}
    else
    if WithTimeZone then begin
      Date := UTCTimeToLocalTime(Date);
    end;
  {$ENDIF}
  end;

  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Date));
end;

{$IFNDEF LITE}
class procedure TPgBinaryConverter.ReadPgDate(Source: TPgSQLNet; Dest: IntPtr);
var
  d: TPgDate;
begin
  d := TPgDate(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  d.Days := Source.ReadInt32;
end;

class procedure TPgBinaryConverter.ReadPgTimeStamp(Source: TPgSQLNet; Dest: IntPtr;
  IntegerDateTimes, WithTimeZone: boolean);
var
  t: Int64;
  Seconds: double;
  ts: TPgTimeStamp;
{$IFNDEF UNIX}
  Days: integer;
  Ticks: int64;
{$ENDIF}
begin
  ts := TPgTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));

  if IntegerDateTimes then begin
    t := Source.ReadInt64;
    if (t = High(Int64)) or (t = Low(Int64)) then
      ts.Ticks := t
    else begin
      ts.Ticks := t mod McSecsPerDay;
      if ts.Ticks < 0 then
        ts.Ticks := ts.Ticks + McSecsPerDay;
      ts.Days := (t - ts.Ticks) div McSecsPerDay;
    end;
  end
  else begin
    Seconds := Source.ReadDouble;
    if Seconds = Infinity then
      ts.Ticks := High(Int64)
    else
    if Seconds = -Infinity then
      ts.Ticks := Low(Int64)
    else begin
      ts.Days := Floor(Seconds / SecsPerDay);
      ts.Ticks := Round((Seconds - ts.Days * (SecsPerDay + 0.0)) * McSecsPerSec);
    end;
  end;
  if WithTimeZone then begin
    ts.HasTimeZone := True;
  {$IFNDEF UNIX}
    if (ts.Ticks <> High(Int64)) and (ts.Ticks <> Low(Int64)) then begin
      Days := ts.Days;
      Ticks := ts.Ticks;
      UTCTimeToLocalTime(Days, Ticks);
      ts.Days := Days;
      ts.Ticks := Ticks;
    end;
  {$ENDIF}
  end;
end;

class procedure TPgBinaryConverter.ReadPgTime(Source: TPgSQLNet; Dest: IntPtr;
  IntegerDateTimes, WithTimeZone: boolean);
var
  Seconds: double;
  ts: TPgTime;
  TimeZone: integer;
{$IFNDEF UNIX}
  Days: integer;
  Ticks: int64;
{$ENDIF}
begin
  ts := TPgTime(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));

  if IntegerDateTimes then begin
    ts.Ticks := Source.ReadInt64;
  end
  else begin
    Seconds := Source.ReadDouble;
    ts.Ticks := Round(Seconds * McSecsPerSec);
  end;
  if WithTimeZone then begin
    ts.HasTimeZone := True;
    TimeZone := -Source.ReadInt32;
  {$IFNDEF UNIX}
    if (ts.Ticks <> High(Int64)) and (ts.Ticks <> Low(Int64)) then begin
      TPgTimeStamp.FromDateTime(Now, Days, Ticks);
      Ticks := ts.Ticks;
      ServerTimeToLocalTime(Days, Ticks, TimeZone);
      ts.Ticks := Ticks;
      ts.TimeZoneOffset := TimeZone;
    end;
  {$ENDIF}
  end;
end;

class procedure TPgBinaryConverter.ReadPgInterval(Source: TPgSQLNet; Dest: IntPtr;
  IntegerDateTimes: boolean);
var
  Interval: TPgInterval;
begin
  Interval := TPgInterval(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  if IntegerDateTimes then
    Interval.SecondsFull := Source.ReadInt64 / McSecsPerSec
  else
    Interval.SecondsFull := Source.ReadDouble;

  Interval.Days := Source.ReadInt32;
  Interval.MonthsFull := Source.ReadInt32;
end;

class procedure TPgBinaryConverter.ReadPgGeometric(Source: TPgSQLNet; Size: integer;
  Dest: IntPtr; DataType: word);

  procedure ReadPoint(Point: TPgPoint);
  begin
    Point.X := Source.ReadDouble;
    Point.Y := Source.ReadDouble;
  end;

var
  i: integer;
  PgGeometric: TPgGeometric;
begin
  PgGeometric := TPgGeometric(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  case DataType of
    dtPgPoint:
      ReadPoint(TPgPoint(PgGeometric));
    dtPgLSeg:
      with TPgLSeg(PgGeometric) do begin
        ReadPoint(StartPoint);
        ReadPoint(EndPoint);
      end;
    dtPgBox:
      with TPgBox(PgGeometric) do begin
        ReadPoint(LowerLeft);
        ReadPoint(UpperRight);
      end;
    dtPgPath:
      with TPgPath(PgGeometric) do begin
        i := Source.ReadByte;
        IsClosedPath := i <> 0;
        Count := Source.ReadInt32;
        for i := 0 to Count - 1 do
          ReadPoint(Points[i]);
      end;
    dtPgPolygon:
      with TPgPath(PgGeometric) do begin
        Count := Source.ReadInt32;
        for i := 0 to Count - 1 do
          ReadPoint(Points[i]);
      end;
    dtPgCircle:
      with TPgCircle(PgGeometric) do begin
        ReadPoint(Center);
        Radius := Source.ReadDouble;
      end;
  end;
end;

class procedure TPgBinaryConverter.ReadPgRow(Source: TPgSQLNet; Dest: IntPtr;
  Trim: boolean; Connection: TPgSQLConnection);
var
  Row: TPgRow;
  RowType: TPgRowType;
  Buffer, IndPtr, FieldBuf, ReadBuf, StrBuf: IntPtr;
  Count, i, Size: integer;
  Attr: TPgAttribute;
begin
  Row := TPgRow(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  RowType := Row.RowType;
  Buffer := Row.Buffer;
  IndPtr := PtrOffset(Buffer, RowType.Size);

  Count := Source.ReadInt32;
  for i := 0 to Count - 1 do begin
    Attr := TPgAttribute(RowType.Attributes[i]);

    Source.ReadInt32; // attr type OID
    Size := Source.ReadInt32;
    if Size >= 0 then begin
      FieldBuf := PtrOffset(Buffer, Attr.Offset);
      case Attr.DataType of
        dtExtString: begin
          StrBuf := Marshal.AllocHGlobal(Size + 1);
          ReadBuf := StrBuf;
        end;
        dtExtWideString: begin
          StrBuf := Marshal.AllocHGlobal((Size + 1) * 2);
          ReadBuf := StrBuf;
        end;
      else
        StrBuf := nil;
        ReadBuf := FieldBuf;
      end;
      ReadValue(Source, Size, ReadBuf, Attr.DataType, Attr.SubDataType, Trim, Connection);
      if StrBuf <> nil then
        Marshal.WriteIntPtr(FieldBuf, StrBuf);
      Marshal.WriteByte(IndPtr, i, 0);
    end
    else
      Marshal.WriteByte(IndPtr, i, Byte(-1));
  end;
end;
{$ENDIF NDEF LITE}

{ TPgTextConverter }

class function TPgTextConverter.EscapeString(const Value: string;
  StringQuote, ByteaQuote, LoaderQuote: boolean; EscapeSign: boolean): string;
var
  sa: AnsiString;
  i, Start: integer;
  sb: StringBuilder;
  c: byte;
  HasEscape: boolean;
begin
  if not (StringQuote or ByteaQuote or LoaderQuote) then begin
    Result := Value;
    exit;
  end;

  HasEscape := False;
  sa := AnsiString(Value);
  sb := StringBuilder.Create(Length(Value));
  try
    if StringQuote then
      sb.Append('''');
    Start := 1;
    for i := 1 to Length(Value) do begin
      c := byte(sa[i]{$IFDEF NEXTGEN}^{$ENDIF});
      if (c < 32) or
         (ByteaQuote and (c > 126)) or
         (c = 92{'\'}) or
         StringQuote and (c = 39{''''})
      then begin
        HasEscape := True;
        sb.Append(Value, Start - 1, i - Start);
        if c = 92{'\'} then begin
          if ByteaQuote and (StringQuote or LoaderQuote) then
            sb.Append('\\\\')
          else
            sb.Append('\\');
        end
        else if c = 39{''''} then
          sb.Append('''''')
        else begin
          if ByteaQuote and (StringQuote or LoaderQuote) then
            sb.Append('\\')
          else
            sb.Append('\');
          sb.Append(char((c shr 6) and 3 + 48));
          sb.Append(char((c shr 3) and 7 + 48));
          sb.Append(char(c and 7 + 48));
        end;
        Start := i + 1;
      end;
    end;
    sb.Append(Value, Start - 1, Length(Value) - Start + 1);
    if StringQuote then begin
      sb.Append('''');
      if EscapeSign and HasEscape then
        sb.Insert(0, 'E');
    end;
    Result := sb.ToString;
  finally
    sb.Free;
  end;
end;

class procedure TPgTextConverter.ReadValue(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
  DataType, SubDataType: word; Trim: boolean; Connection: TPgSQLConnection);
begin
  case DataType of
    dtSmallint:
      ReadInt16(Source, Size, Dest);
    dtInteger:
      ReadInt32(Source, Size, Dest);
    dtInt64:
      ReadInt64(Source, Size, Dest);
    dtBoolean:
      ReadBoolean(Source, Size, Dest);
    dtFloat:
      ReadDouble(Source, Size, Dest);
    dtBCD:
      ReadBCD(Source, Size, Dest);
  {$IFNDEF FPC}
    dtFMTBCD:
      ReadFMTBCD(Source, Size, Dest);
  {$ENDIF}
    dtCurrency:
      ReadCurrency(Source, Size, Dest);
    dtString, dtExtString:
      ReadString(Source, Size, Dest, Trim);
    dtWideString, dtExtWideString:
      ReadWideString(Source, Size, Dest, Trim, Connection.FUseUnicode);
    dtDate:
      ReadDate(Source, Size, Dest);
    dtTime:
      ReadTime(Source, Size, Dest);
    dtDateTime:
      ReadDateTime(Source, Size, Dest);
  {$IFNDEF LITE}
    dtPgDate:
      ReadPgDate(Source, Size, Dest);
    dtPgTime:
      ReadPgTime(Source, Size, Dest, SubDataType = dtPgTimeTZ);
    dtPgTimeStamp, dtPgTimeStampTZ:
      ReadPgTimeStamp(Source, Size, Dest, SubDataType = dtPgTimeStampTZ);
    dtPgInterval:
      ReadPgInterval(Source, Size, Dest);
  {$ENDIF}
    dtMemo:
      ReadMemo(Source, Size, Dest);
    dtWideMemo:
      ReadWideMemo(Source, Size, Dest);
    dtBlob:
      if Connection.FByteaOutputAsHex then
        TPgTextConverter.ReadBlobAsHex(Source, Size, Dest)
      else
        ReadBlob(Source, Size, Dest);
    dtPgLargeObject:
      ReadPgLargeObject(Source, Size, Dest);
    dtGuid:
      ReadGuid(Source, Size, Dest);
  {$IFNDEF LITE}
    dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
      ReadPgGeometric(Source, Size, Dest);
    dtObject:
      ReadPgRow(Source, Size, Dest);
    dtCursor:
      ReadPgCursor(Source, Size, Dest, Connection);
  {$ENDIF}
  end;
end;

class procedure TPgTextConverter.ReadWideString(Source: TPgSQLNet; Size: integer; Dest: IntPtr; Trim, UseUnicode: boolean);
var
  EndPtr: IntPtr;
  s: WideString;
{$IFDEF CLR}
  b: TBytes;
{$ENDIF}
begin
  s := Source.ReadWideString(Size);
  Size := Length(s) * sizeof(WideChar);
{$IFDEF CLR}
  b := Encoding.Unicode.GetBytes(s);
  Marshal.Copy(b, 0, Dest, Size);
{$ELSE}
  if s <> '' then
    Move(s[1], Dest^, Size);
{$ENDIF}
  Marshal.WriteInt16(Dest, Size, 0);
  if Trim then begin
    EndPtr := PtrOffset(Dest, Size - sizeof(WideChar));
    while (PtrCompare(EndPtr, Dest) >= 0) and
    {$IFDEF CLR}
      (Marshal.ReadInt16(EndPtr) = Int16(WideChar(' ')))
    {$ELSE}
      (PWord(EndPtr)^ = Word(WideChar(' ')))
    {$ENDIF}
    do
      EndPtr := PtrOffset(EndPtr, - sizeof(WideChar));
    Marshal.WriteInt16(EndPtr, sizeof(WideChar), 0);
  end;
end;

class function TPgTextConverter.GetInt64(Source: TPgSQLNet; Size: integer): Int64;
var
  s: string;
begin
  s := Source.ReadString(Size);
  Result := StrToInt64(s);
end;

class procedure TPgTextConverter.ReadInt16(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
begin
  Marshal.WriteInt16(Dest, GetInt64(Source, Size));
end;

class procedure TPgTextConverter.ReadInt32(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
begin
  Marshal.WriteInt32(Dest, GetInt64(Source, Size));
end;

class procedure TPgTextConverter.ReadInt64(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
begin
  Marshal.WriteInt64(Dest, GetInt64(Source, Size));
end;

class procedure TPgTextConverter.ReadDouble(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  Value: Double;
  s: string;
{$IFDEF VER7P}
  FmtSet: TFormatSettings;
{$ENDIF}
begin
  s := Source.ReadString(Size);
{$IFDEF VER7P}
  FmtSet.DecimalSeparator := '.';
  Value := StrToFloat(s, FmtSet);
{$ELSE}
  if DecimalSeparator <> '.' then
    s := StringReplace(s, '.', DecimalSeparator, []);
  Value := StrToFloat(s);
{$ENDIF}

  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Value));
end;

class procedure TPgTextConverter.ReadBCD(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  s: string;
{$IFDEF VER7P}
  FmtSet: TFormatSettings;
{$ENDIF}
  Value: currency;
  i64: int64;
begin
  s := Source.ReadString(Size);
{$IFDEF VER7P}
  FmtSet.DecimalSeparator := '.';
  Value := StrToCurr(s, FmtSet);
{$ELSE}
  if DecimalSeparator <> '.' then
    s := StringReplace(s, '.', DecimalSeparator, []);
  Value := StrToCurr(s);
{$ENDIF}
{$IFDEF CLR}
  i64 := Decimal.ToOACurrency(Value);
{$ELSE}
  i64 := PInt64(@Value)^;
{$ENDIF}
  Marshal.WriteInt64(Dest, i64);
end;

{$IFNDEF FPC}
class procedure TPgTextConverter.ReadFMTBCD(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  s: string;
  Value: TBcd;
{$IFDEF CLR}
  b: TBytes;
{$ENDIF}
begin
  s := Source.ReadString(Size);
  if {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator <> '.' then
    s := StringReplace(s, '.', {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator, []);
  Value := StrToBcd(s);
{$IFDEF CLR}
  b := TBcd.ToBytes(Value);
  Marshal.Copy(b, 0, Dest, SizeOfTBcd);
{$ELSE}
  PBcd(Dest)^ := Value;
{$ENDIF}
end;
{$ENDIF}

class procedure TPgTextConverter.ReadCurrency(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  b: Byte;
  i: integer;
  IsNegative: boolean;
  Value: integer;
begin
  Value := 0;
  IsNegative := False;
  for i := 1 to Size do begin
    b := Source.ReadByte;
    case b of
      ord('-'):
        IsNegative := True;
      ord('+'), ord('$'), ord(','), ord('.'):;
      ord('0')..ord('9'):
        Value := Value * 10 + b - Ord('0');
    end;
  end;
  if IsNegative then
    Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(- Value / 100))
  else
    Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Value / 100))
end;

class procedure TPgTextConverter.ReadBoolean(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  s: string;
  b: boolean;
begin
  s := Source.ReadString(Size);
  b := (s = 't');
  Marshal.WriteInt16(Dest, Smallint(b));
end;

class procedure TPgTextConverter.ReadBlob(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  Blob: TBlob;
  BlobData: IntPtr;
  Piece: PPieceHeader;
  ReadPos: integer;
  WritePos: integer;
begin
  if Size = 0 then
    Exit;

  Blob := TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  Blob.AllocPiece(Piece, Size);
  try
    BlobData := PtrOffset(Piece, SizeOf(TPieceHeader));

    Source.ReadBytes(BlobData, 0, Size);

    ReadPos := 0;
    WritePos := 0;
    while ReadPos < Size do begin
      if Marshal.ReadByte(BlobData, ReadPos) = Ord('\') then begin
        if Marshal.ReadByte(BlobData, ReadPos + 1) = Ord('\') then begin
          Marshal.WriteByte(BlobData, WritePos, Ord('\'));
          Inc(ReadPos);
        end  
        else begin
          Marshal.WriteByte(BlobData, WritePos,
            (Marshal.ReadByte(BlobData, ReadPos + 1) - 48) * 64 +
            (Marshal.ReadByte(BlobData, ReadPos + 2) - 48) * 8 +
            Marshal.ReadByte(BlobData, ReadPos + 3) - 48);
          Inc(ReadPos, 3);
        end;
      end
      else
      if ReadPos <> WritePos then
        Marshal.WriteByte(BlobData, WritePos, Marshal.ReadByte(BlobData, ReadPos));
      Inc(ReadPos);
      Inc(WritePos);
    end;

    Piece.Used := WritePos;
    Blob.CompressPiece(Piece);
    Blob.AppendPiece(Piece);
  except
    Blob.FreePiece(Piece);
  end;
end;

class procedure TPgTextConverter.ReadBlobAsHex(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  Blob: TBlob;
  BlobData: IntPtr;
  Piece: PPieceHeader;
{$IFDEF CLR}
  Data: TBytes;
{$ENDIF}
begin
  if Size = 0 then
    Exit;

  Blob := TBlob(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  Blob.AllocPiece(Piece, Size);
  try
    BlobData := PtrOffset(Piece, SizeOf(TPieceHeader));

    Source.ReadBytes(BlobData, 0, Size);

  {$IFDEF CLR}
    Marshal.Copy(BlobData, Data, 2, Size - 2);
    HexToBin(Data, 0, Data, 0, (Size - 2) div 2);
    Marshal.Copy(Data, 0, BlobData, (Size - 2) div 2);
  {$ELSE}
    HexToBin({$IFNDEF NEXTGEN}PAnsiChar{$ELSE}PChar{$ENDIF}(PtrOffset(BlobData,  2)), BlobData, (Size - 2) div 2);
  {$ENDIF}

    Piece.Used := (Size - 2) div 2;
    Blob.CompressPiece(Piece);
    Blob.AppendPiece(Piece);
  except
    Blob.FreePiece(Piece);
  end;
end;

class procedure TPgTextConverter.ReadPgLargeObject(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  Obj: TPgSQLLargeObject;
begin
  Obj := TPgSQLLargeObject(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  Obj.OID := GetInt64(Source, Size);
  TPgObjectsUtils.LargeObjectResetOldOID(Obj);
end;

class procedure TPgTextConverter.ReadDate(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  s: string;
  Days: integer;
  Date: TDateTime;
begin
  s := Source.ReadString(Size);
  TPgDate.FromString(s, Days, True);
  Date := TPgDate.ToDateTime(Days);

  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Date));
end;

class procedure TPgTextConverter.ReadTime(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  s: string;
  Ticks: int64;
  TZOffset: integer;
  Date: TDateTime;
begin
  s := Source.ReadString(Size);
  TPgTime.FromString(s, Ticks, TZOffset, True);
  Date := TPgTime.ToDateTime(Ticks);

  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Date));
end;

class procedure TPgTextConverter.ReadDateTime(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  s: string;
  Days: integer;
  Ticks: int64;
  Date: TDateTime;
begin
  s := Source.ReadString(Size);
  TPgTimeStamp.FromString(s, Days, Ticks, True);
  Date := TPgTimeStamp.ToDateTime(Days, Ticks);

  Marshal.WriteInt64(Dest, BitConverter.DoubleToInt64Bits(Date));
end;

{$IFNDEF LITE}
class procedure TPgTextConverter.ReadPgDate(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  d: TPgDate;
  s: string;
  Days: integer;
begin
  d := TPgDate(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  s := Source.ReadString(Size);
  TPgDate.FromString(s, Days, True);
  d.Days := Days;
end;

class procedure TPgTextConverter.ReadPgTime(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
  WithTimeZone: boolean);
var
  ts: TPgTime;
  s: string;
  tz: integer;
  Ticks: int64;
begin
  ts := TPgTime(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  s := Source.ReadString(Size);
  TPgTime.FromString(s, Ticks, tz, True);
  ts.Ticks := Ticks;
  if WithTimeZone then begin
    ts.HasTimeZone := True;
    ts.TimeZoneOffset := tz;
  end;
end;

class procedure TPgTextConverter.ReadPgTimeStamp(Source: TPgSQLNet; Size: integer; Dest: IntPtr;
  WithTimeZone: boolean);
var
  ts: TPgTimeStamp;
  s: string;
  Days: integer;
  Ticks: int64;
begin
  ts := TPgTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  s := Source.ReadString(Size);
  TPgTimeStamp.FromString(s, Days, Ticks, True);
  ts.Days := Days;
  ts.Ticks := Ticks;

  if WithTimeZone then
    ts.HasTimeZone := True;
end;

class procedure TPgTextConverter.ReadPgInterval(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  Interval: TPgInterval;
  s: string;
  Months, Days: integer;
  Seconds: double;
begin
  s := Source.ReadString(Size);
  Interval := TPgInterval(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  TPgInterval.FromString(s, Months, Days, Seconds);
  Interval.MonthsFull := Months;
  Interval.Days := Days;
  Interval.SecondsFull := Seconds;
end;

class procedure TPgTextConverter.ReadPgGeometric(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  Obj: TPgGeometric;
  s: string;
begin
  Obj := TPgGeometric(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  s := Source.ReadString(Size);
  Obj.AsString := s;
end;

class procedure TPgTextConverter.ReadPgRow(Source: TPgSQLNet; Size: integer; Dest: IntPtr);
var
  Obj: TPgRow;
  s: string;
begin
  Obj := TPgRow(GetGCHandleTarget(Marshal.ReadIntPtr(Dest)));
  s := Source.ReadString(Size);
  Obj.AsString := s;
end;
{$ENDIF}

class function TPgTextConverter.ValueToText(const Value: variant; DataType: word; SubDataType: Word;
  UseUnicode: boolean; Quote: boolean; LoaderQuote: boolean; EscapeSign: boolean): string;

  procedure ReplaceSeparator;
  var
    p: integer;
  begin
    if {$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator <> '.' then begin
      p := Pos({$IFDEF VER16P}FormatSettings.{$ENDIF}DecimalSeparator, Result);
      if p > 0 then
        Result[p] := '.';
    end;
  end;

var
  i64: int64;
{$IFNDEF FPC}
  bcd: TBcd;
{$ENDIF}
{$IFDEF VER7P}
  FmtSet: TFormatSettings;
{$ENDIF}
begin
{$IFDEF VER7P}
  FmtSet.DecimalSeparator := '.';
{$ENDIF}
  case DataType of
    dtSmallint: begin
      Result := IntToStr(Smallint(Value));
    {$IFNDEF LITE}
      Quote := False;
    {$ENDIF}
    end;
    dtInteger: begin
      Result := IntToStr(Integer(Value));
    {$IFNDEF LITE}
      Quote := False;
    {$ENDIF}
    end;
    dtLargeInt: begin
      i64 := Value;
      Result := IntToStr(i64);
    {$IFNDEF LITE}
      Quote := False;
    {$ENDIF}
    end;
    dtUInt8: begin
      Result := IntToStr({$IFDEF VER12P}byte{$ELSE}Smallint{$ENDIF}(Value));
    {$IFNDEF LITE}
      Quote := False;
    {$ENDIF}
    end;
    dtUInt16: begin
      Result := IntToStr(Word(Value));
    {$IFNDEF LITE}
      Quote := False;
    {$ENDIF}
    end;
    dtUInt32: begin
      Result := IntToStr(LongWord(Value));
    {$IFNDEF LITE}
      Quote := False;
    {$ENDIF}
    end;
    dtFloat,
    dtNumeric,
    dtPgSingle: begin
      Result := FloatToStr(Extended(Value){$IFDEF VER7P}, FmtSet{$ENDIF});
    {$IFNDEF VER7P}
      ReplaceSeparator;
    {$ENDIF}
    {$IFNDEF LITE}
      Quote := False;
    {$ENDIF}
    end;
    dtCurrency: begin
      Result := FormatFloat('#################.##', Extended(Value){$IFDEF VER7P}, FmtSet{$ENDIF});
    {$IFNDEF VER7P}
      ReplaceSeparator;
    {$ENDIF}
    end;
    dtBCD: begin
      Result := CurrToStr(Currency(Value){$IFDEF VER7P}, FmtSet{$ENDIF});
    {$IFNDEF VER7P}
      ReplaceSeparator;
    {$ENDIF}
    {$IFNDEF LITE}
      Quote := False;
    {$ENDIF}
    end;
  {$IFNDEF FPC}
    dtFMTBCD: begin
      VarToFmtBcd(Value, Bcd);
      Result := BcdToStr(Bcd);
      ReplaceSeparator;
    {$IFNDEF LITE}
      Quote := False;
    {$ENDIF}
    end;
  {$ENDIF}
    dtBoolean:
      Result := BooleanToText(Value);
    dtUnknown, dtString, dtWideString, dtExtString, dtExtWideString:
      if UseUnicode then
        Result := {$IFNDEF IS_UNICODE}CRFunctions.UTF8Encode(WideString{$ELSE}({$ENDIF}(Value))
      else
        Result := Value;
    dtBlob, dtMemo, dtWideMemo:
      Result := BlobToText(Value, (DataType <> dtBlob) and UseUnicode);
    dtDate, dtPgDate:
      Result := DateToText(Value);
    dtTime, dtPgTime, dtPgTimeTZ:
      if SubDataType = dtPgTimeTZ then
        Result := TimeToText(Value, True)
      else
        Result := TimeToText(Value, False);
    dtDateTime, dtPgTimeStamp, dtPgTimeStampTZ:
      if SubDataType = dtPgTimeStampTZ then
        Result := TimeStampToText(Value, True)
      else
        Result := TimeStampToText(Value, True);
    dtPgLargeObject: begin
      Result := LargeObjectToText(Value);
      Quote := False;
    end;
    dtGuid:
      Result := GUIDToText(Value);
  {$IFNDEF LITE}
    dtPgInterval:
      Result := IntervalToText(Value);
    dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
      Result := PgGeometricToText(Value, DataType);
    dtObject:
      Result := PgRowToText(Value);
  {$ENDIF}
    dtCursor:
      Result := CursorToText(Value, UseUnicode);
  else
    Assert(False);
  end;

  Result := EscapeString(Result, Quote, DataType = dtBlob, LoaderQuote, EscapeSign);
end;

class function TPgTextConverter.BooleanToText(const Value: variant): string;
var
  b: boolean;
begin
  b := Value;
  if b then
    Result := 't'
  else
    Result := 'f';
end;

class function TPgTextConverter.BlobToText(const Value: variant; UseUnicode: boolean): string;
var
  Obj: TObject;
  Blob: TBlob;
  ws: WideString;
{$IFNDEF CLR}
  BlobData: IntPtr;
  lb, hb: integer;
{$ENDIF}
begin
  case VarType(Value) of
    {$IFDEF CLR}varObject{$ELSE}varByRef{$IFDEF FPC} or varVariant{$ENDIF}{$ENDIF}: begin
    {$IFDEF CLR}
      Obj := Value;
    {$ELSE}
      Obj := TObject(TVarData(Value).VPointer);
    {$ENDIF}
      if not IsClass(Obj, TBlob) then
        raise Exception.Create(SCannotConvertType);
      Blob := TBlob(Obj);
      if UseUnicode then begin
        ws := Blob.AsWideString;
        Result := {$IFNDEF IS_UNICODE}CRFunctions.UTF8Encode{$ENDIF}(ws);
      end
      else
        Result := Blob.AsString;
    end;
  {$IFNDEF CLR}
    varArray or varByte: begin
      if VarArrayDimCount(Value) <> 1 then
        raise Exception.Create(SCannotConvertType);
      lb := VarArrayLowBound(Value, 1);
      hb := VarArrayHighBound(Value, 1);
      BlobData := VarArrayLock(Value);
      try
        SetLength(Result, hb - lb + 1);
        Move(BlobData^, IntPtr(Result)^, hb - lb + 1);
      finally
        VarArrayUnlock(Value);
      end;
    end;
  {$ENDIF}
  else
    if VarIsStr(Value) then begin
      if UseUnicode then
        Result := {$IFNDEF IS_UNICODE}CRFunctions.UTF8Encode{$ENDIF}(Value)
      else
        Result := Value;
    end
    else
      raise Exception.Create(SCannotConvertType);
  end;
end;

class function TPgTextConverter.DateToText(const Value: variant): string;
var
  Obj: TSharedObject;
  NeedFree: boolean;
  ts: TCustomPgTimeStamp;
begin
  VarToPgDate(Value, Obj, NeedFree);
  try
    ts := TCustomPgTimeStamp(Obj);
    Result := TPgDate.ConvertToString(ts.Days, 'YYYY-MM-DD');
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

class function TPgTextConverter.TimeToText(const Value: variant; HasTimeZone: boolean): string;
var
  Obj: TSharedObject;
  NeedFree: boolean;
  ts: TCustomPgTimeStamp;
begin
  VarToPgTime(Value, True, Obj, NeedFree);
  try
    ts := TCustomPgTimeStamp(Obj);
    Result := TPgTime.ConvertToString(ts.Ticks, HasTimeZone, ts.TimeZoneOffset, 'HH:NN:SS.ZZZZZZ');
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

class function TPgTextConverter.TimeStampToText(const Value: variant; HasTimeZone: boolean): string;
var
  Obj: TSharedObject;
  NeedFree: boolean;
  ts: TCustomPgTimeStamp;
  tz: integer;
begin
  VarToPgTimeStamp(Value, Obj, NeedFree);
  try
    ts := TCustomPgTimeStamp(Obj);

    if ts.Ticks = High(Int64) then
      Result := 'infinity'
    else
    if ts.Ticks = Low(Int64) then
      Result := '-infinity'
    else begin
    {$IFNDEF UNIX}
      tz := GetUTCOffset(TPgTimeStamp.ToDateTime(ts.Days, ts.Ticks));
    {$ELSE}
      tz := 0;
    {$ENDIF}
      Result := TPgTimeStamp.ConvertToString(ts.Days, ts.Ticks, HasTimeZone, tz,
        'YYYY-MM-DD HH:NN:SS.ZZZZZZ');
    end;
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

class function TPgTextConverter.IntervalToText(const Value: variant): string;
var
  Obj: TSharedObject;
  NeedFree: boolean;
  Int: TPgInterval;
begin
  VarToPgInterval(Value, Obj, NeedFree);
  try
    Int := TPgInterval(Obj);
    Result := TPgInterval.ConvertToString(Int.MonthsFull, Int.Days, Int.SecondsFull);
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

class function TPgTextConverter.LargeObjectToText(const Value: variant): string;
var
  OID: integer;
begin
  VarToOID(Value, OID);
  Result := IntToStr(OID);
end;

class function TPgTextConverter.GUIDToText(const Value: variant): string;
begin
  Result := Value;
end;

{$IFNDEF LITE}
class function TPgTextConverter.PgGeometricToText(const Value: variant; DataType: word): string;
var
  Obj: TSharedObject;
  NeedFree: boolean;
  PgGeometric: TPgGeometric;
begin
  VarToPgGeometric(Value, DataType, Obj, NeedFree);
  PgGeometric := TPgGeometric(Obj);
  Result := PgGeometric.AsString;
end;

class function TPgTextConverter.PgRowToText(const Value: variant): string;
var
  Obj: TDBObject;
  NeedFree: boolean;
  PgRow: TPgRow;
begin
  VarToPgRow(Value, nil, Obj, NeedFree);
  Assert(not NeedFree);
  PgRow := TPgRow(Obj);
  Result := PgRow.AsString;
end;
{$ENDIF}

class function TPgTextConverter.CursorToText(const Value: variant; UseUnicode: boolean): string;
var
  CursorName: string;
begin
  VarToCursor(Value, CursorName);
  if UseUnicode then
    Result := {$IFNDEF IS_UNICODE}CRFunctions.UTF8Encode{$ENDIF}(CursorName)
  else
    Result := CursorName;
end;

{ TPgSQLConnection }

constructor TPgSQLConnection.Create;
begin
  inherited;

  FProtocolVersion := pv30;
  FTypes := TPgSQLTypes.Create(Self);
  GetPrecAndScale(BCDPrecision, FBCDPrecision, FBCDScale);
{$IFNDEF CLR}
  FIPVersion := ivIPv4;
{$ENDIF}
end;

destructor TPgSQLConnection.Destroy;
begin
  Disconnect; // FProtocol must be Free here

  FCommand.Free;
  FTypes.Free;
  FFetchConnection.Free;
{$IFNDEF LITE}
  FAuxConnection.Free;
  FNotificationsHandler.Free;
{$ENDIF}

  SetLength(FSchemas, 0);

  inherited;
end;

function TPgSQLConnection.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDatabase:
      FDatabase := Value;
    prPort:
      FPort := Value;
    prUseUnicode:
      if Value <> FUseUnicode then begin
        FUseUnicode := Value;
        if GetConnected then
          SetClientEncoding;
      end;
    prCharset:
      if Value <> FCharset then begin
        FCharset := Trim(Value);
        if GetConnected then
          SetClientEncoding;
      end;
    prSchema: begin
      if Value <> FSchema then begin
        if GetConnected then
          SetCurrentSchema(Value);
        FSchema := Value;
      end;
    end;
    prProtocolVersion:
      FProtocolVersion := TProtocolVersion(Value);
    prEnablePgTimeStamps:
      FEnablePgTimeStamps := Value;
    prIntervalAsString:
      FIntervalAsString := Value;
    prEnableGeometrics:
      FEnableGeometrics := Value;
    prEnableComposites:
      FEnableComposites := Value;
    prEnableDomains:
      FEnableDomains := Value;
    prConnectionTimeout: begin
      FConnectionTimeout := Value;
      if FConnected then
        FProtocol.SetTimeout(FConnectionTimeout);
    end;
  {$IFNDEF CLR}
    prIPVersion:
      FIPVersion := Value;
  {$ENDIF}
    prSSL_Mode:
      FSSL_Mode := TSSLMode(Integer(Value));
    prSSL_CACert:
      FSSL_CACert := Value;
    prSSL_Cert:
      FSSL_Cert := Value;
    prSSL_Key:
      FSSL_Key := Value;
    prSSL_CipherList:
      FSSL_CipherList := Value;
    prApplicationName:
      FApplicationName := Value;  
    prBCDPrecision:
      GetPrecAndScale(Value, FBCDPrecision, FBCDScale);
    prLastInsertId:
      FLastInsertId := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TPgSQLConnection.GetProp(Prop: integer; out Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prDatabase:
      Value := FDatabase;
    prSchema:
      Value := FSchema;
    prUseUnicode:
      Value := FUseUnicode;
    prProtocolVersion:
      Value := Variant(FProtocolVersion);
    prEnablePgTimeStamps:
      Value := FEnablePgTimeStamps;
    prIntervalAsString:
      Value := FIntervalAsString;
    prEnableGeometrics:
      Value := FEnableGeometrics;
    prEnableComposites:
      Value := FEnableComposites;
    prEnableDomains:
      Value := FEnableDomains;
    prConnectionTimeout:
      Value := FConnectionTimeout;
    prLastInsertId:
      Value := FLastInsertId;
  else
    Result := inherited GetProp(Prop, Value);
  end
end;

function TPgSQLConnection.CheckIsValid: boolean;
begin
  if not FIsValid then
    Result := False
  else begin
    try
      FProtocol.Ping;
    except
      FIsValid := False;
    end;
    Result := FIsValid;
  end;
end;

{$IFNDEF LITE}
procedure TPgSQLConnection.ReturnToPool;
begin
  inherited;

  FOnNotice := nil;
  FOnNotification := nil;
end;
{$ENDIF}

procedure TPgSQLConnection.Connect(const ConnectString: string);

  procedure InternalConnect(ProtocolClass: TPgSQLProtocolClass;
    SuppressError: boolean);
  var
    Port: integer;
  begin
    FProtocol := ProtocolClass.Create;
    try
      FProtocol.SetSSLOptions(_TSSLMode(FSSL_Mode),
        {$IFNDEF LITE}FIOHandler{$ELSE}nil{$ENDIF},
        FSSL_CACert, FSSL_Cert, FSSL_Key, FSSL_CipherList);

      Port := FPort;
      if Port = 0 then
        Port := PG_DEFAULT_PORT;

      FProtocol.Connect(FServer, Port, FConnectionTimeout,
        FDatabase, FUserName, FPassword, FApplicationName{$IFNDEF CLR}, FIPVersion{$ENDIF});
    except
      on E: Exception do begin
        FProtocol.Free;
        FProtocol := nil;
        if E is EPgError then begin
          if not SuppressError then
            ProcessInternalException(EPgError(E), Component);
        end
        else
          raise;
      end;
    end;
  end;

begin
  if FConnected then
    Exit;

  try
    case FProtocolVersion of
      pv20:
        InternalConnect(TPgSQLProtocol20, False);
      pv30:
        InternalConnect(TPgSQLProtocol30, False);
    else
      Assert(False);
    end;

    FConnected := True;
    FNativeConnection := True;

    FProtocol.OnNotice := DoOnNotice;
    FProtocol.OnNotification := DoOnNotification;

    SetClientEncoding;
    GetIntegerDateTimes;
    GetByteaOutput;

    if FSchema <> '' then
      SetCurrentSchema(FSchema);

    inherited;

  except
    on EFailOver do;
    else begin
      try
        Disconnect;
      except
      end;
      raise;
    end
  end;
end;

procedure TPgSQLConnection.Disconnect;
begin
  if not FConnected then
    exit;

  FCachedSchema := '';
  FConnected := False;

  if FNativeConnection then
    try
      FProtocol.Disconnect;
    finally
      FProtocol.Free;
      FProtocol := nil;
    end;

  if FFetchConnection <> nil then
    FFetchConnection.Disconnect;
{$IFNDEF LITE}
  if FAuxConnection <> nil then
    FAuxConnection.Disconnect;
{$ENDIF}

  inherited;
end;

procedure TPgSQLConnection.Ping;
begin
  FProtocol.Ping(False);
end;

procedure TPgSQLConnection.Assign(Source: TCRConnection);
var
  Src: TPgSQLConnection;
begin
  inherited;

  Src := TPgSQLConnection(Source);
  FDatabase := Src.FDatabase;
  FPort := Src.FPort;
  FProtocolVersion := Src.FProtocolVersion;
  FConnectionTimeout := Src.FConnectionTimeout;
  FSSL_Mode := Src.FSSL_Mode;
  FSSL_CACert := Src.FSSL_CACert;
  FSSL_Cert := Src.FSSL_Cert;
  FSSL_Key := Src.FSSL_Key;
  FSSL_CipherList := Src.FSSL_CipherList;
  FUseUnicode := Src.FUseUnicode;
  FCharset := Src.FCharset;
  FSchema := Src.FSchema;
  FEnablePgTimeStamps := Src.FEnablePgTimeStamps;
  FIntervalAsString := Src.FIntervalAsString;
  FEnableGeometrics := Src.FEnableGeometrics;
  FEnableComposites := Src.FEnableComposites;
  FEnableDomains := Src.FEnableDomains;
  FBCDPrecision := Src.FBCDPrecision;
  FBCDScale := Src.FBCDScale;
  FApplicationName := Src.FApplicationName;
{$IFNDEF CLR}
  FIPVersion := Src.FIPVersion;
{$ENDIF}
  FIntegerDateTimes := Src.FIntegerDateTimes;
end;

procedure TPgSQLConnection.AssignConnect(Source: TCRConnection);
var
  Src: TPgSQLConnection;
begin
  if Source <> Self then begin
    Disconnect;
    if Source <> nil then begin
      Src := TPgSQLConnection(Source);
      Assign(Src);
      FProtocol := Src.FProtocol;
      FInternalTransaction.AssignConnect(Src.FInternalTransaction);
      FConnected := FProtocol <> nil;
      FNativeConnection := False;
    end;
  end;
end;

function TPgSQLConnection.GetSchemaNamesForSQL(Flag: integer): string;
const
  ListDelimiters: array[0..1] of string = (',', ' ');
var
  i: integer;
  s: string;
begin
  Result := '';
  for i := Low(FSchemas) to High(FSchemas) do begin
    if Result <> '' then
      Result := Result + ListDelimiters[Flag];
    s := PgSQLInfo.Quote(FSchemas[i], char(''''), char(''''));
    case Flag of
      0: Result := Result + s;
      1: Result := Result + 'WHEN ' + s + ' THEN ' + IntToStr(i);
    end;
  end;
end;

function TPgSQLConnection.GetServerVersion: string;
begin
  Result := FProtocol.ServerVersion;
end;

function TPgSQLConnection.GetServerVersionFull: string;
begin
  Result := FProtocol.ServerVersionFull;
end;

function TPgSQLConnection.GetClientVersion: string;
begin
  Result := '8.0 Direct';
end;

function TPgSQLConnection.GetMajorServerVersion: integer;
begin
  if GetConnected then
    Result := FProtocol.MajorServerVersion
  else
    Result := 0;  
end;

function TPgSQLConnection.GetMinorServerVersion: integer;
begin
  if GetConnected then
    Result := FProtocol.MinorServerVersion
  else
    Result := 0;  
end;

function TPgSQLConnection.VersionIsEqualOrHigher(MajorVer, MinorVer: integer): boolean;
begin
  Result := (GetMajorServerVersion > MajorVer) or
    ((GetMajorServerVersion = MajorVer) and (GetMinorServerVersion >= MinorVer));
end;    

function TPgSQLConnection.GetProcessID: integer;
begin
  Assert(FProtocol <> nil);
  Result := FProtocol.GetBackendPID;
end;

function TPgSQLConnection.GetProtocolVersion: TProtocolVersion;
begin
  Result := FProtocolVersion;
end;

function TPgSQLConnection.GetProtocol: TPgSQLProtocol;
begin
  Result := FProtocol;
end;

function TPgSQLConnection.GetTypes: TPgSQLTypes;
begin
  Result := FTypes;
end;

function TPgSQLConnection.CanChangeDatabase: boolean;
begin
  Result := False; 
end;

function TPgSQLConnection.CreateCommand: TPgSQLCommand;
begin
  Result := TPgSQLCommand.Create;
  Result.SetConnection(Self);
  Result.SetProp(prSimpleQueryExecute, True);
end;

function TPgSQLConnection.GetCommand: TPgSQLCommand;
begin
  if FCommand = nil then
    FCommand := CreateCommand;

  Result := FCommand;
end;

procedure TPgSQLConnection.ExecCommand(const SQL: string);
var
  Command: TPgSQLCommand;
begin
  Command := GetCommand;
  Command.SetSQL(SQL);
  Command.Execute();
end;

procedure TPgSQLConnection.BreakExec;
begin
  if FProtocol <> nil then
    FProtocol.RequestCancel;
end;

function TPgSQLConnection.GetCommandClass: TCRCommandClass;
begin
  Result := TPgSQLCommand;
end;

function TPgSQLConnection.GetTransactionClass: TCRTransactionClass;
begin
  Result := TPgSQLTransaction;
end;

procedure TPgSQLConnection.ProcessInternalException(E: EPgError; Component: TObject);
var
  PgError: EPgError;
  Fail: boolean;
begin
  PgError := EPgError.Create(E.Severity, E.ErrorCode, E.Message, E.DetailMsg, E.Hint, E.CallStack,
    E.FileName, E.ProcedureName, E.Position, E.LineNumber);
{$IFNDEF LITE}
  PgError.Component := Component;
{$ENDIF}
  try
    E := PgError;
    Fail := True;
    DoError(E, Fail);
    if Fail then
      PgError := nil; // don't free
  finally
    PgError.Free;
  end;

  if Fail then
    raise E
  else
    Abort;
end;

procedure TPgSQLConnection.PrepareFetchConnection;
begin
  if FFetchConnection = nil then
    FFetchConnection := TPgSQLConnection.Create;

  if not FFetchConnection.FConnected then begin
    FFetchConnection.Assign(Self);
    FFetchConnection.Connect('');
  end;

  if FFetchConCount = 0 then
    FFetchConnection.GetInternalTransaction.StartTransaction;
  Inc(FFetchConCount);
end;

procedure TPgSQLConnection.ReleaseFetchConnection;
begin
  Dec(FFetchConCount);
  if FFetchConCount = 0 then
    FFetchConnection.GetInternalTransaction.Rollback;
end;

{$IFNDEF LITE}
procedure TPgSQLConnection.CheckAuxConnection;
begin
  if FAuxConnection = nil then
    FAuxConnection := TPgSQLConnection.Create;

  if not FAuxConnection.FConnected then begin
    FAuxConnection.Assign(Self);
    FAuxConnection.Connect('');
  end;
end;
{$ENDIF}

procedure TPgSQLConnection.SetClientEncoding;

  {$IFDEF MSWINDOWS}
  function DetectEncoding: string;
  var
    cp: word;
  begin
    cp := GetACP;
    case cp of
      866: Result := 'WIN866';
      874: Result := 'WIN874';
      936: Result := 'GBK';
      949: Result := 'UHC';
      950: Result := 'BIG5';
      1361: Result := 'JOHAB';
      1250: Result := 'WIN1250';
      1251: Result := 'WIN1251';
      1252: Result := 'WIN1252';
      1253: Result := 'WIN1253';
      1254: Result := 'WIN1254';
      1255: Result := 'WIN1255';
      1256: Result := 'WIN1256';
      1257: Result := 'WIN1257';
      1258: Result := 'WIN1258';
      20866: Result := 'KOI8R';
      21866: Result := 'KOI8U';
      28595: Result := 'ISO_8859_5';
      28596: Result := 'ISO_8859_6';
      28597: Result := 'ISO_8859_7';
      38598: Result := 'ISO_8859_8';
      28591: Result := 'LATIN1';
      28592: Result := 'LATIN2';
      28593: Result := 'LATIN3';
      28594: Result := 'LATIN4';
      28599: Result := 'LATIN5';
      28600: Result := 'LATIN6';
      28603: Result := 'LATIN7';
      28604: Result := 'LATIN8';
      28605: Result := 'LATIN9';
      54936: Result := 'GB18030';
      932: Result := 'SJIS';
      20932, 50220, 50221, 50222: Result := 'EUC_JIS_2004';
      51932: Result := 'EUC_JP';
      51936: Result := 'EUC_CN';
      51949: Result := 'EUC_KR';
      51950: Result := 'EUC_TW';
      65001: Result := 'UTF8';
    else
      Result := '';
    end;
  end;
  {$ENDIF}

var
  SQL: string;
  DefaultEnc: string;
  Encoding: string;
begin
  SQL := '';
  DefaultEnc := UpperCase(FProtocol.GetServerParameter('client_encoding'));
  if FUseUnicode then begin
    if VersionIsEqualOrHigher(8, 1) then begin
      if DefaultEnc <> 'UTF8' then
        SQL := 'SET client_encoding=''UTF8''';
    end
    else begin
      if DefaultEnc <> 'UNICODE' then
        SQL := 'SET client_encoding=''UNICODE''';
    end;
  end
  else begin
    Encoding := FCharset;

  {$IFDEF MSWINDOWS}
    if Encoding = '' then
      Encoding := DetectEncoding;
  {$ENDIF}

    if (Encoding <> '') and (UpperCase(Encoding) <> DefaultEnc) then
      SQL := Format('SET client_encoding=''%s''', [Encoding]);
  end;

  if SQL <> '' then
    ExecCommand(SQL);

  FProtocol.SetUseUnicode(FUseUnicode);
end;

procedure TPgSQLConnection.GetIntegerDateTimes;
var
  RecordSet: TPgSQLRecordSet;
  RecBuf: IntPtr;
  v: variant;
begin
  if not VersionIsEqualOrHigher(8,0) then begin
    FIntegerDateTimes := False;
    exit;
  end;

  RecordSet := TPgSQLRecordSet.Create;
  try
    RecordSet.SetConnection(Self);
    RecordSet.SetProp(prSimpleQueryExecute, True);
    RecordSet.SetSQL('show integer_datetimes');
    RecordSet.Open;

    RecordSet.AllocRecBuf(RecBuf);
    try
      RecordSet.GetNextRecord(RecBuf);
      if RecordSet.Eof then
        FIntegerDateTimes := False
      else begin
        RecordSet.GetFieldAsVariant(RecordSet.Fields[0], RecBuf, v);
        FIntegerDateTimes := LowerCase(VarToStr(v)) = 'on';
      end;
    finally
      RecordSet.FreeRecBuf(RecBuf);
    end;
    RecordSet.Close;
  finally
    RecordSet.Free;
  end;
end;

procedure TPgSQLConnection.GetByteaOutput;
var
  RecordSet: TPgSQLRecordSet;
  RecBuf: IntPtr;
  v: variant;
begin
  if not VersionIsEqualOrHigher(9,0) then begin
    FByteaOutputAsHex := False;
    exit;
  end;

  RecordSet := TPgSQLRecordSet.Create;
  try
    RecordSet.SetConnection(Self);
    RecordSet.SetProp(prSimpleQueryExecute, True);
    RecordSet.SetSQL('show bytea_output');
    RecordSet.Open;

    RecordSet.AllocRecBuf(RecBuf);
    try
      RecordSet.GetNextRecord(RecBuf);
      if RecordSet.Eof then
        FByteaOutputAsHex := False
      else begin
        RecordSet.GetFieldAsVariant(RecordSet.Fields[0], RecBuf, v);
        FByteaOutputAsHex := LowerCase(VarToStr(v)) = 'hex';
      end;
    finally
      RecordSet.FreeRecBuf(RecBuf);
    end;
    RecordSet.Close;
  finally
    RecordSet.Free;
  end;
end;

function TPgSQLConnection.GetCurrentSchema: string;
var
  Command: TPgSQLCommand;
begin
  if not FConnected then
    raise Exception.Create(SConnectionIsClosed);

  Command := GetCommand;
  Command.SQL := 'SELECT CURRENT_SCHEMA()';
  with Command.AddParam do
    SetParamType(pdOutput);
  Command.Execute();
  Result := Command.Params[0].Value;
end;

function TPgSQLConnection.GetCachedSchema: string;
begin
  if FCachedSchema = '' then
    if FSchema <> '' then
      FCachedSchema := FSchema
    else
      FCachedSchema := GetCurrentSchema;

  Result := FCachedSchema;
end;

procedure TPgSQLConnection.SetCurrentSchema(Value: string);
begin
  if not FConnected then
    raise Exception.Create(SConnectionIsClosed);

  if Value = '' then begin
    Value := 'public';
    SetLength(FSchemas, 1);
    FSchemas[0] := Value;
  end
  else
    Value := PgSQLInfo.QuoteSchemasIfNeed(Value, FSchemas);

  ExecCommand('SET search_path TO ' + Value);
  FSchema := Value;
  FCachedSchema := '';
  FMultipleSchema := Length(FSchemas) > 1;
end;

function TPgSQLConnection.GetInTransaction: boolean;
begin
  Result := FInTransaction;
end;

{$IFNDEF LITE}
function TPgSQLConnection.GetNotificationsHandler: TPgSQLNotificationsHandler;
begin
  if FNotificationsHandler = nil then
    FNotificationsHandler := TPgSQLNotificationsHandler.Create(Self);

  Result := FNotificationsHandler;
end;
{$ENDIF}

procedure TPgSQLConnection.DoOnNotice(Errors: TPgErrors);
begin
  if Assigned(FOnNotice) then
    FOnNotice(Errors);
end;

procedure TPgSQLConnection.DoOnNotification(const Name: string; const PID: integer; const Message: string);
begin
  if Assigned(FOnNotification) then
    FOnNotification(Name, PID, Message);
end;

{ TPgSQLTransaction }

procedure TPgSQLTransaction.StartTransaction;
var
  CommandText: string;
  Connection: TPgSQLConnection;
begin
  if FConnections.Count = 0 then
    raise Exception.Create(SNoConnectionsInTransaction);

  Connection := TPgSQLConnection(FConnections[0]);
  
  if not Connection.GetConnected then
    raise Exception.Create(SConnectionInTransactionNotActive);

  CommandText := 'BEGIN; SET TRANSACTION ISOLATION LEVEL ';

  case FIsolationLevel of
    ilReadCommitted:
      CommandText := CommandText + 'READ COMMITTED';
    ilSnapshot:
      CommandText := CommandText + 'SERIALIZABLE';
    ilRepeatableRead:
      CommandText := CommandText + 'REPEATABLE READ';
    ilReadUncommitted:
      CommandText := CommandText + 'READ UNCOMMITTED';
  else
    raise Exception.Create(SUnsupportedIsolationLevel);
  end;

  if FReadOnly then
    CommandText := CommandText + ' READ ONLY';

  Connection.ExecCommand(CommandText);

  FActive := True;
  FNativeTransaction := True;
  Connection.FInTransaction := True;
end;

procedure TPgSQLTransaction.Commit;
var
  Connection: TPgSQLConnection;
begin
  CheckActive;

  Connection := TPgSQLConnection(FConnections[0]);
  if FNativeTransaction then
    Connection.ExecCommand('COMMIT');

  FActive := False;   
  Connection.FInTransaction := False;
end;

procedure TPgSQLTransaction.Rollback;
var
  Connection: TPgSQLConnection;
begin
  CheckActive;

  Connection := TPgSQLConnection(FConnections[0]);
  if FNativeTransaction then
    Connection.ExecCommand('ROLLBACK');

  FActive := False;
  Connection.FInTransaction := False;
end;

procedure TPgSQLTransaction.Savepoint(const Name: string);
var
  Connection: TPgSQLConnection;
begin
  CheckActive;

  Connection := TPgSQLConnection(FConnections[0]);
  Connection.ExecCommand('SAVEPOINT ' + Name);
end;

procedure TPgSQLTransaction.ReleaseSavepoint(const Name: string);
var
  Connection: TPgSQLConnection;
begin
  CheckActive;

  Connection := TPgSQLConnection(FConnections[0]);
  Connection.ExecCommand('RELEASE SAVEPOINT ' + Name);
end;

procedure TPgSQLTransaction.RollbackToSavepoint(const Name: string);
var
  Connection: TPgSQLConnection;
begin
  CheckActive;

  Connection := TPgSQLConnection(FConnections[0]);
  Connection.ExecCommand('ROLLBACK TO SAVEPOINT ' + Name);
end;

{ TPgSQLTypes }

constructor TPgSQLTypes.Create(Connection: TPgSQLConnection);
begin
  inherited Create;

  FConnection := Connection;
{$IFNDEF LITE}
  FUnknownTypes := TThreadList.Create;
  FTypes := TThreadList.Create;
{$ENDIF}
end;

destructor TPgSQLTypes.Destroy;
{$IFNDEF LITE}
var
  i: integer;
  List: TList;
{$ENDIF}
begin
{$IFNDEF LITE}
  FUnknownTypes.Free;
  List := FTypes.LockList;
  for i := 0 to List.Count - 1 do
    TPgType(List[i]).Free;
  FTypes.UnlockList;
  FTypes.Free;
{$ENDIF}

  inherited;
end;

procedure TPgSQLTypes.DecodeTypeLength(TypeOID: Integer; TypeModifier: Integer; var Length, Scale: Integer);
begin
  Length := 0;
  Scale := 0;

  case TypeOID of
    SQL_CHAR, SQL_VARCHAR:
      if TypeModifier <> -1 then
        Length := TypeModifier - 4;
    SQL_NUMERIC:
      if TypeModifier <> -1 then begin
        Length := (TypeModifier - 4) shr 16 and $ffff;
        Scale := (TypeModifier - 4) and $ffff;
      end;
    SQL_TIME, SQL_TIMETZ, SQL_TIMESTAMP, SQL_TIMESTAMPTZ:
      if TypeModifier < 0 then
        Scale := 0
      else
        Scale := TypeModifier - 6;
  end;
end;

procedure TPgSQLTypes.DetectDataType(TypeOID: integer; {$IFNDEF LITE}FetchConverter: TFetchConverter;{$ENDIF}
  var DataType, SubDataType: word; var Length, Scale, Size: integer;
  var Fixed: boolean; var ObjectType: TObjectType;
  LongStrings, FlatBuffers, OIDAsInt, EnableBCD, EnableFMTBCD,
  CursorAsString, UnknownAsString, FieldsAsText: boolean);
const
  dsMaxStringSize = 8192;
begin
  ObjectType := nil;

  Fixed := TypeOID = SQL_CHAR;

{$IFNDEF LITE}
  if FetchConverter <> nil then begin
    DataType := FetchConverter.InternalDataType;
    SubDataType := GetInternalType(TypeOID, ObjectType);
  end
  else
{$ENDIF}
  begin
    DataType := GetInternalType(TypeOID, ObjectType);

    SubDataType := DataType;

    case DataType of
      dtFixedChar, dtPgName, dtPgChar, dtVoid:
        DataType := dtString;
    else
      if FieldsAsText then
        DataType := dtString
      else begin
        case DataType of
          dtUnknown:
            DataType := dtString;
          dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
            if not FConnection.FEnableGeometrics then
              DataType := dtString;
          dtPgInterval:
            if FConnection.FIntervalAsString then
              DataType := dtString;
          dtCursor:
            if CursorAsString then
              DataType := dtString;
        end;
      end;
    end;

    case DataType of
      dtString: begin
        if (Length = 0) and not(SubDataType in [dtPgName, dtPgChar, dtVoid, dtCursor]) then begin
          if UnknownAsString then
            Length := dsMaxStringSize - 1 // TODO: trim on fetch
          else
            DataType := dtMemo;
        end;
        if DataType <> dtMemo then begin
          if (Length > High(Word)) or (not LongStrings and (Length > 255)) then
            DataType := dtMemo;
        end;
        if FConnection.FUseUnicode then
          case DataType of
            dtString:
              DataType := dtWideString;
            dtExtString:
              DataType := dtExtWideString;
            dtMemo: begin
              DataType := dtWideMemo;
              if SubDataType = dtString then
                SubDataType := dtWideString;
            end;
          end;
      end;
      dtPgSingle:
        DataType := dtFloat;
      dtNumeric: begin
      {$IFDEF LITE}
        if EnableFMTBCD or FConnection.EnableFMTBCD then begin
           if (FConnection.FBCDPrecision > 0) and ((Length + Scale) <= FConnection.FBCDPrecision) and (Scale <= FConnection.FBCDScale) then
            DataType := dtBCD
          else
            DataType := dtFMTBCD;
        end
        else
          DataType := dtFloat;
      {$ELSE}
        if (EnableBCD or FConnection.EnableBCD) and (FConnection.FBCDPrecision > 0)
        and ((Length + Scale) <= FConnection.FBCDPrecision) and (Scale <= FConnection.FBCDScale) then
            DataType := dtBCD
      {$IFNDEF FPC}
        else if EnableFMTBCD or FConnection.EnableFMTBCD then
          DataType := dtFMTBCD
      {$ENDIF}
        else if EnableBCD or FConnection.EnableBCD then
          DataType := dtBCD
        else
          DataType := dtFloat;
      {$ENDIF}
      end;
      dtPgDate:
        if not FConnection.FEnablePgTimeStamps then
          DataType := dtDate;
      dtPgTime:
        if not FConnection.FEnablePgTimeStamps then
          DataType := dtTime;
      dtPgTimeTZ:
        if FConnection.FEnablePgTimeStamps then
          DataType := dtPgTime
        else
          DataType := dtTime;
      dtPgTimeStamp:
        if not FConnection.FEnablePgTimeStamps then
          DataType := dtDateTime;
      dtPgTimeStampTZ:
        if FConnection.FEnablePgTimeStamps then
          DataType := dtPgTimeStamp
        else
          DataType := dtDateTime;
      dtOID:
        if OIDAsInt then
          DataType := dtInteger
        else
          DataType := dtPgLargeObject;
      dtMemo:
        if FConnection.FUseUnicode then
          DataType := dtWideMemo;
    {$IFDEF LITE}
      dtLargeint:
        if not (EnableFMTBCD or FConnection.EnableFMTBCD) then
          DataType := dtFloat;
    {$ENDIF}
    end;
  end;

  case SubDataType of
    dtVoid:
      Length := 0;
    dtPgName:
      Length := 63;
    dtPgChar:
      Length := 1;
    dtGuid:
      Length := 38;
    dtCursor:
      Length := 63;
    dtNumeric: begin
    {$IFDEF LITE}
      if Length = 0 then begin
        Length := 32;
        Scale := 8;
      end;
    {$ENDIF}
    {$IFNDEF FPC}
      if DataType = dtFMTBCD then begin
        if Length > MaxFMTBcdDigits then
          Length := MaxFMTBcdDigits;
        if Scale > Length then // if length was reduced
          Scale := Length;
      end
      else
    {$ENDIF}
      if DataType = dtBCD then begin
        if Length > MaxBcdPrecision then
          Length := MaxBcdPrecision;
        if Scale > MaxBcdScale then
          Scale := MaxBcdScale;
      end;
    end;
  end;

  if not FlatBuffers then
    if ((SubDataType in [dtString, dtWideString]) or ((SubDataType in [dtUnknown, dtFixedChar]) and UnknownAsString)) and (Length >= FlatBufferLimit) then
      if DataType = dtString then
        DataType := dtExtString
      else if DataType = dtWideString then
        DataType := dtExtWideString;

  Size := TPgSQLRecordSet.GetBufferSize(DataType, Length);
end;

function TPgSQLTypes.GetInternalType(TypeCode: integer; var ObjectType: TObjectType): word;
{$IFNDEF LITE}
var
  DomainType: TObjectType;
{$ENDIF}
begin
  ObjectType := nil;
  case TypeCode of
    SQL_VOID:
      Result := dtVoid;
    SQL_CHAR:
      Result := dtFixedChar;
    SQL_VARCHAR:
      Result := dtString;
    SQL_NAME:
      Result := dtPgName;
    SQL_CHARACTER:
      Result := dtPgChar;
    SQL_SMALLINT:
      Result := dtSmallInt;
    SQL_INT:
      Result := dtInteger;
    SQL_BIGINT:
      Result := dtLargeInt;
    SQL_REAL:
      Result := dtPgSingle;
    SQL_DOUBLE:
      Result := dtFloat;
    SQL_NUMERIC:
      Result := dtNumeric;
    SQL_MONEY:
      Result := dtCurrency;
    SQL_TEXT:
      Result := dtMemo;
    SQL_BYTEA:
      Result := dtBlob;
    SQL_DATE:
      Result := dtPgDate;
    SQL_TIME:
      Result := dtPgTime;
    SQL_TIMETZ:
      Result := dtPgTimeTZ;
    SQL_TIMESTAMP:
      Result := dtPgTimeStamp;
    SQL_TIMESTAMPTZ:
      Result := dtPgTimeStampTZ;
    SQL_INTERVAL:
      Result := dtPgInterval;
    SQL_OID:
      Result := dtOID;
    SQL_BOOLEAN:
      Result := dtBoolean;
    SQL_POINT:
      Result := dtPgPoint;
    SQL_LSEG:
      Result := dtPgLSeg;
    SQL_BOX:
      Result := dtPgBox;
    SQL_PATH:
      Result := dtPgPath;
    SQL_POLYGON:
      Result := dtPgPolygon;
    SQL_CIRCLE:
      Result := dtPgCircle;
    SQL_REFCURSOR:
      Result := dtCursor;
    SQL_UUID:
      Result := dtGuid;
  else
  {$IFNDEF LITE}
    if FConnection.FEnableComposites or FConnection.FEnableDomains then begin
      case TypeCode of
        PG_TYPE_RELTYPE_OID, PG_ATTRIBUTE_RELTYPE_OID, PG_PROC_RELTYPE_OID, PG_CLASS_RELTYPE_OID: ;
      else
        if (TypeCode < 10000) or IsUnknownType(TypeCode) then begin
          Result := dtUnknown;
          exit;
        end;
      end;

      if FConnection.FEnableComposites then
        ObjectType := GetRowType(TypeCode);
      if ObjectType <> nil then
        Result := dtObject
      else if FConnection.FEnableDomains then begin
        DomainType := GetDomainType(TypeCode);
        if DomainType <> nil then begin
          Result := GetInternalType(TPgDomainType(DomainType).BaseTypeOID, ObjectType);
          Exit;
        end
        else begin
          FUnknownTypes.Add({$IFNDEF CLR}Pointer{$ELSE}System.Object{$ENDIF}(TypeCode));
          Result := dtUnknown;
        end;
      end
      else begin
        FUnknownTypes.Add({$IFNDEF CLR}Pointer{$ELSE}System.Object{$ENDIF}(TypeCode));
        Result := dtUnknown;
      end;
    end
    else
  {$ENDIF}
      Result := dtUnknown;
  end;
end;

function TPgSQLTypes.DataTypeToOID(DataType, SubDataType: word): integer;
begin
  case DataType of
    dtSmallInt, dtInt8:
      Result := SQL_SMALLINT;
    dtInteger:
      if SubDataType = dtOID then
        Result := SQL_OID
      else
        Result := SQL_INT;
    dtWord:
      Result := SQL_INT;
    dtLargeInt, dtLongword:
      Result := SQL_BIGINT;
    dtFloat:
      Result := SQL_DOUBLE;
    dtBCD{$IFNDEF FPC}, dtFMTBCD{$ENDIF}, dtNumeric:
      Result := SQL_NUMERIC;
    dtCurrency:
      Result := SQL_MONEY;
    dtBoolean:
      Result := SQL_BOOLEAN;
    dtMemo, dtWideMemo:
      Result := SQL_TEXT;
    dtBlob:
      Result := SQL_BYTEA;
    dtDate, dtPgDate:
      Result := SQL_DATE;
    dtTime, dtPgTime:
      if SubDataType = dtPgTimeTZ then
        Result := SQL_TIMETZ
      else
        Result := SQL_TIME;
    dtPgTimeTZ:
      Result := SQL_TIMETZ;
    dtDateTime, dtPgTimeStamp:
      if SubDataType = dtPgTimeStampTZ then
        Result := SQL_TIMESTAMPTZ
      else
        Result := SQL_TIMESTAMP;
    dtPgTimeStampTZ:
      Result := SQL_TIMESTAMPTZ;
    dtPgInterval:
      Result := SQL_INTERVAL;
    dtPgPoint:
      Result := SQL_POINT;
    dtPgLSeg:
      Result := SQL_LSEG;
    dtPgBox:
      Result := SQL_BOX;
    dtPgPath:
      Result := SQL_PATH;
    dtPgPolygon:
      Result := SQL_POLYGON;
    dtPgCircle:
      Result := SQL_CIRCLE;
    dtCursor:
      Result := SQL_REFCURSOR;
    dtPgLargeObject:
      Result := SQL_OID;
    dtGuid:
      Result := SQL_UUID;  
  else
    Result := SQL_VARCHAR;
  end;
end;

{$IFNDEF LITE}
function TPgSQLTypes.IsUnknownType(TypeCode: integer): boolean;
var
  i: integer;
  List: TList;
begin
  Result := False;

  List := FUnknownTypes.LockList;
  try
    for i := 0 to List.Count - 1 do
      if Integer(List.Items[i]) = TypeCode then begin
        Result := True;
        exit;
      end;
  finally
    FUnknownTypes.UnlockList;
  end;
end;

function TPgSQLTypes.FindType(TypeCode: integer; TypeClass: TClass): TObjectType;
var
  i: integer;
  List: TList;
  t: TPgType;
begin
  Result := nil;

  List := FTypes.LockList;
  try
    for i := 0 to List.Count - 1 do
      if (TObject(List.Items[i]) is TypeClass) then begin
        t := TPgType(List.Items[i]);
        if t.TypeOID = TypeCode then begin
          Result := t;
          exit;
        end;
      end;
  finally
    FTypes.UnlockList;
  end;
end;

function TPgSQLTypes.FindType(const TypeName: string; TypeClass: TClass): TObjectType;
var
  i: integer;
  List: TList;
  t: TPgType;
begin
  Result := nil;

  List := FTypes.LockList;
  try
    for i := 0 to List.Count - 1 do
      if (TObject(List.Items[i]) is TypeClass) then begin
        t := TPgType(List.Items[i]);
        if t.Name = TypeName then begin
          Result := t;
          exit;
        end;
      end;
  finally
    FTypes.UnlockList;
  end;
end;

function TPgSQLTypes.GetType(TypeCode: integer; TypeClass: TClass): TObjectType;
var
  Con: TPgSQLConnection;
  PgType: TPgType;
begin
  Result := FindType(TypeCode, TypeClass);

  if Result = nil then begin
    if FConnection.FProtocol.ProtocolState = psIsReadyForQuery then
      Con := FConnection
    else begin
      FConnection.CheckAuxConnection;
      Con := FConnection.FAuxConnection;
    end;

    if TypeClass = TPgDomainType then
      PgType := TPgDomainType.Create
    else if TypeClass = TPgRowType then
      PgType := TPgRowType.Create
    else
      PgType := TPgType.Create;

    try
      if PgType.Describe(Con, TypeCode) then begin
        FTypes.Add(PgType);
        Result := PgType;
      end
      else
        PgType.Free;
    except
      PgType.Free;
      raise;
    end;
  end;
end;

function TPgSQLTypes.GetType(const TypeName: string; TypeClass: TClass): TObjectType;
var
  Con: TPgSQLConnection;
  PgType: TPgType;
  Schema, Name, NormName: string;
  Info: TSQLObjectInfo;
begin
  PgSQLInfo.SplitObjectName(TypeName, Info);
  if Info.Schema <> '' then
    Schema := PgSQLInfo.NormalizeName(Info.Schema, True)
  else
    Schema := '"' + FConnection.GetCachedSchema + '"';
  Name := PgSQLInfo.NormalizeName(Info.Name, True);
  NormName := Schema + '.' + Name;
  Result := FindType(NormName, TypeClass);

  if Result = nil then begin
    if FConnection.FProtocol.ProtocolState = psIsReadyForQuery then
      Con := FConnection
    else begin
      FConnection.CheckAuxConnection;
      Con := FConnection.FAuxConnection;
    end;

    if TypeClass = TPgDomainType then
      PgType := TPgDomainType.Create
    else if TypeClass = TPgRowType then
      PgType := TPgRowType.Create
    else
      PgType := TPgType.Create;

    try
      if PgType.Describe(Con, TypeName) then begin
        FTypes.Add(PgType);
        Result := PgType;
      end
      else
        PgType.Free;
    except
      PgType.Free;
      raise;
    end;
  end;
end;

function TPgSQLTypes.GetDomainType(TypeCode: integer): TObjectType;
begin
  Result := GetType(TypeCode, TPgDomainType);
end;

function TPgSQLTypes.GetRowType(TypeCode: integer): TObjectType;
begin
  Result := GetType(TypeCode, TPgRowType);
end;

function TPgSQLTypes.GetRowType(const TypeName: string): TObjectType;
begin
  Result := GetType(TypeName, TPgRowType);
end;
{$ENDIF NDEF LITE}

{ TPgSQLParamDesc }

function TPgSQLParamDesc.GetAsCursor: TPgCursor;
begin
  Result := GetObject as TPgCursor;
end;

procedure TPgSQLParamDesc.SetAsCursor(Value: TPgCursor);
begin
  SetObject(Value);
end;

{ TPgSQLInfo }

function TPgSQLInfo.HasOnlyLexem: boolean;
begin
  Result := True;
end;

procedure TPgSQLInfo.ParseExtColumnName(Parser: TSQLParser; var Code: integer; var Str: string);
begin
  inherited;

  // type convertion
  if Str = ':' then begin
    Code := Parser.GetNext(Str);
    if Str = ':' then begin
      Parser.GetNext(Str);
      Code := Parser.GetNext(Str);
    end
    else
      Parser.Back;
  end;
end;

function TPgSQLInfo.IdentCase: TIdentCase;
begin
  Result := icLower;
end;

function TPgSQLInfo.QuoteSchemasIfNeed(const Value: string; var Values: _TStringArray): string;
var
  Parser: TPgParser;
  Code: integer;
  St, SchemaName: string;
begin
  Result := '';
  SetLength(Values, 0);

  Parser := TPgParser.Create(Value);
  try
    Parser.OmitBlank := True;
    Parser.OmitComment := True;
    Parser.OmitKeywords := True;
    Parser.QuotedString := True;
    Parser.DecSeparator := '.';
    Parser.ToBegin;

    SchemaName := '';
    while True do begin
      Code := Parser.GetNext(St);

      if (Code = 4 {","}) or (Code = lcEnd) then begin
        if Result <> '' then
          Result := Result + ',';
        SchemaName := QuoteIfNeed(SchemaName);
        Result := Result + SchemaName;
        SetLength(Values, Length(Values) + 1);
        Values[High(Values)] := Unquote(SchemaName);
        if Code = lcEnd then
          break
        else
          SchemaName := '';
      end
      else
        SchemaName := SchemaName + St;
    end;
  finally
    Parser.Free;
  end;
end;

{ TPgCursor }

constructor TPgCursor.Create;
begin
  inherited;
end;

destructor TPgCursor.Destroy;
begin
  FStmtHandle.Free;

  inherited;
end;

function TPgCursor.CanFetch: boolean;
begin
  Result := (FState > csInactive) and (FState < csFetched);
end;

procedure TPgCursor.CreateStatement;
begin
  FStmtHandle := TPgSQLStatement.Create;
end;

procedure TPgCursor.FreeStatement;
begin
  FStmtHandle.Free;
  FStmtHandle := nil;
end;

{ TPgSQLCommand }

constructor TPgSQLCommand.Create;
begin
  inherited;

  FCursor := TPgCursor.Create;
  FCursorRef := FCursor;

  FDistinctParams := True;
end;

destructor TPgSQLCommand.Destroy;
begin
{$IFDEF AUTOREFCOUNT}
  FCursorRef := nil;
  FNextCursorRef := nil;
{$ENDIF}
  FCursor.Free;

  inherited;
end;

class function TPgSQLCommand.GetSQLInfoClass: TSQLInfoClass;
begin
  Result := TPgSQLInfo;
end;

class function TPgSQLCommand.GetParserClass: TSQLParserClass;
begin
  Result := TPgParser;
end;

{$IFNDEF LITE}
class function TPgSQLCommand.GetMapRulesClass: TCRMapRulesClass;
begin
  Result := TPgMapRules;
end;
{$ENDIF}

function TPgSQLCommand.GetParamDescType: TParamDescClass;
begin
  Result := TPgSQLParamDesc;
end;

function TPgSQLCommand.AddParam: TParamDesc;
begin
  Result := GetParamDescType.Create;
  FParams.Add(Result);
end;

function TPgSQLCommand.GetParam(Index: integer): TPgSQLParamDesc;
begin
  Result := TPgSQLParamDesc(Params[Index]);
end;

function TPgSQLCommand.ParseSQL(const SQL: string; Params: TParamDescs; ReplaceAll: boolean = True; const RenamePrefix: string = ''): string;
var
  ParsedSQL: StringBuilder;
  Parser: TPgParser;
  Code, p: integer;
  St, TempSt: string;
  l: integer;
  ParamName: string;
  ParamIndex, ParamCount: integer;
  Param: TPgSQLParamDesc;

  LeftQuote, RightQuote: char;
  IsParam, IsFirstLexem: boolean;

  function IndexOfParam(Name: string): integer;
  var
    i: integer;
  begin
    Result := -1;
    for i := 0 to Params.Count - 1 do
    if (Params.Items[i] <> nil) then
      if SameText(TParamDesc(Params[i]).GetName, Name) then begin
        Result := i;
        break;
      end;
  end;
  
begin
  Assert(Params <> nil);

  ClearPlaceHolders;
  FParsedStmtType := stUnknown; 

  if FScanParams then
    Params.Clear;

  ParsedSQL := StringBuilder.Create(Length(SQL) + Length(SQL) div 2);
  try
    Parser := TPgParser.Create(SQL);
    try
      Parser.OmitBlank := False;
      Parser.OmitComment := True;
      Parser.QuotedString := True;
      Parser.DecSeparator := '.';
      Parser.ToBegin;

      LeftQuote := '"';
      RightQuote := '"';
      ParamCount := 0;
      IsFirstLexem := True;

      repeat
        IsParam := False;
        repeat
          Code := Parser.GetNext(St);

          if IsFirstLexem then begin
            if (Code = lxSELECT) or (Code = lxWITH) then
              FParsedStmtType := stSelect;

            if (Code <> lcBlank) and (Code <> lcComment) then
              IsFirstLexem := False;
          end;

          if (Code = 3) then begin     // PostgreSQL conversion (::) workaround
            TempSt := St;
            Code := Parser.GetNext(St);
            if (Code = lcIdent) or (Code = lcNumber) or (Code >= lxSQLFirst) then
              IsParam := True
            else
              St := TempSt + St;
          end;

          if not IsParam then
            ParsedSQL.Append(St);
        until (Code = lcEnd) or IsParam;

        if IsParam then begin
          ParamName := St;

          l := Length(ParamName);
          if (ParamName[1] = LeftQuote) and (ParamName[l] = RightQuote) then
            ParamName := Copy(ParamName, 2, l - 2);

          if FDistinctParams then
            ParamIndex := IndexOfParam(ParamName)
          else
            ParamIndex := -1;

          Param := nil;
          if ParamIndex > -1 then
            Param := GetParam(ParamIndex);

          if FScanParams and (ParamIndex = - 1) then begin
            Param := TPgSQLParamDesc.Create;
            Param.SetName(ParamName);
            ParamIndex := Params.Add(Param);
          end;

          if ReplaceAll or (ParamIndex >= 0) then begin
            p := ParsedSQL.Length + 1;
            if ParamIndex = -1 then
              ParamIndex := ParamCount;
            ParsedSQL.Append('$' + IntToStr(ParamIndex + 1));
            AddPlaceHolder(p, ParsedSQL.Length + 1, Param);
            Inc(ParamCount);
          end
          else
            ParsedSQL.Append(':' + St);
        end;
      until Code = lcEnd;
    finally
      Parser.Free;
    end;
    Result := ParsedSQL.ToString;
  finally
    ParsedSQL.Free;
  end;
end;

procedure TPgSQLCommand.MakeSPParam(const Name: string; Oid: integer; Direction: char);
var
  Param: TParamDesc;
  DataType, SubDataType: word;
  Length, Scale, Size: integer;
  Fixed: boolean;
  ObjectType: TObjectType;
begin
  Param := AddParam;
  Param.SetName(Name);

  case Direction of
    'i': Param.SetParamType(pdInput);
    'o': Param.SetParamType(pdOutput);
    'b': Param.SetParamType(pdInputOutput);
    'r': Param.SetParamType(pdResult);
  else
    Assert(False);
  end;

  FUsedConnection.FTypes.DecodeTypeLength(Oid, -1, Length, Scale);

  FUsedConnection.FTypes.DetectDataType(Oid, {$IFNDEF LITE}nil,{$ENDIF} DataType, SubDataType,
    Length, Scale, Size, Fixed, ObjectType,
    True, True, FOIDAsInt, EnableBCD, {$IFNDEF FPC}EnableFMTBCD{$ELSE}False{$ENDIF},
    False, True, False);

  Param.SetDataType(DataType);
  Param.SetSubDataType(SubDataType);
{$IFDEF LITE}
  Param.SetSize(Size);
{$ENDIF}
end;

procedure TPgSQLCommand.GetProcParamsInfo(const Schema, Name: string; Overload: integer;
  var ParamsInfo: TProcParamsInfo);

  function Split(const s: string; delim: char): _TStringArray;
  var
    i, p, c: integer;
  begin
    SetLength(Result, Length(s));
    if Length(s) = 0 then
      exit;
    c := 0;
    p := 1;
    for i := 1 to Length(s) do begin
      if s[i] = delim then begin
        Result[c] := Copy(s, p, i - p);
        Inc(c);
        p := i + 1;
      end;
    end;
    Result[c] := Copy(s, p, MaxInt);
    Inc(c);
    SetLength(Result, c);
  end;

const
  SQLSelectClause7 =
    'SELECT p.prorettype, p.proretset, p.proargtypes, null as proallargtypes, null as proargmodes, null as proargnames, n.nspname ';

  SQLSelectClause8 =
    'SELECT p.prorettype, p.proretset, p.proargtypes, p.proallargtypes, p.proargmodes, p.proargnames, n.nspname ';

  SQLFromWhereClause =
    'FROM pg_proc p ' +
    '  INNER JOIN pg_namespace n ON n.oid = p.pronamespace ' +
    'WHERE n.nspname = ''%s'' AND p.proname = ''%s'' ';

  SQLFromWhereClauseMulti =
    'FROM pg_proc p ' +
    '  INNER JOIN pg_namespace n ON n.oid = p.pronamespace ' +
    'WHERE n.nspname in (%s) AND p.proname = ''%s'' ' +
    'ORDER BY CASE n.nspname %s END ';

  SQLOffsetLimitClause = 'OFFSET %d LIMIT 1';

var
  RecordSet: TPgSQLRecordSet;
  i: integer;
  RecBuf: IntPtr;
  v: variant;
  s: string;
  stypes: _TStringArray;
  Field0: TFieldDesc;
  Field1: TFieldDesc;
  Field2: TFieldDesc;
  Field3: TFieldDesc;
  Field4: TFieldDesc;
  Field5: TFieldDesc;
  Field6: TFieldDesc;
begin
  stypes := nil;
  RecordSet := TPgSQLRecordSet.Create;
  try
    RecordSet.SetProp(prOIDAsInt, True);
    RecordSet.SetConnection(FUsedConnection);
    RecordSet.SetProp(prOIDAsInt, True);

    if TPgSqlRecordSet(RecordSet).FCommand.FConnection.VersionIsEqualOrHigher(8, 0) then
      SQL := SQLSelectClause8
    else
      SQL := SQLSelectClause7;

    if not FUsedConnection.FMultipleSchema then
      SQL := Format(SQL + SQLFromWhereClause + SQLOffsetLimitClause, [Schema, Name, Overload - 1])
    else
      SQL := Format(SQL + SQLFromWhereClauseMulti + SQLOffsetLimitClause,
        [FUsedConnection.GetSchemaNamesForSQL(0), Name, FUsedConnection.GetSchemaNamesForSQL(1), Overload - 1]);

    RecordSet.SetSQL(SQL);
    RecordSet.Open;

    Field0 := RecordSet.Fields[0];
    Field1 := RecordSet.Fields[1];
    Field2 := RecordSet.Fields[2];
    Field3 := RecordSet.Fields[3];
    Field4 := RecordSet.Fields[4];
    Field5 := RecordSet.Fields[5];
    Field6 := RecordSet.Fields[6];

    RecordSet.AllocRecBuf(RecBuf);
    try
      RecordSet.GetNextRecord(RecBuf);
      if RecordSet.Eof then
        raise Exception.CreateFmt(SStoredProcNotFound, [Schema, Name]);

      RecordSet.GetFieldAsVariant(Field0, RecBuf, v);
      ParamsInfo.RetTypeOid := v;

      RecordSet.GetFieldAsVariant(Field1, RecBuf, v);
      ParamsInfo.IsReturnSet := v;

      if not RecordSet.GetNull(Field3, RecBuf) then begin
        RecordSet.GetFieldAsVariant(Field3, RecBuf, v);
        s := v;
        s := Copy(s, 2, Length(s) - 2);
        stypes := Split(s, ',');
      end
      else begin
        RecordSet.GetFieldAsVariant(Field2, RecBuf, v);
        s := v;
        stypes := Split(s, ' ');
      end;
      SetLength(ParamsInfo.TypeOIDs, Length(stypes));
      for i := 0 to Length(stypes) - 1 do
        ParamsInfo.TypeOIDs[i] := StrToInt(stypes[i]);

      if not RecordSet.GetNull(Field4, RecBuf) then begin
        RecordSet.GetFieldAsVariant(Field4, RecBuf, v);
        s := v;
        s := Copy(s, 2, Length(s) - 2);
        ParamsInfo.Modes := Split(s, ',');
      end;

      if not RecordSet.GetNull(Field5, RecBuf) then begin
        RecordSet.GetFieldAsVariant(Field5, RecBuf, v);
        s := v;
        s := Copy(s, 2, Length(s) - 2);
        ParamsInfo.Names := Split(s, ',');
      end
      else begin
        SetLength(ParamsInfo.Names, Length(stypes));
        for i := 0 to Length(stypes) - 1 do
          ParamsInfo.Names[i] := 'p' + IntToStr(i + 1);
      end;

      if not RecordSet.GetNull(Field6, RecBuf) then begin
        RecordSet.GetFieldAsVariant(Field6, RecBuf, v);
        s := v;
        ParamsInfo.Schema := s;
      end;

    finally
      RecordSet.FreeRecBuf(RecBuf);
    end;
  finally
    RecordSet.Free;
  end;
end;

procedure TPgSQLCommand.InitProcParams(const Name: string; Overload: integer);
var
  ProcName, Schema: string;
  ParamIndex: Integer;
  i: integer;
  ParamsInfo: TProcParamsInfo;
  Info: TSQLObjectInfo;
  HasOutParams: boolean;
  s, ParamName: string;
  Mode: char;
begin
  PgSQLInfo.SplitObjectName(Name, Info);

  if Info.Schema <> '' then
    Schema := PgSQLInfo.NormalizeName(Info.Schema, False, True)
  else
    Schema := FUsedConnection.GetCachedSchema;
  ProcName := PgSQLInfo.NormalizeName(Info.Name, False, True);

  GetProcParamsInfo(Schema, ProcName, Overload, ParamsInfo);

  FParams.Clear;

  if not ParamsInfo.IsReturnSet and (ParamsInfo.RetTypeOid <> SQL_VOID) then begin
    HasOutParams := False;
    for i := 0 to Length(ParamsInfo.Modes) - 1 do
      if ParamsInfo.Modes[i] <> 'i' then begin
        HasOutParams := True;
        break;
      end;

    if not HasOutParams then
      MakeSPParam('result', ParamsInfo.RetTypeOid, 'r');
  end;

  for i := 0 to Length(ParamsInfo.TypeOIDs) - 1 do begin
    if i < Length(ParamsInfo.Names) then begin
      ParamName := ParamsInfo.Names[i];
      ParamName := PgSQLInfo.UnQuote(ParamName);
      if ParamName <> '' then
        ParamName := StringReplace(ParamName, ' ' , '_', [rfReplaceAll])
      else
        ParamName := IntToStr(i + 1);
    end
    else
      ParamName := IntToStr(i + 1);
    if FParams.FindParam(ParamName) <> nil then begin
      ParamIndex := 1;
      while FParams.FindParam(ParamName + '_' + IntToStr(ParamIndex)) <> nil do
        Inc(ParamIndex);
      ParamName := ParamName + '_' + IntToStr(ParamIndex);
    end;

    if i < Length(ParamsInfo.Modes) then begin
      s := ParamsInfo.Modes[i];
      if s <> '' then
        Mode := s[1]
      else
        Mode := 'i';
    end
    else
      Mode := 'i';

    if ParamsInfo.IsReturnSet and (Mode = 'b') then
      Mode := 'i';

    if not ParamsInfo.IsReturnSet or (Mode = 'i') then
      MakeSPParam(ParamName, ParamsInfo.TypeOIDs[i], Mode);
  end;
end;

function TPgSQLCommand.CreateProcCall(const Name: string; NeedDescribe: boolean; IsQuery: boolean): string;
var
  ProcName, s, si: string;
  Overload, OverloadPos, i, j, p, OutCount: integer;
  Added: boolean;
begin
  Overload := 1;
  ProcName := Name;
  OverloadPos := Pos(':', Name);
  if OverloadPos > 0 then begin
    try
      Overload := StrToInt(Trim(Copy(Name, OverloadPos + 1, Length(Name))));
      ProcName := Copy(Name, 1, OverloadPos - 1);
    except
    end;
    if Overload = 0 then
      Overload := 1;
  end;

  if NeedDescribe then
    InitProcParams(ProcName, Overload);

  OutCount := 0;
  for i := 0 to FParams.Count - 1 do begin
    if FParams[i].GetParamType > pdInput then begin
      Inc(OutCount);
      if OutCount > 1 then
        break;
    end;
  end;

  if OutCount = 1 then
    s := 'SELECT '
  else
    s := 'SELECT * FROM ';
  s := s + ProcName + '(';
  si := s;
  Added := False;
  j := 1;
  ClearPlaceHolders;
  for i := 0 to FParams.Count - 1 do begin
    if FParams[i].GetParamType in [pdInput, pdInputOutput] then begin
      if Added then begin
        s := s + ', ';
        si := si + ', ';
      end;
      s := s + ':' + FParams[i].GetName;
      p := Length(si) + 1;
      si := si + '$' + IntToStr(j);
      AddPlaceHolder(p, Length(si) + 1, TPgSQLParamDesc(FParams[i]));
      Inc(j);
      Added := True;
    end;
  end;

  s := s + ')';
  si := si + ')';

  FSQL := si;
  FUserSQL := s;
  FParsedStmtType := stSelect;
  Result := s;
end;

procedure TPgSQLCommand.Prepare;
var
  i: integer;
  ParamTypes: TIntegerDynArray;
begin
  if (GetCursorState > csPrepared) or
     (GetCursorState > csInactive) and (FCursorRef.FStmtHandle <> nil) and FCursorRef.FStmtHandle.Prepared
  then
    Exit;

  FUsedConnection := GetUsedConnection;

  CheckConnection;
  if NativeCursor and (Trim(FSQL) = '') then
    raise Exception.Create(SEmptySQLStatement);
  if not NativeCursor and not FUsedConnection.GetInTransaction then
    raise Exception.Create(SRefCursorNeedTransaction);

  SplitParams;
  FCursorRef.CreateStatement;
  try
    if not UseSimpleProtocol then begin
      if FUseParamTypes and NativeCursor then begin
        SetLength(ParamTypes, FInParamsCount);
        for i := 0 to FInParamsCount - 1 do
          ParamTypes[i] := FUsedConnection.FTypes.DataTypeToOID(
            FInParamRefs[i].GetDataType, FInParamRefs[i].GetSubDataType);
      end
      else
        ParamTypes := nil;

      try
        PerformPrepare(GetFinalSQL, GetParsedStmtType, ParamTypes);
      except
        on E: EPgError do begin
          if FUsedConnection = FConnection.FFetchConnection then
          begin
            FUsedConnection := FConnection;
            FConnection.ReleaseFetchConnection;
          end;

          FUsedConnection.ProcessInternalException(E, Component);
        end;
      end;

      DescribeParams;

      DescribeFields;
    end;

    SetCursorState(csPrepared);
  except
    if (FUsedConnection.FProtocol <> nil) and not UseSimpleProtocol then
      PerformUnprepare;
    FCursorRef.FreeStatement;
    raise;
  end;
end;

procedure TPgSQLCommand.Unprepare;
begin
  if not NativeCursor and not FNativePreparation then
    Exit;

  try
    ResetParams;

    if GetPrepared then begin
      PerformClosePortal;
      if FUsedConnection.FProtocolVersion <> pv20 then
        PerformUnprepare;
      FCursorRef.FreeStatement;

      if FUsedConnection = FConnection.FFetchConnection then begin
        FUsedConnection := FConnection;
        FConnection.ReleaseFetchConnection;
      end;
    end;
  finally
    SetCursorState(csInactive);
  end;
end;

function TPgSQLCommand.GetPrepared: boolean;
begin
  Result := GetCursorState >= csPrepared;
end;

procedure TPgSQLCommand.Execute(Iters: integer);
begin
  if GetCursorState > csPrepared then
    Exit;

  try
    InternalExecute;
  except
    if (FRecordSet = nil) and Assigned(FAfterExecute) then
      FAfterExecute(False);
    raise;
  end;
  if (FRecordSet = nil) and Assigned(FAfterExecute) then
    FAfterExecute(True);
end;

procedure TPgSQLCommand.Close;
begin
  PerformClosePortal;
end;

procedure TPgSQLCommand.SetConnection(Value: TCRConnection);
begin
  if Value <> FConnection then begin
    inherited;

    FConnection := TPgSQLConnection(Value);
    FUsedConnection := FConnection;
  end;
end;

function TPgSQLCommand.GetCursorState: TCursorState;
begin
  Result := FCursorRef.State;
end;

procedure TPgSQLCommand.SetCursorState(Value: TCursorState);
begin
  FCursorRef.FState := Value;
end;

function TPgSQLCommand.GetCursor: TCRCursor;
begin
  Result := FCursorRef;
end;

procedure TPgSQLCommand.SetCursor(Value: TCRCursor);
begin
  if FCursorRef <> Value then begin
    if (FCursorRef <> FCursor) then
      FCursorRef.Release;

    if Value <> nil then begin
      FCursorRef := TPgCursor(Value);
      FCursorRef.AddRef;

      FNativePreparation := FCursorRef.State < csPrepared;
    end
    else
      FCursorRef := FCursor;
  end;
end;

function TPgSQLCommand.GetFirstCursor: TPgCursor;
var
  i: integer;
begin
  Result := nil;

  for i := 0 to Params.Count - 1 do
    if Params[i].GetParamType >= pdOutput then
      if Params[i].GetDataType = dtCursor then
        if Result = nil then
          Result := TPgSQLParamDesc(Params[i]).GetAsCursor
        else begin
          FNextCursorRef := TPgSQLParamDesc(Params[i]).GetAsCursor;
          exit;
        end;
  FNextCursorRef := nil;
end;

function TPgSQLCommand.GetNextCursor: TPgCursor;
var
  i: integer;
  Param: TPgSQLParamDesc;
  Cursor: TPgCursor;
  Found: boolean;
begin
  Result := FNextCursorRef;
  
  if Result <> nil then begin
    Found := False;
    for i := 0 to FParams.Count - 1 do begin
      Param := TPgSQLParamDesc(FParams[i]);
      if Params[i].GetParamType >= pdOutput then
        if Param.GetDataType = dtCursor then begin
          Cursor := Param.GetAsCursor;
          if not Found then begin
            if Cursor = FNextCursorRef then
              Found := True;
          end
          else
          if Cursor.CanFetch then begin
            FNextCursorRef := Cursor;
            exit;
          end;
        end;
      end;
    end;
  FNextCursorRef := nil;
end;

function TPgSQLCommand.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prSimpleQueryExecute:
      FForceSimpleProtocol := Value;
    prCommandTimeout:
      FCommandTimeout := Value;
    prOIDAsInt:
      FOIDAsInt := Value;
    prUseParamTypes:
      FUseParamTypes := Value;
    prDistinctParams: if FDistinctParams <> Value then begin
      FDistinctParams := Value;
      SetSQL(FUserSQL);
    end;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TPgSQLCommand.GetProp(Prop: integer; out Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prLastInsertId:
      Value := FLastInsertOID;
    prRowsProcessed:
      Value := FRowsAffected;
    prCommandTimeout:
      Value := FCommandTimeout;
    prUseParamTypes:
      Value := FUseParamTypes;
    prDistinctParams:
      Value := FDistinctParams;
  else
    Result := inherited GetProp(Prop, Value);    
  end;
end;

function TPgSQLCommand.GetFormatCode(DataType: Word; TypeModifier, Scale: integer; IsField: boolean): integer;
begin
  if (IsField and FFieldsAsText) or UseSimpleProtocol then
    Result := 0
  else begin
    case DataType of
      dtUnknown, dtString, dtPgName, dtPgChar, dtVoid, dtGuid:
        Result := 0;
      dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
        Result := Byte(FUsedConnection.FEnableGeometrics);
      dtPgInterval:
        Result := Byte(not FUsedConnection.FIntervalAsString);
      dtObject:
        Result := Byte(FUsedConnection.FEnableComposites);
    else
      Result := 1; //Byte(not FUsedConnection.FTypes.IsTextOnly(TypeOid));
    end;
  end;
end;

function TPgSQLCommand.UseSimpleProtocol: boolean;
begin
  Result := FForceSimpleProtocol or
  (FUsedConnection <> nil) and (FUsedConnection.FProtocolVersion = pv20) or
  (FRecordSet <> nil) and FRecordSet.FCursorWithHold and not FRecordSet.IsFetchAll;
end;

function TPgSQLCommand.GetUsedConnection: TPgSQLConnection;
begin
  if (GetParsedStmtType = stSelect) and
     (FRecordSet <> nil) and
      not FRecordSet.IsFetchAll and
      not FRecordSet.FCursorWithHold and
      not FConnection.GetInTransaction
  then begin
    FConnection.PrepareFetchConnection;
    Result := FConnection.FFetchConnection;
  end
  else
    Result := FConnection;
end;

procedure TPgSQLCommand.CheckConnection;
begin
  if FUsedConnection = nil then
    raise Exception.Create(SConnectionNotDefined);
end;

procedure TPgSQLCommand.ClearPlaceHolders();
begin
  FPlaceHoldersCount := 0;
end;

procedure TPgSQLCommand.AddPlaceHolder(Position, EndPosition: integer; ParamRef: TPgSQLParamDesc);
begin
  if FPlaceHoldersCount >= Length(FPlaceHolders) then
    SetLength(FPlaceHolders, Length(FPlaceHolders) + 25);

  FPlaceHolders[FPlaceHoldersCount].Position := Position;
  FPlaceHolders[FPlaceHoldersCount].EndPosition := EndPosition;
  FPlaceHolders[FPlaceHoldersCount].ParamRef := ParamRef;

  Inc(FPlaceHoldersCount);
end;

function TPgSQLCommand.GetFinalSQL: string;
begin
  if not NativeCursor and (FCursorRef is TPgRefCursor) then
    Result := PgSQLInfo.NormalizeName(TPgRefCursor(FCursorRef).CursorName, True)
  else
    Result := FSQL;
end;

function TPgSQLCommand.GetFinalSQLWithParamValues: string;
var
  FinalSQL: string;
  s: string;
  i: integer;
  Param: TPgSQLParamDesc;
  ValuesSQL: StringBuilder;
  PrevPos: integer;
  CurrPos: integer;
begin
  FinalSQL := GetFinalSQL;
  if UseSimpleProtocol and NativeCursor and (FPlaceHoldersCount > 0) then begin
    ValuesSQL := StringBuilder.Create(Length(FinalSQL));
    try
      PrevPos := 1;

      for i := 0 to FPlaceHoldersCount - 1 do begin
        CurrPos := FPlaceHolders[i].Position;
        Param := FPlaceHolders[i].ParamRef;
        if Param = nil then begin
          Assert(FPlaceHoldersCount = FInParamsCount);
          Param := TPgSQLParamDesc(Params[i]);
        end;

        s := Copy(FinalSQL, PrevPos, CurrPos - PrevPos);
        ValuesSQL.Append(s);

        if Param.GetNull or (Param.GetDataType = dtCursor) then
          ValuesSQL.Append('null')
        else
          ValuesSQL.Append(TPgTextConverter.ValueToText(Param.Value, Param.GetDataType, Param.GetSubDataType,
                           FUsedConnection.FUseUnicode, True, False, FUsedConnection.VersionIsEqualOrHigher(9, 0)));

        PrevPos := FPlaceHolders[i].EndPosition;
      end;

      s := Copy(FinalSQL, PrevPos, MaxInt);
      ValuesSQL.Append(s);

      Result := ValuesSQL.ToString;
    finally
      ValuesSQL.Free;
    end;
  end
  else
    Result := FinalSQL;
end;

procedure TPgSQLCommand.CallbackBindParamValue(Dest: TPgSQLNet; ParamNo: integer; const ItemDesc: TPgSQLItemDesc);
var
  Param: TPgSQLParamDesc;
  DataType, SubDataType: word;
  Length, Scale, Size: integer;
  Fixed: boolean;
  ObjectType: TObjectType;
begin
  Param := FInParamRefs[ParamNo];
  Assert(Param <> nil);

  if Param.GetNull then
    TPgBinaryConverter.WriteValue(Null, Dest, 0, 0, nil, FUsedConnection)
  else begin
    FUsedConnection.FTypes.DecodeTypeLength(ItemDesc.TypeOid, ItemDesc.TypeModifier, Length, Scale);
    FUsedConnection.FTypes.DetectDataType(ItemDesc.TypeOid, {$IFNDEF LITE}nil,{$ENDIF}
      DataType, SubDataType, Length, Scale, Size, Fixed, ObjectType,
      True, True, True, False, False, False, True, False);
    TPgBinaryConverter.WriteValue(Param.Value, Dest, DataType, SubDataType, ObjectType,
      FUsedConnection);
  end;
end;

procedure TPgSQLCommand.PerformPrepare(const SQL: string; ParsedSQLType: TParsedStmtType; const ParamTypes: TIntegerDynArray);
begin
  FCursorRef.FStmtHandle.Prepared := False;
  FUsedConnection.FProtocol.PrepareStmt(FCursorRef.FStmtHandle, SQL, ParsedSQLType, ParamTypes);
  if not UseSimpleProtocol then
    FCursorRef.FStmtHandle.Prepared := True;
end;

procedure TPgSQLCommand.PerformUnprepare;
begin
  FCursorRef.FStmtHandle.Prepared := False;
  // Protocol = nil after Connection lost
  if FUsedConnection.FProtocol <> nil then
    FUsedConnection.FProtocol.UnPrepareStmt(FCursorRef.FStmtHandle);
end;

procedure TPgSQLCommand.PerformBindExecute;
begin
  FUsedConnection.FProtocol.BindExecutePreparedStmt(FCursorRef.FStmtHandle, CallbackBindParamValue);
end;

procedure TPgSQLCommand.PerformClosePortal;
begin
  if GetCursorState > csPrepared then begin
    // Protocol = nil after Connection lost
    if FUsedConnection.FProtocol <> nil then
      FUsedConnection.FProtocol.CloseStmt(FCursorRef.FStmtHandle);
    SetCursorState(csPrepared);
  end;
end;

procedure TPgSQLCommand.InternalExecute;
var
  i: integer;
  Param: TPgSQLParamDesc;
  LargeObject: TPgSQLLargeObject;
  NeedPrepare: boolean;
  OldCursorState: TCursorState;

begin
  NeedPrepare := not GetPrepared;
  if NeedPrepare then
    Prepare
  else begin
    if not FCursorRef.FStmtHandle.Prepared and not UseSimpleProtocol then begin
      Unprepare;
      Prepare;
    end;
    if FCursorRef.FStmtHandle.Prepared and UseSimpleProtocol then begin
      Unprepare;
      Prepare;
    end;
  end;    

  OldCursorState := GetCursorState;
  try
    for i := 0 to FParams.Count - 1 do begin
      Param := TPgSQLParamDesc(FParams[i]);
      case Param.GetDataType of
        dtPgLargeObject: begin
          LargeObject := Param.GetObject as TPgSQLLargeObject;
          if LargeObject.Cached then begin
            LargeObject.Connection := FUsedConnection;
            LargeObject.WriteBlob;
          end;
        end;
      {$IFDEF LITE}
        dtBlob:
          if not FOIDAsInt and (Param.FTypeOID = SQL_OID) then begin
            LargeObject := TPgSQLLargeObject.Create(FUsedConnection);
            LargeObject.SetData(TBlob(Param.GetObject).GetData);
            TBlob(Param.GetObject).Free;
            Param.SetObject(LargeObject);
            LargeObject.CreateObject;
            LargeObject.WriteBlob;
          end;
      {$ENDIF}
      end;
    end;

    FUsedConnection.FProtocol.SetTimeout(FCommandTimeout);

    if UseSimpleProtocol then
      FUsedConnection.FProtocol.ExecuteStmt(FCursorRef.FStmtHandle, string(GetFinalSQLWithParamValues), GetParsedStmtType)
    else
      PerformBindExecute;

    SetCursorState(csExecuted);

    if OutParamsReturn then
      ReadOutParams;

    if FRecordSet = nil then
      PerformClosePortal;

    // when we execute insert statement with returnin this information
    // is be available after fetch
    FLastInsertOID := FUsedConnection.FProtocol.LastInsertOID(FCursorRef.FStmtHandle);
    FUsedConnection.SetProp(prLastInsertId, FLastInsertOID);
    FRowsAffected := FUsedConnection.FProtocol.RowsAffected(FCursorRef.FStmtHandle);
  except
    on E: Exception do begin
      if UseSimpleProtocol then begin
        if GetPrepared then
          Unprepare;
      end
      else
        SetCursorState(OldCursorState);
      FRowsAffected := 0;

      if E is EPgError then
        FUsedConnection.ProcessInternalException(EPgError(E), Component)
      else
        raise;
    end;
  end;

  if NeedPrepare then
    UnPrepare;
end;

procedure TPgSQLCommand.DescribeFields;
var
  i: integer;
  OutParams: TPgSQLItemDescs;
  DataType: Word;
  ObjectType: TObjectType;
begin
  FUsedConnection.FProtocol.DescribeFields(FCursorRef.FStmtHandle, OutParams);
  for i := 0 to Length(OutParams) - 1 do begin
    DataType := FUsedConnection.FTypes.GetInternalType(OutParams[i].TypeOid, ObjectType);
    OutParams[i].FormatCode := GetFormatCode(DataType, OutParams[i].TypeModifier, 0, True);
  end;
end;

procedure TPgSQLCommand.DescribeParams;
var
  i: integer;
  InParams: TPgSQLItemDescs;
  DataType: Word;
  ObjectType: TObjectType;
begin
  if NativeCursor then begin
    FUsedConnection.FProtocol.DescribeParams(FCursorRef.FStmtHandle, InParams);

  {$IFNDEF LITE}
    if Length(InParams) <> FInParamsCount then
      raise Exception.Create(SInvalidParams);
  {$ENDIF}

    for i := 0 to Length(InParams) - 1 do begin
      DataType := FUsedConnection.FTypes.GetInternalType(InParams[i].TypeOid, ObjectType);
      InParams[i].FormatCode := GetFormatCode(DataType, InParams[i].TypeModifier, 0, False);
    end;
  {$IFDEF LITE}
    for i := 0 to Length(InParams) - 1 do
      FInParamRefs[i].FTypeOID := InParams[i].TypeOid;
  {$ENDIF}
  end;
end;

procedure TPgSQLCommand.ReadOutParams;
var
  RecordSet: TPgSQLRecordSet;
  i, n: integer;
  Param: TPgSQLParamDesc;
  Field: TFieldDesc;
  RecBuf: IntPtr;
  Value: Variant;
  SourceObj: TSharedObject;
  Blob: TBlob;
begin
  RecordSet := TPgSQLRecordSet.Create;
  try
    RecordSet.SetProp(prFetchRows, 1);
    RecordSet.SetProp(prFlatBuffers, False);
    RecordSet.SetProp(prOidAsInt, True);
    RecordSet.SetProp(prCursorAsString, True);

    RecordSet.SetConnection(FUsedConnection);
    RecordSet.GetCommand.SetCursor(FCursor);
    RecordSet.Open;
    RecordSet.AllocRecBuf(IntPtr(RecBuf));
    try
      RecordSet.GetNextRecord(RecBuf);
      if RecordSet.Eof then
        Exit;

      n := 0;
      for i := 0 to FParams.Count - 1 do begin
        Param := TPgSQLParamDesc(FParams[i]);
        if Param.GetParamType in [pdOutput, pdInputOutput, pdResult] then begin
          if n >= RecordSet.Fields.Count then
            break;
          repeat
            Field := RecordSet.Fields[n];
            Inc(n);
          until Field.ParentField = nil;

          if not CheckTypeCorrespondence(Param.GetDataType, Field.DataType) then
            raise Exception.CreateFmt(SInvalidOutParamDataType, [Param.GetName]);

          if RecordSet.GetNull(Field, RecBuf) then
            Param.SetNull(True)
          else begin
            Param.SetNull(False);
            if Field.IsComplex and
              not (Field.DataType in [dtExtString, dtExtWideString])
            then begin
              SourceObj := RecordSet.InternalGetObject(Field, RecBuf);
              case Field.DataType of
                dtBlob, dtMemo, dtWideMemo: begin
                  if Param.GetDataType = dtString then
                    Param.Value := TBlob(SourceObj).AsAnsiString
                  else
                  if Param.GetDataType = dtWideString then
                    Param.Value := TBlob(SourceObj).AsWideString
                  else begin
                    Blob := Param.GetObject as TBlob;
                    // cannot be used in UniDAC
                    {Blob.GetData.Clear;
                    Blob.IsUnicode := TBlob(SourceObj).IsUnicode;
                    Blob.SetData(TBlob(SourceObj).GetData);}
                    Blob.Assign(TBlob(SourceObj));
                  end;
                end;
              {$IFNDEF LITE}
                dtPgDate, dtPgTime, dtPgTimeStamp, dtPgTimeStampTZ:
                  TCustomPgTimeStamp(Param.GetObject).Assign(TCustomPgTimeStamp(SourceObj));
                dtPgInterval:
                  TPgInterval(Param.GetObject).Assign(TPgInterval(SourceObj));
                dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
                  TPgGeometric(Param.GetObject).Assign(TPgGeometric(SourceObj));
                dtObject: begin
                  TPgRow(Param.GetObject).RowType := TPgRow(SourceObj).RowType;
                  TPgRow(Param.GetObject).Assign(TPgRow(SourceObj));
                end;
              {$ENDIF}
              end
            end
            else begin
              RecordSet.GetFieldAsVariant(Field, RecBuf, Value);
              case Param.GetDataType of
                dtPgLargeObject:
                  TPgSQLLargeObject(Param.GetObject).OID := Value;
                dtCursor:
                  TPgRefCursor(Param.GetObject).Assign(FUsedConnection, Value);
              else
                Param.Value := Value;
              end;
            end;
          end;
        end;
      end;
    finally
      Marshal.FreeHGlobal(RecBuf);
      RecordSet.Close;
    end;
  finally
    RecordSet.Free;
  end;
end;

procedure TPgSQLCommand.SplitParams;
var
  i: integer;
  Index: integer;
begin
  FInParamsCount := 0;
  FOutParamsCount := 0;

  for i := 0 to FParams.Count - 1 do begin
    if FParams[i].GetParamType in [pdUnknown, pdInput, pdInputOutput] then
      Inc(FInParamsCount);
    if FParams[i].GetParamType in [pdInputOutput, pdOutput, pdResult] then
      Inc(FOutParamsCount);
  end;

  if not UseSimpleProtocol then begin
    SetLength(FInParamRefs, FInParamsCount);

    Index := 0;
    for i := 0 to FParams.Count - 1 do
      if FParams[i].GetParamType in [pdUnknown, pdInput, pdInputOutput] then begin
        FInParamRefs[Index] := TPgSQLParamDesc(FParams[i]);
        Inc(Index);
      end;
  end;
end;

procedure TPgSQLCommand.ResetParams;
begin
  FInParamsCount := 0;
  FOutParamsCount := 0;

  SetLength(FInParamRefs, 0);
end;

function TPgSQLCommand.NativeCursor: boolean;
begin
  Result := FCursor = FCursorRef;
end;

function TPgSQLCommand.OutParamsReturn: boolean;
begin
  CheckConnection;
  
  Result := False;
  if GetPrepared then
    Result := NativeCursor and
      (FUsedConnection.FProtocol.RowsReturn(FCursorRef.FStmtHandle) and
      ((FOutParamsCount > 0) or FUsedConnection.FProtocol.IsVoidFunc(FCursorRef.FStmtHandle)
        or (FRecordSet = nil) or (FRecordSet.FDescribeExecute)));
end;

function TPgSQLCommand.RowsReturn: boolean;
begin
  CheckConnection;

  Result := False;
  if GetPrepared then
    Result := FUsedConnection.FProtocol.RowsReturn(FCursorRef.FStmtHandle) and
      ((FRecordSet <> nil) and FRecordSet.FDescribeExecute or not OutParamsReturn);
end;

function TPgSQLCommand.GetParsedStmtType: TParsedStmtType;
begin
  if not NativeCursor then
    Result := stCursor
  else
    Result := FParsedStmtType;
end;

procedure TPgSQLCommand.BreakExec;
begin
  if (GetCursorState <> csInactive) and (FUsedConnection <> nil) then
    FUsedConnection.BreakExec;
end;

{ TPgSQLRecordSet }

constructor TPgSQLRecordSet.Create;
begin
  inherited;

  FFetchAll := True;
  FFetchRows := 25;
end;

destructor TPgSQLRecordSet.Destroy;
begin
  Close;

  inherited;
end;

procedure TPgSQLRecordSet.FetchAll;
begin
  if (FCommand.GetCursorState >= csExecuted) and (FCommand.GetCursorState < csFetchingAll) then begin
    FCommand.SetCursorState(csFetchingAll);
    try
      while True do begin
        repeat
          Fetch(False);
        until FNoFetchData;

        if UsedConnection.GetConnected and UsedConnection.FProtocol.HasMoreResultSets then begin
          FreeData;
          InitData;
          FEOF := False;
          CheckFieldDescs;
        end
        else
          break;
      end;
    finally
      if FCommand.GetCursorState <> csInactive then
        FCommand.SetCursorState(csFetched);
    end;
  end;
end;

function TPgSQLRecordSet.CanDisconnect: boolean;
begin
  Result := not FNeedExtFieldsInfo and inherited CanDisconnect;
end;

function TPgSQLRecordSet.GetFieldDescType: TFieldDescClass;
begin
  Result := TPgSQLFieldDesc;
end;

procedure TPgSQLRecordSet.ExecCommand;
var
  NeedPrepare: boolean;
begin
  try
    NeedPrepare := not Prepared;
    if NeedPrepare then
      InternalPrepare;

    try
      FFetchCursor.FStmtHandle.FetchAll := FFetchAll;
      FFetchCursor.FStmtHandle.WithHold := FCursorWithHold;
      if FFetchAll then
        FFetchCursor.FStmtHandle.FetchRows := 0
      else
        FFetchCursor.FStmtHandle.FetchRows := FFetchRows;

      if (FCommand.GetParsedStmtType = stSelect) and not FCursorWithHold and
        not FFetchAll and not UsedConnection.GetInTransaction
      then
        raise Exception.Create(SFetchAllFalseNeedTransaction);

      inherited;

      if FCommand.UseSimpleProtocol then // no fields on prepare
        SetCommandType;

    except
      if NeedPrepare then
        InternalUnprepare;
      raise;
    end;
    if FCommand.CommandType <> ctCursor then
      if NeedPrepare then
        InternalUnprepare
      else
        FCommand.PerformClosePortal;

  except
    if not FDescribeExecute and Assigned(FCommand.AfterExecute) then
      FCommand.AfterExecute(False);
    raise;
  end;
  if not FDescribeExecute and Assigned(FCommand.AfterExecute) then
    FCommand.AfterExecute(True);
end;

function TPgSQLRecordSet.IsFullReopen: boolean;
begin
  Result := not FCommand.NativeCursor;
end;

procedure TPgSQLRecordSet.Reopen;
begin
  if FCommand.NativeCursor then begin
    FCommand.PerformClosePortal;

    FreeData;
    InitData;
    if Assigned(FOnDataChanged) then
      // perform dataset resync to prevent AV if grid is repainted in BeforeFetch/AfterFetch events
      FOnDataChanged;

    InternalOpen(True);
  end
  else begin
    Close;
    Open;
  end;
end;

procedure TPgSQLRecordSet.CreateComplexField(RecBuf: IntPtr; Field: TFieldDesc);
begin
  InternalCreateComplexField(RecBuf, UsedConnection, Field.Offset,
    Field.DataType, Field.SubDataType, Field.ObjectType, FCreateFieldObjectFunc, FCacheBlobs);
end;

class procedure TPgSQLRecordSet.InternalCreateComplexField(RecBuf: IntPtr; Connection: TPgSQLConnection;
  Offset: integer; DataType: word; SubDataType: word; ObjectType: TObjectType;
  CreateFieldObjectFunc: TCreateFieldObjectFunc; CacheBlobs: boolean);
var
  Ptr: IntPtr;
  Obj: TSharedObject;
begin
  Obj := nil;
  Ptr := PtrOffset(RecBuf, Offset);

  if Assigned(CreateFieldObjectFunc) then
    Obj := CreateFieldObjectFunc(DataType);

  case DataType of
    // copied from MemData
    dtBlob, dtMemo, dtWideMemo: begin
      Obj := TCompressedBlob.Create; // TODO: UniDAC require TCompressedBlob
      if DataType = dtWideMemo then
        TBlob(Obj).IsUnicode := True;
      // RollBack is always on for LOB fields. Otherwise modification
      // that cannot be canceled is possible.
      TBlob(Obj).EnableRollback;
    end;
    dtExtString, dtExtWideString, dtExtVarBytes:
      Marshal.WriteIntPtr(Ptr, nil);
    //
    dtPgLargeObject: begin
      if Obj = nil then                       // UniDac and dbExpress
        Obj := TPgSQLLargeObject.Create(Connection);

      TPgSQLLargeObject(Obj).Cached := CacheBlobs;
    end;
  {$IFNDEF LITE}
    dtPgDate:
      Obj := TPgDate.Create;
    dtPgTime: begin
      Obj := TPgTime.Create;
      if SubDataType = dtPgTimeTZ then
        TPgTime(Obj).HasTimeZone := True;
    end;
    dtPgTimeStamp, dtPgTimeStampTZ: begin
      Obj := TPgTimeStamp.Create;
      if SubDataType = dtPgTimeStampTZ then
        TPgTimeStamp(Obj).HasTimeZone := True;
    end;
    dtPgInterval:
      Obj := TPgInterval.Create;
    dtPgPoint:
      Obj := TPgPoint.Create;
    dtPgLSeg:
      Obj := TPgLSeg.Create;
    dtPgBox:
      Obj := TPgBox.Create;
    dtPgPath:
      Obj := TPgPath.Create;
    dtPgPolygon:
      Obj := TPgPolygon.Create;
    dtPgCircle:
      Obj := TPgCircle.Create;
    dtObject:
      Obj := TPgRow.Create(TPgRowType(ObjectType));
  {$ENDIF}
    dtCursor:
      Obj := TPgRefCursor.Create;
  else
    inherited;
  end;

  if Obj <> nil then
    Marshal.WriteIntPtr(Ptr, Obj.GCHandle);
end;

procedure TPgSQLRecordSet.FreeComplexField(RecBuf: IntPtr; Field: TFieldDesc);
var
  Obj: TSharedObject;
begin
  case Field.DataType of
    dtPgLargeObject,
    dtPgDate, dtPgTime, dtPgTimeStamp, dtPgTimeStampTZ, dtPgInterval,
    dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle,
    dtCursor, dtObject: begin
      Obj := TSharedObject(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset)));
      Obj.Free;
    end;
  else
    inherited;
  end;
end;

{$IFNDEF LITE}
procedure TPgSQLRecordSet.CopyComplexField(Source: IntPtr; Dest: IntPtr; Field: TFieldDesc);
var
  SrcPtr, DestPtr: IntPtr;
begin
  SrcPtr := Marshal.ReadIntPtr(Source, Field.Offset);
  DestPtr := Marshal.ReadIntPtr(Dest, Field.Offset);
  case Field.DataType of
    dtPgDate, dtPgTime, dtPgTimeStamp, dtPgTimeStampTZ:
      TCustomPgTimeStamp(GetGCHandleTarget(DestPtr)).Assign(TCustomPgTimeStamp(GetGCHandleTarget(SrcPtr)));
    dtPgInterval:
      TPgInterval(GetGCHandleTarget(DestPtr)).Assign(TPgInterval(GetGCHandleTarget(SrcPtr)));
    dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
      TPgGeometric(GetGCHandleTarget(DestPtr)).Assign(TPgGeometric(GetGCHandleTarget(SrcPtr)));
    dtObject:
      TPgRow(GetGCHandleTarget(DestPtr)).Assign(TPgRow(GetGCHandleTarget(SrcPtr)));
  else
    inherited;
  end;
end;

function TPgSQLRecordSet.InternalCompareFieldValue(ValuePtr: IntPtr; ValueType: Word; FieldBuf: IntPtr; FieldType: Word; FieldLength: Integer; HasParent: boolean; IsFixed: boolean; const Options: TCompareOptions): integer;
var
  v: variant;
  Obj: TSharedObject;
  NeedFree: boolean;
  ts1, ts2: TCustomPgTimeStamp;
  int1, int2: TPgInterval;
  Geom1, Geom2: TPgGeometric;
begin
  Obj := nil;
  NeedFree := False;
  try
    case FieldType of
      dtPgDate, dtPgTime, dtPgTimeStamp, dtPgTimeStampTZ: begin
        ts2 := TCustomPgTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf)));
        ts1 := nil;
        v := Unassigned;
        case ValueType of
          dtDateTime, dtDate, dtTime:
            v := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(ValuePtr));
          dtString:
            v := Marshal.PtrToStringAnsi(ValuePtr);
          dtWideString:
            v := Marshal.PtrToStringUni(ValuePtr);
          dtPgDate, dtPgTime, dtPgTimeStamp, dtPgTimeStampTZ:
            ts1 := TCustomPgTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(ValuePtr)));
        else
          Assert(False);
        end;
        if ts1 = nil then begin
          case FieldType of
            dtPgDate:
              TPgBufferConverter.VarToPgDate(v, Obj, NeedFree);
            dtPgTime:
              TPgBufferConverter.VarToPgTime(v, ts2.HasTimeZone, Obj, NeedFree);
            dtPgTimeStamp, dtPgTimeStampTZ:
              TPgBufferConverter.VarToPgTimeStamp(v, Obj, NeedFree);
          end;
          ts1 := TCustomPgTimeStamp(Obj);
        end;
        Result := ts1.Compare(ts2);
      end;
      dtPgInterval: begin
        int2 := TPgInterval(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf)));
        int1 := nil;
        v := Unassigned;
        case ValueType of
          dtString:
            v := Marshal.PtrToStringAnsi(ValuePtr);
          dtWideString:
            v := Marshal.PtrToStringUni(ValuePtr);
          dtPgInterval:
            int1 := TPgInterval(GetGCHandleTarget(Marshal.ReadIntPtr(ValuePtr)));
        else
          Assert(False);
        end;
        if int1 = nil then begin
          TPgBufferConverter.VarToPgInterval(v, Obj, NeedFree);
          int1 := TPgInterval(Obj);
        end;
        Result := int1.Compare(int2);
      end;
      dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle: begin
        Geom2 := TPgGeometric(GetGCHandleTarget(Marshal.ReadIntPtr(FieldBuf)));
        Geom1 := nil;
        v := Unassigned;
        case ValueType of
          dtString:
            v := Marshal.PtrToStringAnsi(ValuePtr);
          dtWideString:
            v := Marshal.PtrToStringUni(ValuePtr);
          dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle:
            Geom1 := TPgGeometric(GetGCHandleTarget(Marshal.ReadIntPtr(ValuePtr)));
        else
          Assert(False);
        end;
        if Geom1 = nil then begin
          TPgBufferConverter.VarToPgGeometric(v, FieldType, Obj, NeedFree);
          Geom1 := TPgGeometric(Obj);
        end;
        Result := AnsiCompareStr(Geom1.AsString, Geom2.AsString);
      end;
    else
      Result := inherited InternalCompareFieldValue(ValuePtr, ValueType, FieldBuf, FieldType, FieldLength, HasParent, IsFixed, Options);
    end;
  finally
    if NeedFree then
      Obj.Free;
  end;
end;

function TPgSQLRecordSet.GetSortOptions(SortColumn: TSortColumn): TCompareOptions;
begin
  Result := inherited GetSortOptions(SortColumn) + [coInvertNullOrder];
end;

function TPgSQLRecordSet.GetNull(Field: TFieldDesc; RecBuf: IntPtr): boolean;
var
  Obj: TPgRow;
begin
  CheckFetched(RecBuf, Field);

  if not Field.HasParent then begin
    case Field.DataType of
      dtObject: begin
        Obj := TPgRow(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset)));
        Result := Obj.IsNull;
      end;
      dtPgPoint,
      dtPgLSeg,
      dtPgBox,
      dtPgPath,
      dtPgPolygon,
      dtPgCircle:
        Result := TPgGeometric(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset))).IsNull;
      dtPgInterval:
        Result := TPgInterval(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset))).IsNull;
      dtPgDate,
      dtPgTime,
      dtPgTimeStamp,
      dtPgTimeStampTZ,
      dtPgTimeTZ:
        Result := TCustomPgTimeStamp(GetGCHandleTarget(Marshal.ReadIntPtr(RecBuf, Field.Offset))).IsNull;
    else
      Result := Marshal.ReadByte(RecBuf, DataSize + Field.FieldNo - 1) = 1;
      if Result then
        Result := GetNullByBlob(Field, RecBuf);
    end;
  end
  else
    Result := GetChildFieldIsNull(Field, RecBuf);
end;

{$ENDIF}

procedure TPgSQLRecordSet.SetToEnd;
begin
  FetchAll;

  inherited;
end;

function TPgSQLRecordSet.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prOIDAsInt:
      FCommand.FOIDAsInt := Value;
    prCacheBlobs:
      FCacheBlobs := Value;
    prDeferredBlobRead:
      FDeferredBlobRead := Value;
    prCommandTimeout: begin
      Assert(FCommand <> nil);
      FCommand.FCommandTimeout := Value;
    end;
    prCursorAsString:
      FCursorAsString := Value;
    prUnknownAsString:
      FUnknownAsString := Value;
    prFieldsAsText:
      FCommand.FFieldsAsText := Value;
    prSimpleQueryExecute:
      FCommand.FForceSimpleProtocol := Value;
    prUseParamTypes:
      FCommand.FUseParamTypes := Value;
    prCursorWithHold: begin
      // Command should be unprepared on CursorWithHold prop changed
      if FCursorWithHold <> Value then
        UnPrepare;
      FCursorWithHold := Value;
    end;
    prDistinctParams: if FCommand.FDistinctParams <> Value then begin
      UnPrepare;
      FCommand.SetProp(prDistinctParams, Value);
    end;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TPgSQLRecordSet.GetProp(Prop: integer; out Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prRowsFetched:
      Value := FRowsFetched;
    prOIDAsInt:
      Value := FCommand.FOIDAsInt;
    prCacheBlobs:
      Value := FCacheBlobs;
    prDeferredBlobRead:
      Value := FDeferredBlobRead;
    prCommandTimeout: begin
      Assert(FCommand <> nil);
      Value := FCommand.FCommandTimeout;
    end;
    prUnknownAsString:
      Value := FUnknownAsString;
    prFieldsAsText:
      Value := FCommand.FFieldsAsText;
    prSimpleQueryExecute:
      Value := FCommand.FForceSimpleProtocol;
    prUseParamTypes:
      Value := FCommand.FUseParamTypes;
    prCursorWithHold:
      Value := FCursorWithHold;
    prDistinctParams:
      Value := FCommand.FDistinctParams;
  else
    Result := inherited GetProp(Prop, Value);
  end
end;

procedure TPgSQLRecordSet.CreateCommand;
begin
  SetCommand(TPgSQLCommand.Create);
end;

procedure TPgSQLRecordSet.SetCommand(Value: TCRCommand);
begin
  inherited;

  FCommand := TPgSQLCommand(Value);
  if FCommand <> nil then
    FCommand.FRecordSet := Self;
end;

function TPgSQLRecordSet.UsedConnection: TPgSQLConnection;
begin
  Result := FCommand.FUsedConnection;
end;

function TPgSQLRecordSet.InternalGetObject(Field: TFieldDesc; RecBuf: IntPtr): TSharedObject;
begin
  Result := inherited InternalGetObject(Field, RecBuf);
end;

procedure TPgSQLRecordSet.InternalPrepare;
begin
  inherited;

  InitFetchCursor;
end;

procedure TPgSQLRecordSet.InternalUnPrepare;
begin
  if not FCommand.NativeCursor then
    try
      FCommand.Unprepare;
    finally
      FCommand.SetCursor(nil);
    end;

  inherited;

  FCommand.CommandType := ctUnknown;
end;

procedure TPgSQLRecordSet.InitFetchCursor;
var
  RefCursor: TPgCursor;
begin
  RefCursor := nil;
  if FCommand.NativeCursor and (FCommand.FOutParamsCount > 0) then
    RefCursor := FCommand.GetFirstCursor;

  if RefCursor <> nil then begin
    if FCommand.GetCursorState < csExecuted then
      FCommand.Execute();

    FCommand.SetCursor(RefCursor);
    try
      FCommand.Prepare;
    except
      FCommand.SetCursor(nil);
      FCommand.Unprepare;
      raise;
    end;
    FFetchCursor := RefCursor;
  end
  else
    FFetchCursor := FCommand.FCursorRef;

  if FCommand.UseSimpleProtocol then begin // no fields on prepare
    if not FCommand.NativeCursor then
      FCommand.CommandType := ctCursor
    else
      FCommand.CommandType := ctStatement;
  end
  else
    SetCommandType;
end;

function TPgSQLRecordSet.NeedInitFieldsOnFetch: boolean;
begin
  Result := not FCommand.NativeCursor;
end;

procedure TPgSQLRecordSet.DetectIdentityField;
var
  FieldDesc: TPgSQLFieldDesc;
  i: integer;
begin
  FIdentityField := nil;

  for i := 0 to FFields.Count - 1 do begin
    FieldDesc := TPgSQLFieldDesc(FFields[i]);
    if (CompareText(FieldDesc.ActualName, 'OID') = 0) and (FieldDesc.TableCol <= 0) then
      if FieldDesc.TableInfo = UpdatingTableInfo then begin
        FIdentityField := FieldDesc;
        Exit;
      end;
  end;
end;

procedure TPgSQLRecordSet.CreateFieldDescs;

  procedure DescribeFieldDesc(Field: TPgSQLFieldDesc; ItemDesc: TPgSQLItemDesc; FieldNo: Integer);
  var
    DataType, SubDataType: word;
    Length, Scale, Size: integer;
    Fixed: boolean;
    ObjectType: TObjectType;
  {$IFNDEF LITE}
    FetchConverter: TFetchConverter;
  {$ENDIF}
  begin
    Field.Name := ItemDesc.FieldName;
    Field.ActualName := Field.Name;
    Field.FieldNo := FieldNo;

    Field.TableOID := ItemDesc.TableOid;
    Field.TableCol := ItemDesc.TableCol;

    UsedConnection.FTypes.DecodeTypeLength(ItemDesc.TypeOid, ItemDesc.TypeModifier, Length, Scale);

    Field.DBLength := Length;
    Field.DBScale := Scale;
  {$IFNDEF LITE}
    Field.DBType := TPgConverterManager.GetDBType(ItemDesc.TypeOid);
    FetchConverter := GetMapFetchConverter(Field.Name, Field.DBType, Field.DBLength, Field.DBScale);
  {$ENDIF}

    UsedConnection.FTypes.DetectDataType(ItemDesc.TypeOid, {$IFNDEF LITE}FetchConverter,{$ENDIF}
      DataType, SubDataType, Length, Scale, Size, Fixed, ObjectType,
      FLongStrings, FFlatBuffers, FCommand.FOIDAsInt,
      FCommand.EnableBCD, {$IFNDEF FPC}FCommand.EnableFMTBCD{$ELSE}False{$ENDIF}, FCursorAsString,
      FUnknownAsString, FCommand.FFieldsAsText);

    Field.FIsTextMode := FCommand.GetFormatCode(DataType, ItemDesc.TypeModifier, Scale, True) = 0;

    // OID column
    if (CompareText(Field.Name, 'OID') = 0) and
      (Field.TableCol < 0) and
      (DataType = dtPgLargeObject)
    then
      DataType := dtInteger;

    Field.DataType := DataType;
    Field.SubDataType := SubDataType;
    Field.Size := Size;
    Field.Length := Length;
    Field.Scale := Word(Scale);
    Field.Fixed := Fixed;
    Field.ObjectType := ObjectType;
  end;

var
  OldCursorState: TCursorState;
  Field: TPgSQLFieldDesc;
  PgSQLItemDescs: TPgSQLItemDescs;
  FieldsCount: Integer;
  i: integer;
begin
  OldCursorState := FCommand.GetCursorState;
  if OldCursorState = csInactive then begin
    if not FCommand.UseSimpleProtocol then
      InternalPrepare
    else begin
      FDescribeExecute := True;
      try
        ExecCommand;
      finally
        FDescribeExecute := False;
      end;
    end;
  end;

  try
    if FCommand.CommandType <> ctCursor then
      raise Exception.Create(SNotRows);

    UsedConnection.FProtocol.DescribeFields(FFetchCursor.FStmtHandle, PgSQLItemDescs);

    FieldsCount := Length(PgSQLItemDescs);
    for i := 0 to FieldsCount - 1 do begin
      Field := TPgSQLFieldDesc(CreateFieldDesc);
      DescribeFieldDesc(Field, PgSQLItemDescs[i], FFields.Count + 1);
      Field.ActualFieldNo := i;
      FFields.Add(Field);

      if Field.DataType = dtObject then
        InitObjectFields(Field.ObjectType, Field);
    end;

    FCommand.SQLInfo.ParseTablesInfo(FCommand.SQL, FTablesInfo);
    FTablesInfo.CaseSensitive := True;
    if not (FCommand.GetCursorState in [csExecuted, csFetching, csFetchingAll]) {$IFNDEF LITE}or (FSmartFetchState = sfMetaInfo){$ENDIF} then
      GetExtFieldsInfo
    else
      FNeedExtFieldsInfo := True;
  finally
    if OldCursorState = csInactive then
      InternalUnPrepare;
  end;
end;

procedure TPgSQLRecordSet.PutFieldData(Field: TFieldDesc; FieldBuf: IntPtr; Source: IntPtr; NeedConvert: boolean; IsDatabaseValue: boolean = False);
var
  i, pw: Integer;
  d: Double;
begin
  inherited PutFieldData(Field, FieldBuf, Source, NeedConvert, IsDatabaseValue);

  // fix storing TimeStamp(0) .. TimeStamp(5) data types
  if (Field.SubDataType in [dtPgTime, dtPgTimeTZ, dtPgTimeStamp, dtPgTimeStampTZ]) and
     (SmallInt(Field.Scale) < 0)
  then begin
    pw := 86400;
    i := SmallInt(Field.Scale);
    while i > -6 do begin
      pw := pw * 10;
      Dec(i);
    end;
  {$IFDEF FPC}
    if Field.SubDataType in [dtPgTime, dtPgTimeTZ] then begin
      d := Marshal.ReadInt32(FieldBuf) / MSecsPerDay;
      d := Round(d * pw) / pw;
      Marshal.WriteInt32(FieldBuf, Round(d * MSecsPerDay));
    end
    else begin
  {$ENDIF}
      d := BitConverter.Int64BitsToDouble(Marshal.ReadInt64(FieldBuf));
      d := Round(d * pw) / pw;
      Marshal.WriteInt64(FieldBuf, BitConverter.DoubleToInt64Bits(d));
  {$IFDEF FPC}
    end;
  {$ENDIF}
  end;
end;

procedure TPgSQLRecordSet.InternalOpen(DisableInitFields: boolean = False);
begin
  inherited;

  if FNeedExtFieldsInfo then begin
    GetExtFieldsInfo;
    DoAfterFetch;
  end;
end;

procedure TPgSQLRecordSet.InternalClose;
begin
  FCommand.PerformClosePortal;

  inherited;

  if not Prepared then
    InternalUnprepare;
end;

class function TPgSQLRecordSet.IsBlobDataType(DataType: word): boolean;
begin
  Result := (DataType = dtPgLargeObject) or inherited IsBlobDataType(DataType);
end;

class function TPgSQLRecordSet.IsComplexDataType(DataType: word): boolean;
begin
  case DataType of
    dtPgLargeObject,
    dtPgDate, dtPgTime, dtPgTimeStamp, dtPgTimeStampTZ, dtPgInterval,
    dtPgPoint, dtPgLSeg, dtPgBox, dtPgPath, dtPgPolygon, dtPgCircle,
    dtCursor, dtObject:
      Result := True;
  else
    Result := inherited IsComplexDataType(DataType);
  end;
end;

procedure TPgSQLRecordSet.SetCommandType;
begin
  if FCommand.RowsReturn then
    FCommand.CommandType := ctCursor
  else
    FCommand.CommandType := ctStatement;
end;

procedure TPgSQLRecordSet.ReceiveFetchBuffer(Source: TPgSQLNet; Size: integer;
  FetchBlock: IntPtr; Row, Col: integer);
var
  Field: TPgSQLFieldDesc;
  IsNull: boolean;
  RecBuf, FieldBuf, Buf, HeapBuffer: IntPtr;
begin
  Field := TPgSQLFieldDesc(FFields.FieldByActualFieldNo(Col));
  RecBuf := PtrOffset(FetchBlock, SizeOf(TBlockHeader) + (RecordSize + SizeOf(TItemHeader)) * Row + SizeOf(TItemHeader));
  FieldBuf := PtrOffset(RecBuf, Field.Offset);

  CreateComplexField(RecBuf, Field);

  if (Field.ActualFieldNo > -1) {KeyOnly SmartFetchState} then
    IsNull := Size = -1
  else
    IsNull := True;
  SetNull(Field, RecBuf, IsNull);

  if not IsNull then begin
    case Field.DataType of
      dtExtString: begin
        HeapBuffer := StringHeap.NewBuf(Size + 1);
        Buf := HeapBuffer;
      end;
      dtExtWideString: begin
        HeapBuffer := StringHeap.NewBuf((Size + 1) * 2);
        Buf := HeapBuffer;
      end;
    else
      HeapBuffer := nil;
      Buf := FieldBuf;
    end;

    if Field.FIsTextMode then
      TPgTextConverter.ReadValue(Source, Size, Buf, Field.DataType, Field.SubDataType,
        Field.Fixed and TrimFixedChar, UsedConnection)
    else
      TPgBinaryConverter.ReadValue(Source, Size, Buf, Field.DataType, Field.SubDataType,
        Field.Fixed and TrimFixedChar, UsedConnection);

    if HeapBuffer <> nil then
      Marshal.WriteIntPtr(FieldBuf, HeapBuffer);
  end;
end;

procedure TPgSQLRecordSet.FetchBlock(Block: PBlockHeader; FetchBack: boolean; out RowsObtained: Integer);
begin
  RowsObtained := UsedConnection.FProtocol.FetchStmt(FFetchCursor.FStmtHandle, FFetchRows, Block, ReceiveFetchBuffer);

  FNoFetchData := UsedConnection.FProtocol.NoData(FFetchCursor.FStmtHandle);
  if FNoFetchData and not UsedConnection.FProtocol.HasMoreResultSets then
    FCommand.SetCursorState(csFetched);
end;

procedure TPgSQLRecordSet.ProcessFetchedBlock(Block: PBlockHeader; FetchBack: boolean);

  procedure ReadBlobs(FirstItem: PItemHeader);
  var
    i: integer;
    Item: PItemHeader;
    ObjPtr: IntPtr;
    SharedPiece: PPieceHeader;
    Lob: TPgSQLLargeObject;
    Field: TFieldDesc;
  begin
    Item := FirstItem;
    SharedPiece := nil;
    try
      while IntPtr(Item) <> nil do begin
        for i := 0 to FFields.Count - 1 do begin
          Field := FFields[i];
          if (Field.DataType = dtPgLargeObject) then begin
            ObjPtr := Marshal.ReadIntPtr(Item, SizeOf(TItemHeader) + Field.Offset);
            Lob := TPgSQLLargeObject(GetGCHandleTarget(ObjPtr));
            if Lob.IsCreated then begin
              if IntPtr(SharedPiece) = nil then
                TBlob.AllocPiece(SharedPiece, DefaultPieceSize);
              Lob.ReadBlob(SharedPiece);
            end;
          end;
        end;
        Item := Item.Next;
      end;
    finally
      if IntPtr(SharedPiece) <> nil then
        Marshal.FreeHGlobal(SharedPiece);
    end;
  end;

begin
  FRowsFetched := RecordCount;
  if not FDeferredBlobRead and FCacheBlobs then begin
    if not FFetchAll then
      ReadBlobs(PtrOffset(Block, sizeof(TBlockHeader)))
    else
    if FCommand.GetCursorState = csFetched then
      ReadBlobs(FirstItem);
  end;
end;

function TPgSQLRecordSet.ProcessFetchedException(E: Exception): boolean;
begin
  if E is EpgError then begin
    FCommand.SetCursorState(csFetched);
    FCommand.PerformClosePortal;
    UsedConnection.ProcessInternalException(EPgError(E), Component);
    Result := True;
  end
  else
    Result := False;
end;

function TPgSQLRecordSet.NeedUnPrepareAfterFetch: boolean;
begin
  FCommand.PerformClosePortal;
  Result := not Prepared;
end;

procedure TPgSQLRecordSet.GetExtFieldsInfo;

  function Locate1(RecordSet: TPgSQLRecordSet; RecBuf: IntPtr; Field: TFieldDesc; Value: string): boolean;
  var
    v: variant;
  begin
    RecordSet.SetToBegin;
    while True do begin
      RecordSet.GetNextRecord(RecBuf);
      if RecordSet.Eof then
        break;
      RecordSet.GetFieldAsVariant(Field, RecBuf, v);
      if VarToStr(v) = Value then begin
        Result := True;
        exit;
      end;
    end;
    Result := False;
  end;

  function Locate2(RecordSet: TPgSQLRecordSet; RecBuf: IntPtr; Field1, Field2: TFieldDesc; Value1, Value2: integer): boolean;
  var
    v: variant;
  begin
    RecordSet.SetToBegin;
    while True do begin
      RecordSet.GetNextRecord(RecBuf);
      if RecordSet.Eof then
        break;
      RecordSet.GetFieldAsVariant(Field1, RecBuf, v);
      if v = Value1 then begin
        RecordSet.GetFieldAsVariant(Field2, RecBuf, v);
        if v = Value2 then begin
          Result := True;
          exit;
        end;
      end;
    end;
    Result := False;
  end;

const
  fnNAME = 0;
  fnIDX  = 1;
  fnNOTNULL = 2;
  fnDEFAULT = 3;
  fnPRIMARY = 4;
  fnOID  = 5;
  fnNUM  = 6;
var
  ColumnsInfo: TColumnsInfo;
  ColInfo: TColumnInfo;
  i, j, p: integer;
  Value: variant;

  SchemaName: string;
  TableName: string;
  DefVal: string;
  SQL: StringBuilder;
  CaseSQL: StringBuilder;
  WhereSQL: StringBuilder;

  FieldDesc: TPgSQLFieldDesc;
  RecordSet: TPgSQLRecordSet;
  RecBuf: IntPtr;

  DefaultTable: integer;
  AsteriskCount: integer;

  AsteriskTableIndex: integer;
  Located: boolean;

  RequestServerInfo : boolean;
  Info: TSQLObjectInfo;

  FieldNAME: TFieldDesc;
  FieldIDX: TFieldDesc;
  FieldNOTNULL: TFieldDesc;
  FieldDEFAULT: TFieldDesc;
  FieldPRIMARY: TFieldDesc;
  FieldOID: TFieldDesc;
  FieldNUM: TFieldDesc;
begin
  FNeedExtFieldsInfo := False;

{$IFDEF LITE}
  if not FExtendedFieldsInfo then
    exit;
{$ENDIF}

  if FTablesInfo.Count = 0 then
    Exit;

  RecordSet := nil;
  RecBuf := nil;
  DefaultTable := -1; // table index for fields from '*'

  // we parse SQL in order to:
  //  a) get ActualFieldName (not Alias)
  //  b) get tables for fields
  //  c) get asterisks
  ColumnsInfo := TColumnsInfo.Create;
  try
    FCommand.SQLInfo.ParseColumnsInfo(FCommand.SQL, ColumnsInfo);

    // Parse tables info in select list
    AsteriskCount := 0;
    for i := 0 to ColumnsInfo.Count - 1 do begin
      ColInfo := ColumnsInfo[i];
      if ColInfo.Table <> '' then
        for j := 0 to FTablesInfo.Count - 1 do
          if (ColInfo.Table = FTablesInfo[j].TableAlias) or
            (ColInfo.Table = FTablesInfo[j].TableName)
          then begin
            ColInfo.TableIndex := j;
            Break;
          end;
      if ColInfo.Name = '*' then begin
        Inc(AsteriskCount);
        if AsteriskCount = 1 then begin // for first '*'
          if ColInfo.Table = '' then
            DefaultTable := 0
          else
            DefaultTable := ColInfo.TableIndex; // can be -1 for table that is not present in TablesInfo
        end;
      end;
    end;

    RequestServerInfo := ({RequestServerInfo and} FExtendedFieldsInfo) or
      FFieldsOrigin or FDefaultValues;

    // request additional information from server
    if RequestServerInfo then begin
      RecordSet := TPgSQLRecordSet.Create;
      RecordSet.SetConnection(UsedConnection);
      RecordSet.SetProp(prOIDAsInt, True);
      RecordSet.SetProp(prExtendedFieldsInfo, False);

      SQL := StringBuilder.Create(4096);
      CaseSQL :=  StringBuilder.Create(4096);
      WhereSQL :=  StringBuilder.Create(4096);
      try
        for i := 0 to FTablesInfo.Count - 1 do begin
          PgSQLInfo.SplitObjectName(FTablesInfo.Items[i].TableName, Info);

          TableName := PgSQLInfo.ToStringConst(PgSQLInfo.NormalizeName(Info.Name, False, True));
          CaseSQL.Append(' when relname = ' + TableName + ' then ' + IntToStr(i));
          if i > 0 then
            WhereSQL.Append(' or ');

          if UsedConnection.FProtocolVersion = pv30 then
            WhereSQL.Append('(pc.relname = ' + TableName + ')')
          else begin
            WhereSQL.Append('((pc.relname = ' + TableName + ')');
            if Info.Schema <> '' then begin
              SchemaName := PgSQLInfo.ToStringConst(PgSQLInfo.NormalizeName(Info.Schema, False, True));
              WhereSQL.Append(' and (pn.nspname = ' + SchemaName + '))')
            end
            else
              WhereSQL.Append(' and (pn.nspname = current_schema()))')
          end;
        end;

        SQL.Append('select');

        // select list
        SQL.Append(' pa.attname, case '  + CaseSQL.ToString + ' end as idx, pa.attnotnull');
        //if FDataSet.Options.DefaultValues then
        SQL.Append(', pd.adsrc, pi.indisprimary');
        if UsedConnection.FProtocolVersion = pv30 then
          SQL.Append(', pc.oid, pa.attnum');

        // from
        SQL.Append(' from pg_attribute pa');

        // join pg_class
        SQL.Append(' join pg_catalog.pg_class pc on (pa.attrelid = pc.oid)');
        // join pg_namespace
        if not (UsedConnection.FProtocolVersion = pv30) then
          SQL.Append(' join pg_catalog.pg_namespace pn on (pc.relnamespace = pn.oid)');
        // join pg_attrdef
        //if FDataSet.Options.DefaultValues then
        SQL.Append(' left join pg_catalog.pg_attrdef pd on (pd.adnum = pa.attnum) and (pd.adrelid = pc.oid)');
        SQL.Append(' left join pg_catalog.pg_index pi on (pi.indrelid = pc.oid) and (pa.attnum = ANY(pi.indkey))');

        // where
        SQL.Append(' where (pa.attnum > 0)');
        SQL.Append(' and (' + WhereSQL.ToString + ')');

        // order by
        SQL.Append(' order by idx, pa.attnum');

        RecordSet.SetSQL(SQL.ToString);
      finally
        SQL.Free;
        CaseSQL.Free;
        WhereSQL.Free;
      end;

      RecordSet.Open;
      RecordSet.AllocRecBuf(RecBuf);

      FieldNAME := RecordSet.Fields[fnNAME];
      FieldIDX := RecordSet.Fields[fnIDX];
      FieldNOTNULL := RecordSet.Fields[fnNOTNULL];
      FieldDEFAULT := RecordSet.Fields[fnDEFAULT];
      FieldPRIMARY := RecordSet.Fields[fnPRIMARY];

      // supplement parsed information
      if not (UsedConnection.FProtocolVersion = pv30) then begin
        p := 0;
        while p < ColumnsInfo.Count do begin
          if ColumnsInfo[p].Name = '*' then begin
            AsteriskTableIndex := ColumnsInfo[p].TableIndex;
            ColumnsInfo.Delete(p);

            RecordSet.SetToBegin;
            while True do begin
              RecordSet.GetNextRecord(RecBuf);
              if RecordSet.Eof then
                break;
              Value := Unassigned;
              if AsteriskTableIndex <> -1 then
                RecordSet.GetFieldAsVariant(FieldIDX, RecBuf, Value);
              if (AsteriskTableIndex = -1) or
                (Value = AsteriskTableIndex)
              then begin
                ColInfo := TColumnInfo.Create;
                RecordSet.GetFieldAsVariant(FieldNAME, RecBuf, Value);
                ColInfo.Name := VarToStr(Value);
                RecordSet.GetFieldAsVariant(FieldIDX, RecBuf, Value);
                ColInfo.TableIndex := Value;
                //if FDataSet.Options.DefaultValues then
                  RecordSet.GetFieldAsVariant(FieldDEFAULT, RecBuf, Value);
                  ColInfo.Expr := VarToStr(Value);
                RecordSet.GetFieldAsVariant(FieldNOTNULL, RecBuf, Value);
                ColInfo.Required := Boolean(Value);
                ColumnsInfo.Insert(p, ColInfo);
                Inc(p);
              end;
            end;
          end
          else begin
            Located := Locate1(RecordSet, RecBuf, FieldNAME, ColumnsInfo[p].Name);
            if Located then begin
              RecordSet.GetFieldAsVariant(FieldIDX, RecBuf, Value);
              ColumnsInfo[p].TableIndex := Value;
              //if FDataSet.Options.DefaultValues then
                RecordSet.GetFieldAsVariant(FieldDEFAULT, RecBuf, Value);
                ColumnsInfo[p].Expr := VarToStr(Value);
              RecordSet.GetFieldAsVariant(FieldNOTNULL, RecBuf, Value);
              ColumnsInfo[p].Required := Boolean(Value);
            end;
            Inc(p);
          end;
        end;
      end;

      for i := 0 to FFields.Count - 1 do begin
        FieldDesc := TPgSQLFieldDesc(FFields[i]);
        if FieldDesc.HasParent or (FieldDesc.FieldDescKind <> fdkData) then
          continue;

        // field is not represented in ParsedFDs list because:
        // a) it is expression
        // b) it belongs to the table that have not got into TablesInfo
        ColInfo := nil;
        for j := 0 to ColumnsInfo.Count - 1 do
          if ((FieldDesc.ActualName = ColumnsInfo[j].Alias) or
            (ColumnsInfo[j].Alias = '') and (FieldDesc.ActualName = ColumnsInfo[j].Name)) and
            not ColumnsInfo[j].Used
          then begin
            ColInfo := ColumnsInfo[j];
            ColInfo.Used := True;
            break;
          end;

        if RequestServerInfo and (UsedConnection.FProtocolVersion = pv30) then begin
          Assert(RecordSet <> nil);
          if FieldDesc.TableOID > 0 then begin
            FieldOID := RecordSet.Fields[fnOID];
            FieldNUM := RecordSet.Fields[fnNUM];
            if Locate2(RecordSet, RecBuf, FieldOID, FieldNUM, FieldDesc.TableOID, FieldDesc.TableCol) then begin
              RecordSet.GetFieldAsVariant(FieldNAME, RecBuf, Value);
              FieldDesc.ActualName := VarToStr(Value);
              // fnIDX can be incorrect if FROM contains the same table several times
              if (ColInfo <> nil) and (ColInfo.TableIndex >= 0) then
                FieldDesc.TableInfo := FTablesInfo[ColInfo.TableIndex]
              else begin
                RecordSet.GetFieldAsVariant(FieldIDX, RecBuf, Value);
                FieldDesc.TableInfo := FTablesInfo.Items[Value];
              end;
              RecordSet.GetFieldAsVariant(FieldDEFAULT, RecBuf, Value);
              DefVal := VarToStr(Value);
              if (FieldDesc.DataType in [dtInteger, dtLargeint]) and (Pos('nextval', DefVal) > 0) then
                FieldDesc.IsAutoIncrement := True; // serial, bigserial
              //if FDataSet.Options.DefaultValues then
              FieldDesc.DefaultExpr := DefVal;
              RecordSet.GetFieldAsVariant(FieldPRIMARY, RecBuf, Value);
              FieldDesc.IsKey := VarToStr(Value) <> '';
              if not FieldDesc.IsAutoIncrement then begin
                RecordSet.GetFieldAsVariant(FieldNOTNULL, RecBuf, Value);
                FieldDesc.Required := Boolean(Value);
              end;
            end;
          end;
        end
        else begin
          if ColInfo <> nil then begin
            if ColInfo.Name <> '' then begin
              if ColInfo.Alias <> '' then
                FieldDesc.ActualName := ColInfo.Name;

              if ColInfo.TableIndex >= 0 then
                FieldDesc.TableInfo := FTablesInfo[ColInfo.TableIndex]
              else
              // when we don't request additional information from server we suppose that
              // all fields belong to the first table in the FROM list
              if not RequestServerInfo then
                FieldDesc.TableInfo := FTablesInfo[0];

              if RequestServerInfo then begin
                DefVal := ColInfo.Expr;
                if (FieldDesc.DataType in [dtInteger, dtLargeint]) and (Pos('nextval', DefVal) > 0) then
                  FieldDesc.IsAutoIncrement := True; // serial, bigserial
                //if FDataSet.Options.DefaultValues then
                FieldDesc.DefaultExpr := DefVal;
                FieldDesc.Required := not FieldDesc.IsAutoIncrement and ColInfo.Required;
              end;
            end;
          end
          else
            // when we don't request additional information from server we suppose that
            // field that belongs to the same table as '*' does
            if (not RequestServerInfo) and (DefaultTable <> -1) then
              FieldDesc.TableInfo := FTablesInfo[DefaultTable];
        end;
      end;
    end;
  finally
    if RecordSet <> nil then begin
      if RecBuf <> nil then
        RecordSet.FreeRecBuf(RecBuf);
      RecordSet.Free;
    end;

    ColumnsInfo.Free;
  end;
end;

{ TPgSQLMetaData }

function TPgSQLMetaData.GetConnection: TPgSQLConnection;
begin
  Result := TPgSQLRecordSet(FRecordSet).UsedConnection;
end;

function TPgSQLMetaData.CreateRecordSet: TCRRecordSet;
begin
  Result := TPgSQLRecordSet.Create;
  Result.SetProp(prOIDAsInt, True);
end;

function TPgSQLMetaData.InternalGetMetaData(const MetaDataKind: string; Restrictions: TStrings): TData;
begin
  if MetaDataKind = 'sequences' then
    Result := GetSequences(Restrictions)
  else
  if MetaDataKind = 'schemas' then
    Result := GetSchemas(Restrictions)
  else
    Result := inherited InternalGetMetaData(MetaDataKind, Restrictions);
end;

procedure TPgSQLMetaData.InternalGetMetaDataKindsList(List: TStringList);
begin
  inherited;

  List.Add('Databases');
  List.Add('DataTypes');
  List.Add('Users');
  List.Add('Sequences');
  List.Add('Schemas');

  List.Sort;
end;

procedure TPgSQLMetaData.InternalGetRestrictionsList(List: TStringList; const MetaDataKind: string);
begin
  List.Clear;

  if MetaDataKind = 'datatypes' then begin
    List.Add('DATATYPE_SCHEMA');
    List.Add('DATATYPE_NAME');
    List.Add('DATATYPE_OID');
    List.Add('DATATYPE_TYPE');
  end
  else
  if MetaDataKind = 'sequences' then begin
    List.Add('SEQUENCE_SCHEMA');
    List.Add('SEQUENCE_NAME');
    List.Add('SEQUENCE_OID');
  end
  else
    inherited;
end;

function TPgSQLMetaData.GetTables(Restrictions: TStrings): TData;
const
  fmtGetTablesSQL = 'SELECT ' +
    'current_database() AS TABLE_CATALOG, n.nspname AS TABLE_SCHEMA, c.relname AS TABLE_NAME, ' +
    'c.oid AS TABLE_OID, ' +
    'CASE ' +
    '  WHEN c.relkind = ''r'' THEN ''TABLE'' ' +
    '  WHEN c.relkind = ''v'' THEN ''VIEW'' ' +
    'END::varchar(5) AS TABLE_TYPE ' +
    'FROM pg_class c ' +
    '  INNER JOIN pg_namespace n ON n.oid = c.relnamespace ' +
    'WHERE %s c.relkind IN (%s) ORDER BY n.nspname, c.relname';
var
  WhereClause, TableName, Schema, TableOID, TableTypes, QuotedTypes, Scope: string;
begin
  Schema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  TableOID := Trim(Restrictions.Values['TABLE_OID']);
  TableTypes := Trim(Restrictions.Values['TABLE_TYPE']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'n.nspname', Schema)
  else if not GetConnection.FMultipleSchema then
    AddWhere(WhereClause, 'n.nspname', GetConnection.GetCachedSchema)
  else begin
    if WhereClause <> '' then
      WhereClause := WhereClause + ' AND ';
    WhereClause := WhereClause + '(n.nspname in (' + GetConnection.GetSchemaNamesForSQL(0) + '))';
  end;
  AddWhere(WhereClause, 'c.relname', TableName);
  AddWhere(WhereClause, 'c.oid', TableOID);
  if WhereClause <> '' then
    WhereClause := WhereClause + ' AND ';

  if UpperCase(TableTypes) = 'TABLE' then
    TableTypes := 'r'
  else
  if UpperCase(TableTypes) = 'VIEW' then
    TableTypes := 'v';

  if TableTypes <> '' then
    QuotedTypes := PgSQLInfo.ToStringConst(TableTypes)
  else
    QuotedTypes := '''r'', ''v''';

  FRecordSet.SetSQL(Format(fmtGetTablesSQL, [WhereClause, QuotedTypes]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TPgSQLMetaData.GetColumns(Restrictions: TStrings): TData;
const
  fmtColumnsSQL_start =
    'SELECT ' +
    'current_database() AS TABLE_CATALOG, n.nspname AS TABLE_SCHEMA, c.relname AS TABLE_NAME, ' +
    'c.oid AS TABLE_OID, a.attname AS COLUMN_NAME, a.attnum AS POSITION, ' +
    'a.atttypid AS DATA_TYPE, a.attlen AS DATA_LENGTH, ' +
    '0 AS DATA_PRECISION, 0 AS DATA_SCALE, a.atttypmod AS TYPE_MODIFIER ';

  fmtColumnsSQL_8 =
    ', (not a.attnotnull)::integer AS NULLABLE, ';

  fmtColumnsSQL_7 =
    ', CASE WHEN a.attnotnull=TRUE THEN 1 ELSE 0 END AS NULLABLE, ';

  fmtColumnsSQL_end =
    'pg_get_expr(ad.adbin, ad.adrelid) AS DEFAULT_VALUE ' +
    'FROM pg_class c ' +
    '  INNER JOIN pg_namespace n ON n.oid = c.relnamespace ' +
    '  INNER JOIN pg_attribute a ON a.attrelid = c.oid ' +
    '  LEFT JOIN pg_attrdef ad ON a.attrelid = ad.adrelid and a.attnum = ad.adnum ' +
    'WHERE %s a.attnum > 0 AND not a.attisdropped ORDER BY n.nspname, c.relname, a.attnum';
var
  WhereClause, TableName, Schema, TableOID, ColumnName, SQL, Scope: string;
begin
  Schema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  TableOID := Trim(Restrictions.Values['TABLE_OID']);
  ColumnName := Trim(Restrictions.Values['COLUMN_NAME']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'n.nspname', Schema)
  else if not GetConnection.FMultipleSchema then
    AddWhere(WhereClause, 'n.nspname', GetConnection.GetCachedSchema)
  else begin
    if WhereClause <> '' then
      WhereClause := WhereClause + ' AND ';
    WhereClause := WhereClause + '(n.nspname in (' + GetConnection.GetSchemaNamesForSQL(0) + '))';
  end;

  AddWhere(WhereClause, 'c.relname', TableName);
  AddWhere(WhereClause, 'c.oid', TableOID);
  AddWhere(WhereClause, 'a.attname', ColumnName);

  if WhereClause <> '' then
    WhereClause := WhereClause + ' AND ';

  Assert(FRecordSet <> nil);
  Assert(TPgSqlRecordSet(FRecordSet).FCommand.FConnection <> nil);

  SQL := fmtColumnsSQL_start;

  if TPgSqlRecordSet(FRecordSet).FCommand.FConnection.VersionIsEqualOrHigher(8, 0) then
    SQL := SQL + fmtColumnsSQL_8
  else
    SQL := SQL + fmtColumnsSQL_7;

  SQL := SQL + fmtColumnsSQL_end;
  SQL := Format(SQL, [WhereClause]);

  FRecordSet.SetSQL(SQL);
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TPgSQLMetaData.GetProcedures(Restrictions: TStrings): TData;
const
  fmtGetProceduresSQL = 'SELECT ' +
    'current_database() AS PROCEDURE_CATALOG, ' +
    'n.nspname AS PROCEDURE_SCHEMA, p.proname AS PROCEDURE_NAME, ' +
    '''FUNCTION'' AS PROCEDURE_TYPE ' +
    'FROM pg_proc p ' +
    '  INNER JOIN pg_namespace n ON n.oid = p.pronamespace ' +
    '%s ORDER BY n.nspname, p.proname';
var
  WhereClause, ProcName, Schema, Scope: string;
begin
  Schema := Trim(Restrictions.Values['PROCEDURE_SCHEMA']);
  ProcName := Trim(Restrictions.Values['PROCEDURE_NAME']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'n.nspname', Schema)
  else if not GetConnection.FMultipleSchema then
    AddWhere(WhereClause, 'n.nspname', GetConnection.GetCachedSchema)
  else begin
    if WhereClause <> '' then
      WhereClause := WhereClause + ' AND ';
    WhereClause := WhereClause + '(n.nspname in (' + GetConnection.GetSchemaNamesForSQL(0) + '))';
  end;

  AddWhere(WhereClause, 'p.proname', ProcName);

  if WhereClause <> '' then
    WhereClause := 'WHERE ' + WhereClause;

  FRecordSet.SetSQL(Format(fmtGetProceduresSQL, [WhereClause]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

{$IFNDEF LITE}
procedure TPgSQLMetaData.CreateProcedureParametersFields;
begin
  FMemData.Fields.Clear;
  AddField('PROCEDURE_CATALOG', dtString, 100);
  AddField('PROCEDURE_SCHEMA', dtString, 100);
  AddField('PROCEDURE_NAME', dtString, 100);
  AddField('PARAMETER_NAME', dtString, 100);
  AddField('POSITION', dtInt32);
  AddField('DIRECTION', dtString, 10);
  AddField('DATA_TYPE', dtInt32);
  AddField('DATA_LENGTH', dtInt32);
  AddField('DATA_PRECISION', dtInt32);
  AddField('DATA_SCALE', dtInt32);
  FMemData.InitFields;
end;

function TPgSQLMetaData.GetProcedureParameters(Restrictions: TStrings): TData;
var
  Schema, ProcName, OverloadStr, Database: string;
  Overload: integer;
  ParamsInfo: TProcParamsInfo;
  i, a: integer;
  s: string;
  HasOutParams: boolean;
  Mode: char;
  Direction: string;

const
  dnCATALOG        = 1;
  dnSCHEMA         = 2;
  dnPROC_NAME      = 3;
  dnPARAM_NAME     = 4;
  dnPOSITION       = 5;
  dnDIRECTION      = 6;
  dnDATA_TYPE      = 7;
  dnDATA_LENGTH    = 8;
  dnDATA_PRECISION = 9;
  dnDATA_SCALE     = 10;

begin
  Schema := Trim(Restrictions.Values['PROCEDURE_SCHEMA']);
  if Schema <> '' then
    Schema := PgSQLInfo.NormalizeName(Schema, False, True)
  else if not GetConnection.FMultipleSchema then
    Schema := GetConnection.GetCachedSchema
  else begin
    Schema := GetConnection.GetSchemaNamesForSQL(0);
  end;

  ProcName := Trim(Restrictions.Values['PROCEDURE_NAME']);
  ProcName := PgSQLInfo.NormalizeName(ProcName, False, True);
  if ProcName = '' then
    raise Exception.Create('PROCEDURE_NAME restriction must be set');

  OverloadStr := Trim(Restrictions.Values['PROCEDURE_OVERLOAD']);
  if OverloadStr <> '' then begin
    Overload := StrToInt(OverloadStr);
    if Overload <= 0 then
      Overload := 1;
  end
  else
    Overload := 1;

  TPgSQLRecordSet(FRecordSet).FCommand.GetProcParamsInfo(Schema, ProcName, Overload, ParamsInfo);

  CreateProcedureParametersFields;
  FMemData.Open;

  Database := GetConnection.FDatabase;

  HasOutParams := False;
  for i := 0 to Length(ParamsInfo.Modes) - 1 do
    if ParamsInfo.Modes[i] <> 'i' then begin
      HasOutParams := True;
      break;
    end;

  FMemDataHelper.AllocBuffer;

  if HasOutParams then
    a := 0
  else
    a := -1;

  for i := a to High(ParamsInfo.TypeOIDs) do begin
    FMemDataHelper.InitRecord;

    FMemDataHelper.FieldValues[dnCATALOG] := Database;
    FMemDataHelper.FieldValues[dnSCHEMA] := ParamsInfo.Schema;
    FMemDataHelper.FieldValues[dnPROC_NAME] := ProcName;
    if (i >= 0) and (i < Length(ParamsInfo.Names)) and (ParamsInfo.Names[i] <> '""') then
      FMemDataHelper.FieldValues[dnPARAM_NAME] := ParamsInfo.Names[i];
    FMemDataHelper.FieldValues[dnPOSITION] := i + 1;

    if i = -1 then
      Mode := 'o'
    else
    if i < Length(ParamsInfo.Modes) then begin
      s := ParamsInfo.Modes[i];
      if s <> '' then
        Mode := s[1]
      else
        Mode := 'i';
    end
    else
      Mode := 'i';

    case Mode of
      'i':
        Direction := 'IN';
      'o':
        Direction := 'OUT';
      'b':
        Direction := 'IN/OUT';
    end;
    FMemDataHelper.FieldValues[dnDIRECTION] := Direction;

    if i = -1 then
      FMemDataHelper.FieldValues[dnDATA_TYPE] := ParamsInfo.RetTypeOid
    else
      FMemDataHelper.FieldValues[dnDATA_TYPE] := ParamsInfo.TypeOIDs[i];

    FMemDataHelper.AppendRecord;
  end;

  FMemData.SetToBegin;
  Result := FMemData;
end;
{$ENDIF}

function TPgSQLMetaData.GetIndexes(Restrictions: TStrings): TData;
const
  fmtIndexesSQL_start =
    'SELECT ' +
    'current_database() AS TABLE_CATALOG, ' +
    'n.nspname AS TABLE_SCHEMA, t.relname AS TABLE_NAME, t.oid AS TABLE_OID, ' +
    'current_database() AS INDEX_CATALOG, ' +
    'n.nspname AS INDEX_SCHEMA, c.relname AS INDEX_NAME, c.oid AS INDEX_OID ';

  fmtIndexesSQL_8 =
    ', i.indisunique::integer AS UNIQUE ';

  fmtIndexesSQL_7 =
    ', CASE WHEN i.indisunique=TRUE THEN 1 ELSE 0 END AS UNIQUE ';

  fmtIndexesSQL_end =
    'FROM pg_index i ' +
    '  INNER JOIN pg_class c ON c.oid = i.indexrelid ' +
    '  INNER JOIN pg_class t ON t.oid = i.indrelid ' +
    '  INNER JOIN pg_namespace n ON n.oid = t.relnamespace ' +
    '%s ORDER BY n.nspname, t.relname, c.relname';
var
  WhereClause, TableName, TableSchema, TableOID, IndexName, IndexOID, SQL: string;
begin
  TableSchema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  TableOID := Trim(Restrictions.Values['TABLE_OID']);
  IndexName := Trim(Restrictions.Values['INDEX_NAME']);
  IndexOID := Trim(Restrictions.Values['INDEX_OID']);

  WhereClause := '';
  AddWhere(WhereClause, 'n.nspname', TableSchema);
  AddWhere(WhereClause, 't.relname', TableName);
  AddWhere(WhereClause, 'i.indrelid', TableOID);
  AddWhere(WhereClause, 'c.relname', IndexName);
  AddWhere(WhereClause, 'i.indexrelid', IndexOID);

  if WhereClause <> '' then
    WhereClause := 'WHERE ' + WhereClause;

  Assert(FRecordSet <> nil);
  Assert(TPgSqlRecordSet(FRecordSet).FCommand.FConnection <> nil);

  SQL := fmtIndexesSQL_start;

  if TPgSqlRecordSet(FRecordSet).FCommand.FConnection.VersionIsEqualOrHigher(8, 0) then
    SQL := SQL + fmtIndexesSQL_8
  else
    SQL := SQL + fmtIndexesSQL_7;

  SQL := SQL + fmtIndexesSQL_end;
  SQL := Format(SQL, [WhereClause]);

  FRecordSet.SetSQL(SQL);
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TPgSQLMetaData.GetIndexColumns(Restrictions: TStrings): TData;
const
  // ORDER BY indisprimary::integer DESC - index for Primary Key must be first

  fmtGetIndexColumnsSQL7 = 'SELECT ' +
    'current_database() AS TABLE_CATALOG, ' +
    'n.nspname AS TABLE_SCHEMA, t.relname AS TABLE_NAME, t.oid AS TABLE_OID, ' +
    'current_database() AS INDEX_CATALOG, ' +
    'n.nspname AS INDEX_SCHEMA, c.relname AS INDEX_NAME, c.oid AS INDEX_OID, ' +
    'a.attname AS COLUMN_NAME, a.attnum AS COLUMN_POSITION, 0 AS DESCENDING ' +
  {$IFDEF LITE}
    ', i.indisunique::integer AS UNIQUE ' +
  {$ENDIF}
    'FROM pg_index i ' +
    '  INNER JOIN pg_class c ON c.oid = i.indexrelid ' +
    '  INNER JOIN pg_class t ON t.oid = i.indrelid ' +
    '  INNER JOIN pg_namespace n ON n.oid = t.relnamespace ' +
    '  INNER JOIN pg_attribute a ON a.attrelid = i.indrelid and ' +
    '  a.attnum in (i.indkey[0], i.indkey[1], i.indkey[2], i.indkey[3], i.indkey[4], i.indkey[5], i.indkey[6], i.indkey[7], '+
    '               i.indkey[8], i.indkey[9], i.indkey[10], i.indkey[11], i.indkey[12], i.indkey[13], i.indkey[14], i.indkey[15]) ' +
    '%s ORDER BY CASE WHEN indisprimary THEN 0 ELSE 1 END, n.nspname, t.relname, c.relname, a.attnum';

  fmtGetIndexColumnsSQL8 = 'SELECT ' +
    'current_database() AS TABLE_CATALOG, ' +
    'n.nspname AS TABLE_SCHEMA, t.relname AS TABLE_NAME, t.oid AS TABLE_OID, ' +
    'current_database() AS INDEX_CATALOG, ' +
    'n.nspname AS INDEX_SCHEMA, c.relname AS INDEX_NAME, c.oid AS INDEX_OID, ' +
    'a.attname AS COLUMN_NAME, a.attnum AS COLUMN_POSITION, 0 AS DESCENDING ' +
  {$IFDEF LITE}
    ', CASE WHEN i.indisunique=TRUE THEN 1 ELSE 0 END AS UNIQUE ' +
  {$ENDIF}
    'FROM pg_index i ' +
    '  INNER JOIN pg_class c ON c.oid = i.indexrelid ' +
    '  INNER JOIN pg_class t ON t.oid = i.indrelid ' +
    '  INNER JOIN pg_namespace n ON n.oid = t.relnamespace ' +
    '  INNER JOIN pg_attribute a ON a.attrelid = i.indrelid and a.attnum = any (i.indkey) ' +
    '%s ORDER BY indisprimary::integer DESC, n.nspname, t.relname, c.relname, a.attnum';
    
  fmtGetIndexColumnsSQL83 = 'SELECT ' +
    'current_database() AS TABLE_CATALOG, ' +
    'n.nspname AS TABLE_SCHEMA, t.relname AS TABLE_NAME, t.oid AS TABLE_OID, ' +
    'current_database() AS INDEX_CATALOG, ' +
    'n.nspname AS INDEX_SCHEMA, c.relname AS INDEX_NAME, c.oid AS INDEX_OID, ' +
    'a.attname AS COLUMN_NAME, a.attnum AS COLUMN_POSITION,' +
    'indoption[index] & 1 AS DESCENDING ' +
  {$IFDEF LITE}
    ', indisunique::integer AS UNIQUE ' +
  {$ENDIF}
    'FROM ' +
    '  (SELECT generate_series(0, indnatts - 1), indrelid, indexrelid, indkey,' +
    '   indoption, indisunique, indisprimary FROM pg_index i)' +
    '   i(index, indrelid, indexrelid, indkey, indoption, indisunique, indisprimary)' +
    '  INNER JOIN pg_class c ON c.oid = indexrelid ' +
    '  INNER JOIN pg_class t ON t.oid = indrelid ' +
    '  INNER JOIN pg_namespace n ON n.oid = t.relnamespace ' +
    '  INNER JOIN pg_attribute a ON a.attrelid = indrelid and a.attnum = indkey[index] ' +
    '%s ORDER BY indisprimary::integer DESC, n.nspname, t.relname, c.relname, a.attnum';
var
  WhereClause, TableName, TableSchema, TableOID, IndexName, IndexOID, Uniqueness, SQL: string;
begin
  TableSchema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  TableOID := Trim(Restrictions.Values['TABLE_OID']);
  IndexName := Trim(Restrictions.Values['INDEX_NAME']);
  IndexOID := Trim(Restrictions.Values['INDEX_OID']);
  Uniqueness := Trim(Restrictions.Values['UNIQUE']);

  WhereClause := '';
  AddWhere(WhereClause, 'n.nspname', TableSchema);
  AddWhere(WhereClause, 't.relname', TableName);
  AddWhere(WhereClause, 'i.indrelid', TableOID);
  AddWhere(WhereClause, 'c.relname', IndexName);
  AddWhere(WhereClause, 'i.indexrelid', IndexOID);

  if (Uniqueness = '0') or (Uniqueness = '1') then begin
    if WhereClause <> '' then
      WhereClause := WhereClause + ' AND ';
    if Uniqueness = '1' then
      WhereClause := WhereClause + 'i.indisunique'
    else
      WhereClause := WhereClause + 'not i.indisunique';
  end;

  if WhereClause <> '' then
    WhereClause := 'WHERE ' + WhereClause;

  Assert(FRecordSet <> nil);
  Assert(TPgSqlRecordSet(FRecordSet).FCommand.FConnection <> nil);
  if TPgSqlRecordSet(FRecordSet).FCommand.FConnection.VersionIsEqualOrHigher(8, 3) then
    SQL := Format(fmtGetIndexColumnsSQL83, [WhereClause])
  else if TPgSqlRecordSet(FRecordSet).FCommand.FConnection.VersionIsEqualOrHigher(8, 0) then
    SQL := Format(fmtGetIndexColumnsSQL8, [WhereClause])
  else
    SQL := Format(fmtGetIndexColumnsSQL7, [WhereClause]);

  FRecordSet.SetSQL(SQL);
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TPgSQLMetaData.GetConstraints(Restrictions: TStrings): TData;
const
  fmtGetConstraintsSQL = 'SELECT ' +
    'current_database() AS TABLE_CATALOG, n.nspname AS TABLE_SCHEMA, c.relname AS TABLE_NAME, ' +
    'c.oid AS TABLE_OID, con.conname AS CONSTRAINT_NAME, ' +
    'CASE con.contype ' +
    '  WHEN ''c'' THEN ''CHECK'' ' +
    '  WHEN ''f'' THEN ''FOREIGN KEY'' ' +
    '  WHEN ''p'' THEN ''PRIMARY KEY'' ' +
    '  WHEN ''u'' THEN ''UNIQUE'' ' +
    'END::varchar(11) AS CONSTRAINT_TYPE ' +
    'FROM pg_constraint con ' +
    '  INNER JOIN pg_class c ON c.oid = con.conrelid ' +
    '  INNER JOIN pg_namespace n ON n.oid = c.relnamespace ' +
    '%s ORDER BY n.nspname, c.relname, con.conname ';
var
  WhereClause, Schema, TableName, TableOID, ConstraintName, Types: string;
begin
  Schema := Trim(Restrictions.Values['TABLE_SCHEMA']);
  TableName := Trim(Restrictions.Values['TABLE_NAME']);
  TableOID := Trim(Restrictions.Values['TABLE_OID']);
  ConstraintName := Trim(Restrictions.Values['CONSTRAINT_NAME']);
  Types := LowerCase(Trim(Restrictions.Values['CONSTRAINT_TYPE']));

  WhereClause := '';
  AddWhere(WhereClause, 'n.nspname', Schema);
  AddWhere(WhereClause, 'c.relname', TableName);
  AddWhere(WhereClause, 'con.conrelid', TableOID);
  AddWhere(WhereClause, 'con.conname', ConstraintName);

  if Types <> '' then begin
    if Types = 'check' then
      Types := 'c'
    else
    if Types = 'foreign key' then
      Types := 'f'
    else
    if Types = 'primary key' then
      Types := 'p'
    else
    if Types = 'unique' then
      Types := 'u';

    if WhereClause <> '' then
      WhereClause := WhereClause + ' AND ';
    WhereClause := WhereClause + 'con.contype = ' + PgSQLInfo.ToStringConst(Types);
  end;

  if WhereClause <> '' then
    WhereClause := 'WHERE ' + WhereClause;

  FRecordSet.SetSQL(Format(fmtGetConstraintsSQL, [WhereClause]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TPgSQLMetaData.GetDataTypes(Restrictions: TStrings): TData;
const
  fmtGetDataTypesSQL = 'SELECT ' +
    'current_database() AS DATATYPE_CATALOG, n.nspname AS DATATYPE_SCHEMA, ' +
    't.typname AS DATATYPE_NAME, t.oid AS DATATYPE_OID, t.typlen AS DATATYPE_LENGTH, ' +
    'CASE ' +
    '  WHEN t.typtype = ''b'' THEN ''base'' ' +
    '  WHEN t.typtype = ''c'' THEN ''composite'' ' +
    '  WHEN t.typtype = ''d'' THEN ''domain'' ' +
    '  WHEN t.typtype = ''e'' THEN ''enum'' ' +
    '  WHEN t.typtype = ''p'' THEN ''pseudo'' ' +
    'END::varchar(9) AS DATATYPE_TYPE, t.typrelid AS TABLE_OID, t.typbasetype as DATATYPE_BASETYPE ' +
    'FROM pg_type t ' +
    '  INNER JOIN pg_namespace n ON n.oid = t.typnamespace ' +
    '%s ORDER BY n.nspname, t.typname';
var
  WhereClause, TypeName, Schema, OID, TypeType, SQL: string;
begin
  Schema := Trim(Restrictions.Values['DATATYPE_SCHEMA']);
  TypeName := Trim(Restrictions.Values['DATATYPE_NAME']);
  OID := Trim(Restrictions.Values['DATATYPE_OID']);
  TypeType := LowerCase(Trim(Restrictions.Values['DATATYPE_TYPE']));

  WhereClause := '';
  AddWhere(WhereClause, 'n.nspname', Schema);
  AddWhere(WhereClause, 't.typname', TypeName);
  AddWhere(WhereClause, 't.oid', OID);

  if TypeType <> '' then begin
    if TypeType = 'base' then
      TypeType := 'b'
    else
    if TypeType = 'composite' then
      TypeType := 'c'
    else
    if TypeType = 'domain' then
      TypeType := 'd'
    else
    if TypeType = 'enum' then
      TypeType := 'e'
    else
    if TypeType = 'pseudo' then
      TypeType := 'p';

    if WhereClause <> '' then
      WhereClause := WhereClause + ' AND ';
    WhereClause := WhereClause + 't.typtype = ' + PgSQLInfo.ToStringConst(TypeType);
  end;

  if WhereClause <> '' then
    WhereClause := 'WHERE ' + WhereClause;
  SQL := Format(fmtGetDataTypesSQL, [WhereClause]);

  FRecordSet.SetSQL(SQL);
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TPgSQLMetaData.GetSequences(Restrictions: TStrings): TData;
const
  fmtGetSequencesSQL = 'SELECT ' +
    'current_database() AS TABLE_CATALOG, ' +
    'n.nspname AS SEQUENCE_SCHEMA, c.relname AS SEQUENCE_NAME, c.oid AS SEQUENCE_OID ' +
    'FROM pg_class c ' +
    '  INNER JOIN pg_namespace n ON n.oid = c.relnamespace ' +
    'WHERE %s c.relkind = ''S'' ORDER BY n.nspname, c.relname';
var
  WhereClause, Schema, ObjectName, OID, Scope: string;
begin
  Schema := Trim(Restrictions.Values['SEQUENCE_SCHEMA']);
  ObjectName := Trim(Restrictions.Values['SEQUENCE_NAME']);
  OID := Trim(Restrictions.Values['SEQUENCE_OID']);
  Scope := UpperCase(Trim(Restrictions.Values['SCOPE']));

  WhereClause := '';
  if Scope <> 'LOCAL' then
    AddWhere(WhereClause, 'n.nspname', Schema)
  else
    AddWhere(WhereClause, 'n.nspname', '"' + GetConnection.GetCachedSchema + '"');
  AddWhere(WhereClause, 'c.relname', ObjectName);
  AddWhere(WhereClause, 'c.oid', OID);
  if WhereClause <> '' then
    WhereClause := WhereClause + ' AND ';

  FRecordSet.SetSQL(Format(fmtGetSequencesSQL, [WhereClause]));
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TPgSQLMetaData.GetSchemas(Restrictions: TStrings): TData;
const
  fmtGetSchemasSQL = 'SELECT ' +
    'current_database() AS SCHEMA_CATALOG, ' +
    'n.nspname AS SCHEMA_NAME, n.oid AS SCHEMA_OID ' +
    'FROM pg_namespace n ' +
    'ORDER BY n.nspname';
begin
  FRecordSet.SetSQL(fmtGetSchemasSQL);
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TPgSQLMetaData.GetDatabases(Restrictions: TStrings): TData;
const
  fmtGetDatabasesSQL = 'SELECT ' +
    'datname AS DATABASE_NAME, pg_encoding_to_char(encoding) AS DATABASE_CHARSET ' +
    'FROM pg_database ' +
    'ORDER BY datname';
begin
  FRecordSet.SetSQL(fmtGetDatabasesSQL);
  FRecordSet.Open;
  Result := FRecordSet;
end;

function TPgSQLMetaData.GetUsers(Restrictions: TStrings): TData;
const
  fmtGetUsersSQL = 'SELECT ' +
    'usename AS USER_NAME ' +
    'FROM pg_user ' +
    'ORDER BY usename';
begin
  FRecordSet.SetSQL(fmtGetUsersSQL);
  FRecordSet.Open;
  Result := FRecordSet;
end;

{$IFNDEF LITE}

{ TPgSQLAlerter }

constructor TPgSQLAlerter.Create;
begin
  inherited;
end;

destructor TPgSQLAlerter.Destroy;
begin
  inherited;
end;

function TPgSQLAlerter.SetProp(Prop: integer; const Value: variant): boolean;
begin
  {Result := True;
  case Prop of
  else}
    Result := inherited SetProp(Prop, Value);
  //end;
end;

function TPgSQLAlerter.GetProp(Prop: integer; var Value: variant): boolean;
begin
  {Result := True;
  case Prop of
  else}
    Result := inherited GetProp(Prop, Value);
  //end;
end;

procedure TPgSQLAlerter.SendEvent(const EventName, Message: string);
begin
  if (FConnection <> nil) and (TPgSQLConnection(FConnection).VersionIsEqualOrHigher(9, 0)) then
    TPgSQLConnection(FConnection).ExecCommand('NOTIFY ' + EventName + ', ''' + Message + '''')
  else
    TPgSQLConnection(FConnection).ExecCommand('NOTIFY ' + EventName);
end;

procedure TPgSQLAlerter.Start;
begin
  if not FActive then begin
    TPgSQLConnection(FConnection).GetNotificationsHandler.RegisterEvents(
      FEventNames, DoOnEvent);
    FActive := True;
  end;
end;

procedure TPgSQLAlerter.Stop;
begin
  if FActive then begin
    TPgSQLConnection(FConnection).GetNotificationsHandler.UnregisterEvents(
      FEventNames, Self);
    FActive := False;
  end;
end;

procedure TPgSQLAlerter.DoOnEvent(const EventName: string; const PID: integer; const Message: string);
var
  InhOnEvent: TCRAlerterEventCallback;
begin
  InhOnEvent := inherited OnEvent;
  if Assigned(InhOnEvent) then
    InhOnEvent(EventName, Message);

  if Assigned(FOnEvent) then
    FOnEvent(EventName, PID, Message);
end;

{ TPgSQLNotificationsHandler }

{$IFDEF MSWINDOWS}

const
  WM_NOTIFICATION = WM_USER + 1;

function WndProc(hWindow: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; {$IFNDEF CLR} stdcall; {$ENDIF}
var
  Handler: TPgSQLNotificationsHandler;
  Notif: TPgSQLNotification;
begin
  Result := 0;
  case Msg of
    WM_NOTIFICATION: begin
      try
        Handler := TPgSQLNotificationsHandler(GetGCHandleTarget(IntPtr(wParam)));
        Notif := TPgSQLNotification(GetGCHandleTarget(IntPtr(lParam)));
        FreeGCHandle(IntPtr(lParam));
        try
          Handler.DoOnNotification(Notif.PID, Notif.Name, Notif.Message);
        finally
          Notif.Free;
        end;
      except
        if Assigned(ApplicationHandleException) then
          ApplicationHandleException(nil);
      end;
    end
    else
      Result := DefWindowProc(hWindow, Msg, wParam, lParam);
  end;
end;

var
  WndClass: TWndClass = (
    style: 0;
    lpfnWndProc: @WndProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: '';
    lpszClassName: 'PGDACUtilWnd'
  );

procedure AllocWnd;
var
  TempClass: {$IFDEF CLR}TWndClassInfo{$ELSE}TWndClass{$ENDIF};
  ClassRegistered: boolean;
{$IFDEF CLR}
  WndClassPtr: IntPtr;
{$ENDIF}
  WndProcPtr: IntPtr;
begin
  if hUtilWindow = 0 then begin
    WndClass.hInstance := HInstance;
    ClassRegistered := Windows.GetClassInfo(HInstance, WndClass.lpszClassName,
      TempClass);
  {$IFDEF CLR}
    WndClassPtr := Marshal.AllocHGlobal(SizeOf(TWndClass));
    try
      Marshal.StructureToPtr(WndClass, WndClassPtr, False);
      WndProcPtr :=  Marshal.ReadIntPtr(WndClassPtr, 4);
    finally
      Marshal.FreeHGlobal(WndClassPtr);
    end;
  {$ELSE}
    WndProcPtr := @WndProc;
  {$ENDIF}

    if not ClassRegistered or ({$IFDEF FPC}@{$ENDIF}TempClass.lpfnWndProc <> WndProcPtr) then begin
      if ClassRegistered then
        Windows.UnregisterClass(WndClass.lpszClassName, HInstance);

      hUtilWindow := Windows.RegisterClass(WndClass);
    end;

    hUtilWindow := Windows.CreateWindowEx(WS_EX_TOOLWINDOW, 'PGDACUtilWnd',
      '', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);
    Assert(hUtilWindow > 0);
    Windows.SetWindowLong(hUtilWindow, GWL_WNDPROC, Longint(WndProcPtr));
  end;
end;

{$ENDIF}

constructor TPgSQLNotificationsHandler.Create(BaseConnection: TPgSQLConnection);
begin
  inherited Create;

  FBaseConnection := BaseConnection;
  FConnection := TPgSQLConnection.Create;
  FConnection.OnNotification := ProcessNotification;
  FLockConnection := TCriticalSection.Create;
  FAllowLockEvent := TEvent.Create(nil, True, True, '');
end;

destructor TPgSQLNotificationsHandler.Destroy;
begin
  FConnection.Free;
  FLockConnection.Free;
  FAllowLockEvent.Free;
{$IFDEF MSWINDOWS}
  if FGCHandle <> nil then
    FreeGCHandle(FGCHandle);
{$ENDIF}

  inherited;
end;

procedure TPgSQLNotificationsHandler.RegisterEvents(Events: TStrings;
  Callback: TPgSQLNotificationEvent);
var
  i, j, l: integer;
  NormName: string;
begin
  try
    for i := 0 to Events.Count - 1 do begin
      NormName := PgSQLInfo.NormalizeName(Events[i], False, True);
      j := EventIndex(NormName);
      if j < 0 then begin
        Listen(NormName);
        j := Length(FEvents);
        SetLength(FEvents, j + 1);
        FEvents[j].EventName := NormName;
      end;
      l := Length(FEvents[j].Callbacks);
      SetLength(FEvents[j].Callbacks, l + 1);
      FEvents[j].Callbacks[l] := Callback;
    end;
  finally
    if FConnectionIsLocked then begin
      FLockConnection.Leave;
      FConnectionIsLocked := False;
    end;
  end;
end;

procedure TPgSQLNotificationsHandler.UnregisterEvents(Events: TStrings;
  CallbackObject: TObject);
var
  i: integer;
{$IFNDEF CLR}
  j, k, l, l2, m: integer;
  NormName: string;
{$ENDIF}
  UnlistenNames: array of string;
begin
  try
  {$IFNDEF CLR}
    for i := 0 to Events.Count - 1 do begin
      NormName := PgSQLInfo.NormalizeName(Events[i], False, True);
      j := EventIndex(NormName);
      if j < 0 then
        continue;
      l := Length(FEvents[j].Callbacks);
      for k := 0 to l - 1 do begin
        if TMethod(FEvents[j].Callbacks[k]).Data = CallbackObject then begin
          if l > 1 then begin
            for m := k + 1 to l - 1 do
              FEvents[j].Callbacks[m - 1] := FEvents[j].Callbacks[m];
            SetLength(FEvents[j].Callbacks, l - 1);
          end
          else begin
            for m := j + 1 to High(FEvents) do
              FEvents[m - 1] := FEvents[m];
            SetLength(FEvents, Length(FEvents) - 1);

            l2 := Length(UnlistenNames);
            SetLength(UnlistenNames, l2 + 1);
            UnlistenNames[l2] := NormName;
          end;
          break;
        end;
      end;
    end;
  {$ELSE}
    SetLength(FEvents, 0);
  {$ENDIF}

    if Length(FEvents) = 0 then
      Stop
    else
      for i := 0 to High(UnlistenNames) do
        Unlisten(UnlistenNames[i]);
  finally
    if FConnectionIsLocked then begin
      FLockConnection.Leave;
      FConnectionIsLocked := False;
    end;
  end;
end;

function TPgSQLNotificationsHandler.EventIndex(const Name: string): integer;
var
  i: integer;
begin
  for i := 0 to High(FEvents) do begin
    if FEvents[i].EventName = Name then begin
      Result := i;
      exit;
    end;
  end;
  Result := -1;
end;

procedure TPgSQLNotificationsHandler.Start;
begin
  FConnection.Assign(FBaseConnection);
  FConnection.Connect('');
  FLockConnection.Enter;
  FConnectionIsLocked := True;

{$IFDEF MSWINDOWS}
  if hUtilWindow = 0 then
    AllocWnd;
{$ENDIF}    
  FThread := TPgSQLNotificationsThread.Create(True);
  FThread.FHandler := Self;
  FThread.Resume;
end;

procedure TPgSQLNotificationsHandler.Stop;
begin
  FThread.Terminate;
  if not FConnectionIsLocked then
    LockConnection;
  try
    FConnection.Disconnect;
  finally
    FLockConnection.Leave;
    FConnectionIsLocked := False;
  end;
  FThread.WaitFor;
  FThread.Free;
  FThread := nil;
end;

procedure TPgSQLNotificationsHandler.Listen(const Name: string);
begin
  if not FConnection.GetConnected then
    Start
  else begin
    if not FConnectionIsLocked then
      LockConnection;
  end;

  FConnection.ExecCommand('LISTEN "' + Name + '"');
end;

procedure TPgSQLNotificationsHandler.Unlisten(const Name: string);
begin
  if not FConnectionIsLocked then
    LockConnection;

  FConnection.ExecCommand('UNLISTEN "' + Name + '"');
end;

procedure TPgSQLNotificationsHandler.LockConnection;
begin
  FAllowLockEvent.ResetEvent;
  FConnection.FProtocol.TerminateMessageLoop;
  FLockConnection.Enter; // wait until ProcessMessageQueue exits
  FAllowLockEvent.SetEvent;
  FConnectionIsLocked := True;
end;

{$IFDEF MSWINDOWS}
function TPgSQLNotificationsHandler.GetGCHandle: IntPtr;
begin
  if FGCHandle = nil then
    FGCHandle := AllocGCHandle(Self);
  Result := FGCHandle;
end;
{$ELSE}
procedure TPgSQLNotificationsHandler.DoNotification;
begin
  if FLastNotification <> nil then
    DoOnNotification(FLastNotification.PID, FLastNotification.Name, FLastNotification.Message);
end;
{$ENDIF}

procedure TPgSQLNotificationsHandler.ProcessNotification(const Name: string; const PID: integer; const Message: string);
var
  Notif: TPgSQLNotification;
begin
  Notif := TPgSQLNotification.Create;
  Notif.PID := PID;
  Notif.Name := Name;
  Notif.Message := Message;
{$IFDEF MSWINDOWS}
  PostMessage(hUtilWindow, WM_NOTIFICATION, WPARAM(GCHandle), LPARAM(AllocGCHandle(Notif)));
{$ELSE}
  try
    FLastNotification := Notif;
    FThread.Synchronize(DoNotification);
  finally
    FLastNotification := nil;
    Notif.Free;
  end;
{$ENDIF}
end;

procedure TPgSQLNotificationsHandler.DoOnNotification(NotificationPID: Integer; const NotificationName: string; const NotificationMsg: string);
var
  i: integer;
  index: integer;
begin
  index := EventIndex(NotificationName);
  if index >= 0 then begin
    for i := 0 to High(FEvents[index].Callbacks) do begin
      if Assigned(FEvents[index].Callbacks[i]) then
        FEvents[index].Callbacks[i](NotificationName, NotificationPID, NotificationMsg);
    end;
  end;

end;

{ TPgSQLNotificationsThread }

procedure TPgSQLNotificationsThread.Execute;
var
  Protocol: TPgSQLProtocol;
begin
  Protocol := FHandler.FConnection.GetProtocol;
  Assert(Protocol <> nil);

  while not Terminated do begin
    FHandler.FAllowLockEvent.WaitFor(INFINITE);
    if Terminated then
      exit;
    FHandler.FLockConnection.Enter;
    try
      Protocol.ProcessMessageQueue({$IFNDEF NEXTGEN}#0{$ELSE}0{$ENDIF}, False, True);
    except
      FHandler.FLockConnection.Leave;
      exit;
    end;
    FHandler.FLockConnection.Leave;
  end;
end;

{ TPgSQLLoader }

constructor TPgSQLLoader.Create;
begin
  inherited;

  FCommand := TPgSQLCommand.Create;
  FBufferSize := WriteBufferSize;
end;

destructor TPgSQLLoader.Destroy;
begin
  FCommand.Free;

  inherited;
end;

function TPgSQLLoader.SetProp(Prop: integer; const Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prBufferSize:
      FBufferSize := Value;
    prTextMode:
      FTextMode := Value;
  else
    Result := inherited SetProp(Prop, Value);
  end;
end;

function TPgSQLLoader.GetProp(Prop: integer; var Value: variant): boolean;
begin
  Result := True;
  case Prop of
    prBufferSize:
      Value := FBufferSize;
    prTextMode:
      Value := FTextMode;
  else
    Result := inherited GetProp(Prop, Value);
  end;
end;

class function TPgSQLLoader.GetColumnClass: TCRLoaderColumnClass;
begin
  Result := TPgSQLLoaderColumn;
end;

class function TPgSQLLoader.GetRecordSetClass: TCRRecordSetClass;
begin
  Result := TPgSQLRecordSet;
end;

procedure TPgSQLLoader.FillColumn(Column: TCRLoaderColumn; FieldDesc: TFieldDesc);
begin
  inherited;

  with TPgSQLLoaderColumn(Column) do begin
    FSubDataType := FieldDesc.SubDataType;
    FRowType := TPgRowType(FieldDesc.ObjectType);
    if FRowType <> nil then
      FRowTypeName := FRowType.Name;
  end;
end;

procedure TPgSQLLoader.Reset;
begin
  SetLength(FRowValues, 0); // to clear
  FPrepared := False;
  FBlockOpened := False;

  inherited;
end;

procedure TPgSQLLoader.Prepare;
var
  SQL: StringBuilder;
  i: integer;
  Col: TPgSQLLoaderColumn;
begin
  inherited;

  FIsTextMode := FTextMode or (FConnection.GetProtocolVersion = pv20);

  SetLength(FRowValues, Columns.Count);

  for i := 0 to Columns.Count - 1 do begin
    Col := TPgSQLLoaderColumn(Columns[i]);
    if not FIsTextMode and (Col.DataType = dtObject) and (Col.FRowType = nil) then
      Col.FRowType := TPgRowType(FConnection.GetTypes.GetRowType(Col.FRowTypeName));
  end;

  SQL := StringBuilder.Create(1024);
  try
    SQL.Append('COPY ');
    if not FIsTextMode then
      SQL.Append('BINARY ');

    SQL.Append(PgSQLInfo.NormalizeName(TableName) + '(');
    for i := 0 to Columns.Count - 1 do begin
      if i > 0 then
        SQL.Append(', ');
      SQL.Append(PgSQLInfo.NormalizeName(Columns[i].Name, QuoteNames));
    end;
    SQL.Append(') FROM STDIN');

    FCommand.SetSQL(SQL.ToString);
  finally
    SQL.Free;
  end;

  FCommand.SetConnection(FConnection);
  FCommand.Prepare;
  FCommand.Execute;

  if not FIsTextMode then begin
    BeginDataBlock;
    WriteHeader;
  end;

  FPrepared := True;
end;

function TPgSQLLoader.IsPutColumnDataAllowed: boolean;
begin
  Result := High(FRowValues) >= 0;
end;

procedure TPgSQLLoader.PutColumnData(Col, Row: integer; const Value: variant);
begin
  if (FLastRow <> -1) and (Row > FLastRow + 1) then
    LoadRow;

  inherited;

  FRowValues[Col] := Value;
  DoAddObjectRef(Value);
end;

procedure TPgSQLLoader.DoLoad;
begin
  if FLastRow >= FLoadedRows then
    LoadRow;
end;

procedure TPgSQLLoader.LoadRow;
var
  i: integer;
  s: string;
  Col: TPgSQLLoaderColumn;
  Value: variant;
  UseUnicode: boolean;
  Buffer: TBytes;
begin
{$IFNDEF VER8P}
  SetLength(Buffer, 0);
{$ENDIF}  
  FConnection.GetProp(prUseUnicode, Value);
  UseUnicode := Value;

  BeginDataBlock;

  if not FIsTextMode then
    FNet.WriteInt16(Columns.Count);

  for i := 0 to Columns.Count - 1 do begin
    Col := TPgSQLLoaderColumn(Columns[i]);
    Value := FRowValues[i];
    if FIsTextMode then begin
      if VarIsNull(Value) or VarIsEmpty(Value) then
        s := '\N'
      else
        s := TPgTextConverter.ValueToText(Value, Col.DataType, Col.SubDataType, UseUnicode,
                                          False, True, FConnection.VersionIsEqualOrHigher(9, 0));
    {$IFDEF IS_UNICODE}
      if UseUnicode then
        Buffer := Encoding.UTF8.GetBytes(s)
      else
    {$ENDIF}
        Buffer := Encoding.Default.GetBytes(s);
      FNet.WriteBytes(Buffer);
      if i < Columns.Count - 1 then
        FNet.WriteByte(9);
    end
    else
      TPgBinaryConverter.WriteValue(Value, FNet, Col.DataType, Col.FSubDataType, Col.FRowType, FConnection);
  end;

  if FIsTextMode then
    FNet.WriteByte(10);

  if FNet.GetWriteBufferSize >= FBufferSize then
    EndDataBlock;

  Inc(FLoadedRows);

  DoAfterLoadRow;
end;

procedure TPgSQLLoader.BeginDataBlock;
begin
  if not FBlockOpened then begin
    FConnection.GetProtocol.BeginCopyDataBlock(FNet);
    FBlockOpened := True;
  end;
end;

procedure TPgSQLLoader.EndDataBlock;
begin
  if FBlockOpened then begin
    FConnection.GetProtocol.EndCopyDataBlock;
    FBlockOpened := False;
  end;
end;

procedure TPgSQLLoader.DoAfterLoadRow;
var
  i: integer;
begin
  if FObjectReleaseNeeded then
    for i := Low(FRowValues) to High(FRowValues) do
      DoReleaseObjectRef(FRowValues[i]);
end;

procedure TPgSQLLoader.WriteHeader;
var
  PgCopy: TBytes;
begin
  SetLength(PgCopy, 11);
  PgCopy[0] := Ord('P');
  PgCopy[1] := Ord('G');
  PgCopy[2] := Ord('C');
  PgCopy[3] := Ord('O');
  PgCopy[4] := Ord('P');
  PgCopy[5] := Ord('Y');
  PgCopy[6] := 10;
  PgCopy[7] := 255;
  PgCopy[8] := 13;
  PgCopy[9] := 10;
  PgCopy[10] := 0;

  FNet.WriteBytes(PgCopy);
  FNet.WriteInt32(0); // flags
  FNet.WriteInt32(0); // extension
end;

procedure TPgSQLLoader.Finish;
begin
  if FPrepared then begin
    BeginDataBlock;
    if FIsTextMode then begin
      FNet.WriteByte(ord('\'));
      FNet.WriteByte(ord('.'));
      FNet.WriteByte(10);
    end
    else
      FNet.WriteInt16(-1); // trailer

    EndDataBlock;
    FConnection.GetProtocol.PutCopyEnd;

    FCommand.UnPrepare;
  end;

  inherited;
end;

procedure TPgSQLLoader.SetConnection(Value: TCRConnection);
begin
  inherited;

  FConnection := TPgSQLConnection(Value);
end;

{$ENDIF}

initialization
  PgSQLInfo := TPgSQLInfo.Create(nil);


finalization

  PgSQLInfo.Free;

end.

