<

Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x

Timing queries with threads

Published on
14,935 Points
6,735 Views
2 Endorsements
Last Modified:
Geert Gruwez
6 months until my next "Did i really beat the cancer ?" check

Introduction

I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need.
This article will address some of the concepts when dealing with a multithreaded delphi database application.
Shared resource protection
Query connection from thread
Displaying thread results

Sketching the problem
Our only remaining oracle 9 production database on a 7 years old server repeatedly lost disk access.  The oracle db has been due for replacement for a few years, but vendor issues have prevented this. A other server was setup and I moved the db.  Off course the hardware wasn't exactly the same and soon people complained about performance.  
This was odd, taken into account the more  recent hardware.

I won't go into detail about the oracle performance tuning.  After some searching we found some differences but most eye-catching was disk sorting.  A unsorted query took 500ms, but sorted it took 8 seconds.  Playing around with sort_area_size fixed this, but after some time other connection problems occurred.

I decided to play around with some database parameters to find out what the best settings would be.  I needed something to see impact on query execution time when changing parameters.  I'm not a guru at oracle performance tuning, so i setup a test system to play around with.

Specs for the Delphi test application
I wanted a app which would repeatedly time the execution of a query, catching and ignoring any errors and be able to connect to any of my oracle databases.
I also wanted to optionally save test results.
I always use Devart ODAC components for Delphi oracle connections
http://www.devart.com/odac/

Creating the main form
The goal for this app is to highlight the threading approach to this problem.  So the design for the main form must be kept simple to reduce overhead.
Based on the specs i needed following:
entry for a database connection
entry for a query
display for query execution times
option to start/stop a thread
display for saved resultsets

I used a listbox for the timing results, a memo for query and saved results and edit for the db connection. Some panels, splitters and labels were added for the look.

Frontend view
Code for starting a thread
The "add thread" button should start a thread with a given query on a given db.
 
procedure TfrmQueryTiming.btnAddThreadClick(Sender: TObject);
var dbconn: string;
begin
  // cbDB is combobox for db connections, save all unique entries
  dbconn := cbDB.text;
  if cbDB.Items.IndexOf(dbconn) = -1 then
    cbDB.Items.Add(dbconn);
  // Start thread on database with query text
  AddThread(dbconn, memQuery.Text);
end;

Open in new window


The structure for the results
I need a structure to save the timing of the queries.  I don't know how many threads will be running simultaneously and it will never be a fixed number.  The structure needs to be dynamic.  Expanding together with the number of threads being created.  A descendant of TCollection fits these requirements. The timing will be done inside a thread and saved to this collection. For protecting access to the array i will use a TCriticalSection.  

In multithreaded applications it is vital to protect shared resources against simultaneous changes.  

I put the shared resources into a separate unit uResources.  This not a must but allows very tight control to the resources.

The shared resource

The structure for holding the timing of the query is a TCollectionItem descendant.  This can be added to the TCollection descendant.  This allows dynamically adding or deleting items.

type
  // item for holding results
  TQueryTime = class(TCollectionItem)
  public
    // ID to identify the item
    ThreadId: Integer;
    // Time for the query to open
    ExecutionTime: TDateTime;
    // Hold errors or other messages
    Msg: string;
    // Database connection user/pass@db_alias
    DBConn: string;
  end;

  // Structure for holding multiple item results
  TQueryTimes = class(TCollection)
  private
    // Return timing item for specific thread
    function GetQueryItem(ThreadId: integer): TQueryTime;
  public
    // Save timing info for a thread
    procedure ReportQueryTime(aThreadId: Integer; aExecutionTime: TDateTime; aMsg, aDBConn: string);
    // Timing item for thread
    property QueryItem[ThreadId: integer]: TQueryTime read GetQueryItem;
  end;

Open in new window


If i would want to monitor different queries, i would have to indicate which query the result is for too.  Here I'm not going to do that as I'm only interested in the same query on different databases.
The Msg: string is for holding any errors or other info

Protecting the shared resource

Placing the array variable in the implementation part of a unit makes it inaccessible to other units.  A function will provide access to the array variable.

// Return threadlocked variable for results
function LockQueryTimes: TQueryTimes;

// Unlock variable for results
procedure UnlockQueryTimes;

implementation

uses SysUtils, SyncObjs;

