delphi 把多个线程的请求阻塞到另一个线程 TElegantThread
本例是把多个线程访问数据库的请求,全部阻塞到一个线程。
这是实际编程中常见的一种问题。
示例源码下载,所需支持单元均在源码中,且附详细说明。
TElegantThread 的父类是 TSimpleThread。
unit uElegantThread; interface uses
Classes, SysUtils, uSimpleThread, uSimpleList, uSyncObjs; type PSyncRec = ^TSyncRec; TSyncRec = record
FMethod: TThreadMethod;
FProcedure: TThreadProcedure;
FSignal: TSuperEvent;
Queued: boolean;
DebugInfo: string;
end; TSyncRecList = Class(TSimpleList<PSyncRec>)
protected
procedure FreeItem(Item: PSyncRec); override;
End; TElegantThread = class(TSimpleThread)
private
FSyncRecList: TSyncRecList; procedure LockList;
procedure UnlockList; procedure Check;
procedure DoCheck; public // AAllowedActiveX 允许此线程访问 COM 如:IE ,
// 当然,获取 Ie 的 IHtmlDocument2 接口,也必须在此线程内执行
constructor Create(AAllowedActiveX: boolean = false);
destructor Destroy; override; // ADebugInfo 是调用者用来查错用,一般可以写上过程名 如:'DoSomeThing';
procedure Queue(AMethod: TThreadMethod; ADebugInfo: string = ''); overload;
procedure Queue(AProcedure: TThreadProcedure; ADebugInfo: string = ''); overload; procedure Synchronize(AMethod: TThreadMethod; ADebugInfo: string = ''); overload;
procedure Synchronize(AProcedure: TThreadProcedure; ADebugInfo: string = ''); overload; end; implementation { TSyncRecList } procedure TSyncRecList.FreeItem(Item: PSyncRec);
begin
inherited;
if Assigned(Item.FSignal) then
Item.FSignal.Free;
Dispose(Item);
end; { TElegantThread } procedure TElegantThread.Check;
begin
ExeProcInThread(DoCheck);
end; constructor TElegantThread.Create(AAllowedActiveX: boolean);
begin
inherited;
FSyncRecList := TSyncRecList.Create;
end; destructor TElegantThread.Destroy;
begin
WaitThreadStop;
FSyncRecList.Free;
inherited;
end; procedure TElegantThread.DoCheck;
var
p: PSyncRec;
sErrMsg: string;
begin LockList;
try
p := FSyncRecList.PopFirst; // 每次从 List 取出一个过程来执行
finally
UnlockList;
end; if Assigned(p) then
begin try if Assigned(p.FMethod) then
p.FMethod // 执行
else if Assigned(p.FProcedure) then
p.FProcedure(); // 执行 except
on E: Exception do // 错误处理
begin
sErrMsg := 'DebugInfo:' + p.DebugInfo + ##;
sErrMsg := sErrMsg + 'ErrMsg:' + E.Message;
DoOnDebugMsg(sErrMsg);
end;
end; if not p.Queued then // 如果是阻塞,请设为有信号,调用者即可返回
begin
p.FSignal.SetEvent;
end; Dispose(p);
Check; // 继续下一次 DoCheck,也就是本过程。
// 父类 TSimpleThread 已特殊处理,不会递归。 end; end; procedure TElegantThread.LockList;
begin
FSyncRecList.Lock;
end; procedure TElegantThread.Queue(AMethod: TThreadMethod; ADebugInfo: string);
var
p: PSyncRec;
begin
// 此过程为排队执行 new(p);
p.FProcedure := nil;
p.FMethod := AMethod;
p.Queued := true; LockList;
try
FSyncRecList.Add(p); // 把要执行的过程加入 List
Check; // 启动线程
finally
UnlockList;
end; end; procedure TElegantThread.Queue(AProcedure: TThreadProcedure; ADebugInfo: string);
var
p: PSyncRec;
begin
new(p);
p.FProcedure := AProcedure;
p.FMethod := nil;
p.Queued := true;
LockList;
try
FSyncRecList.Add(p);
Check;
finally
UnlockList;
end;
end; procedure TElegantThread.Synchronize(AMethod: TThreadMethod; ADebugInfo: string);
var
p: PSyncRec;
o: TSuperEvent;
begin // 此过程为阻塞执行,即调用者必须等到此过程被执行完成才能返回 new(p); p.FProcedure := nil;
p.FMethod := AMethod;
p.Queued := false;
p.FSignal := TSuperEvent.Create; // 创建一个信号
p.FSignal.ResetEvent; // 清除信号
o := p.FSignal; LockList;
try
FSyncRecList.Add(p);
Check;
finally
UnlockList;
end; o.WaitFor; // 等待信号出现
o.Free; end; procedure TElegantThread.Synchronize(AProcedure: TThreadProcedure; ADebugInfo: string);
var
p: PSyncRec;
o: TSuperEvent;
begin
new(p); p.FProcedure := AProcedure;
p.FMethod := nil;
p.Queued := false;
p.FSignal := TSuperEvent.Create;
p.FSignal.ResetEvent;
o := p.FSignal; LockList;
try
FSyncRecList.Add(p);
Check;
finally
UnlockList;
end; o.WaitFor;
o.Free; end; procedure TElegantThread.UnlockList;
begin
FSyncRecList.Unlock;
end; end. uElegantThread.pas
http://www.cnblogs.com/lackey/p/4782777.html
delphi 把多个线程的请求阻塞到另一个线程 TElegantThread的更多相关文章
- java的服务是每收到一个请求就新开一个线程来处理吗?tomcat呢?
首先,服务器的实现不止有这两种方式. 先谈谈题主说的这两种服务器模型: 1.收到一个请求就处理,这个时候就不能处理新的请求,这种为阻塞 这个是单线程模型,无法并发,一个请求没处理完服务器就会阻塞,不会 ...
- 对tomcat来说,每一个进来的请求(request)都需要一个线程,直到该请求结束。
这段时间折腾了哈java web应用的压力测试,部署容器是tomcat 7.期间学到了蛮多散碎的知识点,及时梳理总结,构建良好且易理解的知识架构把它们组织起来,以备忘.对web应用开发者来说,我们很关 ...
- python笔记9-多线程Threading之阻塞(join)和守护线程(setDaemon)
python笔记9-多线程Threading之阻塞(join)和守护线程(setDaemon) 前言 今天小编YOYO请xiaoming和xiaowang吃火锅,吃完火锅的时候会有以下三种场景: - ...
- 开启两个线程,一个线程打印A~Z,一个线程打印1~52的数据
开启两个线程,一个线程打印A-Z,一个线程打印1-52的数据 import java.util.concurrent.locks.Condition; import java.util.concurr ...
- 死磕 java线程系列之自己动手写一个线程池
欢迎关注我的公众号"彤哥读源码",查看更多源码系列文章, 与彤哥一起畅游源码的海洋. (手机横屏看源码更方便) 问题 (1)自己动手写一个线程池需要考虑哪些因素? (2)自己动手写 ...
- 死磕 java线程系列之自己动手写一个线程池(续)
(手机横屏看源码更方便) 问题 (1)自己动手写的线程池如何支持带返回值的任务呢? (2)如果任务执行的过程中抛出异常了该怎么处理呢? 简介 上一章我们自己动手写了一个线程池,但是它是不支持带返回值的 ...
- 两个线程,一个线程打印1~52,另一个线程打印字母A-Z,打印顺序为12A34B56C……5152Z
使用wait,notify实现 public class Test { public synchronized void a() { for (int i = 1; i <= 52; i++) ...
- Java线程唤醒与阻塞
阻塞指的是暂停一个线程的执行以等待某个条件发生(如某资源就绪),学过操作系统的同学对它一 定已经很熟悉了.Java 提供了大量方法来支持阻塞,下面让我们逐一分析. 转载于:http://blog.cs ...
- jmeter 线程数—请求数详解
一个性能测试请求负载是基于一个线程组完成的.一个测试计划必须有一个线程组.测试计划添加线程组非常简单.在测试计划右键弹出下拉菜单(添加-->Threads(Users)--->线程组)中选 ...
随机推荐
- ubuntu下安装fiddler
因为工作中需要用到fiddler工具 现在工作环境迁移到ubuntu14 下 发现fiddler只支持windows网上也有很多推荐 号称可以代替fiddler 但因为功能使用上比较习惯 并 ...
- mysql服务的注册,启动、停止、注销。 [delphi代码实现]
unit Service; interface uses Windows,Classes,SysUtils,Winsvc,winsock; Type {服务句柄信息} TScmInfo=Record ...
- 【转】ubuntu下putty的复制粘贴 -- 不错
原文网址:http://www.nwber.com/?p=165 今天在ubutnu下想用putty玩玩,突然发现在windows里直接点击右键的复制居然不管用了,调设置也没有用.这可麻烦了,要是手动 ...
- 如何为WPF添加Main()函数 程序入口点的修改
一般的.WPF的Main()函数是自动生成的,不过有时候我们需要为我们的应用程序传参.那么自动生成的Main()函数就不会满足我们的要求. 那么如何为WPF Application 设置Main()函 ...
- Grunt制作个人博客简集
原文:http://www.gbtags.com/gb/share/4916.htm GitHub地址:http://yansm.github.io/fromone/
- 剑指offer-面试题4.替换空格
题目:请实现一个函数,把字符串中的每个空格都替换成"%20".例如输入"We are happy." 则输出"We%20are%20happy.&qu ...
- python模拟Get请求保存网易歌曲的url
python模拟Get请求保存网易歌曲的url 作者:vpoet mail:vpoet_sir@163.com 日期:大约在夏季 #coding:utf-8 import requests impor ...
- poj 2377 Bad Cowtractors(最大生成树!)
Description Bessie has been hired to build a cheap internet network among Farmer John's N (2 <= N ...
- [记录]关于vertical-align单/多选框与说明文字对齐效果
效果图: 第一张使用label标签,第二张没有使用.. 使用label标签,middle对齐方式的单选框下降了1px 而没有使用label标签,sub对齐方式的 却 居 中 了 =_= 不太理解 ...
- 转:C#: static关键字的作用
tatic意思是静态,可以修饰类.字段.属性.方法 标记为static的就不用创建实例对象调用了,可以通过类名直接点出来 static三种用法: 1.用于变量前,表示每次重新使用该变量所在方法.类或自 ...