关于多线程的请教(200分)

  • 主题发起人 主题发起人 zmj94
  • 开始时间 开始时间
Z

zmj94

Unregistered / Unconfirmed
GUEST, unregistred user!
下面的多线程一运行，就死循环，如何修改？
如何释放该线程，还有，每个线程都是调用idtcplient1控件，这会不会产生冲突，如何解决？谢谢！！！
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
type
TBounceThread = class(TThread)
Private
SClient:TIdTCPClient;
Smail:string;
Shost:string;
Sport:integer;
Shelo:string;
Sfrom:string;
Srcpt:string;
Procedure
SmtpOut;
{ Private declarations }
Protected
procedure Execute;Override;
public Constructor Create(Suspended:Boolean;SmtpClient:TIdTCPClient;Smtpmail:string;Smtphost:string;Smtpport:integer;Smtphelo:string;Smtpfrom:string;Smtprcpt:string);
end;

implementation
Procedure TBounceThRead.SmtpOut;
var
EmlFile: TFileStream;
begin
try
try
EmlFile := TFileStream.Create(Smail, fmOpenRead or fmShareDenyWrite);
SClient.Host:=Shost;
SClient.Port:=Sport;
SClient.Connect;
SClient.SendCmd(Shelo);
SClient.SendCmd(Sfrom);
SClient.SendCmd(Srcpt);
SClient.SendCmd('data');
SClient.WriteStream(EmlFile,true);
SClient.Disconnect;
EmlFile.Free;
finally
//发送完毕，释放线程?
end;
except
begin
//发送不出去，释放线程?
end;
end;
end;

procedure TBounceThread.Execute;
begin
While Not TerMinateddo
begin
Synchronize(SmtpOut);
//同步过程
end;
end;

Constructor TBounceThRead.Create(Suspended:Boolean;SmtpClient:TIdTCPClient;Smtpmail:string;Smtphost:string;Smtpport:integer;Smtphelo:string;Smtpfrom:string;Smtprcpt:string);
begin
inherited Create(Suspended);
SClient:=SmtpClient;
Smail:=Smtpmail;
Shost:=Smtphost;
Sport:=Smtpport;
Shelo:=Smtphelo;
Sfrom:=Smtpfrom;
Srcpt:=Smtprcpt;
FreeOnTerminate:=True;
//线程对象自动释放（FreeOnTerminate）为True
end;
end.

Unit1调用多线程：
procedure TForm1.Button1Click(Sender: TObject);
begin
TBounceThread.Create(false,IdTCPClient1,'1.eml','192.168.0.1',25,'helo','user@china.com','user2@mail.com');
end;
 
>死循环 如何修改？
把 While Not TerMinateddo
一句去掉。
》如何释放该线程
在CREATE或EXECUTE时设置FreeOnTerminate := True;线程执行完后自动FREE。
>每个线程都是调用idtcplient1控件，这会不会产生冲突
用Synchronize同步后应该不会。
不过，你的线程会直接在主线程中执行所有代码，没有多线程的意义。你
可以考虑每个线程创建一个idtcplient1，然后不用Synchronize。
 
Constructor TBounceThRead.Create(Suspended:Boolean;SmtpClient:TIdTCPClient;Smtpmail:string;Smtphost:string;Smtpport:integer;Smtphelo:string;Smtpfrom:string;Smtprcpt:string);
begin
inherited Create(Suspended);
SClient := TIdTCPClient.Create(...);//创建
SClient.Assign(SmtpClient);//不一定是Assign了，反正是把SmtpClient的属性复制，相当于把SMTPClient拷贝了一份
Smail:=Smtpmail;
Shost:=Smtphost;
Sport:=Smtpport;
Shelo:=Smtphelo;
Sfrom:=Smtpfrom;
Srcpt:=Smtprcpt;
FreeOnTerminate:=True;
//线程对象自动释放（FreeOnTerminate）为True
end;
end.

procedure TBounceThread.Execute;
begin
SmtpOut;
end;

