代理服务器远代码(100分)

简单的就可以了，最好不用控件，我想自己写一个.

你可以查阅今年上半年的电脑报，
上面有完整的程序和说明：－）
最适合你了

以下就是我写的代理服务器,给分吧!
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
trayicon, StdCtrls, ComCtrls, Menus, ScktComp, ExtCtrls, NMUDP,Registry;

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; {远程服务器连接标志}
BestRoute_Found:Boolean;{最佳路由是否找到标志}
RouteIP:String;{最佳路由}
end;

type
TForm1 = class(TForm)
trayicon1: Ttrayicon;
pmipopup: TPopupMenu;
Show1: TMenuItem;
pgc1pagect1: TPageControl;
TabSheet1: TTabSheet;
exit1: TMenuItem;
ClientSocket: TClientSocket;
ServerSocket: TServerSocket;
Memo1: TMemo;
Edit1: TEdit;
Timer1: TTimer;
MainMenu: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
tuichu1: TMenuItem;
StatusBar: TStatusBar;
Label1: TLabel;
NMUDP: TNMUDP;
EScan1: TEdit;
EScan2: TEdit;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
QuickCheck: TCheckBox;
ERoute1: TEdit;
ERoute2: TEdit;
Label5: TLabel;
Label6: TLabel;
EAdapter: TEdit;
Label7: TLabel;
procedure trayicon1click(Sender: TObject);
procedure trayicon1Dbclick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BterminateClick(Sender: TObject);
procedure BcloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure exit1Click(Sender: TObject);
procedure Show1Click(Sender: TObject);
procedure AppException(Sender:TObject;E:Exception);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure tuichu1Click(Sender: TObject);
procedure ServerSocketListen(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientSocketWrite(Sender: TObject; Socket: TCustomWinSocket);
procedure Timer1Timer(Sender: TObject);
procedure StartScan(index:Integer);
procedure NMUDPSendCmd(Cmd:String;ip:string);
procedure ReadQuickResult(StrResult:String;FromIP:String);
procedure ReadRouteResult(StrResult:String;FromIP:String);
function CompareRouteResult():String;
function CompareQuickResult():String;
procedure RedirectRoute(Index:Integer);
procedure SaveStringToRegistry_LOCAL_MACHINE(sKey,sItem,sVal:string);
procedure SetTCPIPGateWayAddresses(sIPs:string);
procedure NMUDPDataReceived(Sender: TComponent; NumberBytes: Integer;
FromIP: String; Port: Integer);
private
{ Private declarations }
public
Service_Enabled: boolean; {代理服务是否开启}
session: array of session_record; {会话数组}
sessions: integer; {会话数}
LookUpTimeOut: integer; {连接超时值}
InvalidRequests: integer; {无效请求数}
{ Public declarations }
end;

var
Form1: TForm1;
var
Relay1,Relay2,Hops1,Hops2:integer;
SessionIndex:integer;
implementation

{$R *.DFM}
//“页面找不到”等错误信息出现时…
procedure TForm1.AppException(Sender:TObject;E:Exception);
begin
inc(invalidrequests);
end;

procedure TForm1.StartScan(Index:Integer);
var Cmd,Host:string;
begin
Host:=session[Index].CSocket.Host;
if Host='' then exit;
if not QuickCheck.Checked then
Cmd:='RouteScan:'+Host+','+IntToStr(Index){生成完全监测命令(ping,Trace)}
else
Cmd:='QuickScan:'+Host+','+IntToStr(Index);{生成快速监测命令(ping,Trace)}
NMUDPSendCmd(Cmd,EScan1.Text);{向路由监测器1发送}
NMUDPSendCmd(Cmd,EScan2.Text);{向路由监测器2发送}
end;

procedure TForm1.ReadRouteResult(StrResult:String;FromIP:String);
var i,j,k:Integer;
var Strtmp,StrRelay,StrHops:string;
begin
i:=Pos(':',StrResult);
Strtmp:=Copy(StrResult,i+1,Length(StrResult)-i);//取出数据
j:=Pos(',',Strtmp);
StrRelay:=Copy(Strtmp,1,j-1);//取出延迟
Strtmp:=Copy(Strtmp,j+1,Length(Strtmp)-j);
k:=Pos(',',Strtmp);
StrHops:=Copy(Strtmp,1,k-1);//取出跳数
SessionIndex:=StrToInt(Copy(Strtmp,k+1,Length(Strtmp)-k));//取出Session序号
if FromIP=EScan1.Text then
begin
Relay1:=StrToInt(StrRelay);
Hops1:=StrToInt(StrHops);
end;
if FromIP=EScan2.Text then
begin
Relay2:=StrToInt(StrRelay);
Hops2:=StrToInt(StrHops);
end;
end;

procedure TForm1.ReadQuickResult(StrResult:String;FromIP:String);
var i,j:Integer;
var Strtmp,StrRelay:string;
begin
i:=Pos(':',StrResult);
Strtmp:=Copy(StrResult,i+1,Length(StrResult)-i);//取出数据
j:=Pos(',',Strtmp);
StrRelay:=Copy(Strtmp,1,j-1);//取出延迟
SessionIndex:=StrToInt(Copy(Strtmp,j+1,Length(Strtmp)-j));//取出Session序号
if FromIP=EScan1.Text then
begin
Relay1:=StrToInt(StrRelay);
end;
if FromIP=EScan2.Text then
begin
Relay2:=StrToInt(StrRelay);
end;
end;

function TForm1.CompareRouteResult():String;
begin
if Relay1>Relay2 then
CompareRouteResult:=ERoute2.Text;
if Relay1<Relay2 then
CompareRouteResult:=ERoute1.Text;
if Relay1=Relay2 then
if Hops1>Hops2 then
CompareRouteResult:=ERoute2.Text
else
CompareRouteResult:=ERoute1.Text;
end;

function TForm1.CompareQuickResult():String;
begin
if Relay1>Relay2 then
CompareQuickResult:=ERoute2.Text
else
CompareQuickResult:=ERoute1.Text;
end;

procedure TForm1.SetTCPIPGateWayAddresses(sIPs:string);
begin
if EAdapter.Text='' then
begin
MessageDlg('请填写网卡序列号!', mtError,[mbOk],0);
exit;
end;
SaveStringToRegistry_LOCAL_MACHINE('SYSTEM/CurrentControlSet/Services/'+EAdapter.Text+'/Parameters/Tcpip','DefaultGateway',sIPs );
end;

procedure TForm1.SaveStringToRegistry_LOCAL_MACHINE(sKey,sItem,sVal:string);
var
reg:TRegIniFile;
begin
try
reg:=TRegIniFile.Create( '' );
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.WriteString(sKey,sItem,sVal+#0);
finally
reg.Free;
end;
end;

procedure TForm1.RedirectRoute(Index:Integer);
begin
SetTCPIPGateWayAddresses(session[Index].RouteIP);
StatusBar.SimpleText:='修改网关为:'+session[Index].RouteIP;
end;

procedure TForm1.NMUDPSendCmd(Cmd:String;ip:string);
var
Strmem:TMemoryStream;
Strtmp:String;
begin
NMUDP.LocalPort:=2002;
NMUDP.RemotePort:=2001;
NMUDP.RemoteHost:=ip;
Strtmp:=Cmd;
Strmem:=TMemoryStream.Create;
try
Strmem.Write(Strtmp[1],Length(Strtmp));
NMUDP.SendStream(Strmem);
finally
Strmem.Free;
end;
end;

procedure TForm1.trayicon1click(Sender: TObject);
begin
showmessage('click test');
end;

procedure TForm1.trayicon1Dbclick(Sender: TObject);
begin
show;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action:=canone;
hide;
end;

procedure TForm1.BterminateClick(Sender: TObject);
begin
Timer1.Enabled:=false; {关闭定时器}
if Service_Enabled then
serversocket.Active:=false; {退出程序时关闭服务}
application.Terminate;
end;

procedure TForm1.BcloseClick(Sender: TObject);
begin
hide;
end;

procedure TForm1.FormCreate(Sender: TObject);
var ExtendedStyle : Integer;
begin
ExtendedStyle := GetWindowLong (Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle OR WS_EX_TOOLWINDOW
AND NOT WS_EX_APPWINDOW); //应用程序不出现在任务栏
trayicon1.iconvisible:=true;
sessions:=0; {会话数=0}
Application.OnException:=AppException; {为了屏蔽代理服务器出现的异常}
invalidRequests:=0; {0错误}
LookUpTimeOut:=60000; {超时值=1分钟}
timer1.Enabled:=true; {打开定时器}
n1.Enabled:=false; {开启服务菜单项失效}
n2.Enabled:=true; {关闭服务菜单项有效}
serversocket.Port:=988; {代理服务器端口=988}
serversocket.Active:=true; {开启服务}
Service_Enabled:=false;
form1.hide; {隐藏界面，缩小到System Tray上}
end;

procedure TForm1.exit1Click(Sender: TObject);
begin
application.Terminate;
end;

procedure TForm1.Show1Click(Sender: TObject);
begin
show;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
serversocket.Active:=true; {开启服务}
N2.Enabled:=True;
N1.Enabled:=False;
StatusBar.SimpleText:='开启服务';
end;

procedure TForm1.N2Click(Sender: TObject);
begin
serversocket.Active:=false; {停止服务}
N1.Enabled:=True;
N2.Enabled:=False;
Service_Enabled:=false; {标志清零}
StatusBar.SimpleText:='停止服务';
end;

procedure TForm1.N3Click(Sender: TObject);
begin
hide;
end;

procedure TForm1.tuichu1Click(Sender: TObject);
begin
Timer1.Enabled:=false; {关闭定时器}
if Service_Enabled then
serversocket.Active:=false; {退出程序时关闭服务}
application.Terminate;
end;

//开启代理服务后…
procedure TForm1.ServerSocketListen(Sender: TObject;
Socket: TCustomWinSocket);
begin
Service_Enabled:=true; {置正在服务标志}
N1.Enabled:=false;
N2.Enabled:=true;
StatusBar.SimpleText:='开启代理服务已就绪';
end;

//被代理端连接到代理服务器后，建立一个会话，并与套接字绑定…
procedure TForm1.ServerSocketClientConnect(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:=ClientSocketConnect;
session[j].CSocket.OnDisconnect:=ClientSocketDisconnect;
session[j].CSocket.OnError:=ClientSocketError;
session[j].CSocket.OnRead:=ClientSocketRead;
session[j].CSocket.OnWrite:=ClientSocketWrite;
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; {远程未连接}
session[j].BestRoute_Found:=false;{最佳路由未找到}
edit1.text:=inttostr(sessions);
end;

//被代理端断开时…
procedure TForm1.ServerSocketClientDisconnect(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.ServerSocketClientError(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.ServerSocketClientRead(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].BestRoute_Found then{如果没有发现最佳路由,则发出检测信号给网络检测器(用Session的序号表示)}
begin
session[i-1].CSocket.host:=host; {设置远程主机地址}
session[i-1].CSocket.port:=port; {设置端口}
StartScan(i-1);{发出路由检测命令}
end
else
if not session[i-1].remote_connected then {假如远程尚未连接但找到了最佳路由,}
begin
RedirectRoute(i-1);{重定向网关}
session[i-1].Request:=true; {置请求数据就绪标志}
session[i-1].Lookingup:=true; {置标志}
session[i-1].LookupTime:=0; {从0开始计时}
session[i-1].CSocket.active:=true; {连接远程主机}
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.ClientSocketConnect(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.ClientSocketDisconnect(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 serversocket.Socket.ActiveConnections do
if (serversocket.Socket.Connections[k-1].SocketHandle=session[i-1].SS_Handle) and session[i-1].used then
begin
serversocket.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.ClientSocketError(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 serversocket.Socket.ActiveConnections do
if (serversocket.Socket.Connections[k-1].SocketHandle=session[i-1].SS_Handle) and session[i-1].used then
begin
serversocket.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.ClientSocketWrite(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
RedirectRoute(i-1);//用RouteIP修改网关路由
socket.SendText(session[i-1].request_str); {假如有请求，发送}
session[i-1].Request:=false; {清标志}
end;
break;
end;
end;

//远程主机发来页面数据时…
procedure TForm1.ClientSocketRead(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 serversocket.Socket.ActiveConnections do
if serversocket.Socket.Connections[j-1].SocketHandle=session[i-1].SS_Handle then
begin
serversocket.Socket.Connections[j-1].SendBuf(rec_buffer,rec_bytes); {发送数据}
break;
end;
break;
end;
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 serversocket.Socket.ActiveConnections do
if serversocket.Socket.Connections[j-1].SocketHandle=session[i-1].SS_Handle then
begin
serversocket.Socket.Connections[j-1].Close; {断开客户机}
break;
end;
end;
end;
end;

procedure TForm1.NMUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String; Port: Integer);
var
Strmem:TMemoryStream;
Strtmp,StrCmd:String;
i:integer;
begin
Show;
Strmem:=TMemoryStream.Create;
Setlength(Strtmp,NumberBytes);
try
NMUDP.ReadStream(Strmem);
Strmem.Read(Strtmp[1],NumberBytes);
i:=Pos(':',Strtmp);
StrCmd:=Copy(Strtmp,1,i-1);
if StrCmd='RouteResult' then
begin
ReadRouteResult(Strtmp,FromIP);
session[SessionIndex].RouteIP:=CompareRouteResult();
session[SessionIndex].BestRoute_Found:=true;
end;
if StrCmd='QuickResult' then
begin
ReadQuickResult(Strtmp,FromIP);
session[SessionIndex].RouteIP:=CompareQuickResult();
session[SessionIndex].BestRoute_Found:=true;
end;
//ShowMessage(IntToStr(Relay1)+' '+IntToStr(Hops1));
finally
Strmem.Free;
end;

end;

end.

倒！也没Form文件，上载到delphi.antdown.com吧！

先给分吧！然后就上载。

接受答案了.