Browse Source

* Patch from Joost Van der Sluis:
- implemented TSQLQuery.UpdateIndexDefs
- implemented TSQLQuery.ReadOnly
- implemented TSQLQuery.IndexDefs
- implemented TSQLQuery.UpdateMode
- implemented TSQLQuery.UsePrimaryKeyAsKey (Set pfInKey in the
providerflags
of fields that are in the primary index of the underlying table)
- Added support for updates on date-fields

michael 20 years ago
parent
commit
10cc31bbcd
1 changed files with 136 additions and 19 deletions
  1. 136 19
      fcl/db/sqldb/sqldb.pp

+ 136 - 19
fcl/db/sqldb/sqldb.pp

@@ -81,6 +81,7 @@ type
     function StartdbTransaction(trans : TSQLHandle) : boolean; virtual; abstract;
     procedure CommitRetaining(trans : TSQLHandle); virtual; abstract;
     procedure RollBackRetaining(trans : TSQLHandle); virtual; abstract;
+    procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); virtual;
   public
     destructor Destroy; override;
     property Handle: Pointer read GetHandle;
@@ -136,19 +137,29 @@ type
     FSQL                 : TStrings;
     FIsEOF               : boolean;
     FLoadingFieldDefs    : boolean;
+    FIndexDefs           : TIndexDefs;
+    FReadOnly            : boolean;
+    FUpdateMode          : TUpdateMode;
+    FusePrimaryKeyAsKey  : Boolean;
 
     procedure FreeStatement;
     procedure PrepareStatement;
     procedure FreeFldBuffers;
     procedure InitUpdates(SQL : string);
+    function GetIndexDefs : TIndexDefs;
+    procedure SetIndexDefs(AValue : TIndexDefs);
+    procedure SetReadOnly(AValue : Boolean);
+    procedure SetUsePrimaryKeyAsKey(AValue : Boolean);
+    procedure SetUpdateMode(AValue : TUpdateMode);
 
     procedure Execute;
 
   protected
-    // abstract & virual methods of TBufDataset
+    // abstract & virtual methods of TBufDataset
     function Fetch : boolean; override;
     function LoadField(FieldDef : TFieldDef;buffer : pointer) : boolean; override;
-    // abstract & virual methods of TDataset
+    // abstract & virtual methods of TDataset
+    procedure UpdateIndexDefs; override;
     procedure SetDatabase(Value : TDatabase); override;
     procedure InternalAddRecord(Buffer: Pointer; AAppend: Boolean); override;
     procedure InternalClose; override;
@@ -195,7 +206,11 @@ type
     property Database;
 
     property Transaction;
+    property ReadOnly : Boolean read FReadOnly write SetReadOnly;
     property SQL : TStrings read FSQL write FSQL;
+    property IndexDefs : TIndexDefs read GetIndexDefs;
+    property UpdateMode : TUpdateMode read FUpdateMode write SetUpdateMode;
+    property UsePrimaryKeyAsKey : boolean read FUsePrimaryKeyAsKey write SetUsePrimaryKeyAsKey;
   end;
 
 implementation
@@ -224,11 +239,15 @@ begin
       DatabaseError(SErrAssTransaction);
 end;
 
+procedure TSQLConnection.UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string);
+
+begin
+// Empty abstract
+end;
+
 procedure TSQLConnection.DoInternalConnect;
 begin
-// Where is this for?!?!
-//  if Connected then
-//    Close;
+// Empty abstract
 end;
 
 procedure TSQLConnection.DoInternalDisconnect;
@@ -245,7 +264,9 @@ function TSQLConnection.GetAsSQLText(Field : TField) : string;
 begin
   if not assigned(field) then Result := 'Null'
   else case field.DataType of
-    ftString : Result := '''' + field.asstring + ''''
+    ftString   : Result := '''' + field.asstring + '''';
+    ftDate     : Result := '''' + FormatDateTime('yyyy-mm-dd',Field.AsDateTime) + '''';
+    ftDateTime : Result := '''' + FormatDateTime('yyyy-mm-dd hh:mm:ss',Field.AsDateTime) + ''''
   else
     Result := field.asstring;
   end; {case}
@@ -366,11 +387,11 @@ var
 
 begin
   db := (Database as tsqlconnection);
-  if Db = nil then
+  if not assigned(Db) then
     DatabaseError(SErrDatabasenAssigned);
   if not Db.Connected then
     db.Open;
-  if Transaction = nil then
+  if not assigned(Transaction) then
     DatabaseError(SErrTransactionnSet);
 
   sqltr := (transaction as tsqltransaction);
@@ -389,8 +410,7 @@ begin
     exit;
     end;
   FCursor.StatementType := GetSQLStatementType(buf);
-  if FCursor.StatementType = stSelect then
-    InitUpdates(Buf);
+  if (FCursor.StatementType = stSelect) and not ReadOnly then InitUpdates(Buf);
   Db.PrepareStatement(Fcursor,sqltr,buf);
 end;
 
@@ -552,10 +572,13 @@ begin
     end;
 
   FUpdateable := True;
-
 end;
 
 procedure TSQLQuery.InternalOpen;
+
+var tel : integer;
+    f   : TField;
+s : string;
 begin
   try
     PrepareStatement;
@@ -564,7 +587,24 @@ begin
       Execute;
       InternalInitFieldDefs;
       if DefaultFields then
+        begin
         CreateFields;
+
+        if FUpdateable and FusePrimaryKeyAsKey then
+          begin
+          UpdateIndexDefs;
+          for tel := 0 to indexdefs.count-1 do {with indexdefs[tel] do}
+            begin
+            if ixPrimary in indexdefs[tel].options then
+              begin
+              // Todo: If there is more then one field in the key, that must be parsed
+              s := indexdefs[tel].fields;
+              F := fieldbyname(s);
+              F.ProviderFlags := F.ProviderFlags + [pfInKey];
+              end;
+            end;
+          end;
+        end;
       end
     else
       DatabaseError(SErrNoSelectStatement,Self);