由于没有 While Not Terminateddo
语句，这个线程无法中止，你可以稍加一点中止
检测：
Procedure TBounceThRead.SmtpOut;
var
EmlFile: TFileStream;
begin
try
try
EmlFile := TFileStream.Create(Smail, fmOpenRead or fmShareDenyWrite);
SClient.Host:=Shost;
SClient.Port:=Sport;
if Terminated then
Exit;//检测中止
SClient.Connect;
if Terminated then
Exit;//检测中止
SClient.SendCmd(Shelo);
if Terminated then
Exit;//检测中止
SClient.SendCmd(Sfrom);
if Terminated then
Exit;//检测中止
SClient.SendCmd(Srcpt);
if Terminated then
Exit;//检测中止
SClient.SendCmd('data');
if Terminated then
Exit;//检测中止
SClient.WriteStream(EmlFile,true);
SClient.Disconnect;
finally
if SClient.Connected then
//如果中止，要断开连接
SClient.Disconnect;
EmlFile.Free;
//发送完毕，释放线程?
end;
except
begin
//发送不出去，释放线程?
end;
end;
end;

 
谢谢Huzzz,
"不过，你的线程会直接在主线程中执行所有代码，没有多线程的意义。你
可以考虑每个线程创建一个idtcplient1，然后不用Synchronize。"
如何修改成每个线程创建一个idtcplient1？是不是一个线程就要放一个idtcplient控件？
我用此多线程的本意是用户每触发特定的事件时，就调用idtcplient发送信息，
由于同时会有很多用户调用idtcplient发送信息，所以需写成多线程，每个用户
用自己的线程发送，如何修改才能达到高效率？谢谢！！！
 
对了》SClient := TIdTCPClient.Create(...);//创建
忘记FREE了，你要在线程退出时（或在finally中）执行SClient.Free;
procedure TBounceThread.Execute;
begin
try
SmtpOut;
finally
SClient.Free;
end;
end;
 
谢谢，
1、SClient := TIdTCPClient.Create(...);//创建
创建sclient要用到什么参数，这句编译不过去？
2、SClient.Assign(SmtpClient);//不一定是Assign了，反正是把SmtpClient的属性复制，相当于把SMTPClient拷贝了一份
是不是我所需要的smtpclient的属性，如：connect,host,port等属性都要复制？
 
1、SClient := TIdTCPClient.Create(nil);//创建
2、是不是我所需要的smtpclient的属性，如：connect,host,port等属性都要复制？
对，我看了一下，大致是这样写：
with SClientdo
begin
BoundIP := SmtpClient.BoundIP;
Host := SmtpClient.Host;
Port := SmtpClient.Port;
SocksInfo.Assign(SmtpClient.SocksInfo);
UseNagle := SmtpClient.UseNagle;
end;
 
您好，Huzzz：
1、调试通过，一运行出错：'Canvasdo
es not allow drawing'
procedure TBounceThread.Execute;
begin
try
SmtpOut;
finally
SClient.Free;
end;
end;
2、换成下面就可以，为什么，如何修改？
procedure TBounceThread.Execute;
begin
try
Synchronize(SmtpOut);
finally
SClient.Free;
end;
end;
3、是不是只能复制属性（如：host、port），方法不能复制（如：connect,Sendcmd），一复制就调试不通过,
如何修改？我用到了tidtcpclient的host、port属性，connect、sendcmd、writestream、disconect事件。
Constructor TBounceThRead.Create(Suspended:Boolean;SmtpClient:TIdTCPClient;Smtpmail:string;Smtphost:string;Smtpport:integer;Smtphelo:string;Smtpfrom:string;Smtprcpt:string);
begin
inherited Create(Suspended);
SClient := TIdTCPClient.Create(nil);//创建
SClient.Host:=SmtpClient.Host;//把SmtpClient的属性复制，相当于把SMTPClient拷贝了一份
Sclient.Port:=SmtpClient.Port;
//Sclient.Connect:=SmtpClient.Connect;
//Sclient.SendCmd():=SmtpClient.SendCmd();
//Sclient.WriteStream():=SmtpClient.WriteStream();
//Sclient.Disconnect:=SmtpClient.Disconnect;
//SClient:=SmtpClient;
Smail:=Smtpmail;
Shost:=Smtphost;
Sport:=Smtpport;
Shelo:=Smtphelo;
Sfrom:=Smtpfrom;
Srcpt:=Smtprcpt;
FreeOnTerminate:=True;
end;
 
