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