Solved

Help with Threads in Delphi7

Posted on 2010-08-31
8
569 Views
Last Modified: 2012-05-10
Below is the Code I am useing for my thread to run a SQL command in a seperate thread and allow proccessing to continue so my program does not appear to have locked while the SQL is running. This code works except for 2 minor problems 1 if the command takes more then 30 seconds it times out. How do I get it to not time out note I do set the CommandTimeout property to 3600 or 1 hour. Second problem is when the SQL times out I have no way of knowing it timed out unless the data changed and I check the results. How do I pass the SQL Errors back to the calling procedure since I can not access an adoconnection for the errors reported? Thanks in advance for your help


type
  TSQLThread = class(TThread)
  protected
    procedure Execute; override;
  public
    ConnStr : WideString;
    SQLString : TStringList;
    Priority: TThreadPriority;
    Running : Boolean;
    Failed : Boolean;
    ErrMessage : String;
  end;
function RunSQLThread(ConnStr: WideString; SQLString: TStringList; Priority: TThreadPriority): TSQLThread;
procedure ThreadTerminated(Sender: TObject);


implementation
procedure TSQLThread.Execute;
var
  Qry : TADOQuery;
  Idx : integer;
  ErrStr : String;
  Conn : TADOConnection;
begin
  inherited;
  CoInitialize(nil); //CoInitialize was not called
  Qry := TADOQuery.Create(nil);
  try
//    Qry.Connection := Form1.ADOConnection1;     MUST USE OWN CONNECTION
    Qry.ConnectionString := ConnStr;
    Qry.CursorLocation := clUseServer;
    Qry.LockType := ltReadOnly;
    Qry.CursorType := ctOpenForwardOnly;
    Qry.CommandTimeout := 3600;
    For Idx := 0 to (SQLString.Count - 1) Do
       Qry.SQL.Add(SQLString[Idx]);
    Qry.ExecSQL;
  Except
    on e:Exception do
     Begin
       ErrMessage := e.Message;
       Failed := True;
     End;
  end;
  Qry.Free;
  Running := False;
  CoUninitialize();
end; //TCalcThread.Execute;
{==============================================================================}
function RunSQLThread(ConnStr: WideString; SQLString: TStringList; Priority: TThreadPriority): TSQLThread;
var
  SQLThread : TSQLThread;
  Idx : Integer;
begin
  SQLThread := TSQLThread.Create(true);
  SQLThread.Running := True;
  SQLThread.Failed := False;
  SQLThread.FreeOnTerminate := true;
  SQLThread.ConnStr := ConnStr;
  For Idx := 0 to (SQLString.Count - 1) Do
     SQLThread.SQLString := SQLString;
  SQLThread.Priority := Priority;
  SQLThread.Resume;
  Result := SQLThread;
end;

// Calling Routine
Var MyThread : TSQLThread;
begin
MyThread := RunSQLThread(SCAWater32DataModule.SCAWater32Connection.ConnectionString, BillPrntHeaderSQL, tpTimeCritical);
   While MyThread.Running = True Do
    Begin
      Application.ProcessMessages;
    End;
   Error := MyThread.Failed
end;
0
Comment
Question by:malachi223
[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
8 Comments
 
LVL 9

Accepted Solution

by:
sas13 earned 500 total points
ID: 33568988
1. try to Create ADOConnection in the thread.
use ADOConnection.CommandTimeout

2. Use Synchronize method to show error.

Except
    on e:Exception do
     Begin
       ErrMessage := e.Message;
       Failed := True;
       Synchronize(ShowError)
     End;
  end;

procedure TSQLThread.ShowError;
begin
  MessageDlg('Error: ' + ErrMessage, mtError, [mbOk], 0)
end;

>While MyThread.Running = True Do
>    Begin
>      Application.ProcessMessages;
>    End;

what is the reason using TThread if u wait result after creating Thread?
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 33573631
copy string using a for loop ... hmmm can be easier written :

 SQLThread.ConnStr := ConnStr;
 SQLThread.SQLString.Assign(SQLString);
  SQLThread.Priority := Priority;

  Qry.CommandTimeout := 3600;
  Qry.SQL.Assign(SQLString);
    Qry.ExecSQL;

i don't know why you have ThreadTerminated defined, but it's not going to work,
because it's not inside a object (it's should be a method, not a procedure)

you need to catch the error with a try except block (or 2)
to get the error to the calling object you need to free the thread yourself upon finish or use a callback routine to pass back information
the easiest asynchronous way to catch the error is with a callback
function RunSQLThread(ConnStr: WideString; SQLString: TStringList; Priority: TThreadPriority; ThreadFinished: TNotifyEvent): TSQLThread;

