unit fmView;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Vcl.StdCtrls, Vcl.ComCtrls,
  MemDS, VirtualTable, DBAccess, Uni, Vcl.Grids, Vcl.DBGrids,

  QueryThread;

type
  TView = class(TForm)
    DBGrid1: TDBGrid;
    UniDataSource1: TUniDataSource;
    VirtualTable1: TVirtualTable;
    StatusBar1: TStatusBar;
    MSGLog: TMemo;
    Label1: TLabel;
    btnStart: TButton;
    edtConStr: TEdit;
    edtSqlTxt: TEdit;
    QrPB: TProgressBar;
    procedure btnStartClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    FSQLThrd: TSqlQueryThrd;
    procedure OnThreadStatusMsg(
      const ThreadStatusMsgPtr: PThreadStatusdMsg);

    procedure OnThreadQueryStarted(
      const ThreadQueryStartedMsgPtr: PThreadQueryStartMsg);

    procedure OnThreadQueryDone(
      const ThreadQueryDoneMsgPtr: PThreadQueryDoneMsg);

    procedure OnThreadQueryRecCount(
      const ThreadQueryRecCountMsgPtr: PThreadQueryRecCountMsg);
  public
    { Public-Deklarationen }
  protected
    procedure WndProc(var AMsg: TMessage); override;
  end;

var
  View: TView;

implementation

{$R *.dfm}

procedure TView.btnStartClick(Sender: TObject);
begin
  // I know this will leak at the moment!
  FSQLThrd := TSqlQueryThrd.Create(self.Handle, edtConStr.Text, edtSqlTxt.Text,
    VirtualTable1);
  try
    FSQLThrd.FreeOnTerminate := false;
    FSQLThrd.Start;
  except
  on E: Exception do
    MSGLog.Lines.Text := E.Message;
  end;
end;

procedure TView.FormDestroy(Sender: TObject);
begin
  if assigned(FSQLThrd) then
  begin
    FSQLThrd.Terminate;
    FSQLThrd.WaitFor;
    FSQLThrd.Free;
  end;
end;

procedure TView.OnThreadQueryStarted(
  const ThreadQueryStartedMsgPtr: PThreadQueryStartMsg);
begin
  case ThreadQueryStartedMsgPtr^.Running of
   true: QrPB.State := pbsNormal;
   false: QrPB.State := pbsPaused;
  end;
  Dispose(ThreadQueryStartedMsgPtr);
end;

procedure TView.OnThreadQueryDone(
  const ThreadQueryDoneMsgPtr: PThreadQueryDoneMsg);
begin
  case ThreadQueryDoneMsgPtr^.Done of
   true:
   begin
     QrPB.State := pbsPaused;
     try
       UniDataSource1.DataSet.DisableControls;
       UniDataSource1.DataSet := VirtualTable1;
       // exception
       // VCL.Graphics line 4197
       // EInvalidOperation: Canvas erlaubt kein zeichnen!
       DBGrid1.DataSource := UniDataSource1;
     finally
       UniDataSource1.DataSet.EnableControls;
     end;
   end;
   false: QrPB.State := pbsNormal;
  end;
   Dispose(ThreadQueryDoneMsgPtr);
end;

procedure TView.OnThreadStatusMsg(
  const ThreadStatusMsgPtr: PThreadStatusdMsg);
begin
  MSGLog.Lines.Add( string.Format('%s %s %s',
    [
     ThreadStatusMsgPtr^.ExecTime,
     ThreadStatusMsgPtr^.MessageStr,
     ThreadStatusMsgPtr^.SQLStr
    ]));
  Dispose(ThreadStatusMsgPtr);
end;

procedure TView.OnThreadQueryRecCount(
  const ThreadQueryRecCountMsgPtr: PThreadQueryRecCountMsg);
begin
  Statusbar1.Panels[0].Text := string.Format('RecCount: %s' ,
    [IntToStr(ThreadQueryRecCountMsgPtr^.ICount)]);
  Dispose(ThreadQueryRecCountMsgPtr);
end;

