另一个问题:多线程与CPU占用,请教高手(100分)

  • 主题发起人 主题发起人 lzlishl
  • 开始时间 开始时间
L

lzlishl

Unregistered / Unconfirmed
GUEST, unregistred user!
多线程文件传输的程序
文件传输结束后,程序仍然占用相当多的CPU(>10%,一般是1-4%)。
有一种情况,就是在运行RealOne时,可以传输程序占用的CPU会减少,暂停播放REALONE,
传输程序占用的CPU又恢复到20%以上。
不知道什么原因?
 
你的线程,还没有退出吧
把源吗贴出来
 
{主发送线程,实现多文件传送}
unit SendCenThread;
.....
Type
TSendCenThread = class(TThread)
private
{ Private declarations }
Remotes:String;
Stri,CurFile:String;
FNames:TStrings;
LocalUDP:TNMUDP;
Topics:String;
StaBar:TMemo;
ProBar:TProgressBar;
Fi:Integer;
FSender:Array of TSendFileThread;
public
constructor create(AUDP:TNMUDP;Fns:TStrings;Ns:String;Topic:String;P:TProgressBar;M:TMemo);
destructor destroy;override;
protected
procedure Execute;
override;
end;

implementation
{ TSendCenThread }

uses FTransCen;
{ TSendFileThread }
constructor TSendCenThread.create(AUDP:TNMUDP;Fns:TStrings;Ns:String;Topic:String;P:TProgressBar;M:TMemo);
begin
inherited create(true);
LocalUDP:=AUDP;
Topics:=Topic;
StaBar:=m;
ProBar:=P;
FNames:=fns;
Remotes:=ns;
Fi:=0;
freeonterminate :=true;
resume;
end;

destructor TSendCenThread.destroy;
begin
inherited destroy;
end;

procedure TSendCenThread.Execute;
{ Place thread code here }
var
i:Integer;
RName,RIP:String;
RPort:Integer;
begin
While (not terminated) and (Length(Remotes)>0) do
begin
RName:=ExtractHost(Remotes);
If eBook_GetRemoteByName(RName,RIP,RPort) then
begin
i:=0;
If FNames.count>0 then
begin
while (not terminated) and (i<=FNames.count-1) do
begin
if FileExists(FNames) then
begin
{for muti person sending}
Inc(Fi);
SetLength(FSender,Fi);
FSender[Fi-1]:=TSendFileThread.create(MainFrm.ListView2,FNames,Topics,RPort,RName,RIP,ProBar,StaBar);
CurFile:=FNames;
end;
Inc(i);
end;
end;
end;
end;
end;

end.

{发送线程}
unit SendFThread;
...........
type
TSendFileThread = class(TThread)
private
{ Private declarations }
StaBar:TMemo;
ProBar:TProgressBar;
filename:String;
Pos:Integer;
ListView: TListView;
RemotrPort:Integer;
RemotrIP:String;
RemotrName:String;
SendSocket:TSocket;
str:String;
Topics:String;
StopTrans :Boolean;
InTrans :Boolean;
FSend:Longint;
procedure Recordit;
procedure showit;
procedure Drawit;
public
constructor create(AView: TListView;Fname:String;Topic:String;port:integer;N,IP:String;P:TProgressBar;M:TMemo);
destructor destroy;override;
protected
procedure Execute;
override;
end;
Function WaitForFSending:Boolean;
implementation
uses FTransCen;
{ TSendFileThread }
constructor TSendFileThread.create(AView: TListView;Fname:String;Topic:String;port:integer;N,IP:String;P:TProgressBar;M:TMemo);
begin
inherited create(true);
RemotrPort:=Port;
RemotrIP:=IP;
RemotrName:=N;
StaBar:=m;
ProBar:=P;
Topics:=Topic;
ListView:=AView;
FileName:=fname;
freeonterminate :=True;
resume;
end;

destructor TSendFileThread.destroy;
begin
if SendSocket<>INVALID_SOCKET then
begin
closesocket(SendSocket);
end;
postmessage(MainFrm.Handle,wm_prothreaddonmsg,self.ThreadID,0);
inherited destroy;
end;

