Using aSync command execution and the ExecuteComplete Event


2007-04-04 03:36:15 PM
delphi67
Hello,
I'm using ADO without using the TAdoConnection/TADOTable components in
Delphi.
When I connect the events of a _Connection object (CoConnect.Create in
ADOInt) the same way it is done in ADODB, everything works just fine as long
as I don't use adAsyncExecute...
The ExecuteComplete event of the ADO Connection gets fired.
But when I use an aSync execute the event is never fired!!!!
See code below....
--
Regards,
Ronald Hoek
Applicationdevelopper
ComponentAgro B.V.
=======================
CODE
=======================
unit SQLThreadProgressFormU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, MainU, StdCtrls, ComCtrls, ExtCtrls, ADODB, ADOInt, Animate,
ImgList, Buttons;
type
TfrmSQLThreadProgress = class(TForm)
btnCancel: TSpeedButton;
tmrProgress: TTimer;
aniProgress: TAnimatedImage;
procedure FormShow(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure tmrProgressTimer(Sender: TObject);
private
FThread: TThread;
public
destructor Destroy; override;
end;
function ConnectDB(const Server: string; const LogonInfo: TDBLogOnInfo):
integer;
function OpenQuery(const aConnection: _Connection; const aCommand: string;
const aCommandType: TCommandType = cmdText; const Timeout: Integer =
15):
_RecordSet;
function ExecQuery(const aConnection: _Connection; const aQuery: string;
const
Timeout: Integer = 15): integer;
implementation
uses
ActiveX, ComObj, MaindataU, ADOFunc;
{$R *.dfm}
type
TActionThreadStatus = (atsBusy, atsSucceeded, atsFailed);
TAdoEventHandler = class(TObject, IUnknown, ConnectionEventsVt)
private
FConnection: _Connection;
FConnEventsID: Integer;
FRecordsEffected: Integer;
function ConnectionPoint: IConnectionPoint;
function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
protected
{ ConnectionEvents }
procedure InfoMessage(const pError: Error; var adStatus:
EventStatusEnum;
const pConnection: _Connection); safecall;
procedure BeginTransComplete(TransactionLevel: Integer; const pError:
Error;
var adStatus: EventStatusEnum; const pConnection: _Connection);
safecall;
procedure CommitTransComplete(const pError: Error; var adStatus:
EventStatusEnum;
const pConnection: _Connection); safecall;
procedure RollbackTransComplete(const pError: Error; var adStatus:
EventStatusEnum;
const pConnection: _Connection); safecall;
procedure WillExecute(var Source: WideString; var CursorType:
CursorTypeEnum;
var LockType: LockTypeEnum; var Options: Integer;
var adStatus: EventStatusEnum; const pCommand: _Command;
const pRecordset: _Recordset; const pConnection: _Connection);
safecall;
procedure ExecuteComplete(RecordsAffected: Integer; const pError: Error;
var adStatus: EventStatusEnum; const pCommand: _Command;
const pRecordset: _Recordset; const pConnection: _Connection);
safecall;
procedure WillConnect(var ConnectionString: WideString; var UserID:
WideString;
var Password: WideString; var Options: Integer;
var adStatus: EventStatusEnum; const pConnection: _Connection);
safecall;
procedure ConnectComplete(const pError: Error; var adStatus:
EventStatusEnum;
const pConnection: _Connection); safecall;
procedure Disconnect(var adStatus: EventStatusEnum; const pConnection:
_Connection); safecall;
public
constructor Create(aConn: _Connection);
destructor Destroy; override;
end;
TDBActionThread = class(TThread)
private
FEventHandler: TAdoEventHandler;
FError: string;
FErrorClass: ExceptClass;
FStatus: TActionThreadStatus;
procedure ConnectEvents(aConn: _Connection);
procedure DisconnectEvents;
function EventsConnected: Boolean;
procedure ShowError;
protected
procedure DoExecute; virtual; abstract;
procedure Execute; override;
public
constructor Create;
end;
TDBConnectThread = class(TDBActionThread)
private
FConnectionID: Integer;
FLogonInfo: TDBLogOnInfo;
FServer: string;
procedure DoExecute; override;
public
constructor Create(const Server: string; const LogonInfo: TDBLogOnInfo);
end;
TDBOpenExecQueryThread = class(TDBActionThread)
private
FCommandText: string;
FCommandType: TCommandType;
FConnection: _Connection;
FRecordsEffected: OleVariant;
FRecordSet: _Recordset;
FReturnRecordSet: Boolean;
FTimeout: Integer;
protected
procedure DoExecute; override;
public
constructor Create(const Connection: _Connection; const CommandText:
string;
const CommandType: TCommandType; const ReturnRecordSet: boolean;
const
Timeout: Integer = 15);
end;
function ConnectDB(const Server: string; const LogonInfo: TDBLogOnInfo):
integer;
begin
Result := -1;
with TfrmSQLThreadProgress.Create(Application) do
try
Caption := 'Connecting...';
FThread := TDBConnectThread.Create(Server, LogonInfo);
if ShowModal = mrOK then
Result := TDBConnectThread(FThread).FConnectionID
else if Assigned(FThread) then
TDBActionThread(FThread).ShowError
else
Abort;
finally
Free;
end;
end;
function OpenQuery(const aConnection: _Connection; const aCommand: string;
const aCommandType: TCommandType = cmdText; const Timeout: Integer =
15):
_RecordSet;
begin
Result := nil;
with TfrmSQLThreadProgress.Create(Application) do
try
Caption := 'Opening...';
FThread := TDBOpenExecQueryThread.Create(aConnection, aCommand,
aCommandType, True, Timeout);
if ShowModal = mrOK then
Result := TDBOpenExecQueryThread(FThread).FRecordSet
else if Assigned(FThread) then
TDBActionThread(FThread).ShowError
else
Abort;
finally
Free;
end;
end;
function ExecQuery(const aConnection: _Connection; const aQuery: string;
const
Timeout: Integer = 15): integer;
begin
Result := -1;
with TfrmSQLThreadProgress.Create(Application) do
try
Caption := 'Executing...';
FThread := TDBOpenExecQueryThread.Create(aConnection, aQuery, cmdText,
False, Timeout);
if ShowModal = mrOK then
Result := TDBOpenExecQueryThread(FThread).FRecordsEffected
else if Assigned(FThread) then
TDBActionThread(FThread).ShowError
else
Abort;
finally
Free;
end;
end;
{ TAdoEventHandler }
procedure TAdoEventHandler.BeginTransComplete(TransactionLevel: Integer;
const pError: Error; var adStatus: EventStatusEnum;
const pConnection: _Connection);
begin
//
end;
procedure TAdoEventHandler.CommitTransComplete(const pError: Error;
var adStatus: EventStatusEnum; const pConnection: _Connection);
begin
//
end;
procedure TAdoEventHandler.ConnectComplete(const pError: Error;
var adStatus: EventStatusEnum; const pConnection: _Connection);
begin
//
end;
function TAdoEventHandler.ConnectionPoint: IConnectionPoint;
var
ConnPtContainer: IConnectionPointContainer;
begin
OleCheck(FConnection.QueryInterface(IConnectionPointContainer,
ConnPtContainer));
OleCheck(ConnPtContainer.FindConnectionPoint(DIID_ConnectionEvents,
Result));
end;
constructor TAdoEventHandler.Create(aConn: _Connection);
begin
inherited Create;
FConnection := aConn;
OleCheck(ConnectionPoint.Advise(Self as IUnknown, FConnEventsID));
end;
destructor TAdoEventHandler.Destroy;
begin
if FConnEventsID>0 then
OleCheck(ConnectionPoint.UnAdvise(FConnEventsID));
FConnEventsID := 0;
inherited;
end;
procedure TAdoEventHandler.Disconnect(var adStatus: EventStatusEnum;
const pConnection: _Connection);
begin
//
end;
procedure TAdoEventHandler.ExecuteComplete(RecordsAffected: Integer;
const pError: Error; var adStatus: EventStatusEnum;
const pCommand: _Command; const pRecordset: _Recordset;
const pConnection: _Connection);
begin
if adStatus = adStatusOK then
FRecordsEffected := RecordsAffected
else FRecordsEffected := -1;
end;
procedure TAdoEventHandler.InfoMessage(const pError: Error;
var adStatus: EventStatusEnum; const pConnection: _Connection);
begin
//
end;
function TAdoEventHandler.QueryInterface(const IID: TGUID;
out Obj): HRESULT;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
procedure TAdoEventHandler.RollbackTransComplete(const pError: Error;
var adStatus: EventStatusEnum; const pConnection: _Connection);
begin
//
end;
procedure TAdoEventHandler.WillConnect(var ConnectionString, UserID,
Password: WideString; var Options: Integer;
var adStatus: EventStatusEnum; const pConnection: _Connection);
begin
//
end;
procedure TAdoEventHandler.WillExecute(var Source: WideString;
var CursorType: CursorTypeEnum; var LockType: LockTypeEnum;
var Options: Integer; var adStatus: EventStatusEnum;
const pCommand: _Command; const pRecordset: _Recordset;
const pConnection: _Connection);
begin
//
end;
function TAdoEventHandler._AddRef: Integer;
begin
Result := S_OK;
end;
function TAdoEventHandler._Release: Integer;
begin
Result := S_OK;
end;
{ TDBActionThread }
procedure TDBActionThread.ConnectEvents(aConn: _Connection);
begin
if not Assigned(FEventHandler) then
FEventHandler := TAdoEventHandler.Create(aConn);
end;
constructor TDBActionThread.Create;
begin
inherited Create(True);
FStatus := atsBusy;
end;
procedure TDBActionThread.DisconnectEvents;
begin
FreeAndNil(FEventHandler);
end;
function TDBActionThread.EventsConnected: Boolean;
begin
Result := Assigned(FEventHandler);
end;
procedure TDBActionThread.Execute;
begin
CoInitialize(nil);
try
try
DoExecute;
if Terminated then
FStatus := atsFailed
else FStatus := atsSucceeded;
except
on E: Exception do
begin
FStatus := atsFailed;
FError := E.Message;
FErrorClass := ExceptClass(E.ClassType);
end;
else
raise;
end;
finally
CoUninitialize;
end;
end;
procedure TDBActionThread.ShowError;
begin
if Assigned(FErrorClass) then
Raise FErrorClass.Create(FError)
else Abort;
end;
{ TDBConnectThread }
constructor TDBConnectThread.Create(const Server: string; const LogonInfo:
TDBLogOnInfo);
begin
inherited Create;
FServer := Server;
FLogonInfo := LogonInfo;
FConnectionID := -1;
end;
procedure TDBConnectThread.DoExecute;
begin
// Initialiseer connectie even snel
FConnectionID :=
dmMain.ConnectTo(FServer, FLogonInfo.User, FLogonInfo.Password, True);
// Controleer of deze nu echt klaar is.
with dmMain.Items[FConnectionID] do
begin
// Cursor aan client-zijde gebruiken, ivm bookmarks en navigatie van
recordsets!
CursorLocation := adUseClient;
while (not Terminated) and ((adStateConnecting and State) <>0) do
Sleep(100); // Loop
if Terminated then
begin
FConnectionID := -1;
Cancel; // Connect afbreken !!!
end else
if (adStateOpen and State) = 0 then
FConnectionID := -1; // Niet gelukt !!!
end;
end;
{ TDBOpenExecQueryThread }
constructor TDBOpenExecQueryThread.Create(const Connection: _Connection;
const
CommandText: string; const CommandType: TCommandType; const
ReturnRecordSet: boolean; const Timeout: Integer = 15);
begin
inherited Create();
FConnection := Connection;
FCommandText := CommandText;
FCommandType := CommandType;
FReturnRecordSet := ReturnRecordSet;
FTimeout := Timeout;
end;
procedure TDBOpenExecQueryThread.DoExecute;
var
Options: Integer;
begin
Options := GetADOExecOptions(FCommandType, []); // TODO: Voorlopig niet
met [eoAsyncExecute]
if not FReturnRecordSet then
begin
Inc(Options, adExecuteNoRecords);
ConnectEvents(FConnection);
end else
FRecordSet := CoRecordset.Create;
try
// Uitvoeren
FConnection.CommandTimeout := FTimeout;
if FReturnRecordSet then
FRecordSet.Open(FCommandText, FConnection, adOpenKeyset,
adLockOptimistic, Options )
else
FConnection.Execute(FCommandText, FRecordsEffected, Options);
// Controleer of deze nu echt klaar is.
with FConnection do
begin
while (not Terminated) and ((adStateExecuting and State) <>0) do
Sleep(100); // Loop
if Terminated then
begin
FRecordSet := nil;
FRecordsEffected := -1;
Cancel; // Connect afbreken !!!
end else
if EventsConnected then
FRecordsEffected := FEventHandler.FRecordsEffected;
end;
finally
DisconnectEvents;
end;
end;
{ TfrmSQLThreadProgress }
destructor TfrmSQLThreadProgress.Destroy;
begin
FreeAndNil(FThread);
inherited;
end;
procedure TfrmSQLThreadProgress.FormShow(Sender: TObject);
begin
if Assigned(FThread) then
begin
FThread.Resume;
aniProgress.Active := True;
end else
ModalResult := mrCancel; // Anuleren ...
end;
procedure TfrmSQLThreadProgress.btnCancelClick(Sender: TObject);
var
aThread: TThread;
begin
// Thread overzetten
aThread := FThread;
FThread := nil;
// Zelf laten opschonen
aThread.FreeOnTerminate := True;
aThread.Terminate; // En afbreken
end;
procedure TfrmSQLThreadProgress.tmrProgressTimer(Sender: TObject);
begin
if not Assigned(FThread) then
begin
ModalResult := mrCancel;
Exit;
end;
case TDBActionThread(FThread).FStatus of
atsBusy: ; // Niets doen, maar animatie draait automatisch
atsSucceeded: ModalResult := mrOk;
else
ModalResult := mrCancel;
end;
end;
end.