sdpgsql.pas

SQLDirect Component Library is a light-weight Borland Database Engine replacement for Borland Delphi

  PQconsumeInput:function(conn: PPGconn): Integer; cdecl;

  // Routines for copy in/out
  PQgetline: 	function(conn: PPGconn; str: TSDCharPtr; length: Integer): Integer; cdecl;
  PQputline: 	function(conn: PPGconn; const str: TSDCharPtr): Integer; cdecl;
  PQgetlineAsync:function(conn: PPGconn; buffer: TSDCharPtr; bufsize: Integer): Integer; cdecl;
  PQputnbytes: 	function(conn: PPGconn; const buffer: TSDCharPtr; nbytes: Integer): Integer; cdecl;
  PQendcopy: 	function(conn: PPGconn): Integer; cdecl;

  // Set blocking/nonblocking connection to the backend
  PQsetnonblocking:
  		function(conn: PPGconn; arg: Integer): Integer; cdecl;
  PQisnonblocking:
  		function(const conn: PPGconn): Integer; cdecl;

  // Force the write buffer to be written (or at least try)
  PQflush:	function(conn: PPGconn): Integer; cdecl;


  	// Accessor functions for PGresult objects
  PQresultStatus:
  	 	function(const res: PPGresult): TExecStatusType; cdecl;
  PQresStatus: 	function(status: TExecStatusType): TSDCharPtr; cdecl;
  PQresultErrorMessage:
  	 	function(const res: PPGresult): TSDCharPtr; cdecl;
  PQntuples: 	function(const res: PPGresult): Integer; cdecl;
  PQnfields: 	function(const res: PPGresult): Integer; cdecl;
  PQbinaryTuples:
  	 	function(const res: PPGresult): Integer; cdecl;
  PQfname: 	function(const res: PPGresult; field_num: Integer): TSDCharPtr; cdecl;
  PQfnumber: 	function(const res: PPGresult; const field_name: TSDCharPtr): Integer; cdecl;
  PQftype: 	function(const res: PPGresult; field_num: Integer): Oid; cdecl;
  PQfsize: 	function(const res: PPGresult; field_num: Integer): Integer; cdecl;
  PQfmod: 	function(const res: PPGresult; field_num: Integer): Integer; cdecl;
  PQcmdStatus: 	function(res: PPGresult): TSDCharPtr; cdecl;
  PQoidStatus: 	function(const res: PPGresult): TSDCharPtr; cdecl;	       	// old and ugly
  PQoidValue: 	function(const res: PPGresult): Oid; cdecl;		// new and improved
  PQcmdTuples: 	function(res: PPGresult): TSDCharPtr; cdecl;
  PQgetvalue: 	function(const res: PPGresult; tup_num, field_num: Integer): TSDCharPtr; cdecl;  PQgetlength: 	function(const res: PPGresult; tup_num, field_num: Integer): Integer; cdecl;
  PQgetisnull: 	function(const res: PPGresult; tup_num, field_num: Integer): Integer; cdecl;

  // Delete a PGresult
  PQclear:	procedure(res: PPGresult); cdecl;

  // Make an empty PGresult with given status (some apps find this useful).
  //If conn is not NULL and status indicates an error, the conn's errorMessage is copied.
  PQmakeEmptyPGresult:
  		function(conn: PPGconn; status: TExecStatusType): PPGresult; cdecl;


  PQprint:	procedure(fout: Pointer; const res: PPGresult; const ps: PPQprintOpt); cdecl;


	// Large-object access routines
  lo_open: 	function(conn: PPGconn; lobjId: Oid; mode: Integer): Integer; cdecl;
  lo_close: 	function(conn: PPGconn; fd: Integer): Integer; cdecl;
  lo_read: 	function(conn: PPGconn; fd: Integer; buf: TSDCharPtr; len: Integer): Integer; cdecl;
  lo_write: 	function(conn: PPGconn; fd: Integer; buf: TSDCharPtr; len: Integer): Integer; cdecl;
  lo_lseek: 	function(conn: PPGconn; fd: Integer; offset, whence: Integer): Integer; cdecl;
  lo_creat: 	function(conn: PPGconn; mode: Integer): Oid; cdecl;
  lo_tell: 	function(conn: PPGconn; fd: Integer): Integer; cdecl;
  lo_unlink: 	function(conn: PPGconn; lobjId: Oid): Integer; cdecl;
  lo_import: 	function(conn: PPGconn; const filename: TSDCharPtr): Oid; cdecl;
  lo_export: 	function(conn: PPGconn; lobjId: Oid; const filename: TSDCharPtr): Integer; cdecl;


  // Determine length of multibyte encoded char at *s
  PQmblen:	function(const s: TSDCharPtr; encoding: Integer): Integer; cdecl;

  // Get encoding id from environment variable PGCLIENTENCODING
  PQenv2encoding:
  		function: Integer; cdecl;
{$ENDIF}

