Threaded Delphi ADO Query

Reina Macdonald picture Reina Macdonald · Apr 27, 2013 · Viewed 7.2k times · Source

I have a query code that I can call every time I need to fetch data from the database, and I want it to be threaded. Not sure how to implement this in a thread so I can reuse this code, basically, I want this code inside a thread. I know how to create a simple database query inside thread but want something that I can reuse. Can anyone point me to where I can find examples for this or be kind enough to provide an example?

Here is my sample database query:

function TDBConnection.SQLOpen(const SQLStr: String): TDataSet;
var
  i: Integer
begin
  try
    Result := TADOQuery.Create(DBConnect.FDatabaseConection);
    TADOQuery(Result).Connection:=DBConnect.FDatabaseConnection;
    TADOQuery(Result).CommandTimeOut:=30;
    TADOQuery(Result).SQL.Text := SQLStr;
    TADOQuery(Result).Open;
  except

  end;
end;

And this is a sample of how I'm calling the above function:

function TDBConnection.GetUserInfo: Boolean;
var
  sqlStr: String;
  Database: TDataset;
begin
  sqlStr:= 'SELECT FIELD1, FIELD2, FIELD3 FROM TABLE1';
  try
    Dataset := SQLOpen(sqlStr);
    if not Dataset.IsEmpty then
    begin
      //pass result to StringGrid
    end;
  finally
    FreeAndNil(SQLParams);
    FreeAndNil(Dataset);
  end;
end;

Answer

bummi picture bummi · Apr 28, 2013

For reusability using an array with parameterinformations.
Every thread creates an own Adodataset with own Connection.
Recordset can be used for displaying and editing after thread terminated.
For a real application handling of thread instances will have to be add.

unit ThreadedAdoDataset;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, Grids, DBGrids;

type

  TFieldInfoRecord = Record // as far as sometimes parametertypes can not be detected by
    DataType: TFieldType; // Ado on his own, provide all needed informations
    Name: String;
    Size: Integer;
    Value: Variant;
  End;

  TFieldInfoArray = Array of TFieldInfoRecord;

  TDBThread = Class(TThread)
    Constructor Create(Const ConnectionString, SQL: String;
      FDArray: TFieldInfoArray);
  private
    FConnectionString, FSQL: String;
    FFDArray: TFieldInfoArray;
    FRecordSet: _RecordSet;
  Protected
    Procedure Execute; override;
  public
    Property RecordSet: _RecordSet read FRecordSet;
  End;

  TForm7 = class(TForm)
    ADOConnection1: TADOConnection;
    Button1: TButton;
    ADODataSet1: TADODataSet;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure ThreadTerminate(Sender: TObject);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form7: TForm7;

implementation

uses ActiveX;
{$R *.dfm}

procedure TForm7.Button1Click(Sender: TObject);
var
  FDArray: TFieldInfoArray;
  I: Integer;
begin
  // prepare parameterinformations
  SetLength(FDArray, 1);
  FDArray[0].Name := 'cn';
  FDArray[0].DataType := ftString;
  FDArray[0].Size := 20;
  FDArray[0].Value := '%ue%';

  for I := 0 to 10 do // testrun with 11 threads

    With TDBThread.Create(ADOConnection1.ConnectionString,
      'select * from Composition where Componame like :cn', FDArray) do
    begin
      FreeOnTerminate := true;
      // assign the wished procedure to ba called on terminate
      OnTerminate := ThreadTerminate;
    end;

end;

procedure TForm7.ThreadTerminate(Sender: TObject);
begin
  // example of assigning the recordset of the thread for displaying and editing
  // NOTE for editing the connection of ADODataSet1 has to be fitting to the threadcall
  ADODataSet1.RecordSet := TDBThread(Sender).RecordSet;
end;

procedure TForm7.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutDown := true;
end;


{ TDBThread }

constructor TDBThread.Create(const ConnectionString, SQL: String;
  FDArray: TFieldInfoArray);
var
  I: Integer;
begin
  inherited Create(false);
  FConnectionString := ConnectionString;
  FSQL := SQL;
  SetLength(FFDArray, Length(FDArray));
  for I := 0 to High(FDArray) do
  begin
    FFDArray[I].DataType := FDArray[I].DataType;
    FFDArray[I].Size := FDArray[I].Size;
    FFDArray[I].Name := FDArray[I].Name;
    FFDArray[I].Value := FDArray[I].Value;
  end;
end;

procedure TDBThread.Execute;
var
  I: Integer;
begin
  inherited;
  CoInitialize(nil);
  try
    With TADODataSet.Create(nil) do
      try
        CommandTimeOut := 600;
        ConnectionString := FConnectionString;
        // use own connection for the dataset
        // will requite a conncetionsstring including all
        // information for loggon
        Commandtext := FSQL;
        Parameters.ParseSQL(FSQL, true); // extract parameters
        for I := Low(FFDArray) to High(FFDArray) do // set parametervalues
        begin
          Parameters.ParamByName(FFDArray[I].Name).DataType := FFDArray[I]
            .DataType;
          Parameters.ParamByName(FFDArray[I].Name).Size := FFDArray[I].Size;
          Parameters.ParamByName(FFDArray[I].Name).Value := FFDArray[I].Value;
        end;
        Open;
        FRecordSet := RecordSet; // keep recordset
      finally
        Free;
      end;
  finally
    CoUnInitialize;
  end;
end;

end.