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阻塞线程单元 实例的更多相关文章

  1. Delphi Socket 阻塞线程下为什么不触发OnRead和OnWrite事件

    //**********************************************************************************//说明: 阻塞线程下为什么不触 ...

  2. Delphi中的线程类 - TThread详解

    Delphi中的线程类 - TThread详解 2011年06月27日 星期一 20:28 Delphi中有一个线程类TThread是用来实现多线程编程的,这个绝大多数Delphi书藉都有说到,但基本 ...

  3. Delphi中的线程类(转)

    Delphi中的线程类 (转) Delphi中有一个线程类TThread是用来实现多线程编程的,这个绝大多数Delphi书藉都有说到,但基本上都是对 TThread类的几个成员作一简单介绍,再说明一下 ...

  4. 主窗体里面打开子窗体&&打印饼图《Delphi 6数据库开发典型实例》--图表的绘制

    \Delphi 6数据库开发典型实例\图表的绘制 1.在主窗体里面打开子窗体:ShowForm(Tfrm_Print); procedure Tfrm_Main.ShowForm(AFormClass ...

  5. Delphi ActiveX Form的使用实例

    Delphi ActiveX Form的使用实例 By knityster 1. ActiveX控件简介 ActiveX控件也就是一般所说的OCX控件,它是ActiveX技术的一部分. ActiveX ...

  6. tornado 异步调用系统命令和非阻塞线程池

    项目中异步调用 ping 和 nmap 实现对目标 ip 和所在网关的探测 Subprocess.STREAM 不用担心进程返回数据过大造成的死锁, Subprocess.PIPE 会有这个问题. i ...

  7. 使用runloop阻塞线程的正确写法

    使用runloop阻塞线程的正确写法 runloop可以阻塞线程,等待其他线程执行后再执行. 比如: @implementation ViewController{    BOOL end;}…– ( ...

  8. Delphi调用SQL分页存储过程实例

    Delphi调用SQL分页存储过程实例 (-- ::)转载▼ 标签: it 分类: Delphi相关 //-----下面是一个支持任意表的 SQL SERVER2000分页存储过程 //----分页存 ...

  9. java线程池实例

    目的         了解线程池的知识后,写个线程池实例,熟悉多线程开发,建议看jdk线程池源码,跟大师比,才知道差距啊O(∩_∩)O 线程池类 package thread.pool2; impor ...

随机推荐

  1. Dom之标签增删操作

    dom操作:THML新增子标签 a标签(appendChild) <!DOCTYPE html><html lang="en"><head> & ...

  2. Apache 性能优化

    有一个升级服务器,这几天一直访问的比较慢.导致部分用户升级不了.看了一下服务器的负载,发现 CPU和内存占用的都不是很高,可能是Apache配置不当造成的,一番搜索,找到了MPM的配置,提速很明显哦 ...

  3. 【java】serialVersionUID作用

    serialVersionUID适用于Java的序列化机制.简单来说,Java的序列化机制是通过判断类的serialVersionUID来验证版本一致性的.在进行反序列化时,JVM会把传来的字节流中的 ...

  4. [mysql] Expression #2 of SELECT list is not in GROUP BY clause and contains nonaggregated column 'loser.tank_admin.login_ip' which is not functionally dependent on columns in GROUP BY clause; this is

    执行SQL: SELECT login_name,login_ip,sex FROM tank_admin GROUP BY login_name ; 时抛出异常. Expression #2 of ...

  5. Servlet Filter 1

    1.Filter简介 )Filter也称之为过滤器,它是Servlet技术中最实用的技术,WEB开发人员通过Filter技术,对web服务器管理的所有web资源:例如Jsp, Servlet, 静态图 ...

  6. json 解析

    纠结了两天的json数组反序列化,终于在同事的帮助下,找到方法了,特作笔记如下: using Newtonsoft.Json; using Newtonsoft.Json.Linq; using Sy ...

  7. tespeed-测试网速的Python工具

    1.安装(环境CentOS7) #pip install lxml #wget wget http://sourceforge.net/projects/socksipy/files/socksipy ...

  8. [Debug]驱动程序调测方法与技巧

    转自:http://blog.csdn.net/lichangc/article/details/43272457 驱动程序开发的一个重大难点就是不易调试.本文目的就是介绍驱动开发中常用的几种直接和间 ...

  9. Java 中Timer和TimerTask 定时器和定时任务使用的例子

    转自:http://blog.csdn.net/kalision/article/details/7692796 这两个类使用起来非常方便,可以完成我们对定时器的绝大多数需求 Timer类是用来执行任 ...

  10. 黄聪:如何阻止iframe里引用的网页自动跳转

    今天做了个网页,要在网页里设置一个iframe,然后套用其他的网站.使用http://luanqi-cat.blogbus.com 这个网址的时候,出现了莫名其妙的问题,我的网页居然会强制自动跳转到这 ...