procedure TView.WndProc(var AMsg: TMessage);
begin
  with AMsg do
  begin
    case Msg of
      TS_THREAD_STATUS_AVAILABLE: OnThreadStatusMsg(
          PThreadStatusdMsg(WParam));

      TS_THREAD_QUERY_STARTED: OnThreadQueryStarted(
          PThreadQueryStartMsg(WParam));

      TS_THREAD_QUERY_DONE: OnThreadQueryDone(
          PThreadQueryDoneMsg(WParam));

      TS_THREAD_QUERY_COUNT: OnThreadQueryRecCount(
          PThreadQueryRecCountMsg(WParam));
    end;
  end;
  inherited;
end;

end.

unit QueryThread;

interface

uses
  System.Classes,
  System.SysUtils,
  Winapi.Windows,
  Winapi.Messages,
  UniProvider,
  MySQLUniProvider,
  Data.DB,
  DBAccess,
  Uni,
  MemDS,
  MemData,
  VirtualTable;

// messages to be send to the main thread
const
  TS_THREAD_STATUS_AVAILABLE = WM_USER + 1;
  TS_THREAD_QUERY_STARTED = WM_USER +2;
  TS_THREAD_QUERY_DONE = WM_USER +3;
  TS_THREAD_QUERY_COUNT = WM_USER +4;

type
  TThreadStatusMsg = record
    MessageStr: string;
    SQLStr: string;
    ExecTime: String;
  end;
  PThreadStatusdMsg = ^TThreadStatusMsg;

  TThreadQueryStartMsg = record
    Running: Boolean;
  end;
  PThreadQueryStartMsg = ^TThreadQueryStartMsg;

  TThreadQueryDoneMsg = record
    Done: Boolean;
  end;
  PThreadQueryDoneMsg = ^TThreadQueryDoneMsg;

  TThreadQueryRecCountMsg = record
    ICount: Int64;
  end;
  PThreadQueryRecCountMsg = ^TThreadQueryRecCountMsg;

type
  TSqlQueryThrd = class(TThread)
  protected
    procedure Execute; override;
    procedure OnAfterFetchEvent(DataSet: TCustomDADataSet);
    procedure OnAfterOpen(DataSet: TDataSet);
  private
    FMainHandle: THandle;
    FSQLText: string;
    fStatusText: string;
    FUniDacConnection: TUniConnection;
    FUniDacSQLQuery: TUniQuery;
    FVirtualTable: TVirtualTable;

    ThreadStatusMsgPtr: PThreadStatusdMsg;
    ThreadQueryStartedMsgPtr: PThreadQueryStartMsg;
    ThreadQueryDoneMsgPtr: PThreadQueryDoneMsg;
    ThreadQueryRecCountMsgPtr: PThreadQueryRecCountMsg;

    function GetLongTime(aTime: TDatetime) : string;
  public
    constructor Create(aMainHandle: THandle; aConnectionStr: string;
      aSQL: string; aVTable: TVirtualTable); overload;
    destructor Destroy; override;

  end;

implementation

{ TSqlQueryThrd }

constructor TSqlQueryThrd.Create(aMainHandle: THandle;
  aConnectionStr, aSQL: string; aVTable: TVirtualTable);
begin
  inherited Create(True);
  
  // main thread handle
  FMainHandle := aMainHandle;

  FUniDacConnection := TUniConnection.Create(nil);
  FUniDacConnection.ProviderName := 'MySQL';
  FUniDacConnection.ConnectString := aConnectionStr;
  Assert(aConnectionStr <> '', 'Connection-String can not be empty!');

  // test if connection is successful otherwise goodbye
  try
    try
      FUniDacConnection.Connect;
    except
      terminate;
    end;
  finally
    // can be disconnected the unidac query established a connection by itself if needed
    FUniDacConnection.Disconnect;
  end;

  FSQLText := aSQL;
  Assert(FSQLText <> '', 'SQL-Text can not be empty!');

  FUniDacSQLQuery := TUniQuery.Create(nil);
  FUniDacSQLQuery.Connection := FUniDacConnection;
  FUniDacSQLQuery.FetchingAll;
  FUniDacSQLQuery.AfterFetch := OnAfterFetchEvent;
  FUniDacSQLQuery.AfterOpen := OnAfterOpen;
  FUniDacSQLQuery.SQL.Clear;
  FVirtualTable := aVTable;
