--- Merging r31146 into '.':

U    packages/fcl-db/tests/testspecifictbufdataset.pas
U    packages/fcl-db/src/sqldb/sqldb.pp
U    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r31146 into '.':
 U   .
--- Merging r31153 into '.':
U    packages/odbc/src/odbcsql.inc
--- Recording mergeinfo for merge of r31153 into '.':
 G   .
--- Merging r31154 into '.':
A    packages/fcl-db/examples/createsql.pas
A    packages/fcl-db/examples/createsql.lpi
--- Recording mergeinfo for merge of r31154 into '.':
 G   .
--- Merging r31155 into '.':
U    packages/fcl-db/src/base/dsparams.inc
U    packages/fcl-db/tests/testbasics.pas
--- Recording mergeinfo for merge of r31155 into '.':
 G   .
--- Merging r31156 into '.':
U    packages/fcl-db/src/base/dbconst.pas
--- Recording mergeinfo for merge of r31156 into '.':
 G   .
--- Merging r31157 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r31157 into '.':
 G   .
--- Merging r31158 into '.':
U    packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
U    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
U    packages/fcl-db/src/sqldb/oracle/oracleconnection.pp
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
U    packages/fcl-db/src/sqldb/interbase/ibconnection.pp
--- Recording mergeinfo for merge of r31158 into '.':
 G   .
--- Merging r31159 into '.':
G    packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
G    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
--- Recording mergeinfo for merge of r31159 into '.':
 G   .
--- Merging r31160 into '.':
A    packages/fcl-db/examples/logsqldemo.pas
A    packages/fcl-db/examples/logsqldemo.lpi
--- Recording mergeinfo for merge of r31160 into '.':
 G   .
--- Merging r31161 into '.':
U    packages/fcl-db/examples/logsqldemo.pas
--- Recording mergeinfo for merge of r31161 into '.':
 G   .

# revisions: 31146,31153,31154,31155,31156,31157,31158,31159,31160,31161

git-svn-id: branches/fixes_3_0@31274 -

.gitattributes

@@ -2037,12 +2037,16 @@ packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
 packages/fcl-db/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/Makefile.fpc.fpcmake svneol=native#text/plain
+packages/fcl-db/examples/createsql.lpi svneol=native#text/plain
+packages/fcl-db/examples/createsql.pas svneol=native#text/plain
 packages/fcl-db/examples/dbftool.lpi svneol=native#text/plain
 packages/fcl-db/examples/dbftool.lpr svneol=native#text/plain
 packages/fcl-db/examples/fbadmindemo.pp svneol=native#text/plain
 packages/fcl-db/examples/fbeventstest.pp svneol=native#text/plain
 packages/fcl-db/examples/loadlibdemo.lpi svneol=native#text/plain
 packages/fcl-db/examples/loadlibdemo.pp svneol=native#text/plain
+packages/fcl-db/examples/logsqldemo.lpi svneol=native#text/plain
+packages/fcl-db/examples/logsqldemo.pas svneol=native#text/plain
 packages/fcl-db/examples/pqeventstest.pp svneol=native#text/plain
 packages/fcl-db/examples/sqlite3loadlib.lpr svneol=native#text/plain
 packages/fcl-db/examples/sqlparser.pp svneol=native#text/plain

packages/fcl-db/examples/createsql.lpi

@@ -0,0 +1,63 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Generate SQL Demo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="createsql.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-db/examples/createsql.pas

