Solved

Help with Threads in Delphi7

Posted on 2010-08-31
8
551 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
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
 
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
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…
Hi friends,  in this video  I'll show you how new windows 10 user can learn the using of windows 10. Thank you.

920 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

17 Experts available now in Live!

Get 1:1 Help Now