var
  // varaible for thread results
  mQueryTimes: TQueryTimes;
  // protecttion vor thread results variable
  mCSTimes: TCriticalSection;

// Return threadlocked variable for results
function LockQueryTimes: TQueryTimes;
begin
  // Be ware of this when using the TQueryTimes
  // A lock may succeed but it doesn't guarantee there is data
  Result := nil;
  if Assigned(mCsTimes) then
  begin
    // Wait for lock
    mCSTimes.Enter;
    // initialised ?
    if not Assigned(mQueryTimes) then
      mQueryTimes := TQueryTimes.Create(TQueryTime);
    // Return variable
    Result := mQueryTimes;
  end;
end;

// Unlock variable for results
procedure UnlockQueryTimes;
begin
  // Leave lock
  mCSTimes.Leave;
end;

Open in new window


The mCSTimes TCriticalSection only allows 1 thread to enter at a time.  When 1 thread has access to the critical section, other threads have to wait until the first thread has left the critical section.

The complete uResources unit

unit uResources;

interface

uses Classes;

type
  // item for holding results
  TQueryTime = class(TCollectionItem)
  public
    // ID to identify the item
    ThreadId: Integer;
    // Time for the query to open
    ExecutionTime: TDateTime;
    // Hold errors or other messages
    Msg: string;
    // Database connection user/pass@db_alias
    DBConn: string;
  end;

  // Structure for holding multiple item results
  TQueryTimes = class(TCollection)
  private
    // Hold average values
    fAvg: TStrings;
    // Return timing item for specific thread
    function GetQueryItem(ThreadId: integer): TQueryTime;
    // Average execution time item
    function GetAvcExecTime(Index: Integer): string;
    // Average connection item
    function GetAvgDb(Index: Integer): string;
  public
    // Average items calculation
    function AvgCount: Integer;
    // Save timing info for a thread
    procedure ReportQueryTime(aThreadId: Integer; aExecutionTime: TDateTime; aMsg, aDBConn: string);
    // Timing item for thread
    property QueryItem[ThreadId: integer]: TQueryTime read GetQueryItem;
    // Average timing per database connection string
    property AvgDB[Index: Integer]: string read GetAvgDb;
    // Average timing per item
    property AvgExecTime[Index: Integer]: string read GetAvcExecTime;
  end;

// Return threadlocked variable for results
function LockQueryTimes: TQueryTimes;

// Unlock variable for results
procedure UnlockQueryTimes;

// Cleanup
procedure ClearQueryTimes;

implementation

uses SysUtils, DateUtils, SyncObjs;

var
  // varaible for thread results
  mQueryTimes: TQueryTimes;
  // protecttion vor thread results variable
  mCSTimes: TCriticalSection;

// Return threadlocked variable for results
function LockQueryTimes: TQueryTimes;
begin
  // Be ware of this when using the TQueryTimes
  // A lock may succeed but it doesn't guarantee there is data
  Result := nil;
  if Assigned(mCsTimes) then
  begin
    // Wait for lock
    mCSTimes.Enter;
    // initialised ?
    if not Assigned(mQueryTimes) then
      mQueryTimes := TQueryTimes.Create(TQueryTime);
    // Return variable
    Result := mQueryTimes;
  end;
end;

// Unlock variable for results
procedure UnlockQueryTimes;
begin
  // Leave lock
  mCSTimes.Leave;
end;

// Cleanup
procedure ClearQueryTimes;
var QT: TQueryTimes;
begin
  Qt := LockQueryTimes;
  try
    // Delete all entries
    QT.Clear;
  finally
    UnlockQueryTimes;
  end;
end;

{ TQueryTimes }
function TQueryTimes.AvgCount: Integer;
var
  I, J, nCount: Integer;
  Q: TQueryTime;
  nTotal, nAvg: TDateTime;
