?
Solved

Help with Threads in Delphi7

Posted on 2010-08-31
8
Medium Priority
?
589 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 2000 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 38

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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
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 38

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 38

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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

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

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
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…
Suggested Courses
Course of the Month13 days, 16 hours left to enroll

800 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