From c79febe7b4a324c607754bcb4a9219e16e1f9e06 Mon Sep 17 00:00:00 2001 From: rosenfield Date: Sat, 30 Jun 2007 00:25:11 +0000 Subject: [PATCH] Defer execution of TDataSet Post() and ExecSQL() to background thread. --- .../packages/delphi10/HeidiComponents.bdsproj | 2 +- .../packages/delphi10/HeidiComponents.dpk | 8 ++- components/heidisql/source/heidicomp.pas | 51 ++++++++++++++- readme.html | 8 +-- source/childwin.dfm | 2 - source/childwin.pas | 29 ++++++--- source/insertfiles_progress.pas | 13 ++-- source/mysqlquery.pas | 29 ++++++--- source/mysqlquerythread.pas | 62 +++++++++++-------- 9 files changed, 144 insertions(+), 60 deletions(-) diff --git a/components/heidisql/packages/delphi10/HeidiComponents.bdsproj b/components/heidisql/packages/delphi10/HeidiComponents.bdsproj index 127a3e9a..dae2bc20 100644 --- a/components/heidisql/packages/delphi10/HeidiComponents.bdsproj +++ b/components/heidisql/packages/delphi10/HeidiComponents.bdsproj @@ -123,7 +123,7 @@ ..\..\build - + ..\..\..\components\zeosdbo\build diff --git a/components/heidisql/packages/delphi10/HeidiComponents.dpk b/components/heidisql/packages/delphi10/HeidiComponents.dpk index 4aff0715..3f09a99a 100644 --- a/components/heidisql/packages/delphi10/HeidiComponents.dpk +++ b/components/heidisql/packages/delphi10/HeidiComponents.dpk @@ -26,7 +26,13 @@ package HeidiComponents; {$IMPLICITBUILD OFF} requires - vcl; + vcl, + dbrtl, + ZParseSql, + ZCore, + ZDbc, + ZPlain, + ZComponent; contains heidicomp in '..\..\source\heidicomp.pas'; diff --git a/components/heidisql/source/heidicomp.pas b/components/heidisql/source/heidicomp.pas index 09a82d50..88e616a8 100644 --- a/components/heidisql/source/heidicomp.pas +++ b/components/heidisql/source/heidicomp.pas @@ -4,7 +4,8 @@ interface uses Windows, Classes, Controls, Forms, Dialogs, SysUtils, - ComCtrls, CommCtrl, StdCtrls, ExtCtrls, Graphics; + ComCtrls, CommCtrl, StdCtrls, ExtCtrls, Graphics, + ZDataset; {$I ../../../source/const.inc} @@ -79,12 +80,60 @@ type end; +type + TDeferDataSet = class; + TAsyncPostRunner = procedure(ds: TDeferDataSet) of object; + + TDeferDataSet = class(TZQuery) + private + callback: TAsyncPostRunner; + kind: Integer; + protected + procedure InternalPost; override; + public + constructor Create(AOwner: TComponent; PostCallback: TAsyncPostRunner); reintroduce; + procedure ExecSQL; override; + procedure DoAsync; + procedure DoAsyncExecSql; + end; procedure Register; + implementation +procedure TDeferDataSet.InternalPost; +begin + kind := 1; + if @callback = nil then DoAsync + else callback(self); +end; +procedure TDeferDataSet.ExecSql; +begin + kind := 2; + if @callback = nil then DoAsync + else callback(self); +end; + +constructor TDeferDataSet.Create(AOwner: TComponent; PostCallback: TAsyncPostRunner); +begin + callback := PostCallback; + inherited Create(AOwner); +end; + +procedure TDeferDataSet.DoAsync; +begin + case kind of + 1: inherited InternalPost; + 2: inherited ExecSQL; + end; +end; + +procedure TDeferDataSet.DoAsyncExecSql; +begin + inherited ExecSql; +end; procedure Register; begin diff --git a/readme.html b/readme.html index 004cff9d..3d5349c9 100644 --- a/readme.html +++ b/readme.html @@ -173,10 +173,6 @@ components/edbimage/packages/delphi10/EDBImage.bdsgroup Build All + Install "DCLSer100" - - components/heidisql/packages/delphi10/HeidiComponents.bdsproj - Build All + Install "HeidiComponents" - components/smdbgrid/packages/delphi10/SMDBGridComponents.bdsproj Build All + Install "SMDBGridComponents" @@ -189,6 +185,10 @@ components/zeosdbo/packages/delphi10/ZeosDbo.bdsgroup Build All + Install "ZComponentDesign100" + + components/heidisql/packages/delphi10/HeidiComponents.bdsproj + Build All + Install "HeidiComponents" +