procedure TSQLThread.Execute;
var
  Qry : TADOQuery;
  Idx : integer;
  ErrStr : String;
  Conn : TADOConnection;
begin
  // inherited; you don't need to call inherited (it's an override)
  CoInitialize(nil); //CoInitialize was not called
  conn := TADOConnection.Create(nil);
  try
    conn.ConnectionString := ConnStr;
    conn.CommandTimeOut := 3600;
    try
      conn.Connect;
    except
      on E: exception do 
      begin
        ErrMessage := e.Message;
        Failed := True;
      end;
    end;  
    if conn.Connected then
    begin
      Qry := TADOQuery.Create(nil);
      try
        Qry.Connection := Conn;
        Qry.CursorLocation := clUseServer;
        Qry.LockType := ltReadOnly;
        Qry.CursorType := ctOpenForwardOnly;
        Qry.CommandTimeout := 3600;
        Qry.SQL.Assign(SQLString);
        try
          Qry.ExecSQL;
        except
          on e:Exception do
          begin
            ErrMessage := e.Message;
            Failed := True;
          end;
        end;
      finally
        Qry.Free;
      end;
    end;
  finally
    Conn.Free;
  end;
  Running := False;
  CoUninitialize();
  // DoTerminate; called automatically
end; //TCalcThread.Execute;

{==============================================================================}
function RunSQLThread(ConnStr: WideString; SQLString: TStringList; Priority: TThreadPriority; ThreadFinished: TNotifyEvent): TSQLThread;
var
  SQLThread : TSQLThread;
  Idx : Integer;
begin
  SQLThread := TSQLThread.Create(true);
  SQLThread.Running := True;
  SQLThread.Failed := False;
  SQLThread.FreeOnTerminate := true;
  SQLThread.OnTerminate := ThreadTerminated;
  SQLThread.ConnStr := ConnStr;
  For Idx := 0 to (SQLString.Count - 1) Do
     SQLThread.SQLString := SQLString;
  SQLThread.Priority := Priority;
  SQLThread.Resume;
  Result := SQLThread;
end;

// Calling Routine
procedure TForm1.btnTestClick(Sender: TObject);
Var MyThread : TSQLThread;
begin
  MyThread := RunSQLThread(SCAWater32DataModule.SCAWater32Connection.ConnectionString, 
    BillPrntHeaderSQL, tpNormal, ThreadTerminated);
end;

procedure TForm1.ThreadTerminated(Sender: TObject);
var Error: String;
  Failed: Boolean;
begin
  Error := TSQLThread(Sender).ErrMessage;
  Failed := TSQLThread(Sender).Failed;
  if Failed then 
    ShowMessage(Error);
end;

Open in new window

0
 
LVL 2

Expert Comment

by:gtrifidis
ID: 33578236
I have attached an example code and project.
I you need more help just let me know....

Hope i helped ;)
unit o_SQLThread;

interface
uses
   Classes
  ,AdoDB
  ;
type
{------------------------------------------------------------------------------}
  TSQLErrorEvent = procedure (Sender : TObject ; SQLError : string) of Object;
{------------------------------------------------------------------------------}
  TexSQLQuery = class;
{------------------------------------------------------------------------------}
  TexSQLThread = class(TThread)
  private
    { private declarations }
    FAdoQuery     : TADOQuery;
    FSQLQuery     : TexSQLQuery;
    FErrorMessage : string;
  protected
    { protected declarations }
    procedure UI_Update_OnSQLError;
    procedure UI_Update_OnSQLExecuted;
  public
    { public declarations }
    constructor Create(CreateSuspended: Boolean ; ASQLQuery : TexSQLQuery);virtual;
    destructor Destroy;override;
  public
    procedure Execute;override;
  published
    { published declarations }
  end;
{------------------------------------------------------------------------------}
  TexSQLQuery = class(TComponent)
  private
    FConnectionString: string;
    FOnSQLError      : TSQLErrorEvent;
    FSQL             : TStrings;
    FOnSQLExecuted   : TNotifyEvent;
    procedure SetSQL(const Value: TStrings);
    { private declarations }
  protected
    { protected declarations }
    FSQLThread : TexSQLThread;
  protected
    FInternalSQLExecuted : TNotifyEvent;
    procedure InternalOnSQLExecuted(Sender : TObject);
  public
    { public declarations }
    constructor Create(AOwner : TComponent);override;
    destructor  Destroy;override;
    procedure Execute;
  published
    { published declarations }
    property ConnectionString : string    read FConnectionString write FConnectionString;
    property SQL              : TStrings  read FSQL              write SetSQL;
  published
    property OnSQLError     : TSQLErrorEvent read FOnSQLError      write FOnSQLError;
    property OnSQLExecuted  : TNotifyEvent   read FOnSQLExecuted   write FOnSQLExecuted;
  end;
{------------------------------------------------------------------------------}
implementation
uses
  SysUtils
  ,ActiveX
  ;

