奇怪，这是为什么？(100分)

  • 主题发起人 主题发起人 bluebire
  • 开始时间 开始时间
B

bluebire

Unregistered / Unconfirmed
GUEST, unregistred user!
procedure THdTruck.Update;
begin
if (thdReload<>nil) then
//thdReload为一个线程变量。
try
thdReload.Free;
showmessage('freed');
except
showmessage('failed freed');
end;
thdReload:=TInfoReload.Create(iGetMaxjID);//iGetMaxjID是一个整数值。
end;
以上过程第一此执行是正常，但第二次却发现CPU系统占用率100%,
而且thdReload:=TInfoReload.Create(iGetMaxjID);之前
thdReload 确实为nil,但为什么第二次创建就出问题呀？
 
其线程类为:
type
TInfoReload = class(TThread)
private
strHint:String;
tmpXml:IxmldomDocument;
iTop:integer;
tmpQ: TADOQuery;
strXml:String;
procedure CheckAndDown();
function DealOneString(objNode:IxmlDomNode):String;
function Filt_It(ss: string): string;
procedure EnTime();
procedure AddCountInfo();
{ Private declarations }
protected
procedure Execute;
override;
public
constructor Create(iGMjID:integer);
end;

implementation
uses Main,HDConst,forms,ComObj,Variants,Search,DateUtils,DbCmd,HDother;
{ Synchronize(UpdateCaption);
Sync }
constructor TInfoReload.Create(iGMjID:integer);
begin
inherited Create(False);
tmpxml := CreateOLEObject('Microsoft.XmlDom') as IXMLDOMDocument;
tmpxml.async :=false;
iTop:=iGMjID;
strXml:='';
FreeOnTerminate:= true;//false;
end;
procedure TInfoReload.CheckAndDown();
var NodeList:IXmlDomNodeList;
m:integer;
begin