end;

destructor TSqlQueryThrd.Destroy;
begin
  if FUniDacConnection.Connected then
    FUniDacConnection.Disconnect;
  FUniDacConnection.Free;
  FUniDacSQLQuery.Free;
  inherited Destroy;
end;

procedure TSqlQueryThrd.Execute;
begin
  NameThreadForDebugging('StormThread');

  FUniDacSQLQuery.SQL.Text := FSQLText;

  // send the main thread some messages...
  New(ThreadQueryStartedMsgPtr);
  ThreadQueryStartedMsgPtr^.Running := True;
  if not(PostMessage(FMainHandle, TS_THREAD_QUERY_STARTED,
    integer(ThreadQueryStartedMsgPtr), 0)) then
  begin
    Dispose(ThreadQueryStartedMsgPtr);
    terminate;
  end;

  New(ThreadStatusMsgPtr);
  ThreadStatusMsgPtr^.MessageStr := 'Status: Query started';
  ThreadStatusMsgPtr^.ExecTime := GetLongTime(Now);
  ThreadStatusMsgPtr^.SQLStr := '';
  if not(PostMessage(FMainHandle, TS_THREAD_STATUS_AVAILABLE,
    integer(ThreadStatusMsgPtr), 0)) then
  begin
    Dispose(ThreadStatusMsgPtr);
    terminate;
  end;

  try
    try
      FUniDacSQLQuery.Execute;

      // Must be set here otherwise the virtualtable in the main thread
      // does not contain any data!
      FVirtualTable.Assign(FUniDacSQLQuery);
    except
      FUniDacSQLQuery.Close;
      FUniDacConnection.Close;
      terminate;
    end;
  finally
    FUniDacSQLQuery.Close;
    FUniDacConnection.Disconnect;
    terminate;
  end;
end;

function TSqlQueryThrd.GetLongTime(aTime: TDatetime): string;
var
  formattedDate : string;
begin
  Result :='';
  try
    DateTimeToString(formattedDate, 'hh:nn:ss:zz', aTime);
  finally
    Result := FormattedDate;
  end;
end;

// special for unidac if that event is raised the query is done as written in the docu...
procedure TSqlQueryThrd.OnAfterFetchEvent(DataSet: TCustomDADataSet);
begin
  New(ThreadStatusMsgPtr);
  ThreadStatusMsgPtr^.MessageStr := 'Status: Query done';
  ThreadStatusMsgPtr^.ExecTime := GetLongTime(Now);
  ThreadStatusMsgPtr^.SQLStr := '// ' + FSQLText;
  if not(PostMessage(FMainHandle, TS_THREAD_STATUS_AVAILABLE,
    integer(ThreadStatusMsgPtr), 0)) then
  begin
    Dispose(ThreadStatusMsgPtr);
    terminate;
  end;

  New(ThreadQueryDoneMsgPtr);
  ThreadQueryDoneMsgPtr^.Done := True;
  if not(PostMessage(FMainHandle, TS_THREAD_QUERY_DONE,
    integer(ThreadQueryDoneMsgPtr), 0)) then
  begin
    Dispose(ThreadQueryDoneMsgPtr);
    terminate;
  end;
end;

// this event is raised when the record count is available
procedure TSqlQueryThrd.OnAfterOpen(DataSet: TDataSet);
begin
  New(ThreadQueryRecCountMsgPtr);
  ThreadQueryRecCountMsgPtr^.ICount := FUniDacSQLQuery.RecordCount;
  if not(PostMessage(FMainHandle, TS_THREAD_QUERY_COUNT,
    integer(ThreadQueryRecCountMsgPtr), 0)) then
  begin
    Dispose(ThreadQueryRecCountMsgPtr);
    terminate;
  end;
end;

end.