delphi TServerSocket阻塞线程单元 实例
TServerSocket阻塞线程单元,希望对你有所帮助。需要注意的是:
1、如果你使用TServerSocket的stNonBlocking模式,重写TServerClientThread线程时要重载
TServerClientThread的ClientExecute过程,写你自己的处理过程;
2、如果在线程内部调用外部的过程,建议使用同步化方法;
3、线程访问线程内部变量的速度远远高于线程访问线程内部变量的速度
如果有问题的话,可以和我联系 Email: rurality@21cn.com
//**********************************************************************************
//说明: TServerSocket阻塞线程
//作者: licwing 时间: 2001-4-21
//Email: rurality@21cn.com
//**********************************************************************************
unit BlockThread;
interface
uses SysUtils, Windows, Messages, Classes, ScktComp,ProxyCnt;
type
TBlockThread = Class(TServerClientThread)
private
FWebClient: TClientSocket; //对web进行数据请求
FWebClientRead: Boolean; //是否可以对web进行数据请求
FRequestInfo: string;
FReceiveInfo: TReceiveInfo; //接收的数据流信息
FRecBytesFromWebSend: Integer; //已接收到的Web数据字节数
FWebSendBytes: Integer; //Web服务器需要发送的总字节数
Receive_buf: array[0..8191] of char; //接收缓冲区
Request_buf: array[0..8191] of char; //发送缓冲区,用来保存客户端的请求数据
Request_buf_bytes: integer; //发送缓冲区已经接收的字节数
FReceiveInfoSaved : boolean ; //接收的数据头信息保存标志
procedure InitThread;
function SetWebClientInfo(FRequestURLInfo: String): boolean;
protected
procedure ClientExecute; override;
procedure DoTerminate; override;
public
constructor Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
destructor Destroy; override;
end;
implementation
//TProxyClientThread
constructor TBlockThread.Create(CreateSuspended: Boolean; ASocket: TServerClientWinSocket);
begin
FWebClient := TClientSocket.Create(nil);
FWebClient.ClientType := ctBlocking;
inherited Create(CreateSuspended,ASocket);
InitThread;
end;
destructor TBlockThread.Destroy;
begin
FWebClient.Free;
inherited Destroy;
end;
procedure TBlockThread.InitThread;
begin
FRecBytesFromWebSend := 0;
FWebSendBytes := 0;
Request_buf_bytes := 0;
FReceiveInfoSaved := false;
FWebClientRead := false;
end;
function TBlockThread.SetWebClientInfo(FRequestURLInfo: String): boolean;
var
URL_info: TURLHostInfo;
FWebFilter: boolean;
begin
URL_info := GetURLHostPort(FRequestURLInfo);
Result := ( URL_info.HostName <> '' ) and ( URL_info.HostPort > 0 );
FWebClient.Port := URL_info.HostPort;
FWebClient.Host := URL_info.HostName;
end;
procedure TBlockThread.DoTerminate;
begin
FRecBytesFromWebSend := 0;
FWebSendBytes := 0;
FRequestInfo := '';
FReceiveInfoSaved := false;
FWebClientRead := false;
inherited DoTerminate;
end;
procedure TBlockThread.ClientExecute;
var
ReceiveStream,
RequestStream: TWinSocketStream;
Rec_Bytes: integer;
begin
//获取和处理命令直到连接或线程结束
while (not Terminated) and (ClientSocket.Connected) do
try //try 1
//创建TWinSocketStream对被代理端进行读写操作
RequestStream := TWinSocketStream.Create(ClientSocket, 60000);
try //try 2
//获取被代理端请求
Request_buf_bytes := RequestStream.Read(Request_buf,8192);
//如果有请求,设置Web端信息
if Request_buf_bytes > 0 then FWebClientRead := SetWebClientInfo(Request_buf);
//Web端通信准备完成,并且访问站点没有被过滤 IfID=1
if FWebClientRead then
begin //IFID=1 begin Then method
try //try 3
//Web端开始通信
ReceiveStream := TWinSocketStream.Create(FWebClient.Socket, 60000);
FWebClient.Active := True;
try //try 4
//向Web端发送请求
ReceiveStream.Write(Request_buf,Request_buf_bytes);
while (not Terminated) and (FWebClient.Socket.Connected) do
begin
//接收Web端返回的数据
Rec_bytes := ReceiveStream.Read(Receive_buf,8192);
Inc(FRecBytesFromWebSend,Rec_bytes);
//保存Web端返回数据的信息
if not FReceiveInfoSaved then
begin
FReceiveInfo := AnalyzeReceiveData(Receive_buf);
FReceiveInfoSaved := FReceiveInfo.ContentInfo.RequestFound;
FWebSendBytes := FReceiveInfo.ContentInfo.ContentSize +
FReceiveInfo.RemoteFileInfo.RemoteFileSize;
end;
//如果被代理端还连接,传送Web端返回的数据
if ClientSocket.Connected then
RequestStream.Write(Receive_buf,Rec_Bytes);
if ( FRecBytesFromWebSend >= FWebSendBytes ) or ( Rec_bytes = 0 )
or not ClientSocket.Connected then FWebClient.Close;
end;
finally //try 4
ReceiveStream.Free;
end;
finally //try 3
ClientSocket.Close;
end;
end //IFID=1 end Then method
else //IFID=1 begin else method
begin//发送拒绝请求信息到客户端
// RequestStream.Write(AccessLimit,sizeof(AccessLimit));
end;
finally //try 2
RequestStream.Free;
Terminate;
end;
except //try 1
// HandleException;
end;
end;
end.
//**********************************************************************************
// TServerSocket阻塞线程调用方法
//**********************************************************************************
procedure TfrmMain.ServerSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread := TBlockThread.Create(false,ClientSocket);
end;
delphi TServerSocket阻塞线程单元 实例的更多相关文章
- Delphi Socket 阻塞线程下为什么不触发OnRead和OnWrite事件
//**********************************************************************************//说明: 阻塞线程下为什么不触 ...
- Delphi中的线程类 - TThread详解
Delphi中的线程类 - TThread详解 2011年06月27日 星期一 20:28 Delphi中有一个线程类TThread是用来实现多线程编程的,这个绝大多数Delphi书藉都有说到,但基本 ...
- Delphi中的线程类(转)
Delphi中的线程类 (转) Delphi中有一个线程类TThread是用来实现多线程编程的,这个绝大多数Delphi书藉都有说到,但基本上都是对 TThread类的几个成员作一简单介绍,再说明一下 ...
- 主窗体里面打开子窗体&&打印饼图《Delphi 6数据库开发典型实例》--图表的绘制
\Delphi 6数据库开发典型实例\图表的绘制 1.在主窗体里面打开子窗体:ShowForm(Tfrm_Print); procedure Tfrm_Main.ShowForm(AFormClass ...
- Delphi ActiveX Form的使用实例
Delphi ActiveX Form的使用实例 By knityster 1. ActiveX控件简介 ActiveX控件也就是一般所说的OCX控件,它是ActiveX技术的一部分. ActiveX ...
- tornado 异步调用系统命令和非阻塞线程池
项目中异步调用 ping 和 nmap 实现对目标 ip 和所在网关的探测 Subprocess.STREAM 不用担心进程返回数据过大造成的死锁, Subprocess.PIPE 会有这个问题. i ...
- 使用runloop阻塞线程的正确写法
使用runloop阻塞线程的正确写法 runloop可以阻塞线程,等待其他线程执行后再执行. 比如: @implementation ViewController{ BOOL end;}…– ( ...
- Delphi调用SQL分页存储过程实例
Delphi调用SQL分页存储过程实例 (-- ::)转载▼ 标签: it 分类: Delphi相关 //-----下面是一个支持任意表的 SQL SERVER2000分页存储过程 //----分页存 ...
- java线程池实例
目的 了解线程池的知识后,写个线程池实例,熟悉多线程开发,建议看jdk线程池源码,跟大师比,才知道差距啊O(∩_∩)O 线程池类 package thread.pool2; impor ...
随机推荐
- 解决“未启用当前数据库的 SQL Server Service Broker,因此查询通知不受支持。如果希望使用通知,请为此数据库启用 Service Broker”错误
转自:http://blog.csdn.net/andrew_wx/article/details/6947317 解决办法: ALTER DATABASE 数据库名称 SET NEW_BROKER ...
- 深入理解ThreadLocal
ThreadLocal是什么 早在JDK 1.2的版本中就提供java.lang.ThreadLocal,ThreadLocal为解决多线程程序的并发问题提供了一种新的思路.使用这个工具类可以很简洁地 ...
- Neutron分析(7)—— neutron-l3-agent HA solutions
1. keepalived vrrp/conntrackd High availability features will be implemented as extensions or driver ...
- HackerRank "Morgan and a String"
I saw the same sub-problem in LeetCode, and there exists a O(n) neat greedy solution: for _ in range ...
- 【PDF】java使用Itext生成pdf文档--详解
[API接口] 一.Itext简介 API地址:javadoc/index.html:如 D:/MyJAR/原JAR包/PDF/itext-5.5.3/itextpdf-5.5.3-javadoc/ ...
- 【转】七个例子帮你更好地理解 CPU 缓存
我的大多数读者都知道缓存是一种快速.小型.存储最近已访问的内存的地方.这个描述相当准确,但是深入处理器缓存如何工作的"枯燥"细节,会对尝试理解程序性能有很大帮助. 在这篇博文中,我 ...
- Django的列表反序
Django虽然是python的web框架,但它不是所有的python特性都支持的. 最近在项目中遇到一个问题,需要在Django中将获得的列表反序排列,一开始我使用的是python的reverse方 ...
- Windows蓝屏后产生的.dmp分析原因
Windows系统电脑出现蓝屏后都会自动重启,重启后电脑屏幕会提示蓝屏的相关信息,此时如果你没有来得及查看,你也可以进入windows7的“事件查看器”(位置为:控制面板--系统和安全--管理工具-- ...
- 启动Memcache,出现memcached: error while loading shared libraries: libevent-1.4.so.1: cannot open shared
1.有可能是装了多个 libevent而导致memcache无法识别哪一个,解决方法就是卸载掉一个libevent 2.只安装了一个libevent,但是也报这个错,解决方法 32位系统下:ln ...
- ADF_General JSF系列1_创建一个简单的JSF Application
2015-02-17 Creatd By BaoXinjian