begin
  // Initialize
  if not Assigned(fAvg) then
    fAvg := TStringList.Create;
  fAvg.Clear;
  // Count connection strings and set average time = 0
  for I := 0 to Count - 1 do
  begin
    Q := TQueryTime(Items[I]);
    if fAvg.IndexOfName(Q.DBConn) = -1 then
      fAvg.Values[Q.DBConn] := '0';
  end;
  // Calculate average time per connection string
  for I := 0 to fAvg.Count - 1 do
  begin
    nTotal := 0;
    nCount := 0;
    for J := 0 to Count - 1 do
    begin
      Q := TQueryTime(Items[I]);
      if Q.DBConn = fAvg.Names[I] then
      begin
        nTotal := nTotal + Q.ExecutionTime;
        nCount := nCount + 1;
      end;
    end;
    nAvg := nTotal;
    if nCount > 1 then
      nAvg := nTotal / nCount;
    fAvg.Values[fAvg.Names[I]] := Format('Average %.5f sec', [SecondSpan(nAvg, 0)]);
  end;
  Result := fAvg.Count;
end;

function TQueryTimes.GetAvcExecTime(Index: Integer): string;
begin
  // Get average query time per database connection string
  Result := fAvg.Values[AvgDb[Index]];
end;

function TQueryTimes.GetAvgDb(Index: Integer): string;
begin
  // Get n'th connection string
  Result := fAvg.Names[Index];
end;

function TQueryTimes.GetQueryItem(ThreadId: integer): TQueryTime;
var I: Integer;
begin
  // Get thread query timing data
  Result := nil;
  for I := 0 to Count - 1 do
    if TQueryTime(Items[I]).ThreadId = ThreadId then
    begin
      Result := TQueryTime(Items[I]);
      Break;
    end;
end;

// Save the timing info for thread
procedure TQueryTimes.ReportQueryTime(aThreadId: Integer; aExecutionTime: TDateTime;
  aMsg, aDBConn: string);
var QT: TQueryTime;
begin
  Qt := GetQueryItem(aThreadId);
  if QT = nil then
  begin
    Qt := TQueryTime(Add);
    // Thread id
    QT.ThreadId := aThreadId;
    // Connection string
    QT.DBConn := aDBConn;
  end;
  // Save the time
  QT.ExecutionTime := aExecutionTime;
  // Save the message
  QT.Msg := aMsg;
end;

// Initialise unit
procedure Init;
begin
  // Create critical section
  mCSTimes := TCriticalSection.Create;
  // Initialize array
  mQueryTimes := TQueryTimes.Create(TQueryTime);
end;

// Finish the unit
procedure Done;
begin
  // Free up the critical section
  FreeAndNil(mCsTimes);
  // Free structure to hold results
  FreeAndNil(mQueryTimes);
end;

initialization
  Init;
finalization
  Done;
end.

Open in new window


The thread unit

Adding a thread

When you add a thread to a system, you will inevitably come to the point where you want to kill or remove a thread too.  This requires a reference to those added threads.  I will keep a thread list so i can kill them all.  I'm not interested in just killing 1 thread for this test application. To identify a thread I'll use a incremented variable nThreads. The thread class is also in a separate unit uThreads.
(Not the best approach, I agree, this is only for simplicity)

AddThread will be passed the connection string and the query string.  The thread class will TQueryThread.

interface

type

  // Thread class for running and timing queries
  TQueryThread = class(TThread)
      ...
  public
    // initialize the thread
    constructor Create(aId: integer; aDBConn, aQueryText: string); virtual;
      ...
  end;

var
  // var for last thread id, incremented per thread added
  nThreads: Integer;

// Add a new thread with query and connection
procedure AddThread(aDBConn, aQueryText: string);

implementation

var
  // List for running threads
  QueryList: TThreadList;

// Add a new thread with query and connection
procedure AddThread(aDBConn, aQueryText: string);
var
  L: TList;
  Q: TQueryThread;
begin
  // Increment last thread id
  Inc(nThreads);
  // Lock the thread list
  L := QueryList.LockList;
  try
    // Create new thread
    Q := TQueryThread.Create(nThreads, aDBConn, aQueryText);
    // Add it to thread list
    L.Add(Q);
  finally
    // Release thread list
    QueryList.UnlockList;
  end;
end;

Open in new window


I'll assume a thread will free itself when terminating it. Removing all the threads:
// Remove all threads
procedure KillThreads;
var
  L: TList;
  I: Integer;
  T: TQueryThread;
begin
  // Lock the thread list
  L := QueryList.LockList;
  try
    // Find all items and terminate each item
    for I := L.Count - 1 downto 0 do
    begin
      T := TQueryThread(L.Items[I]);
      T.Terminate;
      // Remove from thread list
      L.Delete(I);
    end;
  finally
    // Release thread list
    QueryList.UnlockList;
  end;