A 这个错误说明还是有线程不安全的东西被共用了，在多个线程中产生了冲突。
你在SmtpOut里单步执行看看哪一句出错。
B 方法不用复制（本身就是一样的方法，程序运行时会指向同一个入口）。
 
就你那几句代码，不应该出错啊！？
 
您好，Huzzz：
但如果用Synchronize(SmtpOut)就不会出错，这和没有用Synchronize有什么影响，
是不是会降低效率，如何修改？
全部代码：
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
type
TBounceThread = class(TThread)
Private
SClient:TIdTCPClient;
Smail:string;
Shost:string;
Sport:integer;
Shelo:string;
Sfrom:string;
Srcpt:string;
Procedure
SmtpOut;
{ Private declarations }
Protected
procedure Execute;Override;
public Constructor Create(Suspended:Boolean;SmtpClient:TIdTCPClient;Smtpmail:string;Smtphost:string;Smtpport:integer;Smtphelo:string;Smtpfrom:string;Smtprcpt:string);
end;

implementation
Procedure TBounceThRead.SmtpOut;
var
EmlFile: TFileStream;
begin
try
try
EmlFile := TFileStream.Create(Smail, fmOpenRead or fmShareDenyWrite);
//showmessage(Smail+'/'+shost+'/'+inttostr(sport)+'/'+shelo+'/'+sfrom+'/'+srcpt);
SClient.Host:=Shost;
SClient.Port:=Sport;
if Terminated then
Exit;//检测中止
SClient.Connect;
SClient.SendCmd(Shelo);
if Terminated then
Exit;//检测中止
SClient.SendCmd(Sfrom);
if Terminated then
Exit;//检测中止
SClient.SendCmd(Srcpt);
if Terminated then
Exit;//检测中止
SClient.WriteStream(EmlFile,true);
if Terminated then
Exit;//检测中止
EmlFile.Free;
if Terminated then
Exit;//检测中止
finally //发送完毕，释放线程
begin
if SClient.Connected then
//如果中止，要断开连接
SClient.Disconnect;
end;
end;
except
begin
showmessage('err');//发送不出去，释放线程。
end;
end;
end;

procedure TBounceThread.Execute;
begin
try
Synchronize(SmtpOut);
finally
SClient.Free;
end;
end;

Constructor TBounceThRead.Create(Suspended:Boolean;SmtpClient:TIdTCPClient;Smtpmail:string;Smtphost:string;Smtpport:integer;Smtphelo:string;Smtpfrom:string;Smtprcpt:string);
begin
inherited Create(Suspended);
SClient:=TIdTCPClient.Create(nil);//创建
SClient.Host := SmtpClient.Host;//把SmtpClient的属性复制，相当于把SMTPClient拷贝了一份
SClient.Port := SmtpClient.Port;
//SClient:=SmtpClient;
Smail:=Smtpmail;
Shost:=Smtphost;
Sport:=Smtpport;
Shelo:=Smtphelo;
Sfrom:=Smtpfrom;
Srcpt:=Smtprcpt;
FreeOnTerminate:=True;
end;
end.

Unit1调用多线程：
procedure TForm1.Button1Click(Sender: TObject);
begin
TBounceThread.Create(false,IdTCPClient1,'1.eml','192.168.0.1',25,'helo','user@china.com','user2@mail.com');
end;
 
不会是循环单元的问题吧？
我以前有出错，不过和你不一样，后来才发现是循环单元的问题。[:)]
 
