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