end;

Open in new window


The thread execution

The basics of what the thread must do are to create connection to the database and run a query, store timing info and keep repeating that until termination.
Only if there is a connection and the query is created will it be executed.
Reporting should be done every pass to signal any errors.
// Run the thread
procedure TQueryThread.Execute;
begin
  while not Terminated do
  begin
    // Create a session and query
    if CheckSession and CheckQuery then
      // Run and time the query
      RunQuery;
    // Report captured info
    Report;
    // Wait a while
    Sleep(THREAD_SLEEP);
  end;
end;

Open in new window


Creating a database connection and query

Inside a thread a new database connection must be made.  If this isn't done, Delphi will find a connection in the main thread (form or datamodule)  and use that.  This will give a unresponsive application providing the query and connection component can work across threads.
The creation should be a thread local component or a component which will only by used by that thread.
Once connected to the database, don't assume you will always be connected.
Any error will be caught and stored in the thread local variable fMsg

// Ensure we have a connection
function TQueryThread.CheckSession: boolean;
var n, m: Integer;
begin
  // reset message
  fMsg := '';
  // default no connection
  Result := False;
  try
    // initialize connection
    if not Assigned(fSession) then
    begin
      // create session
      fSession := TOraSession.Create(nil);
      // no login prompty
      fSession.ConnectPrompt := False;
      // extract user password and alias
      n := Pos('/', fDBConn);
      m := Pos('@', fDBConn);
      if (n <= 0) or (m <= 0) then
        raise Exception.Create('Connection string format: user/pass@database');
      fSession.Username := Copy(fDBConn, 1, n-1);
      fSession.Password := Copy(fDBConn, n+1, m-n-1);
      fSession.Server := Copy(fDBConn, m+1, 100);
    end;
    // Connect to the database
    if not fSession.Connected then
      fSession.Connect;
    // check if connect ok
    if fSession.Connected then
      Result := True;
  except
    // catch any error and save it in the fMsg
    on E: Exception do
    begin
      fMsg := E.Message;
      Result := False;
    end;
  end;
end;

Open in new window


Setting up a query through the above created session :
Any error is recorded in fMsg too.
// Ensure we have a query
function TQueryThread.CheckQuery: boolean;
begin
  // reset the message
  fMsg := '';
  // default ok, false when exception
  Result := True;
  try
    // Initialize the query
    if not Assigned(fQuery) then
    begin
      // create object
      fQuery := TOraQuery.Create(nil);
      // attach to session
      fQuery.Session := fSession;
      // fetch all record by default
      fQuery.FetchAll := True;
      // set the query text
      fQuery.SQL.Text := fQueryText;
    end;
  except
    // catch exception and save message
    on E: Exception do
    begin
      fMsg := E.Message;
      Result := False;
    end;
  end;
end;

Open in new window


Timing the query

I'm interested in the time it takes the query to open and retrieve all records.  ODAC components are default set to only return the first 25 rows.  FetchAll := True overrules this.
Some components (like the deprecated BDE TQuery) will count every record manually with a loop.  The ODAC components don't do this, it's simply a variable holding a value.
The record count will be returned in the Msg

// Run and time the query
procedure TQueryThread.RunQuery;
var StartTime: TDateTime;
begin
  try
    // reset the message
    fMsg := '';
    // close the query
    fQuery.Close;
    // init timer
    startTime := now;
    // open the query
    fQuery.Open;
    // end timer (calc delta)
    fExecutionTime := Now - startTime;
    // return message to indicate rows returned
    fMsg := Format('Rows=%d', [fQuery.RecordCount]);
    // close the query
    fQuery.Close;
  except
    // catch exception, reset timer and save message
    on E: Exception do
    begin
      fExecutionTime := 0;
      fMsg := E.Message;
    end;
  end;
end;

Open in new window


Reporting the results

All the data for 1 pass is stored in thread local variables.  This permits us to wait indefinitely for a lock on the shared resource without affecting the results.
The thread will wait until data is copied before running a next pass.
// Report timing info
procedure TQueryThread.Report;
var QT: TQueryTimes;
begin
  // Check if still running
  if not Terminated then
  begin
    // Lock the resource
    QT := LockQueryTimes;
    try
      // Save the timing info
      QT.ReportQueryTime(fId, fExecutionTime, fMsg, fDBConn);
    finally
      // Release the resource
      UnlockQueryTimes;
    end;
  end;