@@ -0,0 +1,203 @@
+program createsql;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  typinfo, Classes, SysUtils, CustApp, db, sqldb, fpdatadict,
+  fpddfb,fpddpq,fpddOracle,fpddsqlite3,fpddmysql40,fpddmysql41,fpddmysql50, fpddodbc,
+  strutils;
+
+
+type
+
+  { TGenSQLApplication }
+
+  TGenSQLApplication = class(TCustomApplication)
+  private
+    function CreateSQLEngine(AType: String): TFPDDSQLEngine;
+    procedure ConnectToDatabase(const AType, ADatabaseName,AUserName,APassword: String);
+    procedure DoConvertQuery(const S, T, KF: String; ST: TSTatementType);
+  protected
+    FConn : TSQLConnector;
+    FDD : TFPDataDictionary;
+    FENG  : TFPDDSQLEngine;
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp(Const AMsg : string); virtual;
+  end;
+
+{ TGenSQLApplication }
+
+procedure TGenSQLApplication.ConnectToDatabase(Const AType,ADatabaseName,AUSerName,APassword : String);
+begin
+  FConn:=TSQLConnector.Create(Self);
+  FConn.ConnectorType:=AType;
+  FConn.DatabaseName:=ADatabaseName;
+  FConn.UserName:=AUserName;
+  FConn.Password:=APassword;
+  FConn.Transaction:=TSQLTransaction.Create(Self);
+  FConn.Connected:=True;
+  FDD:=TFPDataDictionary.Create;
+  FENG:=CreateSQLEngine(AType);
+end;
+
+Function TGenSQLApplication.CreateSQLEngine(AType : String): TFPDDSQLEngine;
+
+begin
+  Case lowercase(AType) of
+    'firebird' :  Result:=TFPDDFBSQLEngine.Create;
+  else
+    Result:=TFPDDSQLEngine.Create;
+  end;
+end;
+
+procedure TGenSQLApplication.DoConvertQuery(Const S,T,KF : String; ST : TSTatementType);
+
+Var
+  Q  : TSQLQuery;
+  TD : TDDTableDef;
+  Fields,KeyFields : TFPDDFieldList;
+  I : Integer;
+  F : TDDFieldDef;
+  FN,SQL : String;
+
+begin
+  TD:=FDD.Tables.AddTable(T);
+  Q:=TSQLQuery.Create(Self);
+  try
+    Q.Database:=FConn;
+    Q.Transaction:=FConn.Transaction;
+    Q.SQL.Text:=S;
+    Q.Open;
+    TD.ImportFromDataset(Q);
+  finally
+    Q.Free;
+  end;
+  if (KF<>'') then
+    begin
+    KeyFields:=TFPDDFieldList.Create(False);
+    For I:=1 to WordCount(KF,[',']) do
+      begin
+      FN:=ExtractWord(I,KF,[',']);
+      F:=TD.Fields.FieldByName(FN);
+      if (F=nil) then
+        Writeln('Warning: Field ',FN,' does not exist.')
+      else
+        KeyFields.Add(F);
+      end;
+    end;
+  Fields:=TFPDDFieldList.CreateFromTableDef(TD);
+  try
+    FEng.TableDef:=TD;
+    Case ST of
+      stDDL    : SQL:=FEng.CreateCreateSQL(KeyFields);
+      stSelect : SQL:=FEng.CreateSelectSQL(Fields,KeyFields);
+      stInsert : SQL:=FEng.CreateInsertSQL(Fields);
+      stUpdate : SQL:=FEng.CreateUpdateSQL(Fields,KeyFields);
+      stDelete : SQL:=FEng.CreateDeleteSQL(KeyFields);
+    end;
+    Writeln(SQL);
+  finally
+    KeyFields.Free;
+  end;
+end;
+procedure TGenSQLApplication.DoRun;
+
+var
+  ErrorMsg: String;
+  S,T,KF : String;
+  I : Integer;
+  ST : TStatementType;
+
+begin
+
+  // quick check parameters
+  ErrorMsg:=CheckOptions('hc:d:s:t:y:k:u:p:', 'help connection-type: database: sql: table: type: keyfields: user: password:');
+  if ErrorMsg<>'' then
+    WriteHelp(ErrorMsg);
+  if HasOption('h', 'help') then
+    WriteHelp('');
+  S:=GetOptionValue('c','connection-type');
+  T:=GetOptionValue('d','database');
+  if (S='') or (t='') then
+    Writehelp('Need database and connectiontype');
+  ConnectToDatabase(S,T,GetOptionValue('u','user'),GetOptionValue('p','password'));
+  S:=GetOptionValue('s','sql');
+  T:=GetOptionValue('t','table');
+  if (t='') then
+    Writehelp('Need table name');
+  i:=GetEnumValue(TypeInfo(TStatementType),'st'+GetOptionValue('y','type'));
+  if I=-1 then
+    Writehelp(Format('Unknown statement type : %s',[GetOptionValue('y','type')]));
+  ST:=TStatementType(i);
+  KF:=GetOptionValue('k','keyfields');
+  if (KF='') and  (st in [stselect, stupdate, stdelete]) then
+    Writehelp('Need key fields for delete, select and update');
+  if (S='') then
+    S:='SELECT * FROM '+T+' WHERE 0=1';
+  DoConvertQuery(S,T,KF,ST);
+  // stop program loop
+  Terminate;
+end;
+
+constructor TGenSQLApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+destructor TGenSQLApplication.Destroy;
+begin
+  FreeAndNil(FConn);
+  FreeAndNil(FDD);
+  FreeAndNil(FENG);
+  inherited Destroy;
+end;
+
+procedure TGenSQLApplication.WriteHelp(Const AMsg : string);
+
+Var
+  S : String;
+  L : TStrings;
+begin
+  if AMsg<>'' then
+    Writeln('Error : ',AMsg);
+  Writeln('Usage: ', ExeName, ' [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h  --help              this help message');
+  Writeln('-c  --connection-type=ctype   Set connection type (required)' );
+  Writeln('-d  --database=db       database connection name (required)');
+  Writeln('-s  --sql=sql           SQL to execute (optional)');
+  Writeln('-t  --table=tablename   tablename to use for statement (required)');
+  Writeln('-y  --type=stype        Statement type (required) one of ddl, select, insert, update, delete)');
+  Writeln('-k  --keyfields=fields  Comma-separated list of key fields (required for delete, update, optional for select,ddl)');
+  Writeln('-u  --user=username     User name to connect to database');
+  Writeln('-p  --password=password Password of user to connect to database with');
+  Writeln('Where ctype is one of : ');
+  L:=TStringList.Create;
+  try
+    GetConnectionList(L);
+    for S in L do
+      Writeln('  ',lowercase(S));
+
+  finally
+    L.Free;
+  end;
+
+  Halt(Ord(AMsg<>''));
+end;
+
+var
+  Application: TGenSQLApplication;
+begin
+  Application:=TGenSQLApplication.Create(nil);
+  Application.Title:='Generate SQL Demo';
+  Application.Run;
+  Application.Free;
+end.
+

