使用BMDThread控件动态创建多线程示例

 BMDThread控件是一套相当成熟的线程控件,使用它可以让你快速的创建、管理线程。
   可以到CSDN或者盒子上下载BMDThread控件。
   下面我们用多线程模拟客户端发送文件的例子来简单认识一下它。
  
   在窗体中放置一个TIDClient,TBMDThread,TBMDThreadGroup.三个TEdit,两个按钮(开始线程,结束线程),一个MEMO用于接受线程结果信息
   功能:使用IDTCPClient向指定服务器发送文件,动态创建线程数量同步发送文件。

开始创建我们的线程单元吧。
新建Unit,保存为ThreadUnit.pas。
在单元接口部分需要引用BMDThread 单元。为了方便下面的代码编写,把Windows,Classes单元也引用。

首先,因为IP,端口,需要创建的线程数都是动态的,所以需要向我们的线程提供。

注: TFileStream.Create 最后一个参数意义:
打开模式:  
fmCreate   :用指定的文件名建立文件,如果文件已经存在则打开它。  
fmOpenRead   :以只读方式打开指定文件  
fmOpenWrite   :以只写方式打开指定文件  
fmOpenReadWrite:以写写方式打开指定文件  
共享模式:  
fmShareCompat   :共享模式与FCBs兼容  
fmShareExclusive:不允许别的程序以任何方式打开该文件  
fmShareDenyWrite:不允许别的程序以写方式打开该文件  
fmShareDenyRead   :不允许别的程序以读方式打开该文件  
fmShareDenyNone   :别的程序可以以任何方式打开该文件

代码如下:

ExpandedBlockStart.gif 代码
unit  ThreadUnit;

interface
uses
Windows, Classes, SysUtils, BMDThread, IdTCPClient;

type

    TSendMsg 