end;

Open in new window


The complete uThreads unit

Here is the complete unit.  In the create constructor there is some small calculation to distribute the threads across the available cpu.

unit uThreads;

interface

uses Classes, Ora;

const
  // Sleep period between queries
  THREAD_SLEEP = 2000;

type

  // Thread class for running and timing queries
  TQueryThread = class(TThread)
  private
    // internal number for indentifying thread
    fId: integer;
    // Database connection string
    fDBConn: string;
    // Query text
    fQueryText: string;

    // Connection object to the database
    fSession: TOraSession;
    // Query object to the database
    fQuery: TOraQuery;

    // Time run by query
    fExecutionTime: TDateTime;
    // Message to report
    fMsg: string;
    // Ensure we have a session
    function CheckSession: boolean;
    // Ensure we have a query
    function CheckQuery: boolean;
    // Run and time the query
    procedure RunQuery;
    // Report timing info
    procedure Report;
  protected
    // Run the thread
    procedure Execute; override;
  public
    // initialize the thread
    constructor Create(aId: integer; aDBConn, aQueryText: string); virtual;
    // finish the thread
    destructor Destroy; override;
  end;

var
  // var for last thread id, incremented per thread added
  nThreads: Integer;

// Add a new thread with query and connection
procedure AddThread(aDBConn, aQueryText: string);

// Remove all threads
procedure KillThreads;

implementation

uses SysUtils, Windows, uResources;

var
  // List for running threads
  QueryList: TThreadList;
  // Number of processors
  NumCPUCores: Integer;

// Add a new thread with query and connection
procedure AddThread(aDBConn, aQueryText: string);
var
  L: TList;
  Q: TQueryThread;
begin
  // Increment last thread id
  Inc(nThreads);
  // Lock the thread list
  L := QueryList.LockList;
  try
    // Create new thread
    Q := TQueryThread.Create(nThreads, aDBConn, aQueryText);
    // Add it to thread list
    L.Add(Q);
  finally
    // Release thread list
    QueryList.UnlockList;
  end;
end;

// Remove all threads
procedure KillThreads;
var
  L: TList;
  I: Integer;
  T: TQueryThread;
begin
  // Lock the thread list
  L := QueryList.LockList;
  try
    // Find all items and terminate each item
    for I := L.Count - 1 downto 0 do
    begin
      T := TQueryThread(L.Items[I]);
      T.Terminate;
      // Remove from thread list
      L.Delete(I);
    end;
  finally
    // Release thread list
    QueryList.UnlockList;
  end;
end;

{ TQueryThread }

// Ensure we have a query
function TQueryThread.CheckQuery: boolean;
begin
  // reset the message
  fMsg := '';
  // default ok, false when exception
  Result := True;
  try
    // Initialize the query
    if not Assigned(fQuery) then
    begin
      // create object
      fQuery := TOraQuery.Create(nil);
      // attach to session
      fQuery.Session := fSession;
      // fetch all record by default
      fQuery.FetchAll := True;
      // set the query text
      fQuery.SQL.Text := fQueryText;
    end;
  except
    // catch exception and save message
    on E: Exception do
    begin
      fMsg := E.Message;
      Result := False;
    end;
  end;
end;

// Ensure we have a connection
function TQueryThread.CheckSession: boolean;
var n, m: Integer;
begin
  // reset message
  fMsg := '';
  // default no connection
  Result := False;
  try
    // initialize connection
    if not Assigned(fSession) then
    begin
      // create session
      fSession := TOraSession.Create(nil);
      // no login prompty
      fSession.ConnectPrompt := False;
      // extract user password and alias
      n := Pos('/', fDBConn);
      m := Pos('@', fDBConn);
      if (n <= 0) or (m <= 0) then
        raise Exception.Create('Connection string format: user/pass@database');
      fSession.Username := Copy(fDBConn, 1, n-1);
      fSession.Password := Copy(fDBConn, n+1, m-n-1);
      fSession.Server := Copy(fDBConn, m+1, 100);
    end;
    // Connect to the database
    if not fSession.Connected then
      fSession.Connect;
    // check if connect ok
    if fSession.Connected then
      Result := True;
  except
    // catch any error and save it in the fMsg
    on E: Exception do
    begin
      fMsg := E.Message;
      Result := False;
    end;
  end;
