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: stringof 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(
00 );
        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.

 

 

 

posted on 2010-09-20 20:44  °ι 、曲 终  阅读(555)  评论(0编辑  收藏  举报