Solved

Help with Threads in Delphi7

Posted on 2010-08-31
8
544 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
8 Comments
 
LVL 9

Accepted Solution

by:
sas13 earned 500 total points
Comment Utility
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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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
Comment Utility
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
 
LVL 14

Expert Comment

by:systan
Comment Utility
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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 36

Expert Comment

by:Geert Gruwez
Comment Utility
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
Comment Utility
@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 36

Expert Comment

by:Geert Gruwez
Comment Utility
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
Comment Utility
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.

763 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

Need Help in Real-Time?

Connect with top rated Experts

7 Experts available now in Live!

Get 1:1 Help Now