end;

// create thread
constructor TQueryThread.Create(aId: integer; aDBConn, aQueryText: string);
var aCore: Integer;
begin
  inherited Create(False);
  // free the object when finished
  FreeOnTerminate := True;
  // init
  fId := aId;
  fQuery := nil;
  fSession := nil;
  fMsg := '';
  // connection string
  fDBConn := aDBConn;
  // query test
  fQueryText := aQueryText;
  // assign the thread to next processor (based on aId)
  if NumCPUCores > 1 then
  begin
    aCore := aId+1;
    while (aCore > NumCPUCores) do aCore := aCore - NumCPUCores;
    if aCore < 1 then aCore := 1;
    SetThreadIdealProcessor(Handle, aCore-1);
  end;
end;

// destroy thread
destructor TQueryThread.Destroy;
begin
  // free the query
  FreeAndNil(fQuery);
  // free the database connection
  FreeAndNil(fSession);
  inherited Destroy;
end;

// Run the thread
procedure TQueryThread.Execute;
begin
  while not Terminated do
  begin
    // Create a session and query
    if CheckSession and CheckQuery then
      // Run and time the query
      RunQuery;
    // Report captured info
    Report;
    // Wait a while
    Sleep(THREAD_SLEEP);
  end;
end;

// Report timing info
procedure TQueryThread.Report;
var QT: TQueryTimes;
begin
  // Check if still running
  if not Terminated then
  begin
    // Lock the resource
    QT := LockQueryTimes;
    try
      // Save the timing info
      QT.ReportQueryTime(fId, fExecutionTime, fMsg, fDBConn);
    finally
      // Release the resource
      UnlockQueryTimes;
    end;
  end;
end;

// Run and time the query
procedure TQueryThread.RunQuery;
var StartTime: TDateTime;
begin
  try
    // reset the message
    fMsg := '';
    // close the query
    fQuery.Close;
    // init timer
    startTime := now;
    // open the query
    fQuery.Open;
    // end timer (calc delta)
    fExecutionTime := Now - startTime;
    // return message to indicate rows returned
    fMsg := Format('Rows=%d', [fQuery.RecordCount]);
    // close the query
    fQuery.Close;
  except
    // catch exception, reset timer and save message
    on E: Exception do
    begin
      fExecutionTime := 0;
      fMsg := E.Message;
    end;
  end;
end;

// Initialize the unit
procedure Init;
var
  MySystem: TSystemInfo;
begin
  // find number of CPU in machine
  GetSystemInfo(MySystem);
  NumCPUCores := MySystem.dwNumberOfProcessors;
  // init thread list
  QueryList := TThreadList.Create;
  // rest running threads
  nThreads := 0;
end;

// Finish the unit
procedure Done;
begin
  // finish all thread
  KillThreads;
  // free thread list
  FreeAndNil(QueryList);
end;

initialization
  Init;
finalization
  Done;
end.

Open in new window


The main unit


Displaying the results on screen
Higher up I already showed the form layout.  The only things left to do are to display the information from the shared resource on screen.  A simple timer is used to show the results on screen periodically (every second).  

// Show results on screen every second
procedure TfrmQueryTiming.timerResultsTimer(Sender: TObject);
var
  I: Integer;
  QT: TQueryTimes;
  Q: TQueryTime;
begin
  // Lock the listbox
  lbResults.Items.BeginUpdate;
  try
    // Lock the shared resource
    QT := LockQueryTimes;
    try
      // list each thread's timing info in the listbox
      for I := 1 to nThreads do
      begin
        Q := QT.QueryItem[I];
        if Assigned(Q) then
          lbResults.Items.Values[Format('Thread %.3d', [I])] := Format('Exec time=%s, DB=%s, Msg=%s', [
            Format('%.5f', [SecondSpan(Q.ExecutionTime, 0)]), Q.DBConn, Q.Msg]);
      end;
      // Add the averages to the listbox
      for I := 0 to QT.AvgCount - 1 do
        lbResults.Items.Values[QT.AvgDb[I]] := QT.AvgExecTime[I];
    finally
      // Release the shared resource
      UnlockQueryTimes;
    end;
    // Sort the listbox
    lbResults.Sorted := False;
    lbResults.Sorted := True;
  finally
    // Release and redraw the listbox on screen
    lbResults.Items.EndUpdate;
  end;
