Timing queries with threads

Geert GOracle dba
CERTIFIED EXPERT
These are my last weeks. If the doctors can reduce the pain I'll still get to september. Pity, but the Delphi ACE level is out of reach.
Published:

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
9,524 Views
Geert GOracle dba
CERTIFIED EXPERT
These are my last weeks. If the doctors can reduce the pain I'll still get to september. Pity, but the Delphi ACE level is out of reach.

Comments (1)

Igor UL7AAjrSenior developer

Commented:
Big work. Readable and usefull:)
Best regards.

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.