mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 12:49:33 +02:00
* Patch from Joost van der Sluis
- Use of the dynamically loaded library (postgres3dyn) - support for the postgreSQL'a internal fieldtype 'name' - implemented UpdateIndexDefs - Support for more then one query for each connection
This commit is contained in:
parent
35a249fc8f
commit
bfcb70b5e4
@ -2,11 +2,18 @@ unit pqconnection;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{$Define LinkDynamically}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, sqldb, db,postgres3, dbconst;
|
||||
|
||||
Classes, SysUtils, sqldb, db, dbconst,
|
||||
{$IfDef LinkDynamically}
|
||||
postgres3dyn;
|
||||
{$Else}
|
||||
postgres3;
|
||||
{$EndIf}
|
||||
|
||||
type
|
||||
TPQTrans = Class(TSQLHandle)
|
||||
protected
|
||||
@ -20,10 +27,12 @@ type
|
||||
nFields : integer;
|
||||
res : PPGresult;
|
||||
BaseRes : PPGresult;
|
||||
Nr : string;
|
||||
end;
|
||||
|
||||
TPQConnection = class (TSQLConnection)
|
||||
private
|
||||
FCursorCount : word;
|
||||
FConnectString : string;
|
||||
FSQLDatabaseHandle : pointer;
|
||||
function TranslateFldType(Type_Oid : integer) : TFieldType;
|
||||
@ -48,6 +57,8 @@ type
|
||||
procedure CommitRetaining(trans : TSQLHandle); override;
|
||||
function StartdbTransaction(trans : TSQLHandle) : boolean; override;
|
||||
procedure RollBackRetaining(trans : TSQLHandle); override;
|
||||
procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
|
||||
|
||||
published
|
||||
property DatabaseName;
|
||||
property KeepConnection;
|
||||
@ -71,6 +82,7 @@ ResourceString
|
||||
|
||||
const Oid_Bool = 16;
|
||||
Oid_Text = 25;
|
||||
Oid_Name = 19;
|
||||
Oid_Int8 = 20;
|
||||
Oid_int2 = 21;
|
||||
Oid_Int4 = 23;
|
||||
@ -238,6 +250,10 @@ procedure TPQConnection.DoInternalConnect;
|
||||
var msg : string;
|
||||
|
||||
begin
|
||||
{$IfDef LinkDynamically}
|
||||
InitialisePostgres3;
|
||||
{$EndIf}
|
||||
|
||||
inherited dointernalconnect;
|
||||
|
||||
if (DatabaseName = '') then
|
||||
@ -261,13 +277,18 @@ end;
|
||||
procedure TPQConnection.DoInternalDisconnect;
|
||||
begin
|
||||
PQfinish(FSQLDatabaseHandle);
|
||||
{$IfDef LinkDynamically}
|
||||
ReleasePostgres3;
|
||||
{$EndIf}
|
||||
|
||||
end;
|
||||
|
||||
function TPQConnection.TranslateFldType(Type_Oid : integer) : TFieldType;
|
||||
|
||||
begin
|
||||
case Type_Oid of
|
||||
Oid_varchar,Oid_bpchar : Result := ftstring;
|
||||
Oid_varchar,Oid_bpchar,
|
||||
Oid_name : Result := ftstring;
|
||||
Oid_text : REsult := ftmemo;
|
||||
Oid_int8 : Result := ftLargeInt;
|
||||
Oid_int4 : Result := ftInteger;
|
||||
@ -301,7 +322,11 @@ begin
|
||||
begin
|
||||
(cursor as TPQCursor).statement := buf;
|
||||
if StatementType = stselect then
|
||||
statement := 'DECLARE selectst' + name + ' BINARY CURSOR FOR ' + statement;
|
||||
begin
|
||||
nr := inttostr(FCursorcount);
|
||||
statement := 'DECLARE slctst' + name + nr +' BINARY CURSOR FOR ' + statement;
|
||||
inc(FCursorcount);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -313,7 +338,7 @@ begin
|
||||
begin
|
||||
if StatementType = stselect then
|
||||
begin
|
||||
Res := pqexec(tr,pchar('CLOSE selectst' + name));
|
||||
Res := pqexec(tr,pchar('CLOSE slctst' + name + nr));
|
||||
if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
|
||||
begin
|
||||
pqclear(res);
|
||||
@ -361,7 +386,7 @@ begin
|
||||
with cursor as TPQCursor do
|
||||
begin
|
||||
// BaseRes := pqexecParams(tr,'FETCH 0 IN selectst' + pchar(name) ,0,nil,nil,nil,nil,1);
|
||||
st := 'FETCH 0 IN selectst' + pchar(name);
|
||||
st := pchar('FETCH 0 IN slctst' + name+nr);
|
||||
BaseRes := pqexec(tr,pchar(st));
|
||||
if (PQresultStatus(BaseRes) <> PGRES_TUPLES_OK) then
|
||||
begin
|
||||
@ -374,7 +399,7 @@ begin
|
||||
size := PQfsize(BaseRes, i);
|
||||
fieldtype := TranslateFldType(PQftype(BaseRes, i));
|
||||
|
||||
if fieldtype = ftstring then
|
||||
if (fieldtype = ftstring) and (size = -1) then
|
||||
size := pqfmod(baseres,i)-3;
|
||||
if fieldtype = ftdate then
|
||||
size := sizeof(double);
|
||||
@ -396,7 +421,7 @@ var st : string;
|
||||
begin
|
||||
with cursor as TPQCursor do
|
||||
begin
|
||||
st := 'FETCH NEXT IN selectst' + pchar(name);
|
||||
st := pchar('FETCH NEXT IN slctst' + name+nr);
|
||||
Res := pqexec(tr,pchar(st));
|
||||
if (PQresultStatus(res) <> PGRES_TUPLES_OK) then
|
||||
begin
|
||||
@ -477,6 +502,63 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPQConnection.UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string);
|
||||
|
||||
var qry : TSQLQuery;
|
||||
|
||||
begin
|
||||
if not assigned(Transaction) then
|
||||
DatabaseError(SErrConnTransactionnSet);
|
||||
|
||||
qry := tsqlquery.Create(nil);
|
||||
qry.transaction := Transaction;
|
||||
qry.database := Self;
|
||||
with qry do
|
||||
begin
|
||||
ReadOnly := True;
|
||||
sql.clear;
|
||||
|
||||
sql.add('select '+
|
||||
'ic.relname as indexname, '+
|
||||
'tc.relname as tablename, '+
|
||||
'ia.attname, '+
|
||||
'i.indisprimary, '+
|
||||
'i.indisunique '+
|
||||
'from '+
|
||||
'pg_attribute ta, '+
|
||||
'pg_attribute ia, '+
|
||||
'pg_class tc, '+
|
||||
'pg_class ic, '+
|
||||
'pg_index i '+
|
||||
'where '+
|
||||
'(i.indrelid = tc.oid) and '+
|
||||
'(ta.attrelid = tc.oid) and '+
|
||||
'(ia.attrelid = i.indexrelid) and '+
|
||||
'(ic.oid = i.indexrelid) and '+
|
||||
'(ta.attnum = i.indkey[ia.attnum-1]) and '+
|
||||
'(upper(tc.relname)=''' + UpperCase(TableName) +''') '+
|
||||
'order by '+
|
||||
'ic.relname;');
|
||||
open;
|
||||
end;
|
||||
|
||||
while not qry.eof do with IndexDefs.AddIndexDef do
|
||||
begin
|
||||
Name := trim(qry.fields[0].asstring);
|
||||
Fields := trim(qry.Fields[2].asstring);
|
||||
If qry.fields[3].asboolean then options := options + [ixPrimary];
|
||||
If qry.fields[4].asboolean then options := options + [ixUnique];
|
||||
qry.next;
|
||||
while (name = qry.fields[0].asstring) and (not qry.eof) do
|
||||
begin
|
||||
Fields := Fields + ';' + trim(qry.Fields[2].asstring);
|
||||
qry.next;
|
||||
end;
|
||||
end;
|
||||
qry.close;
|
||||
qry.free;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user