使用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   :别的程序可以以任何方式打开该文件

代码如下：

代码

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 .

 

主单元代码：

代码

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