急急急!!!请各位大虾帮我看一下我的多线程代码?????(50分)

  • 主题发起人 shadowno
  • 开始时间
S

shadowno

Unregistered / Unconfirmed
GUEST, unregistred user!

为何在调用时会出现程序死机?????
调用程序如下:
pri_data:=‘>1A1301’
lwritedb:=Tmywritedb.Create(pri_data);
lwritedb.Resume;

interface
uses
Classes,
ufuntion,//为用户定义的函数库
udm,//为数据库连接组件模板(TDataModule)
Dialogs,
Sysutils;
const InStationFormat:string = '12444';
{第一位为进出站标志,第二位为车辆序号,第三位为进副站时间 ,
第四位为离副站时间,第五位为进主站时间}
OutStationFormat:string = '124';
{第一位为进出站标志,第二位为车辆序号,第三位为出主站时间}
//下一步可从文本动态引入
type
Tmywritedb = class(TThread)
private
Ustationcode:string;//车站编号
Ubuscode: string;
//车辆编号
Udrivercode:string;
// 驾驶员编号
Ubustypecode: integer;
// 车类型编号
Ubussendsort:integer;//车辆的发车序号与排班表对应;
Usendtime0: Tdatetime;
// 出始发站时间
Usendtime: Tdatetime;
// 出终点站时间
Uintotime0: Tdatetime;
// 进始发站时间
Uintotime: Tdatetime;
// 进终点站时间
Usyssendtime:Tdatetime;
// 系统自动发车时间
Urealsendtime:Tdatetime;
// 没用
{ Private declarations }
protected
procedure writedb;
function SerialToCode(USerial:string):string;
procedure Execute;
override;
public
ubusstate:Tmybusstate;
retrieveddata:string;
constructor Create(sbus:string);
// 构造函数
end;

implementation
constructor Tmywritedb.Create(sbus:string);
begin
retrieveddata:=sbus;
with fdmdo
begin
qserial.DatabaseName :='currentdb';
qserial.SessionName := 'dbsession';
end;
inherited Create(True);
end;

procedure Tmywritedb.writedb;
begin
with ubusstatedo
begin
if copy(retrieveddata,1,1)='<' then
begin
ubusstate.stationcode:='<';
ubusstate.buscode:=SerialToCode(copy(retrieveddata,2,2));
ubusstate.sendtime0:=StrToTime(copy(retrieveddata,4,4));
ufuntion.outstation(ubusstate,fdm.qserial,nil)
end;

if copy(retrieveddata,1,1)='>' then
begin
ubusstate.stationcode:='>';
ubusstate.buscode:=SerialToCode(copy(retrieveddata,2,2));
ubusstate.intotime:=StrToTime(copy(retrieveddata,4,4));
ubusstate.sendtime:=StrToTime(copy(retrieveddata,8,4));
ubusstate.intotime0 :=StrToTime(copy(retrieveddata,12,4));
end;
end;
end;


function Tmywritedb.SerialToCode(USerial:string):string;
var ls_buscode:string;
begin
with udm.fdmdo
begin
qserial.close;
qserial.SQL.Clear;
qserial.SQL.Add('SELECT k_busSerial.kbuscode '+
'FROM k_busSerial '+
'WHERE k_busSerial.kserial = '''+USerial+'''');
dserial.DataSet := qserial;
qserial.Open;
qserial.First ;
ls_buscode:=qserial.fieldbyname('kbuscode').asstring;
if Length(ls_buscode)<1 then
begin
showmessage('该车序号不存在,请与系统管理员联系!!!');
exit;
end;
result:=ls_buscode;
end;
end;

procedure Tmywritedb.Execute;
begin
repeat
Synchronize(writedb);
until terminated;
end;
end.
 
不需要使用repeat...until语句;
 
while not Terminateddo
Synchronize(writedb);
就OK了
 
function Tmywritedb.SerialToCode(USerial:string):string;
var ls_buscode:string;
begin
with udm.fdmdo
begin
qserial.close;
qserial.SQL.Clear;
qserial.SQL.Add('SELECT k_busSerial.kbuscode '+
'FROM k_busSerial '+
'WHERE k_busSerial.kserial = '''+USerial+'''');
dserial.DataSet := qserial;
qserial.Open;
qserial.First ;
ls_buscode:=qserial.fieldbyname('kbuscode').asstring;
if Length(ls_buscode)<1 then
begin
showmessage('该车序号不存在,请与系统管理员联系!!!');
exit;
end;
result:=ls_buscode;
end;
end;
//代码好象有问题
 
问题大大地多,qserial是数据库组件,不是线程安全的,而你却在线程中对他们进行了类似
qserial.DatabaseName :='currentdb';
qserial.SessionName := 'dbsession';的操作,虽然处理数据库主要部分放在 Synchronize的子过程里
,但这样用线程法,还不如不用,,实际效果上和在主线程里运行没两样.你的数据库查询组件是在线程
里动态创建的才对,这样就没必要用Synchronize来调用,直接在线程中查询得到结果并返回,这样才能发挥
线程的优势.还有,类似 qserial.Open;的代码应该用try保护起来,防止出现致命错误
 
顶部