mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 11:49:23 +02:00
--- Merging r32812 into '.':
U packages/fcl-db/src/sqldb/interbase/fbadmin.pp --- Recording mergeinfo for merge of r32812 into '.': U . --- Merging r32938 into '.': U packages/fcl-db/src/sqldb/interbase/ibconnection.pp --- Recording mergeinfo for merge of r32938 into '.': G . --- Merging r32941 into '.': G packages/fcl-db/src/sqldb/interbase/ibconnection.pp --- Recording mergeinfo for merge of r32941 into '.': G . --- Merging r33127 into '.': U packages/fcl-db/src/sqldb/sqldb.pp --- Recording mergeinfo for merge of r33127 into '.': G . --- Merging r33150 into '.': U packages/fcl-db/src/base/bufdataset.pas U packages/fcl-db/tests/testspecifictbufdataset.pas --- Recording mergeinfo for merge of r33150 into '.': G . --- Merging r33169 into '.': G packages/fcl-db/src/sqldb/sqldb.pp A packages/fcl-db/src/base/sqltypes.pp U packages/fcl-db/src/datadict/fpddsqldb.pp U packages/fcl-db/src/datadict/fpdatadict.pp U packages/fcl-db/fpmake.pp --- Recording mergeinfo for merge of r33169 into '.': G . --- Merging r33172 into '.': G packages/fcl-db/src/base/bufdataset.pas --- Recording mergeinfo for merge of r33172 into '.': G . --- Merging r33174 into '.': G packages/fcl-db/src/sqldb/sqldb.pp --- Recording mergeinfo for merge of r33174 into '.': G . # revisions: 32812,32938,32941,33127,33150,33169,33172,33174 git-svn-id: branches/fixes_3_0@33374 -
This commit is contained in:
marco
parent
0bf278ef4b
commit
e6507a4cb0
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2072,6 +2072,7 @@ packages/fcl-db/src/base/fields.inc svneol=native#text/plain
|
||||
packages/fcl-db/src/base/fpmake.inc svneol=native#text/plain
|
||||
packages/fcl-db/src/base/fpmake.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/base/sqlscript.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/base/sqltypes.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/base/xmldatapacketreader.pp svneol=native#text/plain
|
||||
packages/fcl-db/src/codegen/Makefile svneol=native#text/plain
|
||||
packages/fcl-db/src/codegen/Makefile.fpc svneol=native#text/plain
|
||||
|
||||
@ -131,6 +131,8 @@ begin
|
||||
T:=P.Targets.AddUnit('dbconst.pas');
|
||||
T.ResourceStrings:=true;
|
||||
|
||||
T:=P.Targets.AddUnit('sqltypes.pp');
|
||||
|
||||
T:=P.Targets.AddUnit('sqlscript.pp');
|
||||
T.ResourceStrings:=true;
|
||||
|
||||
@ -500,6 +502,7 @@ begin
|
||||
begin
|
||||
AddUnit('db');
|
||||
AddUnit('sqldb');
|
||||
AddUnit('sqltypes');
|
||||
AddUnit('fpdatadict');
|
||||
end;
|
||||
T:=P.Targets.AddUnit('fpddsqlite3.pp', DatadictOSes);
|
||||
@ -743,6 +746,7 @@ begin
|
||||
AddUnit('bufdataset');
|
||||
AddUnit('dbconst');
|
||||
AddUnit('sqlscript');
|
||||
AddUnit('sqltypes');
|
||||
end;
|
||||
T:=P.Targets.AddUnit('sqldblib.pp');
|
||||
with T.Dependencies do
|
||||
|
||||
@ -592,9 +592,10 @@ type
|
||||
procedure LoadFromFile(AFileName: string = ''; Format: TDataPacketFormat = dfAny);
|
||||
procedure SaveToFile(AFileName: string = ''; Format: TDataPacketFormat = dfBinary);
|
||||
procedure CreateDataset;
|
||||
Procedure Clear; // Will close and remove all field definitions.
|
||||
function BookmarkValid(ABookmark: TBookmark): Boolean; override;
|
||||
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
|
||||
|
||||
Procedure CopyFromDataset(DataSet : TDataSet;CopyData : Boolean=True);
|
||||
property ChangeCount : Integer read GetChangeCount;
|
||||
property MaxIndexesCount : Integer read FMaxIndexesCount write SetMaxIndexesCount default 2;
|
||||
property ReadOnly : Boolean read FReadOnly write SetReadOnly default false;
|
||||
@ -1246,18 +1247,20 @@ begin
|
||||
// See mantis #22030
|
||||
|
||||
// if Fields.Count<FieldDefs.Count then
|
||||
if Fields.Count = 0 then
|
||||
if (Fields.Count = 0) or (FieldDefs.Count=0) then
|
||||
DatabaseError(SErrNoDataset);
|
||||
|
||||
// If there is a field with FieldNo=0 then the fields are not found to the
|
||||
// FieldDefs which is a sign that there is no dataset created. (Calculated and
|
||||
// lookup fields have FieldNo=-1)
|
||||
// search for autoinc field
|
||||
FAutoIncField:=nil;
|
||||
for i := 0 to Fields.Count-1 do
|
||||
if Fields[i].FieldNo=0 then
|
||||
DatabaseError(SErrNoDataset)
|
||||
else if (FAutoIncValue>-1) and (Fields[i] is TAutoIncField) and not assigned(FAutoIncField) then
|
||||
FAutoIncField := TAutoIncField(Fields[i]);
|
||||
if FAutoIncValue>-1 then
|
||||
begin
|
||||
for i := 0 to Fields.Count-1 do
|
||||
if Fields[i] is TAutoIncField then
|
||||
begin
|
||||
FAutoIncField := TAutoIncField(Fields[i]);
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
|
||||
InitDefaultIndexes;
|
||||
CalcRecordSize;
|
||||
@ -1355,6 +1358,111 @@ begin
|
||||
SetToLastRecord;
|
||||
end;
|
||||
|
||||
procedure TCustomBufDataset.CopyFromDataset(DataSet: TDataSet; CopyData: Boolean);
|
||||
|
||||
Const
|
||||
UseStreams = ftBlobTypes;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
F,F1,F2 : TField;
|
||||
L1,L2 : TList;
|
||||
N : String;
|
||||
OriginalPosition: TBookMark;
|
||||
S : TMemoryStream;
|
||||
|
||||
begin
|
||||
Close;
|
||||
Fields.Clear;
|
||||
FieldDefs.Clear;
|
||||
For I:=0 to Dataset.FieldCount-1 do
|
||||
begin
|
||||
F:=Dataset.Fields[I];
|
||||
TFieldDef.Create(FieldDefs,F.FieldName,F.DataType,F.Size,F.Required,F.FieldNo);
|
||||
end;
|
||||
CreateDataset;
|
||||
L1:=Nil;
|
||||
L2:=Nil;
|
||||
S:=Nil;
|
||||
If CopyData then
|
||||
try
|
||||
L1:=TList.Create;
|
||||
L2:=TList.Create;
|
||||
Open;
|
||||
For I:=0 to FieldDefs.Count-1 do
|
||||
begin
|
||||
N:=FieldDefs[I].Name;
|
||||
F1:=FieldByName(N);
|
||||
F2:=DataSet.FieldByName(N);
|
||||
L1.Add(F1);
|
||||
L2.Add(F2);
|
||||
If (FieldDefs[I].DataType in UseStreams) and (S=Nil) then
|
||||
S:=TMemoryStream.Create;
|
||||
end;
|
||||
DisableControls;
|
||||
Dataset.DisableControls;
|
||||
OriginalPosition:=Dataset.GetBookmark;
|
||||
Try
|
||||
Dataset.Open;
|
||||
Dataset.First;
|
||||
While not Dataset.EOF do
|
||||
begin
|
||||
Append;
|
||||
For I:=0 to L1.Count-1 do
|
||||
begin
|
||||
F1:=TField(L1[i]);
|
||||
F2:=TField(L2[I]);
|
||||
If Not F2.IsNull then
|
||||
Case F1.DataType of
|
||||
ftFixedChar,
|
||||
ftString : F1.AsString:=F2.AsString;
|
||||
ftFixedWideChar,
|
||||
ftWideString : F1.AsWideString:=F2.AsWideString;
|
||||
ftBoolean : F1.AsBoolean:=F2.AsBoolean;
|
||||
ftFloat : F1.AsFloat:=F2.AsFloat;
|
||||
ftAutoInc,
|
||||
ftLargeInt : F1.AsInteger:=F2.AsInteger;
|
||||
ftSmallInt : F1.AsInteger:=F2.AsInteger;
|
||||
ftInteger : F1.AsInteger:=F2.AsInteger;
|
||||
ftDate : F1.AsDateTime:=F2.AsDateTime;
|
||||
ftTime : F1.AsDateTime:=F2.AsDateTime;
|
||||
ftTimestamp,
|
||||
ftDateTime : F1.AsDateTime:=F2.AsDateTime;
|
||||
ftCurrency : F1.AsCurrency:=F2.AsCurrency;
|
||||
ftBCD,
|
||||
ftFmtBCD : F1.AsBCD:=F2.AsBCD;
|
||||
else
|
||||
if (F1.DataType in UseStreams) then
|
||||
begin
|
||||
S.Clear;
|
||||
TBlobField(F2).SaveToStream(S);
|
||||
S.Position:=0;
|
||||
TBlobField(F1).LoadFromStream(S);
|
||||
end
|
||||
else
|
||||
F1.AsString:=F2.AsString;
|
||||
end;
|
||||
end;
|
||||
Try
|
||||
Post;
|
||||
except
|
||||
Cancel;
|
||||
Raise;
|
||||
end;
|
||||
Dataset.Next;
|
||||
end;
|
||||
Finally
|
||||
DataSet.GotoBookmark(OriginalPosition); //Return to original record
|
||||
Dataset.EnableControls;
|
||||
EnableControls;
|
||||
end;
|
||||
finally
|
||||
L2.Free;
|
||||
l1.Free;
|
||||
S.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TBufIndex }
|
||||
|
||||
constructor TBufIndex.Create(const ADataset: TCustomBufDataset);
|
||||
@ -3078,6 +3186,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomBufDataset.Clear;
|
||||
begin
|
||||
Close;
|
||||
FieldDefs.Clear;
|
||||
Fields.Clear;
|
||||
end;
|
||||
|
||||
function TCustomBufDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
|
||||
begin
|
||||
Result:=assigned(FCurrentIndex) and FCurrentIndex.BookmarkValid(pointer(ABookmark));
|
||||
|
||||
86
packages/fcl-db/src/base/sqltypes.pp
Normal file
86
packages/fcl-db/src/base/sqltypes.pp
Normal file
@ -0,0 +1,86 @@
|
||||
unit sqltypes;
|
||||
|
||||
interface
|
||||
|
||||
uses classes, sysutils;
|
||||
|
||||
type
|
||||
TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata, stSequences);
|
||||
|
||||
|
||||
type
|
||||
TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
|
||||
stDDL, stGetSegment, stPutSegment, stExecProcedure,
|
||||
stStartTrans, stCommit, stRollback, stSelectForUpd);
|
||||
|
||||
TDBEventType = (detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack, detParamValue, detActualSQL);
|
||||
TDBEventTypes = set of TDBEventType;
|
||||
|
||||
TQuoteChars = array[0..1] of char;
|
||||
|
||||
TSqlObjectIdentifierList = class;
|
||||
|
||||
{ TSqlObjectIdenfier }
|
||||
|
||||
TSqlObjectIdenfier = class(TCollectionItem)
|
||||
private
|
||||
FObjectName: String;
|
||||
FSchemaName: String;
|
||||
public
|
||||
constructor Create(ACollection: TSqlObjectIdentifierList; Const AObjectName: String; Const ASchemaName: String = '');
|
||||
property SchemaName: String read FSchemaName write FSchemaName;
|
||||
property ObjectName: String read FObjectName write FObjectName;
|
||||
end;
|
||||
|
||||
{ TSqlObjectIdentifierList }
|
||||
|
||||
TSqlObjectIdentifierList = class(TCollection)
|
||||
private
|
||||
function GetIdentifier(Index: integer): TSqlObjectIdenfier;
|
||||
procedure SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
|
||||
public
|
||||
function AddIdentifier: TSqlObjectIdenfier; overload;
|
||||
function AddIdentifier(Const AObjectName: String; Const ASchemaName: String = ''): TSqlObjectIdenfier; overload;
|
||||
property Identifiers[Index: integer]: TSqlObjectIdenfier read GetIdentifier write SetIdentifier; default;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{ TSqlObjectIdenfier }
|
||||
|
||||
constructor TSqlObjectIdenfier.Create(ACollection: TSqlObjectIdentifierList;
|
||||
const AObjectName: String; Const ASchemaName: String = '');
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
FSchemaName:=ASchemaName;
|
||||
FObjectName:=AObjectName;
|
||||
end;
|
||||
|
||||
{ TSqlObjectIdentifierList }
|
||||
|
||||
function TSqlObjectIdentifierList.GetIdentifier(Index: integer): TSqlObjectIdenfier;
|
||||
begin
|
||||
Result := Items[Index] as TSqlObjectIdenfier;
|
||||
end;
|
||||
|
||||
procedure TSqlObjectIdentifierList.SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
|
||||
begin
|
||||
Items[Index] := AValue;
|
||||
end;
|
||||
|
||||
function TSqlObjectIdentifierList.AddIdentifier: TSqlObjectIdenfier;
|
||||
begin
|
||||
Result:=Add as TSqlObjectIdenfier;
|
||||
end;
|
||||
|
||||
function TSqlObjectIdentifierList.AddIdentifier(Const AObjectName: String;
|
||||
Const ASchemaName: String = ''): TSqlObjectIdenfier;
|
||||
begin
|
||||
Result:=AddIdentifier();
|
||||
Result.SchemaName:=ASchemaName;
|
||||
Result.ObjectName:=AObjectName;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
@ -20,7 +20,7 @@ unit fpdatadict;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,inicol, inifiles, contnrs, db;
|
||||
Classes, SysUtils,inicol, inifiles, contnrs, db, sqltypes;
|
||||
|
||||
Type
|
||||
// Supported objects in this data dictionary
|
||||
@ -577,6 +577,7 @@ Type
|
||||
Procedure Disconnect ; virtual; abstract;
|
||||
procedure ImportDatadict (Adatadict: TFPDataDictionary; UpdateExisting : Boolean);
|
||||
Function GetTableList(List : TStrings) : Integer; virtual; abstract;
|
||||
Function GetObjectList(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual; abstract;
|
||||
Function ImportTables(Tables : TDDTableDefs; List : TStrings; UpdateExisting : Boolean) : Integer;
|
||||
Function ImportFields(Table : TDDTableDef) : Integer; virtual; abstract;
|
||||
Function ImportIndexes(Table : TDDTableDef) : Integer; virtual; abstract;
|
||||
|
||||
@ -20,7 +20,7 @@ unit fpddsqldb;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, DB, sqldb, fpdatadict;
|
||||
Classes, SysUtils, DB, sqltypes, sqldb, fpdatadict;
|
||||
|
||||
Type
|
||||
|
||||
@ -39,6 +39,7 @@ Type
|
||||
Function HostSupported: Boolean; virtual;
|
||||
Function Connect(const AConnectString : String) : Boolean; override;
|
||||
Function GetTableList(List : TStrings) : Integer; override;
|
||||
Function GetObjectList(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; override;
|
||||
Function ImportFields(Table : TDDTableDef) : Integer; override;
|
||||
Function ImportIndexes(Table : TDDTableDef) : Integer; override;
|
||||
Function ViewTable(Const TableName: String; DatasetOwner : TComponent) : TDataset; override;
|
||||
@ -141,6 +142,12 @@ begin
|
||||
result := list.count;
|
||||
end;
|
||||
|
||||
Function TSQLDBDDEngine.GetObjectList(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer;
|
||||
begin
|
||||
Result := FConn.GetObjectNames(ASchemaType, AList);
|
||||
end;
|
||||
|
||||
|
||||
function TSQLDBDDEngine.ImportFields(Table: TDDTableDef): Integer;
|
||||
|
||||
Const
|
||||
|
||||
@ -50,7 +50,8 @@ type
|
||||
IBBkpNoGarbageCollect,IBBkpOldDescriptions,IBBkpNonTransportable,IBBkpConvert);
|
||||
TIBBackupOptions= set of TIBBackupOption;
|
||||
TIBRestoreOption=(IBResVerbose,IBResDeactivateIdx,IBResNoShadow,IBResNoValidity,
|
||||
IBResOneAtaTime,IBResReplace,IBResCreate,IBResUseAllSpace,IBResAMReadOnly,IBResAMReadWrite);
|
||||
IBResOneAtaTime,IBResReplace,IBResCreate,IBResUseAllSpace,IBResAMReadOnly,IBResAMReadWrite,
|
||||
IBFixFssData, IBFixFssMeta);
|
||||
TIBRestoreOptions= set of TIBRestoreOption;
|
||||
TServiceProtocol=(IBSPLOCAL,IBSPTCPIP,IBSPNETBEUI,IBSPNAMEDPIPE);
|
||||
TIBOnOutput= procedure(Sender: TObject; msg: string; IBAdminAction: string) of object;
|
||||
@ -64,6 +65,7 @@ type
|
||||
private
|
||||
FErrorCode: longint;
|
||||
FErrorMsg: string;
|
||||
FFixFssDataCharSet: String;
|
||||
FHost: string;
|
||||
FOnOutput: TIBOnOutput;
|
||||
FOutput: TStringList;
|
||||
@ -152,6 +154,8 @@ type
|
||||
property ServerMsgDir:string read FServerMsgDir;
|
||||
//Path to the security database in use by the server
|
||||
property ServerSecDBDir:string read FServerSecDBDir;
|
||||
// FixFxxData/FixFxxMetaData code page
|
||||
property FixFssDataCharSet: String read FFixFssDataCharSet write FFixFssDataCharSet;
|
||||
published
|
||||
//User name to connect to service manager
|
||||
property User: string read FUser write FUser;
|
||||
@ -373,6 +377,7 @@ begin
|
||||
inherited Create(AOwner);
|
||||
FPort:= 3050;
|
||||
FOutput:=TStringList.Create;
|
||||
FFixFssDataCharSet:= '';
|
||||
end;
|
||||
|
||||
destructor TFBAdmin.Destroy;
|
||||
@ -506,6 +511,10 @@ begin
|
||||
else
|
||||
spb:=spb+chr(isc_spb_res_access_mode)+chr(isc_spb_res_am_readwrite);
|
||||
end;
|
||||
if (IBFixFssData in Options) and (FixFssDataCharSet > ' ') then
|
||||
spb:=spb+IBSPBParamSerialize(isc_spb_res_fix_fss_data, FixFssDataCharSet);
|
||||
if (IBFixFssMeta in Options) and (FixFssDataCharSet > ' ') then
|
||||
spb:=spb+IBSPBParamSerialize(isc_spb_res_fix_fss_metadata, FixFssDataCharSet);
|
||||
spb:=spb+IBSPBParamSerialize(isc_spb_options,MakeRestoreOptions(Options));
|
||||
result:=isc_service_start(@FStatus[0], @FSvcHandle, nil, length(spb),
|
||||
@spb[1])=0;
|
||||
|
||||
@ -54,6 +54,7 @@ type
|
||||
|
||||
TIBConnection = class (TSQLConnection)
|
||||
private
|
||||
FCheckTransactionParams: Boolean;
|
||||
FSQLDatabaseHandle : pointer;
|
||||
FStatus : array [0..19] of ISC_STATUS;
|
||||
FDatabaseInfo : TDatabaseInfo;
|
||||
@ -66,6 +67,7 @@ type
|
||||
|
||||
// Metadata:
|
||||
procedure GetDatabaseInfo; //Queries for various information from server once connected
|
||||
function InterpretTransactionParam(S: String; var TPB: AnsiChar; out AValue: String): Boolean;
|
||||
procedure ResetDatabaseInfo; //Useful when disconnecting
|
||||
function GetDialect: integer;
|
||||
function GetODSMajorVersion: integer;
|
||||
@ -122,6 +124,8 @@ type
|
||||
published
|
||||
property DatabaseName;
|
||||
property Dialect : integer read GetDialect write FDialect stored IsDialectStored default DEFDIALECT;
|
||||
// Set this to true to have starttransaction check transaction parameters. If False, unknown parameters are ignored.
|
||||
Property CheckTransactionParams : Boolean Read FCheckTransactionParams write FCheckTransactionParams;
|
||||
property KeepConnection;
|
||||
property LoginPrompt;
|
||||
property Params;
|
||||
@ -209,59 +213,129 @@ begin
|
||||
else result := true;
|
||||
end;
|
||||
|
||||
function TIBConnection.StartDBTransaction(trans: TSQLHandle; AParams: string
|
||||
): boolean;
|
||||
var
|
||||
DBHandle : pointer;
|
||||
tr : TIBTrans;
|
||||
i : integer;
|
||||
s : string;
|
||||
function TIBConnection.InterpretTransactionParam(S: String; var TPB: AnsiChar;
|
||||
out AValue: String): Boolean;
|
||||
|
||||
Const
|
||||
Prefix = 'isc_tpb_';
|
||||
PrefixLen = Length(Prefix);
|
||||
maxParam = 21;
|
||||
TPBNames : Array[1..maxParam] Of String =
|
||||
// 5 on a line. Lowercase
|
||||
('consistency','concurrency','shared','protected','exclusive',
|
||||
'wait','nowait','read','write','lock_read',
|
||||
'lock_write','verb_time','commit_time','ignore_limbo','read_committed',
|
||||
'autocommit','rec_version','no_rec_version','restart_requests','no_auto_undo',
|
||||
'lock_timeout');
|
||||
|
||||
Var
|
||||
P : Integer;
|
||||
|
||||
begin
|
||||
result := false;
|
||||
|
||||
DBHandle := GetHandle;
|
||||
tr := trans as TIBtrans;
|
||||
with tr do
|
||||
TPB:=#0;
|
||||
Result:=False;
|
||||
P:=Pos('=',S);
|
||||
If P<>0 then
|
||||
begin
|
||||
TPB := chr(isc_tpb_version3);
|
||||
|
||||
i := 1;
|
||||
s := ExtractSubStr(AParams,i,stdWordDelims);
|
||||
while s <> '' do
|
||||
begin
|
||||
if s='isc_tpb_write' then TPB := TPB + chr(isc_tpb_write)
|
||||
else if s='isc_tpb_read' then TPB := TPB + chr(isc_tpb_read)
|
||||
else if s='isc_tpb_consistency' then TPB := TPB + chr(isc_tpb_consistency)
|
||||
else if s='isc_tpb_concurrency' then TPB := TPB + chr(isc_tpb_concurrency)
|
||||
else if s='isc_tpb_read_committed' then TPB := TPB + chr(isc_tpb_read_committed)
|
||||
else if s='isc_tpb_rec_version' then TPB := TPB + chr(isc_tpb_rec_version)
|
||||
else if s='isc_tpb_no_rec_version' then TPB := TPB + chr(isc_tpb_no_rec_version)
|
||||
else if s='isc_tpb_wait' then TPB := TPB + chr(isc_tpb_wait)
|
||||
else if s='isc_tpb_nowait' then TPB := TPB + chr(isc_tpb_nowait)
|
||||
else if s='isc_tpb_shared' then TPB := TPB + chr(isc_tpb_shared)
|
||||
else if s='isc_tpb_protected' then TPB := TPB + chr(isc_tpb_protected)
|
||||
else if s='isc_tpb_exclusive' then TPB := TPB + chr(isc_tpb_exclusive)
|
||||
else if s='isc_tpb_lock_read' then TPB := TPB + chr(isc_tpb_lock_read)
|
||||
else if s='isc_tpb_lock_write' then TPB := TPB + chr(isc_tpb_lock_write)
|
||||
else if s='isc_tpb_verb_time' then TPB := TPB + chr(isc_tpb_verb_time)
|
||||
else if s='isc_tpb_commit_time' then TPB := TPB + chr(isc_tpb_commit_time)
|
||||
else if s='isc_tpb_ignore_limbo' then TPB := TPB + chr(isc_tpb_ignore_limbo)
|
||||
else if s='isc_tpb_autocommit' then TPB := TPB + chr(isc_tpb_autocommit)
|
||||
else if s='isc_tpb_restart_requests' then TPB := TPB + chr(isc_tpb_restart_requests)
|
||||
else if s='isc_tpb_no_auto_undo' then TPB := TPB + chr(isc_tpb_no_auto_undo);
|
||||
s := ExtractSubStr(AParams,i,stdWordDelims);
|
||||
|
||||
end;
|
||||
|
||||
TransactionHandle := nil;
|
||||
|
||||
if isc_start_transaction(@Status[0], @TransactionHandle, 1,
|
||||
[@DBHandle, Length(TPB), @TPB[1]]) <> 0 then
|
||||
CheckError('StartTransaction',Status)
|
||||
else Result := True;
|
||||
AValue:=Copy(S,P+1,Length(S)-P);
|
||||
S:=Copy(S,1,P-1);
|
||||
end;
|
||||
S:=LowerCase(S);
|
||||
P:=Pos(Prefix,S);
|
||||
if P<>0 then
|
||||
Delete(S,1,P+PrefixLen-1);
|
||||
Result:=(Copy(S,1,7)='version') and (Length(S)=8);
|
||||
if Result then
|
||||
TPB:=S[8]
|
||||
else
|
||||
begin
|
||||
P:=MaxParam;
|
||||
While (P>0) and (S<>TPBNames[P]) do
|
||||
Dec(P);
|
||||
Result:=P>0;
|
||||
if Result then
|
||||
TPB:=Char(P);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIBConnection.StartDBTransaction(trans: TSQLHandle; AParams: string
|
||||
): boolean;
|
||||
|
||||
Var
|
||||
DBHandle:pointer;
|
||||
I,T :integer;
|
||||
S :string;
|
||||
tpbv,version : ansichar;
|
||||
prVal :String;
|
||||
pInt :^Int32;
|
||||
LTPB : String; // Local TPB
|
||||
IBTrans : TIBTrans;
|
||||
|
||||
Begin
|
||||
Result:=False;
|
||||
DBHandle:=GetHandle;
|
||||
Version:=#0;
|
||||
I:=1;
|
||||
IBTrans:=(Trans as TIBTrans);
|
||||
LTPB:='';
|
||||
S:=ExtractSubStr(AParams,I,stdWordDelims);
|
||||
While (S<>'') do
|
||||
begin
|
||||
If Not InterpretTransactionParam(S,tpbv,prVal) then
|
||||
begin
|
||||
If CheckTransactionParams then
|
||||
DatabaseError('Invalid parameter for transaction: "'+S+'"',Self);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Check Version
|
||||
if (tpbv>='1') then
|
||||
begin
|
||||
Version:=tpbv;
|
||||
// Check value
|
||||
if Not (Version in ['1','3']) then
|
||||
DatabaseError('Invalid version specified for transaction: "'+Version+'"',Self);
|
||||
end
|
||||
else
|
||||
begin
|
||||
LTPB:=LTPB+tpbv;
|
||||
Case Ord(tpbv) Of
|
||||
isc_tpb_lock_read,
|
||||
isc_tpb_lock_write:
|
||||
Begin
|
||||
If prVal='' Then
|
||||
DatabaseErrorFmt('Table name must be specified for "%s"',[S],Self);
|
||||
LTPB:=LTPB+Char(Length(prVal))+prVal;
|
||||
End;
|
||||
isc_tpb_lock_timeout:
|
||||
Begin
|
||||
//In case of using lock timeout we need add timeout
|
||||
If prVal='' Then
|
||||
DatabaseErrorFmt('Timeout must be specified for "%s"',[S],Self);
|
||||
LTPB:=LTPB+Char(SizeOf(ISC_LONG));
|
||||
SetLength(LTPB,Length(LTPB)+SizeOf(ISC_LONG));
|
||||
pInt:=@LTPB[Length(LTPB)-SizeOf(ISC_LONG)+1];
|
||||
pInt^:=StrToInt(prVal);
|
||||
End;
|
||||
End;
|
||||
end;
|
||||
end;
|
||||
S:=ExtractSubStr(AParams,I,stdWordDelims);
|
||||
end;
|
||||
// Default version.
|
||||
If Version=#0 then
|
||||
Version:='3';
|
||||
// Construct block.
|
||||
With IBTrans do
|
||||
begin
|
||||
TPB:=Char(Ord(Version)-Ord('0'))+LTPB;
|
||||
TransactionHandle:=Nil;
|
||||
If isc_start_transaction(@Status[0],@TransactionHandle,1,[@DBHandle,Length(TPB),@TPB[1]])<>0 Then
|
||||
CheckError('StartTransaction',Status)
|
||||
Else
|
||||
Result := True
|
||||
End
|
||||
End;
|
||||
|
||||
procedure TIBConnection.CommitRetaining(trans : TSQLHandle);
|
||||
begin
|
||||
|
||||
@ -20,23 +20,66 @@ unit sqldb;
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils, Classes, DB, bufdataset, sqlscript;
|
||||
uses SysUtils, Classes, DB, bufdataset, sqlscript, sqltypes;
|
||||
|
||||
type
|
||||
TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata, stSequences);
|
||||
TSchemaType = sqltypes.TSchemaType;
|
||||
TStatementType = sqltypes.TStatementType;
|
||||
TDBEventType = sqltypes.TDBEventType;
|
||||
TDBEventTypes = sqltypes.TDBEventTypes;
|
||||
TQuoteChars = sqltypes.TQuoteChars;
|
||||
|
||||
const
|
||||
StatementTokens : Array[TStatementType] of string = ('(unknown)', 'select',
|
||||
'insert', 'update', 'delete',
|
||||
'create', 'get', 'put', 'execute',
|
||||
'start','commit','rollback', '?'
|
||||
);
|
||||
TSchemaObjectNames: array[TSchemaType] of String = ('???', 'table_name',
|
||||
'???', 'procedure_name', 'column_name', 'param_name',
|
||||
'index_name', 'package_name', 'schema_name','sequence');
|
||||
SingleQuotes : TQuoteChars = ('''','''');
|
||||
DoubleQuotes : TQuoteChars = ('"','"');
|
||||
LogAllEvents = [detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack];
|
||||
LogAllEventsExtra = [detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack, detParamValue,detActualSQL];
|
||||
|
||||
type
|
||||
// Backwards compatibility alias constants.
|
||||
|
||||
stNoSchema = sqltypes.stNoSchema;
|
||||
stTables = sqltypes.stTables;
|
||||
stSysTables = sqltypes.stSysTables;
|
||||
stProcedures = sqltypes.stProcedures;
|
||||
stColumns = sqltypes.stColumns;
|
||||
stProcedureParams = sqltypes.stProcedureParams;
|
||||
stIndexes = sqltypes.stIndexes;
|
||||
stPackages = sqltypes.stPackages;
|
||||
stSchemata = sqltypes.stSchemata;
|
||||
stSequences = sqltypes.stSequences;
|
||||
|
||||
TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
|
||||
stDDL, stGetSegment, stPutSegment, stExecProcedure,
|
||||
stStartTrans, stCommit, stRollback, stSelectForUpd);
|
||||
stUnknown = sqltypes.stUnknown;
|
||||
stSelect = sqltypes.stSelect;
|
||||
stInsert = sqltypes.stInsert;
|
||||
stUpdate = sqltypes.stUpdate;
|
||||
stDelete = sqltypes.stDelete;
|
||||
stDDL = sqltypes.stDDL;
|
||||
stGetSegment = sqltypes.stGetSegment;
|
||||
stPutSegment = sqltypes.stPutSegment;
|
||||
stExecProcedure = sqltypes.stExecProcedure;
|
||||
stStartTrans = sqltypes.stStartTrans;
|
||||
stCommit = sqltypes.stCommit;
|
||||
stRollback = sqltypes.stRollback;
|
||||
stSelectForUpd = sqltypes.stSelectForUpd;
|
||||
|
||||
detCustom = sqltypes.detCustom;
|
||||
detPrepare = sqltypes.detPrepare;
|
||||
detExecute = sqltypes.detExecute;
|
||||
detFetch = sqltypes.detFetch;
|
||||
detCommit = sqltypes.detCommit;
|
||||
detRollBack = sqltypes.detRollBack;
|
||||
detParamValue = sqltypes.detParamValue;
|
||||
detActualSQL = sqltypes.detActualSQL;
|
||||
|
||||
Type
|
||||
TRowsCount = LargeInt;
|
||||
|
||||
TSQLStatementInfo = Record
|
||||
@ -47,7 +90,6 @@ type
|
||||
WhereStopPos : integer;
|
||||
end;
|
||||
|
||||
|
||||
TSQLConnection = class;
|
||||
TSQLTransaction = class;
|
||||
TCustomSQLQuery = class;
|
||||
@ -55,11 +97,6 @@ type
|
||||
TSQLQuery = class;
|
||||
TSQLScript = class;
|
||||
|
||||
|
||||
TDBEventType = (detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack, detParamValue, detActualSQL);
|
||||
TDBEventTypes = set of TDBEventType;
|
||||
TDBLogNotifyEvent = Procedure (Sender : TSQLConnection; EventType : TDBEventType; Const Msg : String) of object;
|
||||
|
||||
TSQLHandle = Class(TObject)
|
||||
end;
|
||||
|
||||
@ -118,18 +155,6 @@ type
|
||||
Class Function ParamClass : TParamClass; override;
|
||||
end;
|
||||
|
||||
TQuoteChars = array[0..1] of char;
|
||||
|
||||
const
|
||||
SingleQuotes : TQuoteChars = ('''','''');
|
||||
DoubleQuotes : TQuoteChars = ('"','"');
|
||||
LogAllEvents = [detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack];
|
||||
LogAllEventsExtra = [detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack, detParamValue,detActualSQL];
|
||||
StatementTokens : Array[TStatementType] of string = ('(unknown)', 'select',
|
||||
'insert', 'update', 'delete',
|
||||
'create', 'get', 'put', 'execute',
|
||||
'start','commit','rollback', '?'
|
||||
);
|
||||
|
||||
type
|
||||
|
||||
@ -142,36 +167,11 @@ type
|
||||
procedure Update; override;
|
||||
end;
|
||||
|
||||
|
||||
TSqlObjectIdentifierList = class;
|
||||
|
||||
{ TSqlObjectIdenfier }
|
||||
|
||||
TSqlObjectIdenfier = class(TCollectionItem)
|
||||
private
|
||||
FObjectName: String;
|
||||
FSchemaName: String;
|
||||
public
|
||||
constructor Create(ACollection: TSqlObjectIdentifierList; Const AObjectName: String; Const ASchemaName: String = '');
|
||||
property SchemaName: String read FSchemaName write FSchemaName;
|
||||
property ObjectName: String read FObjectName write FObjectName;
|
||||
end;
|
||||
|
||||
{ TSqlObjectIdentifierList }
|
||||
|
||||
TSqlObjectIdentifierList = class(TCollection)
|
||||
private
|
||||
function GetIdentifier(Index: integer): TSqlObjectIdenfier;
|
||||
procedure SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
|
||||
public
|
||||
function AddIdentifier: TSqlObjectIdenfier; overload;
|
||||
function AddIdentifier(Const AObjectName: String; Const ASchemaName: String = ''): TSqlObjectIdenfier; overload;
|
||||
property Identifiers[Index: integer]: TSqlObjectIdenfier read GetIdentifier write SetIdentifier; default;
|
||||
end;
|
||||
|
||||
type
|
||||
|
||||
{ TSQLConnection }
|
||||
|
||||
TDBLogNotifyEvent = Procedure (Sender : TSQLConnection; EventType : TDBEventType; Const Msg : String) of object;
|
||||
|
||||
TConnOption = (sqSupportParams, sqSupportEmptyDatabaseName, sqEscapeSlash, sqEscapeRepeat, sqImplicitTransaction, sqLastInsertID, sqSupportReturning);
|
||||
TConnOptions= set of TConnOption;
|
||||
@ -255,7 +255,6 @@ type
|
||||
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
|
||||
function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual;
|
||||
|
||||
function GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual;
|
||||
Procedure MaybeConnect;
|
||||
|
||||
Property Statements : TFPList Read FStatements;
|
||||
@ -269,6 +268,9 @@ type
|
||||
procedure EndTransaction; override;
|
||||
procedure ExecuteDirect(SQL : String); overload; virtual;
|
||||
procedure ExecuteDirect(SQL : String; ATransaction : TSQLTransaction); overload; virtual;
|
||||
// Unified version
|
||||
function GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual;
|
||||
// Older versions.
|
||||
procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); virtual;
|
||||
procedure GetProcedureNames(List : TStrings); virtual;
|
||||
procedure GetFieldNames(const TableName : string; List : TStrings); virtual;
|
||||
@ -1392,6 +1394,10 @@ begin
|
||||
GetDBInfo(stSequences,'','SEQUENCE_NAME',List);
|
||||
end;
|
||||
|
||||
{
|
||||
See if we can integrate/merge this with GetDBInfo. They are virtually identical
|
||||
}
|
||||
|
||||
Function TSQLConnection.GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList) : Integer;
|
||||
var
|
||||
qry : TCustomSQLQuery;
|
||||
@ -1426,7 +1432,6 @@ begin
|
||||
finally
|
||||
qry.free;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
|
||||
@ -3626,40 +3631,6 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TSqlObjectIdenfier }
|
||||
|
||||
constructor TSqlObjectIdenfier.Create(ACollection: TSqlObjectIdentifierList;
|
||||
const AObjectName: String; Const ASchemaName: String = '');
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
FSchemaName:=ASchemaName;
|
||||
FObjectName:=AObjectName;
|
||||
end;
|
||||
|
||||
{ TSqlObjectIdentifierList }
|
||||
|
||||
function TSqlObjectIdentifierList.GetIdentifier(Index: integer): TSqlObjectIdenfier;
|
||||
begin
|
||||
Result := Items[Index] as TSqlObjectIdenfier;
|
||||
end;
|
||||
|
||||
procedure TSqlObjectIdentifierList.SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
|
||||
begin
|
||||
Items[Index] := AValue;
|
||||
end;
|
||||
|
||||
function TSqlObjectIdentifierList.AddIdentifier: TSqlObjectIdenfier;
|
||||
begin
|
||||
Result:=Add as TSqlObjectIdenfier;
|
||||
end;
|
||||
|
||||
function TSqlObjectIdentifierList.AddIdentifier(Const AObjectName: String;
|
||||
Const ASchemaName: String = ''): TSqlObjectIdenfier;
|
||||
begin
|
||||
Result:=AddIdentifier();
|
||||
Result.SchemaName:=ASchemaName;
|
||||
Result.ObjectName:=AObjectName;
|
||||
end;
|
||||
|
||||
|
||||
Initialization
|
||||
|
||||
@ -23,7 +23,7 @@ type
|
||||
|
||||
{ TTestSpecificTBufDataset }
|
||||
|
||||
TTestSpecificTBufDataset = class(TTestCase)
|
||||
TTestSpecificTBufDataset = class(TDBBasicsTestCase)
|
||||
private
|
||||
procedure TestDataset(ABufDataset: TBufDataset; AutoInc: boolean = false);
|
||||
function GetAutoIncDataset: TBufDataset;
|
||||
@ -40,6 +40,9 @@ type
|
||||
procedure TestAutoIncFieldStreaming;
|
||||
procedure TestAutoIncFieldStreamingXML;
|
||||
Procedure TestRecordCount;
|
||||
Procedure TestClear;
|
||||
procedure TestCopyFromDataset; //is copied dataset identical to original?
|
||||
procedure TestCopyFromDatasetMoved; //move record then copy. Is copy identical? Has record position changed?
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -251,7 +254,7 @@ end;
|
||||
procedure TTestSpecificTBufDataset.TestRecordCount;
|
||||
var
|
||||
BDS:TBufDataSet;
|
||||
|
||||
|
||||
begin
|
||||
BDS:=TBufDataSet.Create(nil);
|
||||
BDS.FieldDefs.Add('ID',ftLargeint);
|
||||
@ -263,7 +266,73 @@ begin
|
||||
AssertEquals('IsEmpty: ',True,BDS.IsEmpty);
|
||||
AssertEquals('RecordCount: ',0,BDS.RecordCount);
|
||||
end;
|
||||
|
||||
|
||||
procedure TTestSpecificTBufDataset.TestClear;
|
||||
|
||||
const
|
||||
testValuesCount=3;
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
with DBConnector.GetNDataset(10) as TBufDataset do
|
||||
begin
|
||||
Open;
|
||||
Clear;
|
||||
AssertTrue('Dataset Closed',Not Active);
|
||||
AssertEquals('No fields',0,Fields.Count);
|
||||
AssertEquals('No fielddefs',0,FieldDefs.Count);
|
||||
// test after FieldDefs are Cleared, if internal structures are updated properly
|
||||
// create other FieldDefs
|
||||
FieldDefs.Add('Fs', ftString, 20);
|
||||
FieldDefs.Add('Fi', ftInteger);
|
||||
FieldDefs.Add('Fi2', ftInteger);
|
||||
// use only Open without CreateTable
|
||||
CreateDataset;
|
||||
AssertTrue('Empty dataset',IsEmpty);
|
||||
// add some data
|
||||
for i:=1 to testValuesCount do
|
||||
AppendRecord([TestStringValues[i], TestIntValues[i], TestIntValues[i]]);
|
||||
// check data
|
||||
AssertEquals('Record count',testValuesCount, RecordCount);
|
||||
First;
|
||||
for i:=1 to testValuesCount do
|
||||
begin
|
||||
AssertEquals('Field FS, Record '+InttoStr(i),TestStringValues[i], FieldByName('Fs').AsString);
|
||||
AssertEquals('Field Fi2, Record '+InttoStr(i),TestIntValues[i], FieldByName('Fi2').AsInteger);
|
||||
Next;
|
||||
end;
|
||||
CheckTrue(Eof);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestSpecificTBufDataset.TestCopyFromDataset;
|
||||
var bufds1, bufds2: TBufDataset;
|
||||
begin
|
||||
bufds1:=DBConnector.GetFieldDataset as TBufDataset;
|
||||
bufds2:=DBConnector.GetNDataset(0) as TBufDataset;
|
||||
|
||||
bufds1.Open;
|
||||
bufds2.CopyFromDataset(bufds1);
|
||||
CheckFieldDatasetValues(bufds2);
|
||||
end;
|
||||
|
||||
procedure TTestSpecificTBufDataset.TestCopyFromDatasetMoved;
|
||||
var
|
||||
bufds1, bufds2: TBufDataset;
|
||||
CurrentID,NewID: integer;
|
||||
begin
|
||||
bufds1:=DBConnector.GetFieldDataset as TBufDataset;
|
||||
bufds2:=DBConnector.GetNDataset(0) as TBufDataset;
|
||||
|
||||
bufds1.Open;
|
||||
bufds1.Next; //this should not influence the copydataset step.
|
||||
CurrentID:=bufds1.FieldByName('ID').AsInteger;
|
||||
bufds2.CopyFromDataset(bufds1);
|
||||
CheckFieldDatasetValues(bufds2);
|
||||
NewID:=bufds1.FieldByName('ID').AsInteger;
|
||||
AssertEquals('Mismatch between ID field contents - the record has moved.',CurrentID,NewID);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$ifdef fpc}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user