dlmain.~pas

HTTP代理服务器修改后的增强源码。用Delphi自身待的控件实现。

unit dlmain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent,
  IdTCPServer, ScktComp, StdCtrls, Menus, ExtCtrls;

type
   abuf=array[0..2048] of char;
   session_record=record
      Used: boolean;                       {会话记录是否可用}
      SS_Handle: integer;                  {代理服务器套接字句柄}
      CSocket:  TClientSocket;             {用于连接远程的套接字}
      Lookingup: boolean;                  {是否正在查找服务器}
      LookupTime: integer;                 {查找服务器时间}
      Request: boolean;                    {是否有请求}
      request_str: string;                 {请求数据块}
      reqbuf:abuf;          {请求数据块}
      reqcount:integer;     {数据大小}
      client_connected: boolean;           {客户机联机标志}
      remote_connected: boolean;           {远程服务器连接标志}
end;
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    ServerSocket1: TServerSocket;
    Timer1: TTimer;
    Timer2: TTimer;
    PopupMenu1: TPopupMenu;
    Memo1: TMemo;
    Edit1: TEdit;
    Label1: TLabel;
    n11: TMenuItem;
    n21: TMenuItem;
    n1: TMenuItem;
    n01: TMenuItem;
    procedure Timer2Timer(Sender: TObject);
    procedure AppException(Sender: TObject; E: Exception);
    procedure n11Click(Sender: TObject);
    procedure n21Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure n01Click(Sender: TObject);
    procedure ServerSocket1Listen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Write(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
        Service_Enabled: boolean;           {代理服务是否开启}
    session: array of session_record;      {会话数组}
    sessions: integer;                  {会话数}
    LookUpTimeOut: integer;           {连接超时值}
    InvalidRequests: integer;            {无效请求数}
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer2Timer(Sender: TObject);
begin
   timer2.Enabled:=false;     {关闭定时器}
   sessions:=0;               {会话数=0}
   Application.OnException := AppException;     {为了屏蔽代理服务器出现的异常}
   invalidRequests:=0;           {0错误}
   LookUpTimeOut:=60000;      {超时值=1分钟  单位秒}
   timer1.Enabled:=true;         {打开定时器}
   n11.Enabled:=false;           {开启服务菜单项失效}
   n21.Enabled:=true;           {关闭服务菜单项有效}
   serversocket1.Port:=808;      {代理服务器端口=988}
   serversocket1.Active:=true;    {开启服务}
   //form1.hide;                 {隐藏界面，缩小到System Tray上}
end;
//“页面很难找到”等错误信息出现时…
procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
  inc(invalidrequests);
end;

procedure TForm1.n11Click(Sender: TObject);
begin
   serversocket1.Active:=true;    {开启服务}
   //Service_Enabled:=true; 
end;

procedure TForm1.n21Click(Sender: TObject);
begin
   serversocket1.Active:=false;      {停止服务}
   N11.Enabled:=True;
   N21.Enabled:=False;
   Service_Enabled:=false;           {标志清零}
end;

procedure TForm1.FormCreate(Sender: TObject);
//主窗口建立…
begin
   Service_Enabled:=false;
   timer2.Enabled:=true;        {窗口建立时，打开定时器}
end;

//窗口关闭时…
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   timer1.Enabled:=false;          {关闭定时器}
   if Service_Enabled then
      serversocket1.Active:=false;   {退出程式时关闭服务}
end;


procedure TForm1.n01Click(Sender: TObject);
begin
//退出程式
  close;
end;

procedure TForm1.ServerSocket1Listen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   //开启代理服务后…
   Service_Enabled:=true;            {置正在服务标志}
   N11.Enabled:=false;
   N21.Enabled:=true;

end;

//被代理端连接到代理服务器后，建立一个会话，并和套接字绑定…
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
i,j: integer;
begin
    memo1.Lines.Add('client conn..............');
   j:=-1;
   for i:=1 to sessions do               {查找是否有空白项}
      if not session[i-1].Used and not session[i-1].CSocket.active then
         begin
            j:=i-1;                      {有，分配他}
            session[j].Used:=true;       {置为在用}
            break;
         end
      else
         if not session[i-1].Used and session[i-1].CSocket.active then
               session[i-1].CSocket.active:=false;
   if j=-1 then
      begin                              {无，新增一个}
         j:=sessions;
         inc(sessions);
         setlength(session,sessions);
         session[j].Used:=true;                        {置为在用}
         session[j].CSocket:=TClientSocket.Create(nil);
         session[j].CSocket.OnConnect:=ClientSocket1Connect;
         session[j].CSocket.OnDisconnect:=ClientSocket1Disconnect;
         session[j].CSocket.OnError:=ClientSocket1Error;
         session[j].CSocket.OnRead:=ClientSocket1Read;
         session[j].CSocket.OnWrite:=ClientSocket1Write;
         session[j].Lookingup:=false;
      end;
   session[j].SS_Handle:=socket.socketHandle;    {保存句柄，实现绑定}
   session[j].Request:=false;                    {无请求}
   session[j].client_connected:=true;            {客户机已连接}
   session[j].remote_connected:=false;           {远程未连接}
   edit1.text:=inttostr(sessions);
end;

//被代理端断开时…
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
i,j,k: integer;
begin
   for i:=1 to sessions do
      if (session[i-1].SS_Handle=socket.SocketHandle) and session[i-1].Used then
         begin
            session[i-1].client_connected:=false;   {客户机未连接}
            if session[i-1].remote_connected then
               session[i-1].CSocket.active:=false   {假如远程尚连接，断开他}
            else
               session[i-1].Used:=false;           {假如两者都断开，则置释放资源标志}
            break;
         end;
   j:=sessions;
   k:=0;
   for i:=1 to j do                        {统计会话数组尾部有几个未用项}
      begin
         if session[j-i].Used then
            break;
         inc(k);
      end;
   if k>0 then                          {修正会话数组，释放尾部未用项}
      begin
         sessions:=sessions-k;
         setlength(session,sessions);
      end;
   edit1.text:=inttostr(sessions);
end;


//通信错误出现时…
procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
var
i,j,k: integer;
begin
   for i:=1 to sessions do
      if (session[i-1].SS_Handle=socket.SocketHandle) and session[i-1].Used then
         begin
            session[i-1].client_connected:=false;   {客户机未连接}
            if session[i-1].remote_connected then
               session[i-1].CSocket.active:=false   {假如远程尚连接，断开他}
            else
               session[i-1].Used:=false;           {假如两者都断开，则置释放资源标志}
            break;
         end;
   j:=sessions;
   k:=0;
   for i:=1 to j do
      begin
         if session[j-i].Used then
            break;
         inc(k);
      end;
   if k>0 then
      begin
         sessions:=sessions-k;
         setlength(session,sessions);
      end;
   edit1.text:=inttostr(sessions);
   errorcode:=0;
end;

procedure dispHex(buf:abuf;m:tmemo;len:integer);
var
  i,k:integer;
  s:string;
begin