>这和没有用Synchronize有什么影响
影响很大，这个方法会发一个消息给主线程，告诉主线程要执行一个过程，过程的地址
也在消息里，然后本线程会等待主线程执行完才继续。
相当于全部代码都在主线程中执行，可以达到避免共享冲突的问题。
》是不是会降低效率：当然了。
》如何修改？
我先看看吧。
 
谢谢Huzzz，等待您的结果！
 
to zmj94:
SClient.Connect;连接不上，怎么连接？你的Form1是怎么写的，要加什么控件？
 
我不会连接！！
1 17:59:16 Start: e:/1.eml/192.168.0.1/25/helo/user@china.com/user2@mail.com
1 17:59:16 Open Emlfile...
1 17:59:16 Connect...
1 17:59:44 Error: Socket Error # 10060
Connection timed out.
 
我去看它的DEMO先
 
您好，From1加了Indy client下的IdTCPClient控件
E：/1.eml随便一个文件、
 
我试了，没有问题，下面是4个线程同时运行的日志：
Thread_1 - 19:07:54 Start: e:/1.eml/127.0.0.1/8090/helo/user@china.com/user2@mail.com
Thread_1 - 19:07:54 Open Emlfile...
Thread_1 - 19:07:54 Connect...
Thread_1 - 19:07:54 Send Hello...
Thread_2 - 19:07:54 Start: e:/1.eml/127.0.0.1/8090/helo/user@china.com/user2@mail.com
Thread_2 - 19:07:54 Open Emlfile...
Thread_2 - 19:07:54 Connect...
Thread_2 - 19:07:54 Send Hello...
Thread_3 - 19:07:54 Start: e:/1.eml/127.0.0.1/8090/helo/user@china.com/user2@mail.com
Thread_3 - 19:07:54 Open Emlfile...
Thread_3 - 19:07:54 Connect...
Thread_3 - 19:07:54 Send Hello...
Thread_4 - 19:07:54 Start: e:/1.eml/127.0.0.1/8090/helo/user@china.com/user2@mail.com
Thread_4 - 19:07:54 Open Emlfile...
Thread_4 - 19:07:54 Connect...
Thread_4 - 19:07:54 Send Hello...
Thread_1 - 19:07:54 Send From...
Thread_2 - 19:07:54 Send From...
Thread_4 - 19:07:54 Send From...
Thread_1 - 19:07:54 Send Scrpt...
Thread_4 - 19:07:54 Send Scrpt...
Thread_3 - 19:07:54 Send From...
Thread_1 - 19:07:54 Send File...
Thread_2 - 19:07:54 Send Scrpt...
Thread_4 - 19:07:54 Send File...
Thread_3 - 19:07:54 Send Scrpt...
Thread_2 - 19:07:54 Send File...
Thread_3 - 19:07:54 Send File...
Thread_4 - 19:07:55 Ending...
Thread_4 - 19:07:55 End
Thread_4 - 19:07:55 Disconnect
Thread_1 - 19:07:55 Ending...
Thread_1 - 19:07:55 End
Thread_1 - 19:07:55 Disconnect
Thread_2 - 19:07:56 Ending...
Thread_2 - 19:07:56 End
Thread_2 - 19:07:56 Disconnect
Thread_3 - 19:07:56 Ending...
Thread_3 - 19:07:56 End
Thread_3 - 19:07:56 Disconnect
 
Huzzz：告诉我您的邮箱，我把整个程序压缩后寄给您，您再帮我查查。
 
您必须登录或注册才可回复。

Similar threads

I
提高分布式多层系统的效率之二（Pooler）
回复
0
查看
754
import
I
P
timer中关闭，启动线程的问题！请大家帮忙(200)
回复
3
查看
2K
skyccf
S
S
高手请教：把需要接收消息的过程中代码转为线程类或线程函执行(100)
回复
4
查看
1K
wql
W
I
(200分)请问一下，在多线程中当关闭主程序是如何快速结束所有子线程（其中有一些线程在等待状态，无法正常退出此线程)(200)
回复
4
查看
2K
happycyp
H
菜
请教一下多线程的问题(100)
回复
4
查看
1K
hs-kill
H
后退
顶部