分享
 
 
 

用DELPHI设计代理服务器程序

王朝delphi·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

用DELPHI设计代理服务器程序

摘自《天极网学习中心》 (文/万雪勇)

用Delphi开发串口通信软件一般有两种方法:一是利用Windows的通信API函数,另一种是采用Microsoft的MSComm控件。利用API编写串口通信程序较为复杂,需要掌握大量通信知识,其优点是可实现的功能更强大,应用面更广泛,更适合于编写较为复杂的低层次通信程序。而利用MSComm控件则相对较简单,该控件具有丰富的与串口通信密切相关的属性及事件,提供了对串口的各种操作。

一、MSComm控件的主要属性及事件

(1)CommPort:设置或返回串行端口号,缺省为1。

(2)Setting:设置或返回串口通信参数,格式为“波特率,奇偶校验位,数据位,停止位”。例如:MSComm1.Setting:='9600,n,8,1'

(3)PortOpen:打开或关闭串行端口,格式为:MSComm1.PortOpen:={True|False}

(4)InBufferSize:设置或返回接收缓冲区的大小,缺省值为1024字节。

(5)InBufferCount:返回接收缓冲区内等待读取的字节数,可通过设置该属性为0来清空接收缓冲区。

(6)RThreshold:该属性为一阀值,它确定当接收缓冲区内的字节个数达到或超过该值后就产生代码为ComEvReceive的OnComm事件。

(7)SThreshold:该属性为一阀值,它确定当发送缓冲区内的字节个数少于该值后就产生代码为ComEvSend的OnComm事件。

(8)InputLen:设置或返回接收缓冲区内用Input读入的字节数,设置该属性为0表示Input读取整个缓冲区的内容。

(9)Input:从接收缓冲区读取一串字符。

(10)OutBufferSize:设置或返回发送缓冲区的大小,缺省值为512字节。

(11)OutBufferCount:返回发送缓冲区内等待发送的字节数,可通过设置该属性为0来清空缓冲区。

(12)OutPut:向发送缓冲区传送一串字符。

如果在通信过程中发生错误或事件,就会引发OnComm事件,并由CommEvent属性代码反映错误类型,在通信程序的设计中可根据该属性值来执行不同的操作。CommEvent属性值及其含义如下:

(1)ComEvSend:值为1,发送缓冲区的内容少于SThreshold指定的值。

(2)ComEvReceive:值为2,接收缓冲区内字符数达到RThreshold指定的值。

(3)ComEvFrame:值为1004,硬件检测到帧错误。

(4)ComEvRxOver:值为1008,接收缓冲区溢出。

(5)ComEvTxFull:值为1010,发送缓冲区溢出。

(6)ComEvRxParity:值为1009,奇偶校验错误。

(7)ComEvEOF:值为7,接收数据中出现文件尾(ASCII码为26)字符。

二、程序样例

在Delphi3.0中无法使用MSComm控件,笔者使用的是Delphi5.0。MSComm控件是VB中的OCX控件,首先需要将其添加到Delphi中,选择菜单“Component”→“Import ActiveX Control”,在“Import ActiveX”页内选择“Microsoft Comm Control”,点击“Install”安装,安装后在“ActiveX”组件板中出现MSComm图标,即可被使用。有一点要注意,在Object Inspector中MSComm控件的Input和Output属性是不可见的,但它们仍然存在,这两个属性的类型是OleVariant(Ole万能变量)。

下面是一接收程序的样例(主要部分),大家可根据实际需要进行完善。

在Form中放置一Memo控件用于显示接收的数据,Combobox1选择通信参数(Setting属性值),Combobox2选择串口(CommPort属性值),按Button1开始接收数据,按Button2停止接收。

procedure TForm1.FormCreate(Sender: TObject);

begin

Mscomm1.InBufferCount :=0; // 清空接收缓冲区

Mscomm1.InputLen :=0; // Input读取整个缓冲区内容

Mscomm1.RThreshold :=1; // 每次接收到字符即产生OnComm事件

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Mscomm1.Settings :=ComboBox1.Text;

if ComboBox2.Text ='com1' then // 假设只考虑com1和com2两种情况

Mscomm1.CommPort :=1

else

Mscomm1.CommPort :=2;

Mscomm1.PortOpen :=true; // 打开串口

Mscomm1.DTREnable :=true; // 数据终端准备好

Mscomm1.RTSEnable :=true; // 请求发送

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

Mscomm1.PortOpen :=false; // 关闭串口

Mscomm1.DTREnable :=false;

Mscomm1.RTSEnable :=false;

end;

procedure TForm1.MSComm1Comm(Sender: TObject);

var recstr:Olevariant;

begin

if Mscomm1.CommEvent = 2 then

begin

recstr := Mscomm1.Input ;

Memo1.text := Memo1.Text + recstr;

end;

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

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.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 k0 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 k0 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 j0 do{逐行扫描请求文本,查找主机地址}

begin

line:=copy(tmp,1,j-1);{取一行}

delete(tmp,1,j+1);{删除一行}

j:=pos('Host',line);{主机地址标志}

if j0 then

begin

delete(line,1,j+5);{删除前面的无效字符}

j:=pos(':',line);

if j0 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;

//当连接远程主机成功时

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 k0 then{修正会话数组}

begin

sessions:=sessions-k;

setlength(session,sessions);

end;

edit1.text:=inttostr(sessions);

end;

file://当与远程主机通信发生错误时/

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 k0 then{修正会话数组}

begin

sessions:=sessions-k;

setlength(session,sessions);

end;

edit1.text:= inttostr(sessions);

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.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.AppException(Sender:TObject; E: Exception);

begin

inc(invalidrequests);

end;

file://查找远程主机定时/

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;

end.

三、总结

由于这种设计思路仅仅在被代理端和远程主机之间增加了一个重定向功能,被代理端原有的缓存技术等特点均保留,因此效率较高。经过测试,利用1个33.6K的Modem上网时,三到十个被代理工作站同时上网,仍有较好的响应速度。由于被代理工作站和代理服务器之间的连接一般通过高速链路,因此瓶颈主要出现在代理服务器的上网方式上。 通过上述方法,作者成功开发了一套完善的代理服务器软件并与机房计费系统完全集成,实现了利用一台工作站完成上网代理、上网计费、用机计费等功能。 有编程经验的朋友完全可以另行增加代理服务器功能,如设定禁止访问站点、统计客户流量、Web访问列表等等。

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有