精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● Delphi>>Delphi 网络编程>>用delphi设计代理服务器(winsocket和动态创建控件的例子)

主题:用delphi设计代理服务器(winsocket和动态创建控件的例子)
发信人: teleme(GateWay)
整理人: teleme(2001-03-05 18:04:21), 站内信件
用delphi设计代理服务器(winsocket和动态创建控件的例子)
//************unit1.pas********************
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, ExtCtrls, Menus, StdCtrls;
type
session_record=record
used:boolean;//会话记录是否可用
SS_Handle:integer; //代理服务器套接字句柄
CSocket:Tclientsocket;  //用于远程连接的套接字
Lookingup:boolean;      //是否正在查找服务器
lookuptime:integer;     //查找服务器时间
Request:boolean;        //是否有请求
request_str:string;     //请求数据块
client_connected:boolean;  //客户联机标志
remote_connected:boolean;  //远程服务器连接标志
end;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    ClientSocket1: TClientSocket;
    Timer1: TTimer;
    Timer2: TTimer;
    PopupMenu1: TPopupMenu;
    N11: TMenuItem;
    N21: TMenuItem;
    Memo1: TMemo;
    Edit1: TEdit;
    Close1: TMenuItem;
    N1: TMenuItem;
    Button1: TButton;
    procedure Timer2Timer(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Close1Click(Sender: TObject);
    procedure ServerSocket1Listen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientConnect(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 ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Write(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Lookup(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 Timer1Timer(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
   procedure AppException(Sender: TObject; E: Exception);
  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;      //超时60秒
timer1.Enabled :=true;     //打开定时器
n11.Enabled :=false;       //开启服务器菜单项无效
n21.Enabled :=true;        //关闭代理服务器有效
ServerSocket1.Port :=988; //代理服务器端口988
ServerSocket1.Active :=true; //开启服务


end;

//开启服务器
procedure TForm1.N11Click(Sender: TObject);
begin
ServerSocket1.Active :=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.Close1Click(Sender: TObject);
begin
form1.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
  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.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
var
i: integer;
begin
for i:=1 to sessions do
if (session[i-1].CSocket.socket.sockethandle=socket.SocketHandle) and
   session[i-1].Used then
   begin
    session[i-1].CSocket.tag:=socket.SocketHandle;
    session[i-1].remote_connected:=true;{置远程主机已连通标志}
    session[i-1].Lookingup:=false;{清标志}
    break;
   end;

end;
//当远程主机断开时
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var i,j,k: integer;
begin
 for i:=1 to sessions do
  if (session[i-1].CSocket.tag=socket.SocketHandle) and
      session[i-1].Used then
        begin
          session[i-1].remote_connected:=false;{置为未连接}
          if not session[i-1].client_connected then
                session[i-1].Used:=false{假如客户机已断开,则置释放资源标志}
           else for k:=1 to serversocket1.Socket.ActiveConnections do
                  if (serversocket1.Socket.Connections[k-1].SocketHandle=
                        session[i-1].SS_Handle) and
                     session[i-1].used then
                         begin
                          serversocket1.Socket.Connections[k-1].Close;
                          break;
                          end;
         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.ClientSocket1Error(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].CSocket.tag=socket.SocketHandle) and
      session[i-1].Used then
   begin
      socket.close;
      session[i-1].remote_connected:=false;{置为未连接}
      if not session[i-1].client_connected then
           session[i-1].Used:=false{假如客户机已断开,则置释放资源标志}
      else for k:=1 to serversocket1.Socket.ActiveConnections do
         if (serversocket1.Socket.Connections[k-1].SocketHandle=
                 session[i-1].SS_Handle)  and
           session[i-1].used then
            begin
             serversocket1.Socket.Connections[k-1].Close;
             break;
            end;
      break;
   end;
    j:=sessions;
    k:=0;
    for i:=1 to j do
     begin
     if session[j-i].Used then
       break;
       inc(k);
     end;
    errorcode:=0;
    if k>0 then{修正会话数组}
      begin
       sessions:=sessions-k;
       setlength(session,sessions);
       end;
   edit1.text:=inttostr(sessions);
end;
//远程主机发来页面数据时
procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var i,j: integer;
rec_bytes: integer;{传回的数据块长度}
rec_Buffer: array[0..2047] of char; {传回的数据块缓冲区}
begin
for i:=1 to sessions do
  if (session[i-1].CSocket.tag=socket.SocketHandle) and
   session[i-1].Used then
    begin
    rec_bytes:=socket.ReceiveBuf(rec_buffer,2048); {接收数据}
    for j:=1 to serversocket1.Socket.ActiveConnections do
     if serversocket1.Socket.Connections[j-1].SocketHandle=
            session[i-1].SS_Handle then
        begin
         serversocket1.Socket.Connections[j-1].SendBuf(rec_buffer,rec_bytes);
         {发送数据}
         break;
        end;
    break;
   end;
end;

//向远程主机发送页面请求
procedure TForm1.ClientSocket1Write(Sender: TObject;
  Socket: TCustomWinSocket);
var i: integer;
begin
 for i:=1 to sessions do
   if (session[i-1].CSocket.tag=socket.SocketHandle) and
       session[i-1].Used then
       begin
       if session[i-1].Request then
       begin
       socket.SendText(session[i-1].request_str);{假如有请求,发送}
       session[i-1].Request:=false;{清标志}
       end;
       break;
       end;
end;

procedure TForm1.ClientSocket1Lookup(Sender: TObject;
  Socket: TCustomWinSocket);
begin
//
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 TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
tmp,line,host: string;
i,j,port: integer;
begin
  for i:=1 to sessions do{判断是哪一个会话}
    if session[i-1].Used and
      (session[i-1].SS_Handle=socket.sockethandle) then
   begin
    session[i-1].request_str:=socket.ReceiveText; {保存请求数据}
    tmp:=session[i-1].request_str; {存放到临时变量}
    memo1.lines.add(tmp);
    j:= pos(char(13)+char(10),tmp);{一行标志}
   while j>0 do{逐行扫描请求文本,查找主机地址}
     begin
      line:=copy(tmp,1,j-1);{取一行}
      delete(tmp,1,j+1);{删除一行}
      j:=pos('Host',line);{主机地址标志}
      if j>0 then
       begin
          delete(line,1,j+5);{删除前面的无效字符}
          j:=pos(':',line);
         if j>0 then
            begin
               host:=copy(line,1,j-1);
               delete(line,1,j);
             try
               port:=strtoint(line);
             except
               port:=80;
             end;
       end
      else
        begin
           host:=trim(line);{获取主机地址}
           port:=80;
        end;

 if not session[i-1].remote_connected then{假如远征尚未连接}
   begin
    session[i-1].Request:=true;{置请求数据就绪标志}
    session[i-1].CSocket.host:=host;{设置远程主机地址}
    session[i-1].CSocket.port:=port;{设置端口}
    session[i-1].CSocket.active:=true;{连接远程主机}
    session[i-1].Lookingup:=true;{置标志}
    session[i-1].LookupTime:=0;{从0开始计时}
   end
  else
{假如远程已连接,直接发送请求}
   session[i-1].CSocket.socket.sendtext(session[i-1].request_str);
   break;{停止扫描请求文本}
  end;
  j:=pos(char(13)+char(10),tmp);{指向下一行}
  end;
 break;{停止循环}
end;

end;


//“页面找不到”等错误信息出现时
procedure TForm1.AppException(Sender: TObject; E: Exception);
begin
inc(invalidrequests);
end;
//查找远程主机定时
procedure TForm1.Timer1Timer(Sender: TObject);
var i,j: integer;
 begin
  for i:=1 to sessions do
  if session[i-1].Used and
    session[i-1].Lookingup then{假如正在连接}
    begin
     inc(session[i-1].LookupTime);
     if session[i-1].LookupTime>lookuptimeout then{假如超时}
      begin
       session[i-1].Lookingup:=false;
       session[i-1].CSocket.active:=false;{停止查找}
      for j:=1 to serversocket1.Socket.ActiveConnections do
       if serversocket1.Socket.Connections[j-1].SocketHandle=
          session[i-1].SS_Handle then
        begin
         serversocket1.Socket.Connections[j-1].Close;{断开客户机}
         break;
       end;
     end;
   end;

end;

procedure TForm1.N1Click(Sender: TObject);
begin

   ServerSocket1.Active :=false; //开启服务
   ServerSocket1.Port :=strtoint(InputBox('输入',
                                 '输入端口',
                                 inttostr(ServerSocket1.Port)));
                                  //代理服务器端口988
   ServerSocket1.Active :=true; //开启服务
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;

end.
//*****************************************
//**************unit1.dfm************************
object Form1: TForm1
  Left = 192
  Top = 107
  Width = 544
  Height = 375
  Caption = '用Delphi设计代理服务器'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PopupMenu = PopupMenu1
  OnClose = FormClose
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Memo1: TMemo
    Left = 19
    Top = 11
    Width = 491
    Height = 272
    ScrollBars = ssBoth
    TabOrder = 0
  end
  object Edit1: TEdit
    Left = 95
    Top = 313
    Width = 101
    Height = 21
    TabOrder = 1
  end
  object Button1: TButton
    Left = 465
    Top = 319
    Width = 49
    Height = 22
    Caption = '退出'
    TabOrder = 2
    OnClick = Button1Click
  end
  object ServerSocket1: TServerSocket
    Active = False
    Port = 0
    ServerType = stNonBlocking
    OnListen = ServerSocket1Listen
    OnClientConnect = ServerSocket1ClientConnect
    OnClientDisconnect = ServerSocket1ClientDisconnect
    OnClientRead = ServerSocket1ClientRead
    OnClientError = ServerSocket1ClientError
    Left = 145
    Top = 19
  end
  object ClientSocket1: TClientSocket
    Active = False
    ClientType = ctNonBlocking
    Port = 0
    OnLookup = ClientSocket1Lookup
    OnConnect = ClientSocket1Connect
    OnDisconnect = ClientSocket1Disconnect
    OnRead = ClientSocket1Read
    OnWrite = ClientSocket1Write
    OnError = ClientSocket1Error
    Left = 201
    Top = 34
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 88
    Top = 52
  end
  object Timer2: TTimer
    OnTimer = Timer2Timer
    Left = 140
    Top = 92
  end
  object PopupMenu1: TPopupMenu
    Left = 72
    Top = 240
    object N11: TMenuItem
      Caption = '启动服务'
      OnClick = N11Click
    end
    object N21: TMenuItem
      Caption = '停止服务'
      OnClick = N21Click
    end
    object N1: TMenuItem
      Caption = '改换端口'
      OnClick = N1Click
    end
    object Close1: TMenuItem
      Caption = '退出'
      OnClick = Close1Click
    end
  end
end

[关闭][返回]