Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 614
  • Last Modified:

Help with Threads in Delphi7

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
malachi223
Asked:
malachi223
1 Solution
 
sas13Commented:
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
 
Geert GOracle dbaCommented:
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
 
gtrifidisCommented:
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
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
systanCommented:
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
 
Geert GOracle dbaCommented:
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
 
gtrifidisCommented:
@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
 
Geert GOracle dbaCommented:
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
 
gtrifidisCommented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now