packages/fcl-db/examples/logsqldemo.lpi

@@ -0,0 +1,64 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Generate SQL Demo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="-c firebird -d localhost:/home/firebird/timetrack.fb -u WISASOFT -p SysteemD -s 'SELECT * FROM PROJECT WHERE PJ_ID=:ID' -P ID=s:632F3D2F-055A-4DD9-852B-4050BF6A2ED9"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="logsqldemo.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-db/examples/logsqldemo.pas

@@ -0,0 +1,200 @@
+program logsqldemo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  typinfo, Classes, SysUtils, CustApp, db, sqldb,
+  ibconnection, sqlite3conn, oracleconnection, mysql40conn,mysql41conn, mssqlconn,
+  mysql50conn, mysql55conn, mysql56conn, odbcconn, pqconnection, strutils;
+
+
+type
+
+  { TGenSQLApplication }
+
+  TGenSQLApplication = class(TCustomApplication)
+    procedure DoSQLLog(Sender: TSQLConnection; EventType: TDBEventType;
+      const Msg: String);
+  private
+    procedure ConnectToDatabase(const AType, ADatabaseName,AUserName,APassword: String);
+    procedure RunQuery(SQL: String; ParamValues: TStrings);
+  protected
+    FConn : TSQLConnector;
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp(Const AMsg : string); virtual;
+  end;
+
+{ TGenSQLApplication }
+
+procedure TGenSQLApplication.DoSQLLog(Sender: TSQLConnection;
+  EventType: TDBEventType; const Msg: String);
+begin
+  Writeln(stderr,'[',EventType,'] : ',Msg);
+end;
+
+procedure TGenSQLApplication.ConnectToDatabase(const AType, ADatabaseName,
+  AUserName, APassword: String);
+begin
+  FConn:=TSQLConnector.Create(Self);
+  FConn.ConnectorType:=AType;
+  FConn.DatabaseName:=ADatabaseName;
+  FConn.UserName:=AUserName;
+  FConn.Password:=APassword;
+  FConn.Transaction:=TSQLTransaction.Create(Self);
+  FConn.OnLog:=@DoSQLLog;
+  FConn.LogEvents:=LogAllEventsExtra;
+  FConn.Connected:=True;
+end;
+
+procedure TGenSQLApplication.RunQuery(SQL : String; ParamValues : TStrings);
+
+Var
+  S,PT,V : String;
+  I : Integer;
+  P : TParam;
+  Q : TSQLQuery;
+  F : TField;
+
+begin
+  Q:=TSQLQuery.Create(Self);
+  try
+    Q.Database:=FConn;
+    Q.Transaction:=FConn.Transaction;
+    Q.SQL.Text:=SQL;
+    For P in Q.Params do
+      begin
+      S:=ParamValues.Values[P.Name];
+      PT:=ExtractWord(1,S,[':']);
+      V:=ExtractWord(2,S,[':']);
+      Case lowercase(PT) of
+        's' : P.AsString:=V;
+        'i'    : P.AsInteger:=StrToInt(V);
+        'i64'  : P.AsLargeInt:=StrToInt64(V);
+        'dt'   : P.AsDateTime:=StrToDateTime(V);
+        'd'    : P.AsDateTime:=StrToDate(V);
+        't'    : P.AsDateTime:=StrToTime(V);
+        'f'    : P.AsFloat:=StrToFloat(V);
+        'c'    : P.AsCurrency:=StrToCurr(V);
+      else
+        Raise Exception.CreateFmt('unknown parameter type for %s : %s (value: %s)',[P.Name,PT,V]);
+      end
+      end;
+    Q.Open;
+    I:=0;
+    While not Q.EOF do
+      begin
+      Inc(I);
+      Writeln('Record ',I,':');
+      For F in Q.Fields do
+        if F.IsNull then
+          writeln(F.FieldName,'=<Null>')
+        else
+          writeln(F.FieldName,'=',F.AsString);
+      Q.Next;
+      end;
+  finally
+    Q.Free;
+  end;
+end;
+
+procedure TGenSQLApplication.DoRun;
+
+var
+  ErrorMsg: String;
+  S,T,KF : String;
+  I : Integer;
+  ST : TStatementType;
+  P : TStrings;
+
+begin
+
+  // quick check parameters
+  ErrorMsg:=CheckOptions('hc:d:s:u:p:P:', 'help connection-type: database: sql: user: password: param:');
+  if ErrorMsg<>'' then
+    WriteHelp(ErrorMsg);
+  if HasOption('h', 'help') then
+    WriteHelp('');
+  S:=GetOptionValue('c','connection-type');
+  T:=GetOptionValue('d','database');
+  if (S='') or (t='') then
+    Writehelp('Need database and connectiontype');
+  ConnectToDatabase(S,T,GetOptionValue('u','user'),GetOptionValue('p','password'));
+  S:=GetOptionValue('s','sql');
+  P:=TStringList.Create;
+  try
+    P.AddStrings(GetOptionValues('P','param'));
+    RunQuery(S,P);
+  finally
+    P.Free;
+  end;
+  // stop program loop
+  Terminate;
+end;
+
+constructor TGenSQLApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+end;
+
+destructor TGenSQLApplication.Destroy;
+begin
+  FreeAndNil(FConn);
+  inherited Destroy;
+end;
+
+procedure TGenSQLApplication.WriteHelp(const AMsg: string);
+
+Var
+  S : String;
+  L : TStrings;
+begin
+  if AMsg<>'' then
+    Writeln('Error : ',AMsg);
+  Writeln('Usage: ', ExeName, ' [options]');
+  Writeln('Where options is one or more of:');
+  Writeln('-h  --help              this help message');
+  Writeln('-c  --connection-type=ctype   Set connection type (required)' );
+  Writeln('Where ctype is one of : ');
+  L:=TStringList.Create;
+  try
+    GetConnectionList(L);
+    for S in L do
+      Writeln('  ',lowercase(S));
+
+  finally
+    L.Free;
+  end;
+  Writeln('-d  --database=db       database connection name (required)');
+  Writeln('-s  --sql=sql           SQL to execute (required), can contain parameters');
+  Writeln('-u  --user=username     User name to connect to database');
+  Writeln('-p  --password=password Password of user to connect to database with');
+  Writeln('-P  --param=name=value  Parameter values encoded as ptype:value');
+  Writeln('Where ptype is one of : ');
+  Writeln('  s  : string');
+  Writeln('  dt : datetime');
+  Writeln('  d  : date');
+  Writeln('  t  : time');
+  Writeln('  i  : integer');
+  Writeln('  i64  : int64');
+  Writeln('  f  : float');
+  Writeln('  c  : currency');
+
+  Halt(Ord(AMsg<>''));
+end;
+
+var
+  Application: TGenSQLApplication;
+begin
+  Application:=TGenSQLApplication.Create(nil);
+  Application.Title:='Generate SQL Demo';
+  Application.Run;
+  Application.Free;
+end.
+

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