{ TexSQLThread }

{------------------------------------------------------------------------------}
constructor TexSQLThread.Create(CreateSuspended: Boolean;ASQLQuery: TexSQLQuery);
begin
  inherited Create(True);
  FSQLQuery := ASQLQuery;
end;
{------------------------------------------------------------------------------}
destructor TexSQLThread.Destroy;
begin
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TexSQLThread.Execute;
begin
  CoInitialize(nil);
  FAdoQuery                  := TADOQuery.Create(nil);
  FAdoQuery.ConnectionString := FSQLQuery.ConnectionString;
  try
    FAdoQuery.SQL.Assign(FSQLQuery.SQL);
    try
      FAdoQuery.ExecSQL;
      Synchronize(UI_Update_OnSQLExecuted);
    except
     on E:Exception do
     begin
      FErrorMessage := E.Message;
      Synchronize(UI_Update_OnSQLError);
     end;
    end;
  finally
    FreeAndNil(FAdoQuery);
    CoUninitialize;
  end;
end;
{------------------------------------------------------------------------------}
procedure TexSQLThread.UI_Update_OnSQLError;
begin
  if Assigned(FSQLQuery.OnSQLError) then
    FSQLQuery.FOnSQLError(FSQLQuery,FErrorMessage);
end;
{------------------------------------------------------------------------------}
procedure TexSQLThread.UI_Update_OnSQLExecuted;
begin
  if Assigned(FSQLQuery.OnSQLExecuted) then
    FSQLQuery.FInternalSQLExecuted(FSQLQuery);
end;
{------------------------------------------------------------------------------}



{ TexSQLQuery }
{------------------------------------------------------------------------------}
constructor TexSQLQuery.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSQL                 := TStringList.Create;
  FInternalSQLExecuted := Self.InternalOnSQLExecuted;
end;
{------------------------------------------------------------------------------}
destructor TexSQLQuery.Destroy;
begin
  FSQL.Free;
  inherited;
end;
{------------------------------------------------------------------------------}
procedure TexSQLQuery.InternalOnSQLExecuted(Sender: TObject);
begin
  FSQLThread.Free;
  FSQLThread := nil;
  if Assigned(FOnSQLExecuted) then
    FOnSQLExecuted(Sender);
end;
{------------------------------------------------------------------------------}
procedure TexSQLQuery.Execute;
begin
  if not Assigned(FSQLThread) then
  begin
    FSQLThread := TexSQLThread.Create(True,Self);
    FSQLThread.Resume;
  end;
end;

{------------------------------------------------------------------------------}
procedure TexSQLQuery.SetSQL(const Value: TStrings);
begin
  FSQL.Assign(Value);
end;
{------------------------------------------------------------------------------}

end.

Open in new window

mainscreen.png
SQL-Thread-Expert-Exchange-Examp.zip
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 14

Expert Comment

by:systan
ID: 33580498
Possible cause;
The user you are connecting as does not have SELECT, UPDATE, INSERT, DELETE, EXEC permissions on the object;
You aren't logging in / connecting as the user you expect;
You are referencing the object without an owner name prefix (or with the wrong owner name);
You are connected to the wrong database;
You are, in fact, spelling the object's name incorrectly.

0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 33580704
gtrifidis
did you know you only need 1 declaration for each section of private, protected, public and published ?
a little over to keep on defining it like that
and why published ???
you'll never a component like that on a form
0
 
LVL 2

Expert Comment

by:gtrifidis
ID: 33584222
@Geert Gruwez
Yes i know that only one section is needed, but it is a habbit of mine it helps me keep the code
in my view more organized.

I suppose you also have some coding habbits that another programmer would propably find strange.
Critic about my coding habbits i believe it is irrelavant to the topics subject.
So why the critic?

As far as why published , yes of course it could be a design time component that's why.
Never say never.
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 33590517
it's not critics i'm giving, i was wondering why, with so few methods
with a few pages of methods, yes, but with these 5 or 6 ...
i thought it was causing a bit more confusion than actually helping

and you don't ever need a published section in a thread
you didn't fill it in, i know, but you did put it there
0
 
LVL 2

Expert Comment

by:gtrifidis
ID: 33594052
Just for the record the published section of the Thread declaration came from a code template
that's why it's there. I forgot to remove it, besides the compiler i think gives a warning about having
a published declaration section in Thread class.


0

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Show Listview image from database (String field) 5 144
find a node in VST 2 78
Dynamically Created Query 3 69
Add New Database Table in database file using delphi 3 27
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

735 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question