使用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.