@@ -558,7 +558,6 @@ type
     procedure SetReadOnly(AValue: Boolean); virtual;
     function IsReadFromPacket : Boolean;
     function getnextpacket : integer;
-    procedure ActiveBufferToRecord;
     function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; virtual;
     // abstracts, must be overidden by descendents
     function Fetch : boolean; virtual;
@@ -2553,7 +2552,8 @@ begin
       FUpdateBuffer[FCurrentUpdateBuffer].OldValuesBuffer := nil;
       end;
     end;
-  ActiveBufferToRecord;
+
+  Move(ActiveBuffer^, FCurrentIndex.CurrentBuffer^, FRecordSize);
 
   // new data are now in current record so reorder current record if needed
   for i := 1 to FIndexesCount-1 do
@@ -2561,12 +2561,6 @@ begin
       FIndexes[i].OrderCurrentRecord;
 end;
 
-procedure TCustomBufDataset.ActiveBufferToRecord;
-
-begin
-  move(ActiveBuffer^,FCurrentIndex.CurrentBuffer^,FRecordSize);
-end;
-
 procedure TCustomBufDataset.CalcRecordSize;
 
 var x : longint;
@@ -2844,23 +2838,19 @@ function TCustomBufDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode
 var bufblob : TBufBlobField;
 
 begin