=   procedure (Owner: TObject; ThreadID: Integer; Msg:  string of   object ;

    TSendThread
=   class (TBMDThread)
      
private
        FHost: 
string ;
        FPort: Integer;
        FThreadID: integer;
        FSendmsg: 
string ;
        FOnSendMsg: TSendMsg;
        
procedure  DoSend;
        
procedure  SetSendMsg( const  Value: TSendMsg);
      
protected
         
procedure  Execute();  override ;
         
procedure  DoSendMsg(Sender: TObject);
      
public
        
constructor  Create(Owner: TComponent; Host:  string ; Port, ThreadID: Integer);
        
destructor  Destroy();  override ;
        
property  OnSendMsg: TSendMsg  read  FOnSendMsg  write  SetSendMsg;
    
end ;

implementation

{  TSendThread  }

constructor  TSendThread.Create(Owner: TComponent; Host:  string ; Port, ThreadID: Integer);
begin
FHost:
=  Host;
FPort:
=  Port;
FThreadID:
=  ThreadID;
inherited  Create(Owner);
end ;

destructor  TSendThread.Destroy;
begin
inherited ;
end ;

procedure  TSendThread.DoSend;
var
IdTCPClient:TIdTCPClient;
fs:TFileStream;
FileName: 
string ;
begin
inherited ;
try
    FileName:
=   ' E:\text.txt ' ;
    
try
      IdTCPClient :
=  TIdTCPClient.Create( nil );
      
try
        IdTCPClient.Host :
=  FHost;
        IdTCPClient.Port :
=  FPort;
        IdTCPClient.Connect;
        fs:
=  TFileStream.Create(FileName, FmOpenRead  or  fmShareDenyNone);
        fs.Position:
=   0 ;
        fs.Seek(
0 0  );
        IdTCPClient.WriteLn(
' <SEND> '   +  FileName);
        IdTCPClient.WriteStream(fs);
        FSendmsg :
=   ' 发送成功 ' ;
        Thread.Synchronize(DoSendMsg);
      
except  on E: Exception  do
        
begin
          FSendmsg :
=   ' 连接错误: '   +  e.Message;
          Thread.Synchronize(DoSendMsg);
        
end ;
      
end ;
    
finally
      FreeAndNil(fs);
      IdTCPClient.Disconnect;
      IdTCPClient.free;
    
end ;
except

end ;
end ;

procedure  TSendThread.DoSendMsg(Sender: TObject);
begin
if  Assigned(FOnSendMsg)  then
    FOnSendMsg(Sender, FThreadID, FSendmsg);
end ;

procedure  TSendThread.Execute;
begin
// while   not  Thread.Terminated DO  // 如果你想你的代码一直进行下去直至线程结束,可以这么做
    doSend;
end ;

procedure  TSendThread.SetSendMsg( const  Value: TSendMsg);
begin
FOnSendMsg:
=  Value;
end ;

end .

 

主单元代码:

ExpandedBlockStart.gif 代码
unit  MainUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, BMDThread;

type
TForm1 
=   class (TForm)
    BMDThread1: TBMDThread;
    BMDThreadGroup1: TBMDThreadGroup;
    IdTCPClient1: TIdTCPClient;
    edt_Host: TEdit;
    lbl1: TLabel;
    lbl2: TLabel;
    edt_Port: TEdit;
    lbl3: TLabel;
    edt_Count: TEdit;
    btn_Send: TButton;
    btn_Stop: TButton;
    mmo1: TMemo;
    btn1: TButton;
    
procedure  btn_SendClick(Sender: TObject);
    
procedure  GetMsg(Sender: TObject; ThreadID: Integer; Msg:  string );
    
procedure  btn_StopClick(Sender: TObject);
    
procedure  btn1Click(Sender: TObject);
private
    
{  Private declarations  }
public
    
{  Public declarations  }
end ;

var
Form1: TForm1;

implementation
uses  ThreadUnit;
{ $R *.dfm }

procedure  TForm1.btn_SendClick(Sender: TObject);
var
i: Integer;
SendThread: TSendThread;
begin
btn_Stop.Click;
for  i: =   1   to  StrToInt(edt_Count.Text)  do
begin
    SendThread:
=  TSendThread.Create(Self,edt_Host.Text, StrToInt(edt_Port.Text),I);
    
try
      SendThread.ThreadGroup:
=  BMDThreadGroup1;
      SendThread.OnSendMsg:
=  GetMsg;
    
except
      SendThread.Free;
    
end ;
end ;
for  i: =   0   to  BMDThreadGroup1.ThreadsCount  -   1   do
begin
    SendThread:
=  TSendThread(BMDThreadGroup1.ThreadItems[i]) ;
    
try
      SendThread.Start ;
    
except
      On E: Exception 
do
      
begin
        SendThread.Stop ;
        SendThread.Thread.WaitFor;
      
end ;
    
end ;
end ;
end ;

procedure  TForm1.GetMsg(Sender: TObject; ThreadID: Integer; Msg:  string );
begin
mmo1.Lines.Add(FormatDateTime(
' yyyy-mm-dd hh:mm:ss ' ,Now)  +   '  线程ID: '   +  IntToStr(ThreadID) +  Msg);
end ;

procedure  TForm1.btn_StopClick(Sender: TObject);
var
SendThread: TBMDThread;
begin
BMDThreadGroup1.Stop() ;
while  BMDThreadGroup1.ThreadsCount  >   0   do
begin
    SendThread:
=  BMDThreadGroup1.Threads[BMDThreadGroup1.ThreadsCount  - 1 ] ;
    
try
      
if  SendThread.Thread  <>   nil   then
      
begin
        SendThread.Stop() ;
        SendThread.Thread.WaitFor ;
      
end ;
    
except
    
end ;
    BMDThreadGroup1.RemoveThread(SendThread);
end ;
end ;

procedure  TForm1.btn1Click(Sender: TObject);
begin
mmo1.Clear;
end ;

end .

 

 

 

转载于:https://www.cnblogs.com/rogee/archive/2010/09/20/1832032.html

相关资源:BMDThread(D6-xe10).rar
表情包
插入表情
评论将由博主筛选后显示,对所有人可见 | 还能输入1000个字符
相关推荐
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页