用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 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;
//当连接远程主机成功时
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 < BR> 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;
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 k>0 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 >
注：本站部分文章源于互联网，版权归原作者所有！如有侵权，请原作者与本站联系，本站将立即删除！ 本站文章除特别注明外均可转载，但需注明出处！ [MinTao学以致用网] 
