傻傻(5分)

unit uservermain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdHTTPServer,
OleCtrls, MSCommLib_TLB, StdCtrls, ScktComp, Menus, CoolTrayIcon,
ComCtrls, DFSStatusBar, ImgList, ToolWin;
{
DTR: PC 发往MODEM，表示PC机是否准备好
RTS：PC 发往MODEM，表示PPC机是否允许MODEM发回数据
DSR：MODEM 发往PC，表示MODEM是否已做好操作准备
CTS：MODEM 发往PC，表示MODEM是否允许发送数据
CD ：MODEM 发往PC，表示MODEM已经与呼叫的远方MODEM处于连接状态

TSocketNotifyEvent = procedure (Sender: TObject; Socket: TCustomWinSocket) of object;
在客户端上Sender和Socket是同一个，在服务端上Socket是指ClientSocket
}
const
C_K = 1024;
C_PageSize = 4 * C_K;
C_ReadBuffer = 8 * C_K;
C_M = C_K * C_K;
type
TUserStatusList = Class(TList)
function uslAdd(Item: Pointer): Integer;
procedure sulDelete(Index: Integer);
end;
TUserStatus = class
private
FHostAddress : String;
FSendData: LongInt;
FReceiveData: LongInt;
FStartTime: TDateTime;
procedure SetHostAddress(const Value: String);
procedure SetReceiveData(const Value: LongInt);
procedure SetSendData(const Value: LongInt);
public
property HostAddress : String read FHostAddress write SetHostAddress;
property StartTime : TDateTime read FStartTime write FStartTime;
property SendData : LongInt read FSendData write SetSendData;
property ReceiveData : LongInt read FReceiveData write SetReceiveData;
procedure ReSetListView(HostAddress : String);
constructor Create;
end;
TSessions = class(TClientSocket)
private
public
IDHandle : THandle; //客户机向代理服务器的
Request : Boolean;
Used : Boolean;
Local_Connected : Boolean;
Remote_Connected : Boolean;
Request_Str : String;
constructor Create(Owner : TComponent); override;
end;
TfMain = class(TForm)
MSComm1: TMSComm;
proxyserver: TServerSocket;
ClientSocket1: TClientSocket;
MainMenu1: TMainMenu;
mit1: TMenuItem;
N1: TMenuItem;
miExit: TMenuItem;
mit5: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
wunoman163net1: TMenuItem;
miProxyserver: TMenuItem;
mit2: TMenuItem;
mit4: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
mit3: TMenuItem;
miLog: TMenuItem;
miServerSetting: TMenuItem;
miModem: TMenuItem;
miStatus: TMenuItem;
N2: TMenuItem;
TrayIcon1: TCoolTrayIcon;
TrayPm: TPopupMenu;
miTrayRestore: TMenuItem;
Close1: TMenuItem;
stb: TDFSStatusBar;
commImageList: TImageList;
N6: TMenuItem;
MenuImageList: TImageList;
Modem1: TMenuItem;
mmImageList: TImageList;
procedure httpserver1CommandGet(AThread: TIdPeerThread;
RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
procedure MSComm1Comm(Sender: TObject);
procedure proxyserverClientConnect(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 proxyserverClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure proxyserverClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure proxyserverClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure miExitClick(Sender: TObject);
procedure miServerSettingClick(Sender: TObject);
procedure miModemClick(Sender: TObject);
procedure miProxyserverClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure miStatusClick(Sender: TObject);
procedure Modem1Click(Sender: TObject);
procedure TrayIcon1DblClick(Sender: TObject);
private
{ Private declarations }
public
function getCurrentSession(IDHandle : THandle):Integer;
function GetLocalClient(IDHandle : THandle): Integer;
function GetHostAndPort(s : String; var Host : string; var Port: Integer):boolean;
function GetProxyServer(IDHandle : THandle) : Integer;
procedure SetLog(LogType : Integer; LogText : String);
procedure ReSetView;
procedure noUsed;
function UserStatusIndexof(HostAddress : String):Integer;
procedure ReSetListView;
{ Public declarations }
end;
function ChangeToShow(SendData, ReceiveData : LongInt) : String;
var
fMain: TfMain;
Sessions : Integer;
Session : array of TSessions;
IsLog : Boolean;
UserStatusList : TList;
implementation

uses ulog;

{$R *.dfm}


procedure TfMain.httpserver1CommandGet(AThread: TIdPeerThread;
RequestInfo: TIdHTTPRequestInfo; ResponseInfo: TIdHTTPResponseInfo);
begin
ResponseInfo.ContentText := 'I love you';
end;

procedure TfMain.MSComm1Comm(Sender: TObject);
begin
// comEvSend = $00000001; //当发送缓冲区内的字节个数少于SThreshold时
// comEvReceive = $00000002; //当接收缓冲区内的字节数达到或超过RThreshold时
// comEvCTS = $00000003; //CTS线发生变化
// comEvDSR = $00000004; //DSR线发生变化
// comEvCD = $00000005; //CD线发生变化
// comEvRing = $00000006; //检测到振铃信号
// comEvEOF = $00000007; //接收数据中出现文件尾（ASCII26)字符
case MSComm1.CommEvent of
1: begin end;
2: begin end;
3: begin end;
4: begin end;
5: begin end;
6: begin end;
end;
end;

procedure TfMain.proxyserverClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
I, J : Integer;
us : TUserStatus;
hostAddress : String;
begin
J := -1;
for I := 1 to Sessions do begin
if (not Session[i-1].Local_Connected ) and (not Session[i-1].Remote_Connected) then begin
J := i - 1; // 有，分配它
//Session[j].Used := True; //置为在用
break;
end
end;
if J = -1 then begin //一个也没找到，准备给它分配一个新的吧
J := Sessions;
Inc(Sessions); //哦，又多了一个
Setlength(Session,Sessions); //这是一个动态数组，增加元素的个数
Session[j] := TSessions.Create(nil); //创建一个ClientSocket
Session[j].OnConnect := ClientSocket1Connect;
Session[j].OnDisconnect := ClientSocket1DisConnect;
Session[j].OnError := ClientSocket1Error;
Session[j].OnRead := ClientSocket1Read;
Session[j].OnWrite := ClientSocket1Write;
end;
Session[j].IDHandle := Socket.SocketHandle; //会话数组保存以便和客户端相认
Session[j].Remote_Connected := False; //远程未连接
Session[j].Local_Connected := True; //置本地连接
SetLog(Socket.SocketHandle,'有客户连接请求到来[本地]');
J := GetProxyServer(Socket.SocketHandle);
HostAddress := ProxyServer.Socket.Connections[j].RemoteAddress;
I := UserStatusIndexOf(HostAddress);
if I = -1 then begin //新来的
us := TUserStatus.Create;
UserStatusList.Add(us);
us.HostAddress := HostAddress;
end;
end;

{ TSessions }

constructor TSessions.Create(Owner: TComponent);
begin
inherited Create(Owner);
Used := true; //置为在用,客户机已连接
Remote_Connected := False; //远程未连接
Local_Connected := False;
end;

//连上远程服务器
procedure TfMain.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
var
I : Integer;
begin
I := GetCurrentSession(Socket.SocketHandle);
if I = -1 then Exit;
Session.Remote_Connected := True; //标志已连接上远程服务
SetLog(Socket.SocketHandle ,'连接上远程服务器[远程]');
end;

//与远程服务器断开
procedure TfMain.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
I,j : Integer;
H : THandle;
begin
I := GetCurrentSession(Socket.SocketHandle);
if I = -1 then Exit;
H := Session.IDHandle;
Session.Remote_Connected := False;//关掉远程连接
SetLog(h ,'与远程服务器断开[远程]');
j := getProxyServer(H);
if j <> -1 then begin
SetLog(Proxyserver.Socket.Connections[j].SocketHandle ,'关掉相关客户端[本地]');
if session.Local_Connected then begin
Proxyserver.Socket.Connections[j].Close; //关掉对应的本地连接
Session.Local_Connected := False;
end;
end;
noUsed;
end;

procedure TfMain.ClientSocket1Error(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var
I,j : Integer;
H : THandle;
begin
ErrorCode := 0; //不要让错误暴出来
I := GetCurrentSession(Socket.SocketHandle);
if I = -1 then Exit;
H := Session.IDHandle;
Session.Socket.Close; //关掉
session.Remote_Connected := False; //没有远程连接
SetLog(H,'与远程服务器接通出错[远程]');
j := getProxyServer(H);
if j <> -1 then begin
setlog(Proxyserver.Socket.Connections[j].SocketHandle ,'关掉相关客户端[本地]');
if Session.Local_Connected then begin
Proxyserver.Socket.Connections[j].Close; //关掉对应的本地连接
Session.Local_Connected := False;
end;
end;
noUsed;
end;

procedure TfMain.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
I, J, H : Integer;
HostAddress : String;
us : TUserStatus;
Rec_bytes : integer; //传回的数据块长度
Rec_Buffer :array[0..C_ReadBuffer-1] of Char; //传回的数据块缓冲区
begin
I := getCurrentSession(Socket.SocketHandle);
if I = -1 then Exit;
Rec_bytes := Socket.ReceiveBuf(Rec_buffer,C_ReadBuffer);//接收远程服务器数据
H := Session.IDHandle;
I := GetProxyServer(Session.IDHandle);
if I <> -1 then begin
proxyserver.Socket.Connections.SendBuf(Rec_Buffer,Rec_Bytes); //向客户机发送数据
setlog(77,'向客户机发送数据[本地]');
end;
SetLog(H,'从远程服务器上读取数据[远程]');
J := GetProxyServer(H);
if J = -1 then Exit;
HostAddress := ProxyServer.Socket.Connections[j].RemoteAddress;
I := UserStatusIndexOf(HostAddress);
if I <> -1 then begin
us := UserStatusList.Items;
us.ReceiveData := us.ReceiveData + Rec_bytes;
end;
end;

procedure TfMain.ClientSocket1Write(Sender: TObject;
Socket: TCustomWinSocket);
var
I : Integer;
begin
I := getCurrentSession(Socket.SocketHandle);
if i = -1 then exit;
if Session.Request then begin
Socket.SendText(Session.Request_Str);
end;
SetLog(Socket.SocketHandle,'发送请求上远程服务器[远程]');
end;

procedure TfMain.proxyserverClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i : integer;
H : THandle;
begin
I := GetLocalClient(Socket.SocketHandle);
if I = -1 then exit;
H := Session.IDHandle;
Session.Local_Connected := False; //本地连接断开
if Session.Remote_Connected then begin
Session.Socket.Close; //关掉远程连接
Session.Remote_Connected := False;
end;
SetLog(h,'与远程服务器断开[远程]');
NoUsed;
end;

procedure TfMain.proxyserverClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var
i :integer;
H : THandle;
begin
ErrorCode := 0; //不要让错误暴出来
H := Socket.SocketHandle;
I := GetProxyServer(H);
if I <> -1 then begin
Proxyserver.Socket.Connections.Close;
end;
I := GetLocalClient(H);
if I = -1 then Exit;
Session.Local_Connected := False;
if Session.Remote_Connected then begin
Session.Socket.Close; //关闭与远程连接
Session.Remote_Connected := False;
end;
SetLog(H,'与客户连接出错');
noUsed;
end;

procedure TfMain.proxyserverClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
tmp, host, HostAddress :string;
i,j,len,port :integer;
us : TUserStatus;
begin
I := GetLocalClient(Socket.SocketHandle);
if I = -1 then exit;
session.Request_Str := Socket.ReceiveText; //保存请求数据
Len := Length(session.Request_Str);
tmp := Session.Request_Str;
if not session.Remote_Connected then begin
GetHostAndPort(tmp,Host,port); //取远程主机名和端口
session.Request := True; //置请求数据就绪标志
session.Host := host;
session.Port := port;
session.Active := true; //打开与远程连接
end;
session.Socket.SendText(Session.Request_Str); //送出数据
SetLog(Socket.SocketHandle,format('有客户请求到来 %s %d[本地]',[Host,port]));
J := GetProxyServer(Socket.SocketHandle);
HostAddress := ProxyServer.Socket.Connections[j].RemoteAddress;
I := UserStatusIndexOf(HostAddress);
if I <> -1 then begin
us := UserStatusList.Items;
us.SendData := us.SendData + Len;
end;
end;
//在会话数据中找出当前（由IDHandle指定）的连接远程服务的ClientSocket
function TfMain.getCurrentSession(IDHandle : THandle):Integer;
var
I : Integer;
begin
Result := -1;
for I := 1 to Sessions do begin
if (Session[i-1].Socket.SocketHandle = IDHandle)
{and (Session[i-1].Remote_Connected)} then begin
Result := I-1;
break;
end;
end;
end;

procedure TfMain.SetLog(LogType: Integer; LogText: String);
var
I : Integer;
s : string;
begin
{ if IsLog then
ListBox1.Items.Add(format('%d : %s',[LogType,LogText]));
listbox2.items.Clear;
for I := 0 to sessions -1 do begin
if session.Used then s := 'Used'
else s := 'not used';
Listbox2.Items.Add(format('%d %s',[session.IDHandle,s]));
end;
listbox2.Items.Add('----------------------');
for I := 0 to proxyserver.Socket.ActiveConnections - 1 do begin
Listbox2.Items.Add(format('%d',[proxyserver.Socket.sockethandle]))
end; }
end;
//在会话数据中找出当前（由IDHandle指定）的本地的ClientSocket
function TfMain.GetLocalClient(IDHandle: THandle): Integer;
var
I : Integer;
begin
Result := -1;
for I := 1 to Sessions do begin
if (Session[i-1].IDHandle = IDHandle)
{ and (Session[i-1].Local_Connected)} then begin
Result := I-1;
break;
end;
end;
end;

function TfMain.GetHostAndPort(s: String; var Host: string;
var Port: Integer): boolean;
var
Line : String;
J : Integer;
begin
Host := 'blank'; port := 80;
J := Pos(Char(13)+Char(10),s); //找到一行的标志，回车符
while J > 0 do begin //逐行扫描请求文本，查找主机地址
line := Copy(s,1,j-1); //取出一行
delete(s,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
host := Copy(line,1,j-1); //把Host拷出来
delete(line,1,j);
port := StrToIntDef(Line,80);
end
else begin
Host := trim(line);
port := 80;
end;
end;
j := pos(Char(13) + char(10), s); //指向下一行
end;
end;
//在会话数据中找出当前（由IDHandle指定）的代理服务器的ServerSocket
function TfMain.GetProxyServer(IDHandle: THandle): Integer;
var
I : Integer;
begin
Result := -1;
for I := 0 to Proxyserver.Socket.ActiveConnections -1 do begin
if (ProxyServer.Socket.Connections.SocketHandle = IDHandle) then begin
Result := i;
break;
end;
end;
end;

procedure TfMain.Button2Click(Sender: TObject);
begin
IsLog := not IsLog
end;

procedure TfMain.Button3Click(Sender: TObject);
begin

end;
//设置不用的标志
procedure TfMain.noUsed;
var
I : Integer;
begin
for I := 0 to Sessions - 1 do begin
if (not Session.Local_Connected) and (not Session.Remote_Connected ) then begin
Session.Used := False;
end;
end;
end;

procedure TfMain.miExitClick(Sender: TObject);
begin
Close;
end;

procedure TfMain.miServerSettingClick(Sender: TObject);
begin
mscomm1.OutBufferSize := 4096; //设置或返回传输缓冲区大小
mscomm1.InBufferSize := 1024; //设置或返回接收缓冲区大小
mscomm1.InputMode := 1 ; //二进制; 0 为文本数据
end;

procedure TfMain.miModemClick(Sender: TObject);
var
OpenFlag : Boolean;
begin
//MODEM命令
//S0 = n ;(n>=1)自动应答，n 为响铃次数
//E0/E1 ;关闭/打开命令字符回应
//Q0/S1 ;MODEM返回/不返回结果码
//M0/M1 ;关闭/打开MODEM扬声器
//Example : MSComm1.Output = 'AT S0=1 E1 Q0 M0' + #13;
// MSComm1.Output = 'ATDT' + TelphoneCode + #13; //拨号
MSComm1.Output := 'ATDT 96169 ' + #13;
MSComm1.PortOpen := True;
OpenFlag := MSComm1.PortOpen;
MSComm1.DTREnable := OpenFlag;

end;

procedure TfMain.miProxyserverClick(Sender: TObject);
begin
proxyserver.Active := not ProxyServer.Active;
reSetView;
end;

procedure TfMain.ReSetView;
var
bmp : TBitmap;
begin
bmp := TBitmap.Create;
if Proxyserver.Active then begin
miProxyserver.Caption := '关闭代理';
if CommImageList.GetBitmap(1,bmp) then
stb.Panels[0].Glyph.Assign(bmp);
stb.Panels[1].Text := '启动时间'+DateTimeToStr(Now);
end
else begin
miProxyServer.Caption := '启动代理';
if CommImageList.GetBitmap(0,bmp) then
stb.Panels[0].Glyph.Assign(bmp);
stb.Panels[1].Text := '关闭时间'+DateTimeToStr(Now);
end;
end;

procedure TfMain.FormCreate(Sender: TObject);
//var
// Bmp : TBitmap;
begin
// bmp := TBitmap.Create;
// if CommImageList.GetBitmap(0,bmp) then
// stb.Panels[0].Glyph.Assign(bmp);
miProxyServerClick(nil);
end;

procedure TfMain.miStatusClick(Sender: TObject);
begin
if fLog = nil then begin
fLog := TFLog.Create(Application);
LockWindowUpdate(handle);
Flog.Show;
LockWindowUpdate(0);
end
else FLog.Show;
FMain.ReSetListView;
end;

procedure TfMain.Modem1Click(Sender: TObject);
begin
Mscomm1.PortOpen := False;
Mscomm1.DTREnable := False;
Mscomm1.RTSEnable := False;
end;

function TfMain.UserStatusIndexof(HostAddress: String): Integer;
var
I : Integer;
us : TUserStatus;
begin
Result := -1;
for I := 0 to UserStatusList.Count - 1 do begin
us := UserStatusList;
if us.HostAddress = HostAddress then begin
Result := i;
break;
end;
end;
end;

{ TUserStatus }

constructor TUserStatus.Create;
begin
FHostAddress := '';
FStartTime := now;
FSendData := 0;
FreceiveData := 0;
end;

procedure TUserStatus.ReSetListView(HostAddress : String);
var
I : Integer;
s1, s2 : String;
begin
if FLog <> nil then begin
if FLog.lvUser.Items.Count < UserStatusList.Count then begin
FMain.ReSetListView;
end;
I := fMain.UserStatusIndexof(HostAddress);
if I <> -1 then begin
FLog.lvUser.Items.Caption := HostAddress;
FLog.lvUser.Items.SubItems[0] := DateTimeToStr(FStartTime);
Flog.lvUser.Items.SubItems[1] := ChangeToSHow(FSendData,FReceiveData);
end;
end;
end;

procedure TUserStatus.SetHostAddress(const Value: String);
begin
FHostAddress := Value;
ResetListView(FHostAddress);
end;

procedure TUserStatus.SetReceiveData(const Value: LongInt);
begin
FReceiveData := Value;
ResetListView(FHostAddress);
end;

procedure TUserStatus.SetSendData(const Value: LongInt);
begin
FSendData := Value;
ResetListView(FHostAddress);
end;

procedure TFmain.ResetListView;
var
I : Integer;
us : TUserStatus;
s1, s2 : String;
begin
if FLog <> nil then begin
flog.lvUser.Items.Clear;
for I := 0 to UserStatusList.Count -1 do begin
us := UserStatusList.Items;
With Flog.lvUser.Items.Add do begin
ImageIndex := 2;
Caption := us.HostAddress;
SubItems.Add(DateTimeToStr(us.StartTime));
SubItems.Add(ChangetoShow(Us.SendData,Us.ReceiveData));
end;
end;
end;
end;

{ TUserStatusList }
procedure TUserStatusList.sulDelete(Index: Integer);
begin
Delete(Index);
FMain.ResetListView;
end;

function TUserStatusList.uslAdd(Item: Pointer): Integer;
begin
Add(Item);
FMain.ResetListView;
end;

procedure TfMain.TrayIcon1DblClick(Sender: TObject);
begin
trayicon1.ShowMainForm;
windows.SetActiveWindow(handle);
end;

function ChangeToShow(SendData, ReceiveData : LongInt) : String;
var
S1 , S2 : String;
begin
if SendData > C_M then begin
S1 := format('%d M',[SendData div C_M]) + '--> ';
end else begin
if SendData > C_K then begin
S1 := format('%d K',[SendData div C_k]) + '--> ';
end else begin
S1 := format('%d B',[SendData]) + '--> ';
end;
end;
if ReceiveData > C_M then begin
S2 := ' <-- ' + format('%d M',[ReceiveData div C_M]);
end else begin
if SendData > C_K then begin
S2 := ' <-- ' + format('%d K',[ReceiveData div C_k]);
end else begin
S2 := ' <-- ' + format('%d B',[ReceiveData]);
end;
end;
Result := S1 + S2;
end;

initialization
Sessions := 0;
IsLog := False;
UserStatusList := TList.Create;
finalization
UserStatusList.Free;
end.

发给您老人家了.^_^

在我那不要老是天呀天呀的
那我 就只要5位和6位呢？？？
字符串是HHJJKKLLL

up:
找上门来了，我躲！！！！！

不要吧 告诉我呀》。。。。。 我会急死的啦

那个东西是怎么发的？？？

1