特
特尔斐
Unregistered / Unconfirmed
GUEST, unregistred user!
请大家花点时间看看以下的代码及结尾处的说明:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActiveX, ComObj, StdCtrls, DB, ADODB;
type
TExecutorThread = class;
TExecutorThreadCompleted = procedure(Sender: TExecutorThread) of object;
TExecutorThreadState = (etsWaiting, etsWorking, etsTerminating);
TExecutorThread = class(TThread)
private
FThreadEvent: THandle;
FReturnValue: String;
FErrorMsg: String;
FHasError: Boolean;
FOnCompleted: TExecutorThreadCompleted;
FState: TExecutorThreadState;
procedure SafeCallOnCompleted;
function StartThread: Boolean;
function EndThread: Boolean;
protected
procedure Execute;
override;
proceduredo
Working(var AReturnValue: String);
virtual;
abstract;
public
constructor Create;
destructor Destroy;
override;
procedure Activate;
property OnCompleted: TExecutorThreadCompleted read FOnCompleted write FOnCompleted;
property ReturnValue: String read FReturnValue;
property ErrorMsg: String read FErrorMsg;
property HasError: Boolean read FHasError;
property State: TExecutorThreadState read FState;
end;
TBackgroundAuditor = class(TExecutorThread)
private
FSQLCommandText: String;
//FADOConn: TADOConnection;
//FCommander: TADOQuery;
protected
procedure Execute;
override;
proceduredo
Working(var AReturnValue: String);
override;
function ExecSQL: String;
public
destructor Destroy;
override;
property SQLCommandText: String read FSQLCommandText write FSQLCommandText;
end;
type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Button1: TButton;
ADOConnection1: TADOConnection;
procedure Button1Click(Sender: TObject);
private
FChargeAuditor: TBackgroundAuditor;
FDispensingAuditor: TBackgroundAuditor;
procedure AfterBillAuditorExecute(Sender: TExecutorThread);
procedure AuditDispensingBills(S: String);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TExecutorThread }
var
CriticalSection: TRTLCriticalSection;
constructor TExecutorThread.Create;
begin
FThreadEvent := CreateEvent(nil, True, False, nil);
inherited Create(True);
FreeOnTerminate := False;
Priority := tpLower;
end;
destructor TExecutorThread.Destroy;
begin
CloseHandle(FThreadEvent);
inherited;
end;
procedure TExecutorThread.Execute;
begin
while Truedo
begin
if StartThread then
begin
EnterCriticalSection(CriticalSection);
try
FReturnValue := '';
FErrorMsg := '';
FHasError := False;
try
FState := etsWorking;
do
Working(FReturnValue);
except
on E: Exceptiondo
begin
FErrorMsg := E.Message;
FHasError := True;
end;
end;
finally
LeaveCriticalSection(CriticalSection);
end;
end;
if EndThread then
begin
FState := etsTerminating;
Break;
end;
end;
end;
function TExecutorThread.StartThread: Boolean;
begin
FState := etsWaiting;
if WaitForSingleObject(FThreadEvent, INFINITE) = WAIT_OBJECT_0 then
ResetEvent(FThreadEvent);
Result := not Terminated;
end;
function TExecutorThread.EndThread: Boolean;
begin
Result := Terminated;
if not Result then
try
SafeCallOnCompleted;
except
end;
end;
procedure TExecutorThread.SafeCallOnCompleted;
begin
if Assigned(FOnCompleted) then
FOnCompleted(Self);
end;
procedure TExecutorThread.Activate;
begin
if FState = etsWaiting then
SetEvent(FThreadEvent);
end;
{ TBackgroundAuditor }
procedure TBackgroundAuditor.DoWorking(var AReturnValue: String);
begin
AReturnValue := DateTimeToStr(Now);
AReturnValue := AReturnValue + '--->' + ExecSQL;
end;
function TBackgroundAuditor.ExecSQL: String;
var
FADOConn: TADOConnection;
//此变量原为私有成员
FCommander: TADOQuery;
//此变量原为私有成员
begin
//------------------1、对象只创建一次,在对象析构时销毁-----------------------
//if FADOConn = nil then
//begin
// FADOConn := TADOConnection.Create(nil);
// FADOConn.LoginPrompt := False;
// FADOConn.KeepConnection := True;
// FADOConn.ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=NewDrClinicNew;Data Source=192.168.0.100';
//end;
//if FCommander = nil then
//begin
// FCommander := TADOQuery.Create(nil);
// FCommander.Connection := FADOConn;
//end;
//----------------------------------------------------------------------------
//------------------2、每次执行创建新的对象,用完即销毁-----------------------
FADOConn := TADOConnection.Create(nil);
FADOConn.LoginPrompt := False;
FADOConn.KeepConnection := True;
FADOConn.ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=NewDrClinicNew;Data Source=192.168.0.100';
FCommander := TADOQuery.Create(nil);
FCommander.Connection := FADOConn;
//----------------------------------------------------------------------------
FCommander.SQL.Text := FSQLCommandText;
FCommander.Open;
Result := FCommander.Fields[0].AsString;
FCommander.Close;
//------------------用第2种方案时销毁对象-------------------------------------
FCommander.Free;
FADOConn.Free;
//----------------------------------------------------------------------------
end;
destructor TBackgroundAuditor.Destroy;
begin
//-------------------用第1种方案时销毁对象------------------------------------
//FADOConn.Free;
//FCommander.Free;
//----------------------------------------------------------------------------
inherited;
end;
procedure TBackgroundAuditor.Execute;
begin
ActiveX.CoInitialize(nil);
try
inherited;
finally
ActiveX.CoUninitialize;
end;
end;
{ TForm1 }
procedure TForm1.AfterBillAuditorExecute(Sender: TExecutorThread);
var
S: String;
begin
if Sender.HasError then
ShowMessage(Sender.ErrorMsg)
else
begin
S := Sender.ReturnValue;
if S = '' then
Exit
else
if Sender = FChargeAuditor then
begin
Memo1.Lines.Add('FChargeAuditor: ' + S);
AuditDispensingBills(S);
end
else
if Sender = FDispensingAuditor then
Memo1.Lines.Add('FDispensingAuditor: ' + S);
end;
end;
procedure TForm1.AuditDispensingBills(S: String);
begin
if not Assigned(FDispensingAuditor) then
begin
FDispensingAuditor := TBackgroundAuditor.Create;
FDispensingAuditor.OnCompleted := AfterBillAuditorExecute;
FDispensingAuditor.Resume;
end;
FDispensingAuditor.SQLCommandText := 'select top 1 currname from goodses';
FDispensingAuditor.Activate;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Assigned(FChargeAuditor) then
begin
FChargeAuditor := TBackgroundAuditor.Create;
FChargeAuditor.OnCompleted := AfterBillAuditorExecute;
FChargeAuditor.Resume;
end;
FChargeAuditor.SQLCommandText := 'select ProvName from providers';
FChargeAuditor.Activate;
end;
initialization
InitializeCriticalSection(CriticalSection);
finalization
DeleteCriticalSection(CriticalSection);
end.
说明:
上面的代码是一个多线程程序中抽出的一部分,大家从注释中可以看到,原来是将两个
用到的ADO对象声明为成员变量,在使用中发现为nil时创建,在析构时销毁。
但是,这样却出现一个奇怪的问题:程序可以正常执行,可只要这个线程(TBackgroundAuditor类型)被创建并执行一次后,当用户通过键盘或鼠标在本程序中任一文本框中切换到中文输入法时,程序死掉(在ntdll中的某处代码调用WaitForSingleObject函数时停止,即要等待的内核对象已不能再处于有信号状态)。
后来,改用每次创建对象,用完即销毁的方案(即注释中的方案2),问题不再出现。
该问题虽然已解决,但只有治标不治本的感觉,真是百思不得其解,还望高手指点迷津。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActiveX, ComObj, StdCtrls, DB, ADODB;
type
TExecutorThread = class;
TExecutorThreadCompleted = procedure(Sender: TExecutorThread) of object;
TExecutorThreadState = (etsWaiting, etsWorking, etsTerminating);
TExecutorThread = class(TThread)
private
FThreadEvent: THandle;
FReturnValue: String;
FErrorMsg: String;
FHasError: Boolean;
FOnCompleted: TExecutorThreadCompleted;
FState: TExecutorThreadState;
procedure SafeCallOnCompleted;
function StartThread: Boolean;
function EndThread: Boolean;
protected
procedure Execute;
override;
proceduredo
Working(var AReturnValue: String);
virtual;
abstract;
public
constructor Create;
destructor Destroy;
override;
procedure Activate;
property OnCompleted: TExecutorThreadCompleted read FOnCompleted write FOnCompleted;
property ReturnValue: String read FReturnValue;
property ErrorMsg: String read FErrorMsg;
property HasError: Boolean read FHasError;
property State: TExecutorThreadState read FState;
end;
TBackgroundAuditor = class(TExecutorThread)
private
FSQLCommandText: String;
//FADOConn: TADOConnection;
//FCommander: TADOQuery;
protected
procedure Execute;
override;
proceduredo
Working(var AReturnValue: String);
override;
function ExecSQL: String;
public
destructor Destroy;
override;
property SQLCommandText: String read FSQLCommandText write FSQLCommandText;
end;
type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Button1: TButton;
ADOConnection1: TADOConnection;
procedure Button1Click(Sender: TObject);
private
FChargeAuditor: TBackgroundAuditor;
FDispensingAuditor: TBackgroundAuditor;
procedure AfterBillAuditorExecute(Sender: TExecutorThread);
procedure AuditDispensingBills(S: String);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TExecutorThread }
var
CriticalSection: TRTLCriticalSection;
constructor TExecutorThread.Create;
begin
FThreadEvent := CreateEvent(nil, True, False, nil);
inherited Create(True);
FreeOnTerminate := False;
Priority := tpLower;
end;
destructor TExecutorThread.Destroy;
begin
CloseHandle(FThreadEvent);
inherited;
end;
procedure TExecutorThread.Execute;
begin
while Truedo
begin
if StartThread then
begin
EnterCriticalSection(CriticalSection);
try
FReturnValue := '';
FErrorMsg := '';
FHasError := False;
try
FState := etsWorking;
do
Working(FReturnValue);
except
on E: Exceptiondo
begin
FErrorMsg := E.Message;
FHasError := True;
end;
end;
finally
LeaveCriticalSection(CriticalSection);
end;
end;
if EndThread then
begin
FState := etsTerminating;
Break;
end;
end;
end;
function TExecutorThread.StartThread: Boolean;
begin
FState := etsWaiting;
if WaitForSingleObject(FThreadEvent, INFINITE) = WAIT_OBJECT_0 then
ResetEvent(FThreadEvent);
Result := not Terminated;
end;
function TExecutorThread.EndThread: Boolean;
begin
Result := Terminated;
if not Result then
try
SafeCallOnCompleted;
except
end;
end;
procedure TExecutorThread.SafeCallOnCompleted;
begin
if Assigned(FOnCompleted) then
FOnCompleted(Self);
end;
procedure TExecutorThread.Activate;
begin
if FState = etsWaiting then
SetEvent(FThreadEvent);
end;
{ TBackgroundAuditor }
procedure TBackgroundAuditor.DoWorking(var AReturnValue: String);
begin
AReturnValue := DateTimeToStr(Now);
AReturnValue := AReturnValue + '--->' + ExecSQL;
end;
function TBackgroundAuditor.ExecSQL: String;
var
FADOConn: TADOConnection;
//此变量原为私有成员
FCommander: TADOQuery;
//此变量原为私有成员
begin
//------------------1、对象只创建一次,在对象析构时销毁-----------------------
//if FADOConn = nil then
//begin
// FADOConn := TADOConnection.Create(nil);
// FADOConn.LoginPrompt := False;
// FADOConn.KeepConnection := True;
// FADOConn.ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=NewDrClinicNew;Data Source=192.168.0.100';
//end;
//if FCommander = nil then
//begin
// FCommander := TADOQuery.Create(nil);
// FCommander.Connection := FADOConn;
//end;
//----------------------------------------------------------------------------
//------------------2、每次执行创建新的对象,用完即销毁-----------------------
FADOConn := TADOConnection.Create(nil);
FADOConn.LoginPrompt := False;
FADOConn.KeepConnection := True;
FADOConn.ConnectionString := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=NewDrClinicNew;Data Source=192.168.0.100';
FCommander := TADOQuery.Create(nil);
FCommander.Connection := FADOConn;
//----------------------------------------------------------------------------
FCommander.SQL.Text := FSQLCommandText;
FCommander.Open;
Result := FCommander.Fields[0].AsString;
FCommander.Close;
//------------------用第2种方案时销毁对象-------------------------------------
FCommander.Free;
FADOConn.Free;
//----------------------------------------------------------------------------
end;
destructor TBackgroundAuditor.Destroy;
begin
//-------------------用第1种方案时销毁对象------------------------------------
//FADOConn.Free;
//FCommander.Free;
//----------------------------------------------------------------------------
inherited;
end;
procedure TBackgroundAuditor.Execute;
begin
ActiveX.CoInitialize(nil);
try
inherited;
finally
ActiveX.CoUninitialize;
end;
end;
{ TForm1 }
procedure TForm1.AfterBillAuditorExecute(Sender: TExecutorThread);
var
S: String;
begin
if Sender.HasError then
ShowMessage(Sender.ErrorMsg)
else
begin
S := Sender.ReturnValue;
if S = '' then
Exit
else
if Sender = FChargeAuditor then
begin
Memo1.Lines.Add('FChargeAuditor: ' + S);
AuditDispensingBills(S);
end
else
if Sender = FDispensingAuditor then
Memo1.Lines.Add('FDispensingAuditor: ' + S);
end;
end;
procedure TForm1.AuditDispensingBills(S: String);
begin
if not Assigned(FDispensingAuditor) then
begin
FDispensingAuditor := TBackgroundAuditor.Create;
FDispensingAuditor.OnCompleted := AfterBillAuditorExecute;
FDispensingAuditor.Resume;
end;
FDispensingAuditor.SQLCommandText := 'select top 1 currname from goodses';
FDispensingAuditor.Activate;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not Assigned(FChargeAuditor) then
begin
FChargeAuditor := TBackgroundAuditor.Create;
FChargeAuditor.OnCompleted := AfterBillAuditorExecute;
FChargeAuditor.Resume;
end;
FChargeAuditor.SQLCommandText := 'select ProvName from providers';
FChargeAuditor.Activate;
end;
initialization
InitializeCriticalSection(CriticalSection);
finalization
DeleteCriticalSection(CriticalSection);
end.
说明:
上面的代码是一个多线程程序中抽出的一部分,大家从注释中可以看到,原来是将两个
用到的ADO对象声明为成员变量,在使用中发现为nil时创建,在析构时销毁。
但是,这样却出现一个奇怪的问题:程序可以正常执行,可只要这个线程(TBackgroundAuditor类型)被创建并执行一次后,当用户通过键盘或鼠标在本程序中任一文本框中切换到中文输入法时,程序死掉(在ntdll中的某处代码调用WaitForSingleObject函数时停止,即要等待的内核对象已不能再处于有信号状态)。
后来,改用每次创建对象,用完即销毁的方案(即注释中的方案2),问题不再出现。
该问题虽然已解决,但只有治标不治本的感觉,真是百思不得其解,还望高手指点迷津。