-  result := nil;
-  if Mode = bmRead then
-    begin
-    if not Field.GetData(@bufblob) then
-      exit;
-
-    result := TBufBlobStream.Create(Field as TBlobField, bmRead);
-    end
-  else if Mode = bmWrite then
-    begin
-    if not (State in [dsEdit, dsInsert, dsFilter, dsCalcFields]) then
-      DatabaseErrorFmt(SNotEditing, [Name], Self);
-    if Field.ReadOnly and not (State in [dsSetKey, dsFilter]) then
-      DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);
-
-    result := TBufBlobStream.Create(Field as TBlobField, bmWrite);
-    end;
+  Result := nil;
+  case Mode of
+    bmRead:
+      if not Field.GetData(@bufblob) then Exit;
+    bmWrite:
+      begin
+      if not (State in [dsEdit, dsInsert, dsFilter, dsCalcFields]) then
+        DatabaseErrorFmt(SNotEditing, [Name], Self);
+      if Field.ReadOnly and not (State in [dsSetKey, dsFilter]) then
+        DatabaseErrorFmt(SReadOnlyField, [Field.DisplayName]);
+      end;
+  end;
+  Result := TBufBlobStream.Create(Field as TBlobField, Mode);
 end;
 
 procedure TCustomBufDataset.SetDatasetPacket(AReader: TDataPacketReader);

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

@@ -101,7 +101,7 @@ Resourcestring
   SIndexFieldMissing       = 'Cannot access index field ''%s''';
   SNoFieldIndexes          = 'No index currently active';
   SNotIndexField           = 'Field ''%s'' is not indexed and cannot be modified';
-  SErrUnknownConnectorType = 'Unknown connector type';
+  SErrUnknownConnectorType = 'Unknown connector type: "%s"';
   SNoIndexFieldNameGiven   = 'There are no fields selected to base the index on';
   SStreamNotRecognised     = 'The data-stream format is not recognized';
   SNoReaderClassRegistered = 'There is no TDatapacketReaderClass registered for this kind of data-stream';