type
  ESDPgSQLError = class(ESDEngineError);

{ TIPsDatabase }
  TIPgConnInfo= packed record
    ServerType: Byte;
    PgConnPtr:	PPGconn;			// pointer to structure for communication with the PostgreSQL
  end;

  TIPgDatabase = class(TISqlDatabase)
  private
    FHandle: TSDPtr;

    procedure Check(pgconn: PPGconn);
    procedure CheckRes(pgres: PPGresult);
    procedure AllocHandle;
    procedure FreeHandle;
    procedure ExecCmd(const sStmt: string; CheckRslt: Boolean);
    function GetPgConnPtr: PPGconn;
  protected
    function GetHandle: TSDPtr; override;

    procedure DoConnect(const sRemoteDatabase, sUserName, sPassword: string); override;
    procedure DoDisconnect(Force: Boolean); override;
    procedure DoCommit; override;
    procedure DoRollback; override;
    procedure DoStartTransaction; override;

    procedure SetAutoCommitOption(Value: Boolean); override;
    procedure SetHandle(AHandle: TSDPtr); override;
  public
    constructor Create(ADbParams: TStrings); override;
    destructor Destroy; override;
    function CreateSqlCommand: TISqlCommand; override;

    function GetClientVersion: LongInt; override;
    function GetServerVersion: LongInt; override;
    function GetVersionString: string; override;
    function GetSchemaInfo(ASchemaType: TSDSchemaType; AObjectName: string): TISqlCommand; override;

    procedure SetTransIsolation(Value: TISqlTransIsolation); override;
    function TestConnected: Boolean; override;

    property PgConnPtr: PPGconn read GetPgConnPtr;
  end;

{ TIPgCommand }
  TIPgCommand = class(TISqlCommand)
  private
    FHandle: PSDCursor;
    FRecCount,			// record count in a result set
    FCurrRec: Integer;		// the current record number (0..FRecCount-1)

    FStmt,			// w/o bind data
    FBindStmt: string;		// with bind parameter data, it's used to check whether the statement was executed
    FRowsAffected: Integer;	// number of rows affected by the last query

    function GetIsOpened: Boolean;
    function GetSqlDatabase: TIPgDatabase;
    function CnvtDateTime2SqlString(Value: TDateTime): string;
    function CnvtFloat2SqlString(Value: Double): string;
    function CnvtByteString2String(Value: string): string;
    function CnvtString2ByteString(Value: string): TSDBlobData;
    function CnvtString2EscapeString(Value: string): string;
    procedure InternalQBindParams;
    function InternalQExecute: Boolean;
  protected
    procedure Check(pgres: PPGresult);

    function FieldDataType(ExtDataType: Integer): TFieldType; override;
    function NativeDataSize(FieldType: TFieldType): Word; override;
    function RequiredCnvtFieldType(FieldType: TFieldType): Boolean; override;

    procedure DoPrepare(Value: string); override;
    procedure DoExecDirect(Value: string); override;
    procedure DoExecute; override;
    procedure BindParamsBuffer; override;
    function GetHandle: PSDCursor; override;
    procedure GetFieldDescs(Descs: TSDFieldDescList); override;
    procedure InitParamList; override;
    procedure SetFieldsBuffer; override;

    property IsOpened: Boolean read GetIsOpened;
  public
    constructor Create(ASqlDatabase: TISqlDatabase); override;
    destructor Destroy; override;
	// command interface
    procedure CloseResultSet; override;
    procedure Disconnect(Force: Boolean); override;
    function GetRowsAffected: Integer; override;
    function ResultSetExists: Boolean; override;
	// cursor interface
    function FetchNextRow: Boolean; override;
    function GetCnvtFieldData(AFieldDesc: TSDFieldDesc; Buffer: TSDPtr; BufSize: Integer): Boolean; override;
    procedure GetOutputParams; override;

    function ReadBlob(AFieldDesc: TSDFieldDesc; var BlobData: TSDBlobData): Longint; override;

    property SqlDatabase: TIPgDatabase read GetSqlDatabase;
  end;


const
  DefSqlApiDLL	= 'libpq.dll';

var
  SqlApiDLL: string;

{*******************************************************************************
		Load/Unload Sql-library
*******************************************************************************}
procedure LoadSqlLib;
procedure FreeSqlLib;

