From 58b4a368698eb16d6f70a1a954f75569bafafe68 Mon Sep 17 00:00:00 2001 From: marco Date: Tue, 4 Aug 2015 09:13:52 +0000 Subject: [PATCH] --- 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 | 4 + packages/fcl-db/examples/createsql.lpi | 63 ++++++ packages/fcl-db/examples/createsql.pas | 203 ++++++++++++++++++ packages/fcl-db/examples/logsqldemo.lpi | 64 ++++++ packages/fcl-db/examples/logsqldemo.pas | 200 +++++++++++++++++ packages/fcl-db/src/base/bufdataset.pas | 40 ++-- packages/fcl-db/src/base/dbconst.pas | 3 +- packages/fcl-db/src/base/dsparams.inc | 6 +- .../src/sqldb/interbase/ibconnection.pp | 7 +- packages/fcl-db/src/sqldb/mssql/mssqlconn.pp | 4 + packages/fcl-db/src/sqldb/mysql/mysqlconn.inc | 7 +- .../src/sqldb/oracle/oracleconnection.pp | 4 + .../fcl-db/src/sqldb/postgres/pqconnection.pp | 4 + packages/fcl-db/src/sqldb/sqldb.pp | 41 +++- .../fcl-db/src/sqldb/sqlite/sqlite3conn.pp | 6 +- packages/fcl-db/tests/testbasics.pas | 3 + .../fcl-db/tests/testspecifictbufdataset.pas | 3 +- packages/odbc/src/odbcsql.inc | 10 +- 18 files changed, 625 insertions(+), 47 deletions(-) create mode 100644 packages/fcl-db/examples/createsql.lpi create mode 100644 packages/fcl-db/examples/createsql.pas create mode 100644 packages/fcl-db/examples/logsqldemo.lpi create mode 100644 packages/fcl-db/examples/logsqldemo.pas diff --git a/.gitattributes b/.gitattributes index b956564361..0cff1b39d5 100644 --- a/.gitattributes +++ b/.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 diff --git a/packages/fcl-db/examples/createsql.lpi b/packages/fcl-db/examples/createsql.lpi new file mode 100644 index 0000000000..aefb4b1178 --- /dev/null +++ b/packages/fcl-db/examples/createsql.lpi @@ -0,0 +1,63 @@ + + + + + + + + + + + + <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> diff --git a/packages/fcl-db/examples/createsql.pas b/packages/fcl-db/examples/createsql.pas new file mode 100644 index 0000000000..bb6592c58e --- /dev/null +++ b/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. + diff --git a/packages/fcl-db/examples/logsqldemo.lpi b/packages/fcl-db/examples/logsqldemo.lpi new file mode 100644 index 0000000000..b6200e2c9b --- /dev/null +++ b/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> diff --git a/packages/fcl-db/examples/logsqldemo.pas b/packages/fcl-db/examples/logsqldemo.pas new file mode 100644 index 0000000000..904a98b0c6 --- /dev/null +++ b/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. + diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas index 6b0c58cd32..a77e31b8f9 100644 --- a/packages/fcl-db/src/base/bufdataset.pas +++ b/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); diff --git a/packages/fcl-db/src/base/dbconst.pas b/packages/fcl-db/src/base/dbconst.pas index 0be600018b..7a575c651e 100644 --- a/packages/fcl-db/src/base/dbconst.pas +++ b/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 diff --git a/packages/fcl-db/src/base/dsparams.inc b/packages/fcl-db/src/base/dsparams.inc index 7cc5665e2f..c6c1e6a254 100644 --- a/packages/fcl-db/src/base/dsparams.inc +++ b/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; diff --git a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp b/packages/fcl-db/src/sqldb/interbase/ibconnection.pp index 835d6a5e6d..03230a835c 100644 --- a/packages/fcl-db/src/sqldb/interbase/ibconnection.pp +++ b/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 diff --git a/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp b/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp index be3a756bb3..200f6defcf 100644 --- a/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp +++ b/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; diff --git a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc index cb8ad8af2b..4a658984ac 100644 --- a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc +++ b/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 diff --git a/packages/fcl-db/src/sqldb/oracle/oracleconnection.pp b/packages/fcl-db/src/sqldb/oracle/oracleconnection.pp index b048e7f3e4..2852b01eed 100644 --- a/packages/fcl-db/src/sqldb/oracle/oracleconnection.pp +++ b/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 diff --git a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp b/packages/fcl-db/src/sqldb/postgres/pqconnection.pp index d8cb82153c..1ec1ab0846 100644 --- a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp +++ b/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; diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp index d8e7e82e81..4917018931 100644 --- a/packages/fcl-db/src/sqldb/sqldb.pp +++ b/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; diff --git a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp b/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp index 800e98d952..33201b3f05 100644 --- a/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp +++ b/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; diff --git a/packages/fcl-db/tests/testbasics.pas b/packages/fcl-db/tests/testbasics.pas index 8ec0640e4d..6fa029435e 100644 --- a/packages/fcl-db/tests/testbasics.pas +++ b/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; diff --git a/packages/fcl-db/tests/testspecifictbufdataset.pas b/packages/fcl-db/tests/testspecifictbufdataset.pas index a5355e01f2..c2e40f89a1 100644 --- a/packages/fcl-db/tests/testspecifictbufdataset.pas +++ b/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 } diff --git a/packages/odbc/src/odbcsql.inc b/packages/odbc/src/odbcsql.inc index d4185ac5b6..34d2f076e4 100644 --- a/packages/odbc/src/odbcsql.inc +++ b/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;