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

http://www.cnblogs.com/railgunman/archive/2010/12/08/1900688.html

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: ext.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.

来源：http://www.wesoho.com/article/Delphi/2882.htm