try
tmpxml.load(ReloadUrl+'?iTop='+inttostr(iTop)+'&amp;a1='+CopyRightString+'&amp;uid='+uid);
{ while (tmpxml.readyState<>4)do
begin
application.ProcessMessages;
end;
}
if tmpxml.parseError.errorCode <> 0 then
begin
strHint:=(tmpXml.parseError.url+#13+tmpxml.parseError.reason+#13+tmpxml.parseError.srcText);
Exit;
end
else
begin
NodeList:=tmpXml.selectNodes('//One');
if (NodeList.length<1) then
exit
else
begin
strXml:='';
TmpQ := TAdoQuery.Create(nil);
TmpQ.CacheSize:=5;
TmpQ.Connection:=Conn;
for m:=NodeList.length-1do
wnto 0do
strXml:=strXml + DealOneString(NodeList[m]);
TmpQ.Free;
backXml:=strXml;
end;
//数据返回，处理之
end;
finally
//tmpxml:=nil;
end;
end;

function TInfoReload.DealOneString(objNode:IxmlDomNode):String;
var strTmp:string;
begin
//
Result:='';
if objNode=nil then
exit;
strTmp:=objNode.text;
//测试
//ssInfoString:=ssInfoString+'$' + strTmp +'#';
strTmp:=ParseOneString(strTmp,tmpQ,iTop);
if (strTmp='') then
strHint:='保存出错'
else
begin
Synchronize(AddCountInfo);
Result:=strTmp;
end;
end;
procedure TInfoReload.AddCountInfo();
begin
AddCount();
end;

procedure TInfoReload.EnTime();
begin
frmMain.InfoTimer.Enabled:=true;
frmMain.Caption:=InttoStr(iTop)+datetimetostr(now);
end;

procedure TInfoReload.Execute;
begin
CoInitialize(nil);
while not Terminateddo
begin
Application.ProcessMessages;
if (bReload=true) then
CheckAndDown();
Application.ProcessMessages;
// Synchronize(EnTime);
Suspend;
end;
showmessage('terminated');
iGetMaxjID:=iTop;
tmpxml:=nil;
CoUninitialize();
end;

function TInfoReload.Filt_It(ss: string): string;
var st: string;
begin
st := ss;
if ss <> '' then
begin
st := StringReplace(st, '&amp;', '&amp;amp;', [rfReplaceAll]);
st := StringReplace(st, '<', '&amp;lt;', [rfReplaceAll]);
st := StringReplace(st, '>', '&amp;gt;', [rfReplaceAll]);
st := StringReplace(st, '"', '&amp;quot;', [rfReplaceAll]);
st := StringReplace(st, '''', '&amp;apos;', [rfReplaceAll]);
end;
Result := st;
end;
end.
 
这样强制释放线程可能有问题，既然FreeOnTerminate:= true;那用Terminate释放不是更安全？
procedure THdTruck.Update;
begin
if (thdReload<>nil) then
//thdReload为一个线程变量。
try
thdReload.Terminate;
thdReload.waitfor;
thdReload:=nil;
showmessage('freed');
except
showmessage('failed freed');
end;
thdReload:=TInfoReload.Create(iGetMaxjID);//iGetMaxjID是一个整数值。
end;
 
谢谢迷糊兄的指点,不胜感谢:
如果把线程类作为:
constructor TInfoReload.Create(iGMjID:integer);
begin
inherited Create(False);
tmpxml := CreateOLEObject('Microsoft.XmlDom') as IXMLDOMDocument;
tmpxml.async :=false;
iTop:=iGMjID;
strXml:='';
FreeOnTerminate:= false;
end;
且调用方法改为:
procedure THdTruck.Update;
begin
if (thdReload<>nil) then
//thdReload为一个线程变量。
try
thdReload.Terminate;
thdReload.waitfor;
thdReload.Free;
thdReload:=nil;

showmessage('freed');
except
showmessage('failed freed');
end;
thdReload:=TInfoReload.Create(iGetMaxjID);//iGetMaxjID是一个整数值。
end;
可以吗?
 
既然thdReload.Terminate;，就不要再 thdReload.Free了，要不会有问题的
 
如果 FreeOnTerminate:= false;那么thdReload.Free;还是要要的。
 
谢谢大伙的指导。
但是刚才我试了一下
结果----------------CPU系统占用率持续为100%,
天呀，难道thdReload.Free;不可以让人类调用吗？
 
如果是CPU占有100%，最有可能的是死循环了，比如你的：
procedure TInfoReload.Execute;
begin
CoInitialize(nil);
while not Terminateddo
begin
Application.ProcessMessages;
if (bReload=true) then
CheckAndDown();
Application.ProcessMessages;
// Synchronize(EnTime);
Suspend;
end;
showmessage('terminated');
iGetMaxjID:=iTop;
tmpxml:=nil;
CoUninitialize();
end;

如果CheckAndDown()出现Exception，就会出现100％占用CPU
 
谢谢：qince:
但是当我把线程类主函数CheckAndDown()注释掉
情况依旧呀
 
你将Execute改成这样试试：
procedure TInfoReload.Execute;
begin
CoInitialize(nil);
while not Terminateddo
begin
Sleep(100);
end;
showmessage('terminated');
iGetMaxjID:=iTop;
tmpxml:=nil;
CoUninitialize();
end;
 
还是出现100％占用CPU，估计应该是线程对象操作出的问题。
但是线程Execute方法执行一次就挂起，这时删除（thdReload.Free;）却死机。
但是如果依次调用thdReload.Terminate;thdReload.waitfor;
thdReload.Free;
还是死机。难道用语句释放线程对象不可以吗？
 
是不是线程创建的时候，参数设为挂起了？
 
谢谢qince：
线程创建函数如下：
constructor TInfoReload.Create(iGMjID:integer);
begin
inherited Create(False);//---------------不该会挂起呀?
tmpxml := CreateOLEObject('Microsoft.XmlDom') as IXMLDOMDocument;
tmpxml.async :=false;
iTop:=iGMjID;
strXml:='';
FreeOnTerminate:= true;//false;
end;
 
看你的Create没问题呀？奇怪了，要不你都贴出来看看。
 
线程定义单元：
unit InfoReload;
interface
uses
Classes,MSXML2_TLB,msxmldom,ADODB,Activex,SysUtils,Dialogs;
type
TInfoReload = class(TThread)
private
strHint:String;
tmpXml:IxmldomDocument;
iTop:integer;
tmpQ: TADOQuery;
strXml:String;
procedure CheckAndDown();
function DealOneString(objNode:IxmlDomNode):String;
function Filt_It(ss: string): string;
procedure EnTime();
procedure AddCountInfo();
{ Private declarations }
protected
procedure Execute;
override;
public
constructor Create(iGMjID:integer);
end;

implementation
uses Main,HDConst,forms,ComObj,Variants,Search,DateUtils,DbCmd,HDother;
{ Synchronize(UpdateCaption);
Sync }
constructor TInfoReload.Create(iGMjID:integer);
begin
inherited Create(False);
tmpxml := CreateOLEObject('Microsoft.XmlDom') as IXMLDOMDocument;
tmpxml.async :=false;
iTop:=iGMjID;
strXml:='';
FreeOnTerminate:= true;//false;
end;
procedure TInfoReload.CheckAndDown();
var NodeList:IXmlDomNodeList;
m:integer;
begin

try
tmpxml.load(ReloadUrl+'?iTop='+inttostr(iTop)+'&amp;a1='+CopyRightString+'&amp;uid='+uid);
{ while (tmpxml.readyState<>4)do
begin
application.ProcessMessages;
end;
}
if tmpxml.parseError.errorCode <> 0 then
begin
strHint:=(tmpXml.parseError.url+#13+tmpxml.parseError.reason+#13+tmpxml.parseError.srcText);
Exit;
end
else
begin
NodeList:=tmpXml.selectNodes('//One');
if (NodeList.length<1) then
exit
else
begin
strXml:='';
TmpQ := TAdoQuery.Create(nil);
TmpQ.CacheSize:=5;
TmpQ.Connection:=Conn;
for m:=NodeList.length-1do
wnto 0do
strXml:=strXml + DealOneString(NodeList[m]);
TmpQ.Free;
backXml:=strXml;
end;
//数据返回，处理之
end;
finally
//tmpxml:=nil;
end;
end;

function TInfoReload.DealOneString(objNode:IxmlDomNode):String;
var strTmp:string;
begin
//
Result:='';
if objNode=nil then
exit;
strTmp:=objNode.text;
//测试
//ssInfoString:=ssInfoString+'$' + strTmp +'#';
strTmp:=ParseOneString(strTmp,tmpQ,iTop);
if (strTmp='') then
strHint:='保存出错'
else
begin
Synchronize(AddCountInfo);
Result:=strTmp;
end;
end;
procedure TInfoReload.AddCountInfo();
begin
AddCount();
end;

procedure TInfoReload.EnTime();
begin
frmMain.InfoTimer.Enabled:=true;
frmMain.Caption:=InttoStr(iTop)+datetimetostr(now);
end;

procedure TInfoReload.Execute;
begin
CoInitialize(nil);
while not Terminateddo
begin
//Application.ProcessMessages;
// if (bReload=true) then
CheckAndDown();
sleep(100);
//Application.ProcessMessages;
// Synchronize(EnTime);
Suspend;
end;
showmessage('terminated');
iGetMaxjID:=iTop;
tmpxml:=nil;
CoUninitialize();
end;

function TInfoReload.Filt_It(ss: string): string;
var st: string;
begin
st := ss;
if ss <> '' then
begin
st := StringReplace(st, '&amp;', '&amp;amp;', [rfReplaceAll]);
st := StringReplace(st, '<', '&amp;lt;', [rfReplaceAll]);
st := StringReplace(st, '>', '&amp;gt;', [rfReplaceAll]);
st := StringReplace(st, '"', '&amp;quot;', [rfReplaceAll]);
st := StringReplace(st, '''', '&amp;apos;', [rfReplaceAll]);
end;
Result := st;
end;
end.
主窗体单元:
procedure Tck.Update;
begin
//showmessage('asfd');
//UpdateData();
bReload:=true;
if (thdReload<>nil) then
begin
try
thdReload.Terminate;
//.esume;
//.Free;
thdreload.WaitFor;
//.Resume;
if thdreload=nil then
begin
showmessage('real terminate and free');
end
else
showmessage('no terminate');
//showmessagRe('Resume');
except
showmessage('failed Resume');
end
end
else
thdReload:=TInfoReload.Create(iGetMaxjID);
end;
 
你将Suspend注销调就可以了,刚才试过了,没问题的.
 
那么说如果线程对象在挂起时（或者说没有中止时），不能有法子释放掉了吗？
（谢谢你的参与与支持，一会儿就发分）
 
是呀,当然在释放的时候,需要将挂起的全部释放,要不当然系统是不会做这事的.
 
我是问线程对象在挂起时，我一释放（thdReload.Free）就死机，为什么？
 
>>我是问线程对象在挂起时，我一释放（thdReload.Free）就死机，为什么？
我觉得问题在这里，看看你的线程执行部分
procedure TInfoReload.Execute;
begin
CoInitialize(nil);
。。。。。。
CoUninitialize();//如果线程在挂起时thdReload.Free，那么这句不执行，前边申请的资源没释放
end;
你可以把CoInitialize(nil);放在线程的create中，CoUninitialize();放在destroy中
或者让线程resume，然后用Terminate退出
 
您必须登录或注册才可回复。

Similar threads

Ray
[转]终于可以发布Delphi下收点OSGI精髓皮毛而设计的插件框架WisdomPluginFramework
回复
4
查看
4K
chlkuei
C
S
为什么会这样!!!奇怪啊!(0分)
回复
0
查看
105
skymean
S
P
为什么在线程里使用输入框“InputBox”，Win98下不会出错,在win2000下会出错！(100分)
回复
14
查看
377
paf
P
Y
请教各位：奇怪，为什么这样就不行？(50分)
回复
7
查看
213
yangh888
Y
W
这个问题为什么那么怪？关于Eof的！(30分)
回复
5
查看
121
winsock
W
后退
顶部