end;

Open in new window


Here is the whole main unit for the project
pas file
unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TfrmQueryTiming = class(TForm)
    timerResults: TTimer;
    pnlSavedResults: TPanel;
    pnlQuery: TPanel;
    splitQuery: TSplitter;
    pnlConnection: TPanel;
    lblDBConnection: TLabel;
    lblQuery: TLabel;
    cbDB: TComboBox;
    memQuery: TMemo;
    pnlResults: TPanel;
    lbResults: TListBox;
    splitResults: TSplitter;
    memSavedResults: TMemo;
    btnAddThread: TBitBtn;
    btnKillThread: TBitBtn;
    pnlSaveOptions: TPanel;
    btnSaveResults: TBitBtn;
    procedure timerResultsTimer(Sender: TObject);
    procedure btnAddThreadClick(Sender: TObject);
    procedure btnKillThreadClick(Sender: TObject);
    procedure btnSaveResultsClick(Sender: TObject);
  private
  public
  end;

var
  frmQueryTiming: TfrmQueryTiming;

implementation

uses uThreads, uResources, DateUtils;

{$R *.dfm}

procedure TfrmQueryTiming.btnAddThreadClick(Sender: TObject);
var dbconn: string;
begin
  // cbDB is combobox for db connections, save all unique entries
  dbconn := cbDB.text;
  if cbDB.Items.IndexOf(dbconn) = -1 then
    cbDB.Items.Add(dbconn);
  // Start thread on database with query text
  AddThread(dbconn, memQuery.Text);
end;

procedure TfrmQueryTiming.btnKillThreadClick(Sender: TObject);
begin
  // Terminate all running threads
  KillThreads;
  // Reset thread id counter
  nThreads := 0;
  // Clear listbox results
  lbResults.Items.Clear;
  // clear shared resource
  ClearQueryTimes;
end;

procedure TfrmQueryTiming.btnSaveResultsClick(Sender: TObject);
var TopLine: Integer;
begin
  if memSavedResults.Lines.Count > 0 then
    memSavedResults.Lines.Add('---------------------');
  TopLine := memSavedResults.Lines.Add('Results on ' + FormatDateTime('dd/mm/yyyy hh:nn:ss', Now));
  memSavedResults.Lines.AddStrings(lbResults.Items);
  memSavedResults.CaretPos := Point(1, TopLine);
end;

// Show results on screen every second
procedure TfrmQueryTiming.timerResultsTimer(Sender: TObject);
var
  I: Integer;
  QT: TQueryTimes;
  Q: TQueryTime;
begin
  // Lock the listbox
  lbResults.Items.BeginUpdate;
  try
    // Lock the shared resource
    QT := LockQueryTimes;
    try
      // list each thread's timing info in the listbox
      for I := 1 to nThreads do
      begin
        Q := QT.QueryItem[I];
        if Assigned(Q) then
          lbResults.Items.Values[Format('Thread %.3d', [I])] := Format('Exec time=%s, DB=%s, Msg=%s', [
            Format('%.5f', [SecondSpan(Q.ExecutionTime, 0)]), Q.DBConn, Q.Msg]);
      end;
      // Add the averages to the listbox
      for I := 0 to QT.AvgCount - 1 do
        lbResults.Items.Values[QT.AvgDb[I]] := QT.AvgExecTime[I];
    finally
      // Release the shared resource
      UnlockQueryTimes;
    end;
    // Sort the listbox
    lbResults.Sorted := False;
    lbResults.Sorted := True;
  finally
    // Release and redraw the listbox on screen
    lbResults.Items.EndUpdate;
  end;
end;

end.

Open in new window