@@ -123,6 +123,7 @@ Resourcestring
   SErrRefreshEmptyResult      = 'Refresh SQL resulted in empty result set.';
   SErrNoKeyFieldForRefreshClause = 'No key field found to construct refresh SQL WHERE clause';
   SErrFailedToFetchReturningResult = 'Failed to fetch returning result';
+  SLogParamValue              = 'Parameter "%s" value : "%s"';
 
 Implementation
 

packages/fcl-db/src/base/dsparams.inc

@@ -235,9 +235,9 @@ begin
   case p^ of
     '''', '"', '`':
       begin
+        Result := True;
         // single quote, double quote or backtick delimited string
         SkipQuotesString(p, p^, EscapeSlash, EscapeRepeat);
-        Result := True;
       end;
     '-': // possible start of -- comment
       begin
@@ -315,7 +315,7 @@ begin
   p:=PChar(SQL);
   BufStart:=p; // used to calculate ParamPart.Start values
   repeat
-    SkipComments(p,EscapeSlash,EscapeRepeat);
+    while SkipComments(p,EscapeSlash,EscapeRepeat) do ;
     case p^ of
       ':','?': // parameter
         begin
@@ -403,7 +403,7 @@ begin
             Dec(NewQueryLength,p-ParamNameStart);
           end;
         end;
-      #0:Break;
+      #0:Break; // end of SQL
     else
       Inc(p);
     end;

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

@@ -692,8 +692,11 @@ begin
     tr := aTransaction.Handle;
     
     if assigned(AParams) and (AParams.count > 0) then
+      begin
       buf := AParams.ParseSQL(buf,false,sqEscapeSlash in ConnOptions, sqEscapeRepeat in ConnOptions,psInterbase,paramBinding);
-
+      if LogEvent(detActualSQL) then
+        Log(detActualSQL,Buf);
+      end;
     if isc_dsql_prepare(@Status[0], @tr, @Statement, 0, @Buf[1], Dialect, nil) <> 0 then
       CheckError('PrepareStatement', Status);
     if assigned(AParams) and (AParams.count > 0) then
@@ -836,6 +839,8 @@ var tr : pointer;
 begin
   tr := aTransaction.Handle;
   if Assigned(APArams) and (AParams.count > 0) then SetParameters(cursor, atransaction, AParams);
+  if LogEvent(detParamValue) then
+    LogParams(AParams);
   with cursor as TIBCursor do
   begin
     if FStatementType = stExecProcedure then

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

@@ -611,7 +611,11 @@ var c: TDBLibCursor;
 begin
   c:=cursor as TDBLibCursor;
 
+  if LogEvent(detParamValue) then
+    LogParams(AParams);
   cmd := c.ReplaceParams(AParams);
+  if LogEvent(detActualSQL) then
+    Log(detActualSQL,Cmd);
   Execute(cmd);
 
   res := SUCCEED;

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -599,7 +599,12 @@ begin
       // paramreplacestring kan een probleem geven bij postgres als hij niet meer gewoon $ is?
       C.FStatement := stringsreplace(C.FStatement,ParamNames,ParamValues,[rfReplaceAll]);
       end;
-    Log(detExecute, C.FStatement);
+    if LogEvent(detParamValue) then
+      LogParams(AParams);
+    if LogEvent(detExecute) then
+      Log(detExecute, C.FStatement);
+    if LogEvent(detActualSQL) then
+      Log(detActualSQL,C.FStatement);
     if mysql_query(FMySQL,Pchar(C.FStatement))<>0 then
       begin
       if not ForcedClose then

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

@@ -599,6 +599,8 @@ var i        : integer;
 begin
   with cursor as TOracleCursor do
     begin
+    if LogEvent(detActualSQL) then
+      Log(detActualSQL,Buf);
     if OCIStmtPrepare2(TOracleTrans(ATransaction.Handle).FOciSvcCtx,FOciStmt,FOciError,@buf[1],length(buf),nil,0,OCI_NTV_SYNTAX,OCI_DEFAULT) = OCI_ERROR then
       HandleError;
     // Get statement type
@@ -830,6 +832,8 @@ procedure TOracleConnection.Execute(cursor: TSQLCursor; ATransaction: TSQLTransa
   end;
 begin
   if Assigned(AParams) and (AParams.Count > 0) then SetParameters(cursor, ATransaction, AParams);
+  if LogEvent(detParamValue) then
+    LogParams(AParams);
   if cursor.FStatementType = stSelect then
     begin
     if OCIStmtExecute(TOracleTrans(ATransaction.Handle).FOciSvcCtx,(cursor as TOracleCursor).FOciStmt,FOciError,0,0,nil,nil,OCI_DEFAULT) = OCI_ERROR then

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

@@ -931,6 +931,8 @@ begin
       s := s + ' as ' + buf;
       if LogEvent(detPrepare) then
         Log(detPrepare,S);
+      if LogEvent(detActualSQL) then
+        Log(detActualSQL,S);
       res := PQexec(tr.PGConn,pchar(s));
       CheckResultError(res,nil,SErrPrepareFailed);
       // if statement is INSERT, UPDATE, DELETE with RETURNING clause, then
@@ -992,6 +994,8 @@ begin
     PQclear(res);
     if FStatementType in [stInsert,stUpdate,stDelete,stSelect] then
       begin
+      if LogEvent(detParamValue) then
+        LogParams(AParams);
       if Assigned(AParams) and (AParams.Count > 0) then
         begin
         l:=AParams.Count;

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

@@ -49,7 +49,7 @@ type
   TSQLScript = class;
 
 
-  TDBEventType = (detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack);
+  TDBEventType = (detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack, detParamValue, detActualSQL);
   TDBEventTypes = set of TDBEventType;
   TDBLogNotifyEvent = Procedure (Sender : TSQLConnection; EventType : TDBEventType; Const Msg : String) of object;
 
@@ -116,7 +116,8 @@ type
 const
   SingleQuotes : TQuoteChars = ('''','''');
   DoubleQuotes : TQuoteChars = ('"','"');
-  LogAllEvents = [detCustom, detPrepare, detExecute, detFetch, detCommit, detRollBack];
+  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',
@@ -159,7 +160,6 @@ type
     FStatements          : TFPList;
     FLogEvents: TDBEventTypes;
     FOnLog: TDBLogNotifyEvent;
-    FInternalTransaction : TSQLTransaction;
     function GetPort: cardinal;
     procedure SetOptions(AValue: TSQLConnectionOptions);
     procedure SetPort(const AValue: cardinal);
@@ -191,6 +191,7 @@ type
     function GetAsSQLText(Param : TParam) : string; overload; virtual;
     function GetHandle : pointer; virtual;
     Function LogEvent(EventType : TDBEventType) : Boolean;
+    Procedure LogParams(Const AParams : TParams); virtual;
     Procedure Log(EventType : TDBEventType; Const Msg : String); virtual;
     Procedure RegisterStatement(S : TCustomSQLStatement);
     Procedure UnRegisterStatement(S : TCustomSQLStatement);
@@ -1580,6 +1581,27 @@ begin
   Result:=(Assigned(FOnLog) or Assigned(GlobalDBLogHook)) and (EventType in LogEvents);
 end;
 
+procedure TSQLConnection.LogParams(const AParams: TParams);
+
+Var
+  S : String;
+  P : TParam;
+
+begin
+  if not LogEvent(detParamValue) then
+    Exit;
+  For P in AParams do
+    begin
+    if P.IsNull then
+      S:='<NULL>'
+    else if (P.DataType in ftBlobTypes) and  not (P.DataType in [ftMemo, ftFmtMemo,ftWideMemo]) then
+      S:='<BLOB>'
+    else
+      S:=P.AsString;
+    Log(detParamValue,Format(SLogParamValue,[P.Name,S]));
+    end;
+end;
+
 procedure TSQLConnection.Log(EventType: TDBEventType; const Msg: String);
 
 Var
@@ -2842,7 +2864,7 @@ end;
 procedure TCustomSQLQuery.ApplyRecUpdate(UpdateKind: TUpdateKind);
 
 Var
-  DoRefresh, RecordRefreshed : Boolean;
+  DoRefresh : Boolean;
   LastIDField : TField;
   S : TDataSetState;
 
@@ -2862,17 +2884,13 @@ begin
     //   TDataSet buffers are resynchronized at end of ApplyUpdates process
     S:=SetTempState(dsRefreshFields);
     try
-      RecordRefreshed:=False;
       if assigned(LastIDField) then
-        RecordRefreshed:=RefreshLastInsertID(LastIDField);
+        RefreshLastInsertID(LastIDField);
       if DoRefresh then
-        RecordRefreshed:=RefreshRecord(UpdateKind) or RecordRefreshed;
+        RefreshRecord(UpdateKind);
     finally
       RestoreState(S);
     end;
-    if RecordRefreshed then
-      // Active buffer is updated, move to record.
-      //ActiveBufferToRecord;
     end;
 end;
 
@@ -3278,6 +3296,9 @@ begin
   FProxy.Role:=Self.Role;
   FProxy.UserName:=Self.UserName;
   FProxy.FTransaction:=Self.Transaction;
+  FProxy.LogEvents:=Self.LogEvents;
+  FProxy.OnLog:=Self.OnLog;
+  FProxy.Options:=Self.Options;
   D:=GetConnectionDef(ConnectorType);
   D.ApplyParams(Params,FProxy);
   FProxy.Connected:=True;

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

@@ -233,6 +233,8 @@ Procedure TSQLite3Cursor.Prepare(Buf : String; AParams : TParams);
 begin
   if assigned(AParams) and (AParams.Count > 0) then
     Buf := AParams.ParseSQL(Buf,false,false,false,psInterbase,fparambinding);
+  if (detActualSQL in fconnection.LogEvents) then
+    fconnection.Log(detActualSQL,Buf);
   checkerror(sqlite3_prepare(fhandle,pchar(Buf),length(Buf),@fstatement,@ftail));
   FPrepared:=True;
 end;
@@ -530,7 +532,9 @@ begin
   checkerror(sqlite3_reset(sc.fstatement));
   If (AParams<>Nil) and (AParams.count > 0) then
     SC.BindParams(AParams);
-  SC.Execute;    
+  If LogEvent(detParamValue) then
+    LogParams(AParams);
+  SC.Execute;
 end;
 
 Function NextWord(Var S : ShortString; Sep : Char) : String;

packages/fcl-db/tests/testbasics.pas

@@ -145,6 +145,9 @@ begin
   // Bracketed comment
   AssertEquals(     'select * from table where id=/*comment :c*/$1-$2',
     Params.ParseSQL('select * from table where id=/*comment :c*/:a-:b', True, True, True, psPostgreSQL));
+  // Consecutive comments, with quote in second comment
+  AssertEquals(     '--c1'#10'--c'''#10'select '':a'' from table where id=$1',
+    Params.ParseSQL('--c1'#10'--c'''#10'select '':a'' from table where id=:id', True, True, True, psPostgreSQL));
 
   Params.Free;
 end;

packages/fcl-db/tests/testspecifictbufdataset.pas

@@ -13,7 +13,7 @@ interface
 
 uses
 {$IFDEF FPC}
-  fpcunit, testutils, testregistry, testdecorator, BufDataset,
+  fpcunit, testregistry, BufDataset,
 {$ELSE FPC}
   TestFramework,
 {$ENDIF FPC}
@@ -49,7 +49,6 @@ uses
 //
 {$endif fpc}
   variants,
-  strutils,
   FmtBCD;
 
 { TTestSpecificTBufDataset }

packages/odbc/src/odbcsql.inc

@@ -130,7 +130,11 @@ const
   SQL_TYPE_DATE     = 91;
   SQL_TYPE_TIME     = 92;
   SQL_TYPE_TIMESTAMP= 93;
-  // MS SQL Server types
+  // Microsoft has -150 thru -199 reserved for Microsoft SQL Server Native Client driver usage.
+  SQL_SS_VARIANT          = -150;
+  SQL_SS_UDT              = -151;
+  SQL_SS_XML              = -152;
+  SQL_SS_TABLE            = -153;
   SQL_SS_TIME2            = -154;
   SQL_SS_TIMESTAMPOFFSET  = -155;
  {$endif}
@@ -1780,8 +1784,8 @@ begin
     Result.sign:=0;
     c := -c;
   end;
-  n := int64(c);
-  for i:=0 to 15 do begin
+  n := NtoLE(int64(c));
+  for i:=0 to high(Result.val) do begin
     Result.val[i] := n and $ff;
     n := n shr 8;
   end;