发信人: 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 |
|