dfm file
object frmQueryTiming: TfrmQueryTiming
  Left = 326
  Top = 142
  Caption = 'Query timing'
  ClientHeight = 547
  ClientWidth = 624
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object splitResults: TSplitter
    Left = 0
    Top = 336
    Width = 624
    Height = 5
    Cursor = crVSplit
    Align = alTop
    ExplicitWidth = 879
  end
  object pnlSavedResults: TPanel
    Left = 0
    Top = 341
    Width = 624
    Height = 206
    Align = alClient
    Caption = 'pnlSavedResults'
    TabOrder = 0
    ExplicitLeft = 1
    ExplicitWidth = 879
    ExplicitHeight = 330
    object memSavedResults: TMemo
      Left = 1
      Top = 36
      Width = 622
      Height = 169
      Align = alClient
      ScrollBars = ssBoth
      TabOrder = 0
    end
    object pnlSaveOptions: TPanel
      Left = 1
      Top = 1
      Width = 622
      Height = 35
      Align = alTop
      BevelOuter = bvNone
      TabOrder = 1
      object btnSaveResults: TBitBtn
        Left = 7
        Top = 5
        Width = 138
        Height = 25
        Caption = 'Save results'
        TabOrder = 0
        OnClick = btnSaveResultsClick
      end
    end
  end
  object pnlQuery: TPanel
    Left = 0
    Top = 0
    Width = 624
    Height = 336
    Align = alTop
    BevelOuter = bvNone
    TabOrder = 1
    ExplicitLeft = 1
    ExplicitTop = 1
    ExplicitWidth = 877
    object splitQuery: TSplitter
      Left = 0
      Top = 179
      Width = 624
      Height = 5
      Cursor = crVSplit
      Align = alBottom
      ExplicitLeft = 872
      ExplicitTop = 42
      ExplicitWidth = 118
    end
    object pnlConnection: TPanel
      Left = 0
      Top = 0
      Width = 624
      Height = 42
      Align = alTop
      BevelOuter = bvNone
      TabOrder = 0
      ExplicitLeft = 1
      ExplicitTop = 1
      ExplicitWidth = 739
      object lblDBConnection: TLabel
        Left = 8
        Top = 7
        Width = 181
        Height = 13
        Caption = 'Database connection (user/pass@db)'
      end
      object lblQuery: TLabel
        Left = 8
        Top = 26
        Width = 30
        Height = 13
        Caption = 'Query'
      end
      object cbDB: TComboBox
        Left = 208
        Top = 4
        Width = 225
        Height = 21
        ItemIndex = 0
        TabOrder = 0
        Text = 'DBADM/DBADM@TEST_DB'
        Items.Strings = (
          'DBADM/DBADM@TEST_DB')
      end
      object btnAddThread: TBitBtn
        Left = 454
        Top = 11
        Width = 75
        Height = 25
        Caption = 'Add thread'
        TabOrder = 1
        OnClick = btnAddThreadClick
      end
      object btnKillThread: TBitBtn
        Left = 535
        Top = 11
        Width = 75
        Height = 25
        Caption = 'Kill All threads'
        TabOrder = 2
        OnClick = btnKillThreadClick
      end
    end
    object memQuery: TMemo
      Left = 0
      Top = 42
      Width = 624
      Height = 137
      Align = alClient
      Lines.Strings = (
        'SELECT * FROM TEST.VW_ORDERS ORDER BY 1')
      ScrollBars = ssBoth
      TabOrder = 1
    end
    object pnlResults: TPanel
      Left = 0
      Top = 184
      Width = 624
      Height = 152
      Align = alBottom
      Caption = 'pnlResults'
      TabOrder = 2
      object lbResults: TListBox
        Left = 1
        Top = 1
        Width = 622
        Height = 150
        Align = alClient
        ItemHeight = 13
        Sorted = True
        TabOrder = 0
      end
    end
  end
  object timerResults: TTimer
    OnTimer = timerResultsTimer
    Left = 24
    Top = 256
  end
end

Open in new window


Screenshot running application
Here is a screenshot of the application in action:
Fronted running view

That's all folks

I hope this helps in understanding how threads can be used in Delphi programs.  Keep in mind this is a very basic threading example.

For more advanced threading i can only recommend the Delphi Geek's approach and his library: Omni Thread Library.

G
2
Comment
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 9

Expert Comment

by:ITugay
Big work. Readable and usefull:)
Best regards.
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Join & Write a Comment

Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Want to learn how to record your desktop screen without having to use an outside camera. Click on this video and learn how to use the cool google extension called "Screencastify"! Step 1: Open a new google tab Step 2: Go to the left hand upper corn…
Suggested Courses

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month