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.
来源:http://www.wesoho.com/article/Delphi/2882.htm
BMDThread控件动态创建多线程示例的更多相关文章
- 不在界面上用控件 动态创建idhttp,IdAntiFreeze来用
不在界面上用控件 动态创建idhttp,IdAntiFreeze来用 var IdHTTP: Tidhttp; IdAntiFreeze: TidAntiFreeze; begin IdAntiFre ...
- C# DataGridView控件动态添加新行
C# DataGridView控件动态添加新行 DataGridView控件在实际应用中非常实用,特别需要表格显示数据时.可以静态绑定数据源,这样就自动为DataGridView控件添加相应的行.假如 ...
- C# DataGridView控件 动态添加新行
DataGridView控件在实际应用中非常实用,特别需要表格显示数据时.可以静态绑定数据源,这样就自动为DataGridView控件添加相应的行.假如需要动态为DataGridView控件添加新行, ...
- Swift学习之函数和简单地控件的创建
今天还是重复昨天做的事情--敲代码,但唯一的不同就是所学的知识不同了,我们又进一步往深得层次学习了,感觉越来越有意思了,虽然临近结束了看着大家积极性越来越低了,但是我知道我不能这样,我要比别人付出的 ...
- win32 控件的创建和消息响应
1. 控件的创建 控件的创建和窗口创建是一样的,例如: ,,,, hWnd,(HMENU)IDB_BUTTON01,hInst,NULL); 是一个按钮的创建,其中hWnd是窗口句柄,hInst是应用 ...
- Delphi7 第三方控件1stClass4000的TfcImageBtn按钮控件动态加载jpg图片例子
Delphi7 第三方控件1stClass4000的TfcImageBtn按钮控件动态加载jpg图片例子 procedure TForm1.Button1Click(Sender: TObject); ...
- MFC动态创建对话框中的按钮控件并创建其响应消息
转自:http://www.cnblogs.com/huhu0013/p/4626686.html 动态按钮(多个)的创建: 1.在类中声明并定义按钮控件的ID #define IDC_D_BTN 1 ...
- Image控件的简单使用示例1
Image控件加载图片包括加载动态图片,加载静态图片两种方式.一.加载动态图片通过生成一个BitmapImage,创建该对象后,赋给Image的Source即可.加载的形式: 示例1 BitmapIm ...
- DotNetBar RibbonControl 控件动态添加项
想做个插件式开发,界面用Dotnetbar的RibbonControl,需要通过代码动态的向RibbonControl控件添加项 示例代码如下: RibbonTabItem rti = new Rib ...
随机推荐
- jps command not found已解决
根据当前版本安装devel 包 eg: yum install java--openjdk-devel -y jdk小工具jps介绍 jps(Java Virtual Machine Process ...
- e.g.-basic-Si
! Band structure of silicon. The points listed after plot1d below are the ! vertices joined in the b ...
- 有几个Pass,对象就会绘制几次
在每个SubShader内部可以包含多个,至少一个Pass.有几个Pass,对象就会绘制几次.在编写时我们应该尽量控制Pass的数量. 在Pass中包含Cg/HLSL程序片段,在其中编写vertex ...
- 百度Cafe原理--Android自动化测试学习历程
主要讲解内容及笔记: 一.Cafe原理 Cafe是一款自动化测试框架,解决问题:跨进程测试.快速深度测试 官网:http://baiduqa.github.io/Cafe/ Cafe provides ...
- Spring框架的AOP的底层实现
1. Srping框架的AOP技术底层也是采用的代理技术,代理的方式提供了两种 1. 基于JDK的动态代理 * 必须是面向接口的,只有实现了具体接口的类才能生成代理对象 2. 基于CGLIB动态代理 ...
- Linux Doxygen的安装和使用
一.简介 Doxygen是一种开源跨平台的,以类似JavaDoc风格描述的文档系统,完全支持C.C++.Java.Objective-C和IDL语言,部分支持PHP.C#.注释的语法与Qt-Doc.K ...
- linux-Centos 7下mysql 5.7.9的rpm包安装
操作系统:Centos 7.1 mysql数据库版本:mysql5.7.18 1.安装新版mysql之前,我们需要将系统自带的mariadb-lib卸载 [root@123 ~]# rpm -qa|g ...
- git 提交新创建的文件
git add -u:把所有tracked文件中被修改过或已删除文件的信息添加到索引库.它不会处理untracted的文件. 如果想将本地新创建的文件也提交上去,需执行如下操作:
- MyIocp 测试截图
根据 小猪的网络教程 学习了 IOCP 并且自己写了一个命令行版本的 客户端测试还是使用的小猪的代码 有兴趣学习IOCP的 建议去小猪的空间看看 代码思路都讲解的很清楚 推荐 http://blog. ...
- jquery插件解读之tabs
先上代码,符简略关键性说明: /** * jQuery EasyUI 1.4.1 * * Copyright (c) 2009-2014 www.jeasyui.com. All rights re ...