--- 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 -

.gitattributes

@@ -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

packages/fcl-db/fpmake.pp

@@ -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

packages/fcl-db/src/base/bufdataset.pas

@@ -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));

packages/fcl-db/src/base/sqltypes.pp

@@ -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.

packages/fcl-db/src/datadict/fpdatadict.pp

@@ -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;

packages/fcl-db/src/datadict/fpddsqldb.pp

@@ -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

packages/fcl-db/src/sqldb/interbase/fbadmin.pp

@@ -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;

packages/fcl-db/src/sqldb/interbase/ibconnection.pp

@@ -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.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
+  TPB:=#0;
+  Result:=False;
+  P:=Pos('=',S);
+  If P<>0 then
+    begin
+    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;
-  tr       : TIBTrans;
-  i        : integer;
-  s        : string;
-begin
-  result := false;
 
-  DBHandle := GetHandle;
-  tr := trans as TIBtrans;
-  with tr do
+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
-    TPB := chr(isc_tpb_version3);
-
-    i := 1;
-    s := ExtractSubStr(AParams,i,stdWordDelims);
-    while s <> '' do
+    If Not InterpretTransactionParam(S,tpbv,prVal) then
       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);
-
+      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;
-
-    TransactionHandle := nil;
-
-    if isc_start_transaction(@Status[0], @TransactionHandle, 1,
-       [@DBHandle, Length(TPB), @TPB[1]]) <> 0 then
-      CheckError('StartTransaction',Status)
-    else Result := True;
+    S:=ExtractSubStr(AParams,I,stdWordDelims);
     end;
-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

packages/fcl-db/src/sqldb/sqldb.pp

@@ -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
-
-  TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
-    stDDL, stGetSegment, stPutSegment, stExecProcedure,
-    stStartTrans, stCommit, stRollback, stSelectForUpd);
-
+  // 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;
+
+  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

packages/fcl-db/tests/testspecifictbufdataset.pas

@@ -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}