procedure TSendFileThread.Execute;
{ Place thread code here }
Const
BlockLen=1024*4;
var
ca:SOCKADDR_IN;
hostaddr:u_long;
begin
SendSocket:=Socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
if SendSocket=INVALID_SOCKET then
begin
Exit;
end;
ca.sin_family:=PF_INET;
ca.sin_port:=htons(RemotrPort);
hostaddr:=inet_addr(PChar(Trim(RemotrIP)));
if (hostaddr=-1) then
begin
closesocket(SendSocket);
Exit;
end
else
ca.sin_addr.S_addr:=hostaddr;
if connect(SendSocket,ca,sizeof(ca))<>0 then
begin
closesocket(SendSocket);
Exit;
end
else
begin
StopTrans:=False;
SenFile(FileName);
closesocket(SendSocket);
end;
end;

end.

{接受线程}
{//////////////////////////////////////////////}
unit ReceiveFThread;
................
type
TReceiveFileThread = class(TThread)
private
{ Private declarations }
HostIP,
HostName,
Topics:String;
StaBar:TMemo;
ProBar:TProgressBar;
DestDir:String;
Fname:String;
str:String;
Posi:Integer;
ListView:TListView;

LocalUDP:TNMUDP;
LisenPort:Integer;
LiseSocket :TSocket;
ReceSocket :TSocket;
StopTrans :Boolean;
InTrans :Boolean;
FReceived,FSend:Longint;
public
constructor create(AUDP:TNMUDP;AView:TListView;Dest:String;Port:Integer;ASoc:TSocket;P:TProgressBar;M:TMemo);
destructor destroy;override;
protected
procedure Execute;
override;
end;

Procedure WaitForFReceiving;
implementation

{ TReceiveFileThread }
constructor TReceiveFileThread.create(AUDP:TNMUDP;AView:TListView;Dest:string;Port:Integer;ASoc:TSocket;P:TProgressBar;M:TMemo);
begin
inherited create(true);
LocalUDP:=AUDP;
LisenPort:=Port;
LiseSocket:=ASoc;
DestDir:=Dest;
StaBar:=m;
ProBar:=P;
ListView:=AView;
freeonterminate :=true;
resume;
end;

destructor TReceiveFileThread.destroy;
begin
if ReceSocket<>INVALID_SOCKET then
begin
closesocket(ReceSocket);
end;
postmessage(MainFrm.Handle,wm_prothreaddonmsg,self.ThreadID,0);
inherited destroy;
end;

procedure TReceiveFileThread.Execute;
{Place thread code here }
Const
BlockLen=1024*4;
var
Ftrans:File of Byte;
sa:SOCKADDR_IN;
salen:integer;
begin
sa.sin_family:=PF_INET;
sa.sin_port:=htons(Lisenport);
sa.sin_addr.S_addr:=INADDR_ANY;
salen:=sizeof(sa);
ReceSocket:=accept(Lisesocket,@sa,@Salen);
if ReceSocket<>INVALID_SOCKET then
begin
// 创建接受Socket成功;
ReceFile;
end;
end;

end.
 
怎么没有人回答啊,有没有高手啊.

 
我一般解决CPU占用率的方法,要不后台线程退出,可以减低CPU占用率,要不用信号触发线程,或者用信号当作时钟使用,定时扫描,或者一个线程定时扫描,来触发其他线程。不知是否有帮助
 
to:一只没有缺点的狼
我想知道是什么原因.为何线程结束后,CPU仍被占用.
 
确定一个线程结束了没有,好像不是那么简单,如果你认为线程已经结束了,但是CPU的占用率还是很高,可能你的线程并没有结束啊,你看看代码是不是线程已经正常结束了
 
我在destroy中加入跟踪的代码,可以确认该destroy过程的确被执行.
另外:
1.传输结束后CPU仍被占用只在发送端,而接收端无此现象.
2.发送端是采用了2层线程调用方式:即主程序-->主线程--->子线程
3.接受端采用1层线程:主程序-->子线程
不知道这种差别,对于会引占用CPU的麻烦吗?


 
-->2.发送端是采用了2层线程调用方式:即主程序-->主线程--->子线程
so, 确保子线程也结束了先
 
说的不一定对,这段代码可能有问题,当传送完后terminated应设成true;
while (not terminated) and (i<=FNames.count-1) do
begin
if FileExists(FNames) then
begin
{for muti person sending}
Inc(Fi);
SetLength(FSender,Fi);
FSender[Fi-1]:=TSendFileThread.create(MainFrm.ListView2,FNames,Topics,RPort,RName,RIP,ProBar,StaBar);
CurFile:=FNames;
end;
Inc(i);
 

Similar threads

后退
顶部