function InitSqlDatabase(ADbParams: TStrings): TISqlDatabase;

{$IFDEF SD_CLR}

[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQconnectStart')]
function PQconnectStart(szConnInfo: TSDCharPtr): PPGconn; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQconnectPoll')]
function PQconnectPoll(conn: PPGconn): TPostgresPollingStatusType; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQconnectdb')]
function PQconnectdb(szConnInfo: TSDCharPtr): PPGconn; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQsetdbLogin')]
function PQsetdbLogin(pghost, pgport, pgoptions, pgtty, dbName, login, pwd: TSDCharPtr): PPGconn; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQfinish')]
procedure PQfinish(conn: PPGconn); external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQconndefaults')]
function PQconndefaults: PPQconninfoOption; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQconninfoFree')]
procedure PQconninfoFree(connOptions: PPQconninfoOption); external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQresetStart')]
function PQresetStart(conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQresetPoll')]
function PQresetPoll(conn: PPGconn): TPostgresPollingStatusType; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQreset')]
procedure PQreset(conn: PPGconn); external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQrequestCancel')]
function PQrequestCancel(conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQdb')]
function PQdb(const conn: PPGconn): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQuser')]
function PQuser(const conn: PPGconn): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQpass')]
function PQpass(const conn: PPGconn): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQhost')]
function PQhost(const conn: PPGconn): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQport')]
function PQport(const conn: PPGconn): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQtty')]
function PQtty(const conn: PPGconn): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQoptions')]
function PQoptions(const conn: PPGconn): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQstatus')]
function PQstatus(const conn: PPGconn): TConnStatusType; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQerrorMessage')]
function PQerrorMessage(const conn: PPGconn): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQsocket')]
function PQsocket(const conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQbackendPID')]
function PQbackendPID(const conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQclientEncoding')]
function PQclientEncoding(const conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQsetClientEncoding')]
function PQsetClientEncoding(conn: PPGconn; const encoding: TSDCharPtr): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQgetssl')]
function PQgetssl(conn: PPGconn): PSSL; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQtrace')]
procedure PQtrace(conn: PPGconn; debug_port: TVoid); external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQuntrace')]
procedure PQuntrace(conn: PPGconn); external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQexec')]
function PQexec(conn: PPGconn; const query: TSDCharPtr): PPGresult; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQnotifies')]
function PQnotifies(conn: PPGconn): PPGnotify; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQsendQuery')]
function PQsendQuery(conn: PPGconn; const query: TSDCharPtr): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQgetResult')]
function PQgetResult(conn: PPGconn): PPGresult; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQisBusy')]
function PQisBusy(conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQconsumeInput')]
function PQconsumeInput(conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQgetline')]
function PQgetline(conn: PPGconn; str: TSDCharPtr; length: Integer): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQputline')]
function PQputline(conn: PPGconn; const str: TSDCharPtr): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQgetlineAsync')]
function PQgetlineAsync(conn: PPGconn; buffer: TSDCharPtr; bufsize: Integer): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQputnbytes')]
function PQputnbytes(conn: PPGconn; const buffer: TSDCharPtr; nbytes: Integer): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQendcopy')]
function PQendcopy(conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQsetnonblocking')]
function PQsetnonblocking(conn: PPGconn; arg: Integer): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQisnonblocking')]
function PQisnonblocking(const conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQflush')]
function PQflush(conn: PPGconn): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQresultStatus')]
function PQresultStatus(const res: PPGresult): TExecStatusType; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQresStatus')]
function PQresStatus(status: TExecStatusType): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQresultErrorMessage')]
function PQresultErrorMessage(const res: PPGresult): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQntuples')]
function PQntuples(const res: PPGresult): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQnfields')]
function PQnfields(const res: PPGresult): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQbinaryTuples')]
function PQbinaryTuples(const res: PPGresult): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQfname')]
function PQfname(const res: PPGresult; field_num: Integer): TSDCharPtr; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQfnumber')]
function PQfnumber(const res: PPGresult; const field_name: TSDCharPtr): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQftype')]
function PQftype(const res: PPGresult; field_num: Integer): Oid; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQfsize')]
function PQfsize(const res: PPGresult; field_num: Integer): Integer; external;
[DllImport(DefSqlApiDLL, CallingConvention = CallingConvention.cdecl, CharSet = CharSet.Ansi, SetLastError = True, EntryPoint = 'PQfmod')]
function PQfmod(const res: PPGresult; field_num: Integer): Integer; external;