Forráskód Böngészése

Additional fixes for Apply, Commit button. Issue #20 should be fixed now

Reinier Olislagers 11 éve
szülő
commit
0dad5bfbf1
1 módosított fájl, 76 hozzáadás és 70 törlés
  1. 76 70
      querywindow.pas

+ 76 - 70
querywindow.pas

@@ -9,7 +9,7 @@ uses
   Controls, Graphics, Dialogs, ExtCtrls, PairSplitter, StdCtrls, Buttons,
   DBGrids, Menus, ComCtrls, SynEdit, SynHighlighterSQL, Reg,
   SynEditTypes, SynCompletion, Clipbrd, grids, DbCtrls, types, LCLType,
-  modsqlscript, dbugintf, turbocommon;
+  modsqlscript, dbugintf, turbocommon, variants;
 
 type
 
@@ -184,12 +184,13 @@ type
     FCounter: Integer;
     FModifiedRecords: array of array of Integer;
 
+    // Makes commit button in current tabsheet visible
     procedure EnableCommitButton;
     procedure ExecuteQuery;
     function GetNewTabNum: string;
     procedure FinishCellEditing(DataSet: TDataSet);
-    // Gets sql query on current result tabsheet
-    function GetRecordSet: TSQLQuery;
+    // Gets TSQLQuery of current result tabsheet - only if it is a select query
+    function GetCurrentSelectQuery: TSQLQuery;
     // Gets both querytype and whether SQL is DML or DDL
     // Investigates QueryList[LookAtIndex] to find out
     function GetQuerySQLType(QueryList: TStringList; var LookAtIndex: Integer;
@@ -204,7 +205,6 @@ type
     procedure ApplyClick(Sender: TObject);
     procedure EnableApplyButton;
     function GetTableName(SQLText: string): string;
-    function GetCurrentSQLText: string;
     procedure CommitResultClick(Sender: TObject);
   protected
     // This procedure will receive the events that are logged by the connection:
@@ -401,27 +401,25 @@ end;
 { ApplyClick: Save Updates for the query }
 
 procedure TfmQueryWindow.ApplyClick(Sender: TObject);
+//todo: review this and perhaps use regular FPC databound controls? autogenerated updatesql etc
 var
   i, x: Integer;
-  aTableName: string;
+  TableName: string;
   UpdateQuery: TSQLQuery;
   PKIndexName: string;
   ConstraintName: string;
   KeyList, FieldsList: TStringList;
   WhereClause: string;
-  RecordSet: TSQLQuery;
+  UserData: TSQLQuery;
   TabIndex: Integer;
-  //todo: review this and perhaps use regular FPC databound controls? autogenerated updatesql etc
   FieldsSQL: string;
 begin
   try
     TabIndex:= pgOutputPageCtl.TabIndex;
-    RecordSet:= nil;
-    RecordSet:= GetRecordSet;
-    aTableName:= GetTableName(RecordSet.SQL.Text);
-
+    UserData:= nil;
+    UserData:= GetCurrentSelectQuery;
     // Better safe than sorry
-    if not(Assigned(RecordSet)) then
+    if not(Assigned(UserData)) then
     begin
       ShowMessage('Error getting query from tabsheet.');
       {$IFDEF DEBUG}
@@ -429,9 +427,10 @@ begin
       {$ENDIF}
       exit;
     end;
+    TableName:= GetTableName(UserData.SQL.Text);
 
     // Get primary key name
-    PKIndexName:= fmMain.GetPrimaryKeyIndexName(FDBIndex, ATableName, ConstraintName);
+    PKIndexName:= fmMain.GetPrimaryKeyIndexName(FDBIndex, TableName, ConstraintName);
     if PKIndexName <> '' then
     begin
       KeyList:= TStringList.Create;
@@ -442,43 +441,45 @@ begin
         UpdateQuery.Transaction:= FSQLTrans;
 
         // Get primary key fields
-        fmMain.GetIndexFields(ATableName, PKIndexName, UpdateQuery, KeyList);
-        fmMain.GetFields(FDBIndex, ATableName, FieldsList);
+        fmMain.GetIndexFields(TableName, PKIndexName, UpdateQuery, KeyList);
+        fmMain.GetFields(FDBIndex, TableName, FieldsList);
         WhereClause:= 'where ';
 
-        RecordSet.DisableControls;
-        // Check modified fields
+        UserData.DisableControls;
+        // Check modified records
         for i:= Low(FModifiedRecords[TabIndex]) to High(FModifiedRecords[TabIndex]) do
         begin
           FieldsSQL:= '';
-          RecordSet.RecNo:= FModifiedRecords[TabIndex][i];
-          for x:= 0 to RecordSet.FieldCount - 1 do
+          UserData.RecNo:= FModifiedRecords[TabIndex][i];
+          // For each record, check modified fields:
+          for x:= 0 to UserData.FieldCount - 1 do
           begin
-            if (FieldsList.IndexOf(RecordSet.Fields[x].FieldName) <> -1) and  // Field exist in origional table
-              (RecordSet.Fields[x].NewValue <> RecordSet.Fields[x].OldValue) then // field data has been modified
+            if (FieldsList.IndexOf(UserData.Fields[x].FieldName) <> -1) and  // Field exists in origional table
+              (UserData.Fields[x].NewValue <> UserData.Fields[x].OldValue) then // field data has been modified
             begin
               if FieldsSQL <> '' then
                 FieldsSQL += ',';
-              FieldsSQL += RecordSet.Fields[x].FieldName + '=';
+              FieldsSQL += UserData.Fields[x].FieldName + '=';
 
               // Typecast field values according to their main type
-              case RecordSet.Fields[x].DataType of
-                ftInteger, ftSmallint: FieldsSQL += IntToStr(RecordSet.Fields[x].NewValue);
-                ftFloat: FieldsSQL += FloatToStr(RecordSet.Fields[x].NewValue);
-                ftTimeStamp, ftDateTime: FieldsSQL += '''' + DateTimeToStr(RecordSet.Fields[x].NewValue) + '''';
-                ftTime: FieldsSQL += '''' + TimeToStr(RecordSet.Fields[x].NewValue) + '''';
-                ftDate: FieldsSQL += '''' + DateToStr(RecordSet.Fields[x].NewValue) + '''';
+              case UserData.Fields[x].DataType of
+                ftInteger, ftSmallint: FieldsSQL += IntToStr(UserData.Fields[x].NewValue);
+                ftFloat: FieldsSQL += FloatToStr(UserData.Fields[x].NewValue);
+                ftTimeStamp, ftDateTime: FieldsSQL += QuotedStr(DateTimeToStr(UserData.Fields[x].NewValue));
+                ftTime: FieldsSQL += QuotedStr(TimeToStr(UserData.Fields[x].NewValue));
+                ftDate: FieldsSQL += QuotedStr(DateToStr(UserData.Fields[x].NewValue));
               else // Other types like string
-                FieldsSQL += '''' + RecordSet.Fields[x].NewValue + '''';
+                FieldsSQL += QuotedStr(UserData.Fields[x].NewValue);
               end;
             end;
           end;
 
           // Update current record
+          // todo: high priority: add facility for inserting records
           if FieldsSQL <> '' then
           begin
             UpdateQuery.Close;
-            UpdateQuery.SQL.Text:= 'update ' + aTableName + ' set ' + FieldsSQL;
+            UpdateQuery.SQL.Text:= 'update ' + TableName + ' set ' + FieldsSQL;
 
             WhereClause:= 'where ';
             // where clause
@@ -486,20 +487,37 @@ begin
             begin
               if Trim(KeyList[x]) <> '' then
               begin
-                WhereClause += KeyList[x] + ' = ';
-
-                // Typecast index values
-                case RecordSet.Fields[x].DataType of
-                  ftInteger, ftSmallint: WhereClause += IntToStr(RecordSet.Fields[x].OldValue);
-                  ftFloat: WhereClause += FloatToStr(RecordSet.Fields[x].OldValue);
-                else
-                  WhereClause += '''' + RecordSet.Fields[x].OldValue + '''';
+                { Typecast key values
+                If the old value was null the, typecast will fail so try to
+                deal with that }
+                try
+                  case UserData.Fields[x].DataType of
+                    ftInteger, ftSmallint:
+                      WhereClause += KeyList[x] + ' = ' + IntToStr(UserData.Fields[x].OldValue);
+                    ftFloat:
+                      WhereClause += KeyList[x] + ' = ' + FloatToStr(UserData.Fields[x].OldValue);
+                  else
+                    WhereClause += KeyList[x] + ' = ' + QuotedStr(UserData.Fields[x].OldValue);
+                  end;
+                except
+                  on E: EVariantTypeCastError do
+                  begin
+                    // Only ignore typecast errors;
+                    // let higher level handle the rest
+                    // Assume field was NULL
+                    WhereClause += KeyList[x] + ' IS NULL';
+                  end;
                 end;
+
                 if x < KeyList.Count - 1 then
                   WhereClause += ' and ';
               end;
             end;
             UpdateQuery.SQL.Add(WhereClause);
+            {$IFDEF DEBUG}
+            //todo: debug
+            SendDebug('going to run update query: '+Updatequery.sql.text);
+            {$ENDIF DEBUG}
             UpdateQuery.ExecSQL;
             (Sender as TBitBtn).Visible:= False;
 
@@ -513,7 +531,7 @@ begin
 
         // Reset FModifiedRecords pointer
         FModifiedRecords[TabIndex]:= nil;
-        RecordSet.EnableControls;
+        UserData.EnableControls;
       finally
         FieldsList.Free;
         KeyList.Free;
@@ -521,7 +539,7 @@ begin
       end;
     end
     else
-      ShowMessage('There is no primary key on the table: ' + aTableName);
+      ShowMessage('There is no primary key on the table: ' + TableName);
   except
     on e: exception do
     begin
@@ -627,26 +645,6 @@ begin
 end;
 
 
-{ GetCurrentSQLText: return current SQL query text }
-
-function TfmQueryWindow.GetCurrentSQLText: string;
-var
-  i: Integer;
-  Ctl: TControl;
-begin
-  // Tabsheet has grid as well as panel
-  for i:= 0 to pgOutputPageCtl.ActivePage.ControlCount-1 do
-  begin
-    Ctl:=pgOutputPageCtl.ActivePage.Controls[i];
-    if (Ctl is TDBGrid) then
-    begin
-      Result:= (TDBGrid(Ctl).DataSource.DataSet as TSQLQuery).SQL.Text;
-      Break;
-    end;
-  end;
-end;
-
-
 { CommitResultClick: commit current transaction }
 
 procedure TfmQueryWindow.CommitResultClick(Sender: TObject);
@@ -674,22 +672,20 @@ begin
 end;
 
 
-{ GetRecordSet: return result recordset of a page tab }
+{ GetCurrentSelectQuery: return result recordset of a page tab }
 
-function TfmQueryWindow.GetRecordSet: TSQLQuery;
+function TfmQueryWindow.GetCurrentSelectQuery: TSQLQuery;
 var
   i: Integer;
   Ctl: TControl;
 begin
-  // Tabsheet has grid as well as panel - let's use that to get the dataset
-  //todo: high priority perhaps better go directly to Tsqlquery object?
-  for i:= 0 to pgOutputPageCtl.ActivePage.ControlCount-1 do
+  // Tabsheet's tag property should point to any select query
+  Result:= nil;
+  if (pgOutputPageCtl.PageCount > 0) then
   begin
-    Ctl:=pgOutputPageCtl.ActivePage.Controls[i];
-    if (Ctl is TDBGrid) then
+    if (pgOutputPageCtl.ActivePage.Tag<>0) then
     begin
-      Result:= (TDBGrid(Ctl).DataSource.DataSet as TSQLQuery);
-      Break;
+      Result:= TSQLQuery(pgOutputPageCtl.ActivePage.Tag);
     end;
   end;
 end;
@@ -1168,12 +1164,18 @@ begin
   if QueryType = qtSelectable then // Select, need record set result
   begin
     // Query
+    // Clean up any existing object to avoid memory leak
+    if assigned(aSQLQuery) then
+      aSQLQuery.Free;
     aSqlQuery:= TSQLQuery.Create(self);
     aSqlQuery.DataBase:= FIBConnection;
     aSqlQuery.Transaction:= FSQLTrans;
     aSqlQuery.AfterScroll:= @QueryAfterScroll;
     aSqlQuery.AfterPost:= @FinishCellEditing;
-    aSqlQuery.Tag:= ATab.TabIndex;
+    aSqlQuery.Tag:= ATab.TabIndex; //Query points to tabsheet number
+    {Tab points to query object so we can look it up more easily via the
+    tab sheet if we need to enable Apply/Commit buttons etc}
+    ATab.Tag:= PtrInt(aSQLQuery);
 
     // Status Bar
     StatusBar:= TStatusBar.Create(self);
@@ -1234,6 +1236,9 @@ begin
       end;
       qtScript: // Script
       begin
+        // Clean up to avoid memory leak
+        if assigned(aSQLScript) then
+          aSQLScript.Free;
         aSQLScript:= TModSQLScript.Create(self);
         aSQLScript.DataBase:= FIBConnection;
         aSQLScript.Transaction:= FSQLTrans;
@@ -1583,6 +1588,7 @@ begin
     begin
       for i:= 0 to ControlCount - 1 do
       begin
+        //todo: directly go to sqlquery?
         if Controls[i] is TDBGrid then
         begin
           Result:= TSqlQuery((Controls[i] as TDBGrid).DataSource.DataSet);