diff --git a/source/childwin.dfm b/source/childwin.dfm index e607de9e..78881c11 100644 --- a/source/childwin.dfm +++ b/source/childwin.dfm @@ -1934,13 +1934,11 @@ object MDIChild: TMDIChild end object DataSource1: TDataSource OnDataChange = DataSourceDataChange - OnUpdateData = DataSourceUpdateData Left = 304 Top = 136 end object DataSource2: TDataSource OnDataChange = DataSourceDataChange - OnUpdateData = DataSourceUpdateData Left = 304 Top = 168 end diff --git a/source/childwin.pas b/source/childwin.pas index ecb4205d..1df61deb 100644 --- a/source/childwin.pas +++ b/source/childwin.pas @@ -267,7 +267,6 @@ type btnUnsafeEdit: TToolButton; btnColumnSelection: TSpeedButton; btnAltTerminator: TToolButton; - procedure DataSourceUpdateData(Sender: TObject); procedure btnTableViewDataClick(Sender: TObject); procedure btnDbViewDataClick(Sender: TObject); procedure btnColumnSelectionClick(Sender: TObject); @@ -447,6 +446,7 @@ type function ExecuteQuery(query: String): TDataSet; function CreateOrGetRemoteQueryTab(sender: THandle): THandle; function GetCalculatedLimit( Table: String ): Int64; + procedure RunAsyncPost(ds: TDeferDataSet); private strHostRunning : String; @@ -3729,7 +3729,6 @@ begin if not DBMemo1.Modified then exit; if DBMemo1.ReadOnly then exit; if Length(DBMemo1.DataField) = 0 then exit; - debug('TODO: Non-threaded database call to TDataSet.Post().'); DBMemo1.DataSource.DataSet.Post; //SendMessage(DBMemo1.Handle, CM_EXIT, 0, 0); end; @@ -4593,7 +4592,6 @@ begin // Save changes. Fixes issue #1538021. ds := DBMemo1.DataSource; if ds.State in [dsEdit, dsInsert] then begin - debug('TODO: Non-threaded database call to TDataSet.Post().'); ds.DataSet.Post; end; end; @@ -4908,6 +4906,24 @@ begin ); end; +procedure TMDIChild.RunAsyncPost(ds: TDeferDataSet); +begin + FQueryRunning := true; + try + try + CheckConnection; + except + exit; + end; + FProgressForm := TFrmQueryProgress.Create(Self); + debug('RunThreadedQuery(): Launching asynchronous query.'); + ExecPostAsync(FConn,nil,FProgressForm.Handle,ds); + WaitForQueryCompletion(FProgressForm); + finally + FQueryRunning := false; + end; +end; + {*** Run a query in a separate thread of execution on the current connection. } @@ -4940,7 +4956,7 @@ begin * Set FQueryRunning to false } debug('RunThreadedQuery(): Launching asynchronous query.'); - Result := ExecMysqlStatementAsync (AQuery,FConn,nil,FProgressForm.Handle); + Result := ExecMysqlStatementAsync (AQuery,FConn,nil,FProgressForm.Handle,RunAsyncPost); { Repeatedly check if the query has finished by inspecting FQueryRunning Allow repainting of user interface @@ -4956,11 +4972,6 @@ begin ResizeImageToFit; end; -procedure TMDIChild.DataSourceUpdateData(Sender: TObject); -begin - debug('TODO: Non-threaded database call to TDataSet.Post().'); -end; - {*** Used to catch when the highlighted row in a grid changes. Possibly the AfterScroll event would be better suited for the purpose? diff --git a/source/insertfiles_progress.pas b/source/insertfiles_progress.pas index f148ddd9..f594800b 100644 --- a/source/insertfiles_progress.pas +++ b/source/insertfiles_progress.pas @@ -31,7 +31,8 @@ type implementation -uses main, childwin, helpers,insertfiles; +uses main, childwin, helpers,insertfiles, + HeidiComp; {$I const.inc} {$R *.DFM} @@ -55,16 +56,14 @@ var value, filename : String; y,m,d,h,mi,s,ms : Word; FileStream : TFileStream; - zq : TZReadOnlyQuery; + zq : TDeferDataSet; begin Timer1.Enabled := false; screen.Cursor := crHourglass; ProgressBar1.Max := TfrmInsertFiles(FInsertFilesForm).ListViewFiles.Items.Count; - debug('TODO: Non-threaded database call in TfrmInsertFilesProgress.ProcessFiles().'); - zq := TZReadOnlyQuery.Create(nil); + zq := TDeferDataSet.Create(nil, MainForm.ChildWin.RunAsyncPost); zq.Connection := MainForm.ChildWin.Conn.MysqlConn; - MainForm.ChildWin.FQueryRunning := true; TRY with TfrmInsertFiles(FInsertFilesForm) do @@ -129,7 +128,8 @@ begin MessageDlg( 'Error reading file:' + CRLF + filename, mtError, [mbOK], 0 ); break; end; - zq.ExecSQL; + debug('TODO: Non-threaded ExecSql call in TfrmInsertFilesProgress.ProcessFiles().'); + zq.ExecSql; lblOperation.caption := 'Freeing memory ...'; lblOperation.Repaint; ProgressBar1.StepIt; @@ -138,7 +138,6 @@ begin end; FINALLY - MainForm.ChildWin.FQueryRunning := false; zq.ParamCheck := false; screen.Cursor := crDefault; Close(); diff --git a/source/mysqlquery.pas b/source/mysqlquery.pas index 423cc202..537ad59f 100644 --- a/source/mysqlquery.pas +++ b/source/mysqlquery.pas @@ -2,7 +2,8 @@ unit MysqlQuery; interface -uses Windows, Messages, Classes, Db, ZConnection, ZDataSet, MysqlQueryThread; +uses Windows, Messages, Classes, Db, ZConnection, ZDataSet, MysqlQueryThread, + HeidiComp; const @@ -54,9 +55,9 @@ type protected public - constructor Create (AOwner : TComponent; AConn : POpenConnProf); + constructor Create (AOwner : TComponent; AConn : POpenConnProf); overload; destructor Destroy (); override; - procedure Query (ASql : String; AMode : Integer = MQM_SYNC; ANotifyWndHandle : THandle = 0); + procedure Query(ASql: String; AMode: Integer; ANotifyWndHandle : THandle; Callback: TAsyncPostRunner; ds: TDeferDataSet); procedure SetMysqlDataset(ADataset : TDataset); procedure PostNotification (AQueryResult : TThreadResult; AEvent : Integer); procedure SetThreadResult(AResult : TThreadResult); @@ -74,8 +75,9 @@ type property OnNotify : TMysqlQueryNotificationEvent read FOnNotify write FOnNotify; // Event procedure used in MQN_EVENTPROC notification mode end; - function ExecMysqlStatementAsync(ASql : String; AConn : TOpenConnProf; ANotifyProc : TMysqlQueryNotificationEvent = nil; AWndHandle : THandle = 0) : TMysqlQuery; + function ExecMysqlStatementAsync(ASql : String; AConn : TOpenConnProf; ANotifyProc : TMysqlQueryNotificationEvent; AWndHandle : THandle; Callback: TAsyncPostRunner) : TMysqlQuery; function ExecMysqlStatementBlocking(ASql : String; AConn : TOpenConnProf; AWndHandle : THandle) : TMysqlQuery; + procedure ExecPostAsync(AConn : TOpenConnProf; ANotifyProc : TMysqlQueryNotificationEvent; AWndHandle : THandle; ds: TDeferDataSet); implementation @@ -101,14 +103,23 @@ uses @param TMysqlQueryNotificationEvent Notify procedure @param THandle Window handle to post thread status messages to } -function ExecMysqlStatementAsync(ASql : String; AConn : TOpenConnProf; ANotifyProc : TMysqlQueryNotificationEvent; AWndHandle : THandle) : TMysqlQuery; +function ExecMysqlStatementAsync(ASql : String; AConn : TOpenConnProf; ANotifyProc : TMysqlQueryNotificationEvent; AWndHandle : THandle; Callback: TAsyncPostRunner) : TMysqlQuery; begin Result := TMysqlQuery.Create(nil,@AConn); Result.OnNotify := ANotifyProc; - Result.Query(ASql,MQM_ASYNC,AWndHandle); + Result.Query(ASql,MQM_ASYNC,AWndHandle,Callback,nil); end; +procedure ExecPostAsync(AConn : TOpenConnProf; ANotifyProc : TMysqlQueryNotificationEvent; AWndHandle : THandle; ds: TDeferDataSet); +var + q: TMysqlQuery; +begin + q := TMysqlQuery.Create(nil,@AConn); + q.OnNotify := ANotifyProc; + q.Query('',MQM_ASYNC,AWndHandle,nil,ds); +end; + {*** Wrapper function to simplify running a query in blocking mode Status notifications are sent by the WM_MYSQL_THREAD_NOTIFY message; @@ -123,7 +134,7 @@ end; function ExecMysqlStatementBlocking(ASql : String; AConn : TOpenConnProf; AWndHandle : THandle) : TMysqlQuery; begin Result := TMysqlQuery.Create(nil,@AConn); - Result.Query(ASql,MQM_SYNC,AWndHandle); + Result.Query(ASql,MQM_SYNC,AWndHandle,nil,nil); end; @@ -285,13 +296,13 @@ end; @result } -procedure TMysqlQuery.Query(ASql: String; AMode: Integer; ANotifyWndHandle : THandle); +procedure TMysqlQuery.Query(ASql: String; AMode: Integer; ANotifyWndHandle : THandle; Callback: TAsyncPostRunner; ds: TDeferDataSet); var EventHandle : THandle; begin // create thread object - FQueryThread := TMysqlQueryThread.Create(Self,FConn,ASql,AMode); + FQueryThread := TMysqlQueryThread.Create(Self,FConn,ASql,AMode,Callback,ds); FQueryThread.NotifyWndHandle := ANotifyWndHandle; FThreadID := FQueryThread.ThreadID; FEventName := APPNAME+'_'+IntToStr(FThreadID); diff --git a/source/mysqlquerythread.pas b/source/mysqlquerythread.pas index 3f885196..fe274fbb 100644 --- a/source/mysqlquerythread.pas +++ b/source/mysqlquerythread.pas @@ -3,7 +3,8 @@ unit MysqlQueryThread; interface uses - Windows, Messages, Forms, Db, Classes, ZConnection, ZDataSet, StdCtrls, SysUtils; + Windows, Messages, Forms, Db, Classes, ZConnection, ZDataSet, StdCtrls, SysUtils, + HeidiComp; {$IFDEF EXAMPLE_APP} const @@ -66,6 +67,8 @@ type FConn : TOpenConnProf; FOwner : TObject; // TMysqlQuery object FSql : String; + FCallback: TAsyncPostRunner; + FPostDataSet: TDeferDataSet; FResult : Integer; FComment : String; FSyncMode : Integer; @@ -83,11 +86,11 @@ type procedure NotifyStatusViaEventProc (AEvent : Integer); procedure NotifyStatusViaWinMessage (AEvent : Integer); function AssembleResult () : TThreadResult; - function RunDataQuery (ASql : String; var ADataset : TDataset; out AExceptionData : TExceptionData) : Boolean; - function RunUpdateQuery (ASql : String; var ADataset : TDataset; out AExceptionData : TExceptionData) : Boolean; + function RunDataQuery (ASql : String; var ADataset : TDataset; out AExceptionData : TExceptionData; callback: TAsyncPostRunner) : Boolean; + function RunUpdateQuery (ASql : String; var ADataset : TDataset; out AExceptionData : TExceptionData; callback: TAsyncPostRunner) : Boolean; function QuerySingleCellAsInteger (ASql : String) : Integer; public - constructor Create (AOwner : TObject; AConn : TOpenConnProf; ASql : String; ASyncMode : Integer); + constructor Create (AOwner : TObject; AConn : TOpenConnProf; ASql : String; ASyncMode : Integer; Callback: TAsyncPostRunner; APostDataSet: TDeferDataSet); destructor Destroy; override; property NotifyWndHandle : THandle read FNotifyWndHandle write SetNotifyWndHandle; end; @@ -116,7 +119,7 @@ begin Result.Comment := FComment; end; -constructor TMysqlQueryThread.Create(AOwner : TObject; AConn : TOpenConnProf; ASql : String; ASyncMode : Integer); +constructor TMysqlQueryThread.Create (AOwner : TObject; AConn : TOpenConnProf; ASql : String; ASyncMode : Integer; Callback: TAsyncPostRunner; APostDataSet: TDeferDataSet); var mc : TZConnection; begin @@ -125,6 +128,8 @@ begin FOwner := AOwner; FConn := AConn; FSyncMode := ASyncMode; + FCallback := Callback; + FPostDataSet := APostDataSet; mc := TMysqlQuery(FOwner).MysqlConnection; FMysqlConn := mc; FResult := 0; @@ -189,15 +194,17 @@ procedure TMysqlQueryThread.NotifyStatusViaWinMessage(AEvent: Integer); var qr : TThreadResult; begin - qr := AssembleResult(); debug(Format('qry: Setting result and posting status %d via WM_MYSQL_THREAD_NOTIFY message', [AEvent])); - TMysqlQuery(FOwner).SetThreadResult(qr); + if self.FPostDataSet = nil then begin + qr := AssembleResult(); + TMysqlQuery(FOwner).SetThreadResult(qr); + end; PostMessage(FNotifyWndHandle,WM_MYSQL_THREAD_NOTIFY,Integer(FOwner),AEvent); end; procedure TMysqlQueryThread.Execute; var - q : TZQuery; + q : TDeferDataSet; r : Boolean; e : TExceptionData; begin @@ -219,9 +226,11 @@ begin NotifyStatus (MQE_STARTED); q := nil; - if ExpectResultSet(FSql) then + if FPostDataSet <> nil then FPostDataSet.DoAsync + else begin + if ExpectResultSet(FSql) then begin - r := RunDataQuery (FSql,TDataSet(q),e); + r := RunDataQuery (FSql,TDataSet(q),e,FCallback); if r then begin @@ -232,18 +241,19 @@ begin end; end - else - r := RunUpdateQuery (FSql,TDataSet(q),e); - TMysqlQuery(FOwner).SetMysqlDataset(q); + else + r := RunUpdateQuery (FSql,TDataSet(q),e,FCallBack); + TMysqlQuery(FOwner).SetMysqlDataset(q); - if r then - SetState (MQR_SUCCESS,'SUCCESS') - else - SetState (MQR_QUERY_FAIL,e.Msg); + if r then + SetState (MQR_SUCCESS,'SUCCESS') + else + SetState (MQR_QUERY_FAIL,e.Msg); + end; end; - NotifyStatus (MQE_FINISHED); + NotifyStatus (MQE_FINISHED); NotifyStatus (MQE_FREED); debug(Format('qry: Thread %d suspending.', [ThreadID])); end; @@ -264,7 +274,7 @@ var begin Result := 0; - if RunDataQuery(ASql,ds,e) then + if RunDataQuery(ASql,ds,e, FCallback) then begin if ds.Fields.Count > 0 then Result := ds.Fields[0].AsInteger; @@ -313,12 +323,12 @@ begin end; function TMysqlQueryThread.RunDataQuery(ASql: String; - var ADataset: TDataset; out AExceptionData : TExceptionData): Boolean; + var ADataset: TDataset; out AExceptionData : TExceptionData; callback: TAsyncPostRunner): Boolean; var - q : TZQuery; + q : TDeferDataSet; begin Result := False; - q := TZQuery.Create(nil); + q := TDeferDataSet.Create(nil, callback); q.Connection := FMysqlConn; q.SQL.Text := ASql; ADataset := q; @@ -335,18 +345,18 @@ begin end; end; -function TMysqlQueryThread.RunUpdateQuery(ASql: String; var ADataset: TDataset; out AExceptionData : TExceptionData): Boolean; +function TMysqlQueryThread.RunUpdateQuery(ASql: String; var ADataset: TDataset; out AExceptionData : TExceptionData; callback: TAsyncPostRunner): Boolean; var - q : TZQuery; + q : TDeferDataSet; begin Result := False; - q := TZQuery.Create(nil); + q := TDeferDataSet.Create(nil, callback); q.Connection := FMysqlConn; q.SQL.Text := ASql; ADataSet := q; try - q.ExecSQL(); + q.DoAsyncExecSql(); Result := True; except On E: Exception do