@@ -591,6 +631,13 @@ constructor TSQLQuery.Create(AOwner : TComponent);
 begin
   inherited Create(AOwner);
   FSQL := TStringList.Create;
+  FIndexDefs := TIndexDefs.Create(Self);
+  FReadOnly := false;
+// Delphi has upWhereAll as default, but since strings and oldvalue's don't work yet
+// (variants) set it to upWhereKeyOnly
+  FUpdateMode := upWhereKeyOnly;
+  
+  FUsePrimaryKeyAsKey := True;
 end;
 
 destructor TSQLQuery.Destroy;
@@ -650,6 +697,35 @@ begin
       Exit(t);
 end;
 
+procedure TSQLQuery.SetReadOnly(AValue : Boolean);
+
+begin
+  if not Active then FReadOnly := AValue
+  else
+    begin
+    // Just temporary, this should be possible in the future
+    DatabaseError(SActiveDataset);
+    end;
+end;
+
+procedure TSQLQuery.SetUsePrimaryKeyAsKey(AValue : Boolean);
+
+begin
+  if not Active then FusePrimaryKeyAsKey := AValue
+  else
+    begin
+    // Just temporary, this should be possible in the future
+    DatabaseError(SActiveDataset);
+    end;
+end;
+
+Procedure TSQLQuery.UpdateIndexDefs;
+
+begin
+  if assigned(DataBase) then
+    (DataBase as TSQLConnection).UpdateIndexDefs(FIndexDefs,FTableName);
+end;
+
 function TSQLQuery.ApplyRecUpdate : boolean;
 
 var r,x,f     : integer;
@@ -664,16 +740,28 @@ var r,x,f     : integer;
 begin
   Result := False;
   sql_tables := FTableName;
-  s := fields[0].oldvalue;
-  sql_where := '('+fields[0].displayName+'='+s+')';
   sql_set := '';
+  sql_where := '';
   for x := 0 to Fields.Count -1 do
-    if ord(ActiveBuffer[(Fields[x].Fieldno-1) div 8]) and (1 shl ((Fields[x].Fieldno-1) mod 8)) > 0 then // check for null
-      sql_set := sql_set + fields[x].DisplayName + '=' + (Database as TSQLConnection).GetAsSQLText(nil) + ','
-    else
-      sql_set := sql_set + fields[x].DisplayName + '=' + (Database as TSQLConnection).GetAsSQLText(fields[x]) + ',';
+    begin
+    if (pfInKey in Fields[x].ProviderFlags) or
+       ((FUpdateMode = upWhereAll) and (pfInWhere in Fields[x].ProviderFlags)) or
+       ((FUpdateMode = UpWhereChanged) and (pfInWhere in Fields[x].ProviderFlags) and (fields[x].value <> fields[x].oldvalue)) then
+      begin
+      // This should be converted to something like GetAsSQLText, but better wait until variants (oldvalue) are working for strings
+      s := fields[x].oldvalue; // This directly int the line below raises a variant-error
+      sql_where := sql_where + '(' + fields[x].DisplayName + '=' + s + ') and ';
+      end;
+      
+    if (pfInUpdate in Fields[x].ProviderFlags) then
+      if ord(ActiveBuffer[(Fields[x].Fieldno-1) div 8]) and (1 shl ((Fields[x].Fieldno-1) mod 8)) > 0 then // check for null
+        sql_set := sql_set + fields[x].DisplayName + '=' + (Database as TSQLConnection).GetAsSQLText(nil) + ','
+      else
+        sql_set := sql_set + fields[x].DisplayName + '=' + (Database as TSQLConnection).GetAsSQLText(fields[x]) + ',';
+    end;
 
   setlength(sql_set,length(sql_set)-1);
+  setlength(sql_where,length(sql_where)-5);
 
   with tsqlquery.Create(nil) do
     begin
@@ -693,16 +781,45 @@ Function TSQLQuery.GetCanModify: Boolean;
 
 begin
   if FCursor.StatementType = stSelect then
-    Result:= Active and  FUpdateable
+    Result:= Active and  FUpdateable and (not FReadOnly)
   else
     Result := False;
 end;
 
+function TSQLQuery.GetIndexDefs : TIndexDefs;
+
+begin
+  Result := FIndexDefs;
+end;
+
+procedure TSQLQuery.SetIndexDefs(AValue : TIndexDefs);
+
+begin
+  FIndexDefs := AValue;
+end;
+
+procedure TSQLQuery.SetUpdateMode(AValue : TUpdateMode);
+
+begin
+  FUpdateMode := AValue;
+end;
+
 end.
 
 {
   $Log$
-  Revision 1.10  2004-12-29 14:31:27  michael
+  Revision 1.11  2005-01-12 10:30:33  michael
+   * Patch from Joost Van der Sluis:
+     - implemented TSQLQuery.UpdateIndexDefs
+     - implemented TSQLQuery.ReadOnly
+     - implemented TSQLQuery.IndexDefs
+     - implemented TSQLQuery.UpdateMode
+     - implemented TSQLQuery.UsePrimaryKeyAsKey (Set pfInKey in the
+       providerflags
+       of fields that are in the primary index of the underlying table)
+     - Added support for updates on date-fields
+
+  Revision 1.10  2004/12/29 14:31:27  michael
     + Patch from Joost van der Sluis:
     - implemented support for modifying queries, with a simple parser
     - implemented ApplyRecUpdate