// 单元功用：代理服务器协议
// 单元设计：陈新光
// 设计日期：2013-11-30
// 单元说明：Status=0 成功；=1失败
// 中间件和客户端节点以IP标识自己
unit untPackage;
interface
uses
SysUtils;
// 缓存定义
type
TChar10 = array[0..9] of AnsiChar;
TChar15 = array[0..14] of AnsiChar;
// 客户验证用户和密码
const
c_UserName='123';
c_Password='123';
// 命令字
const
c_Auth = $01;
c_Auth_Resp = $51;
c_ConnectMiddle = $2;
c_ConnectMiddle_Resp = $52;
c_MiddleHeartBeat = $5;
c_MiddleHeartBeat_Resp = $55;
type
THead = packed record // 公共消息头
Command: Byte; // 消息类型
end;
// 只有通过代理服务器验证的客户端才可以连接中间件
TAuth = packed record // 验证消息
Head: THead;
Username: TChar10;
Password: TChar10;
end;
TAuth_Resp = packed record
Head: THead;
Status: Byte;
end;
// 客户端向代理服务器申请连接中间件
TConnectMiddle = packed record
Head: THead;
end;
TConnectMiddle_Resp = packed record
Head: THead;
Status: Byte;
IP: TChar15; // 中间件IP
Port: Word; // 中间件port
end;
// 心跳包用于长连接的保活和断线处理，
// 中间件每隔6秒钟向代理服务器发送心跳包，
// 如果代理服务器发现有超过20秒未收到某个中间件的心跳包则认为该中间件已经断线
TMiddleHeartBeat = packed record
Head: THead;
IP: TChar15;
Port: Word;
end;
TMiddleHeartBeat_Resp = packed record
Head: THead;
Status: Byte;
end;
implementation
end.
object Form1: TForm1
Left = 0
Top = 0
Caption = #20195#29702#26381#21153#22120
ClientHeight = 404
ClientWidth = 484
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object GroupBox1: TGroupBox
Left = 0
Top = 0
Width = 484
Height = 73
Align = alTop
Caption = #20195#29702#26381#21153#22120
TabOrder = 0
object edtIp: TLabeledEdit
Left = 24
Top = 32
Width = 121
Height = 21
EditLabel.Width = 8
EditLabel.Height = 13
EditLabel.Caption = 'ip'
TabOrder = 0
Text = '127.0.0.1'
end
object edtPort: TLabeledEdit
Left = 224
Top = 32
Width = 121
Height = 21
EditLabel.Width = 20
EditLabel.Height = 13
EditLabel.Caption = 'port'
TabOrder = 1
Text = '9999'
end
object btnStart: TButton
Left = 376
Top = 24
Width = 75
Height = 25
Caption = #21551#21160
TabOrder = 2
OnClick = btnStartClick
end
end
object GroupBox2: TGroupBox
Left = 0
Top = 73
Width = 484
Height = 173
Align = alTop
Caption = #38598#32676#26381#21153#22120#21015#34920
TabOrder = 1
object DBGrid1: TDBGrid
Left = 2
Top = 15
Width = 480
Height = 156
Align = alClient
DataSource = ds
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
end
end
object GroupBox3: TGroupBox
Left = 0
Top = 246
Width = 484
Height = 158
Align = alClient
Caption = #20195#29702#26381#21153#22120#26085#24535
TabOrder = 2
object Memo1: TMemo
Left = 2
Top = 15
Width = 480
Height = 141
Align = alClient
ScrollBars = ssVertical
TabOrder = 0
end
end
object ds: TDataSource
DataSet = cds
Left = 240
Top = 136
end
object cds: TClientDataSet
Active = True
Aggregates = <>
Params = <>
Left = 152
Top = 136
Data = {
4A0000009619E0BD0100000018000000020000000000030000004A0002697001
00490000000100055749445448020002001E0004706F72740100490000000100
055749445448020002000A000000}
object cdsip: TStringField
FieldName = 'ip'
Size = 30
end
object cdsport: TStringField
FieldName = 'port'
Size = 10
end
end
object TCPServer: TIdTCPServer
Bindings = <>
DefaultPort = 0
OnExecute = TCPServerExecute
Left = 320
Top = 136
end
object TimerHeartBeat: TTimer
Interval = 5000
OnTimer = TimerHeartBeatTimer
Left = 152
Top = 192
end
end
// 单元功用：代理服务器主窗体
// 单元设计：陈新光
// 设计日期：2013-12-01
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.DBGrids,
Data.DB, Datasnap.DBClient, Vcl.ExtCtrls, IdContext, IdBaseComponent,
IdComponent, IdCustomTCPServer, IdTCPServer, untPackage, IdGlobal,
System.UITypes, System.SyncObjs, Generics.Collections;
const
c_MiddleOffLine = 20;
// 中间件对象
type
TMiddle = class(TWinControl)
public
ip: string;
port: Integer;
LastHeartBeat: Cardinal; // 最近心跳
end;
// 客户对象
type
TClient = class(TWinControl)
public
ip: string;
port: Integer;
LastHeartBeat: Cardinal; // 最近心跳
end;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
Memo1: TMemo;
DBGrid1: TDBGrid;
ds: TDataSource;
cds: TClientDataSet;
cdsip: TStringField;
cdsport: TStringField;
edtIp: TLabeledEdit;
edtPort: TLabeledEdit;
btnStart: TButton;
TCPServer: TIdTCPServer;
TimerHeartBeat: TTimer;
procedure btnStartClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TCPServerExecute(AContext: TIdContext);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TimerHeartBeatTimer(Sender: TObject);
private
{ Private declarations }
FCriticalSection: TCriticalSection;
FClientAuthList: TStringList;
FMiddleList: TStringList;
procedure AddLine(const sText: string);
function GetRandom: Integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.AddLine(const sText: string);
begin
if sText = '' then
Exit;
if Memo1.Lines.Count >= 1000 then
Memo1.Clear
else
begin
Memo1.Lines.Add(formatdatetime('yyyy-mm-dd hh:nn:ss', Now) + ' ' + sText);
end;
end;
procedure TForm1.btnStartClick(Sender: TObject);
begin
if btnStart.Caption = '启动' then
begin
TCPServer.Bindings.Clear;
with TCPServer.Bindings.Add do
begin
IP := edtIP.Text;
Port := StrToInt(edtPort.Text);
end;
TCPServer.Active := True;
btnStart.Caption := '停止';
AddLine('代理服务器已启动');
end
else
begin
if MessageDlg('是否停止代理服务器？', mtConfirmation, [mbYes, mbNo], 0) = mrYes then
begin
TCPServer.Active := false;
btnStart.Caption := '启动';
AddLine('代理服务器已停止');
end;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if btnStart.Caption = '停止' then
begin
AddLine('先停止代理服务器，然后才能关闭');
Abort;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FCriticalSection := TCriticalSection.Create;
FClientAuthList := TStringList.Create;
FMiddleList := TStringList.Create;
btnStart.Click;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(FCriticalSection);
FreeAndNil(FClientAuthList);
FreeAndNil(FMiddleList);
end;
function TForm1.GetRandom: Integer;
begin
Result := -1;
if cds.RecordCount <= 0 then
Exit;
Randomize;
Result := Random(cds.RecordCount);
end;
procedure TForm1.TCPServerExecute(AContext: TIdContext);
var
buf: TBytes;
msgHead: THead;
msg1: TAuth;
msg101: TAuth_Resp;
msg2: TConnectMiddle;
msg102: TConnectMiddle_Resp;
msg5: TMiddleHeartBeat;
msg105: TMiddleHeartBeat_Resp;
iRec: Integer;
middle: TMiddle;
client: TClient;
i: Integer;
begin
AContext.Connection.IOHandler.ReadBytes(buf, SizeOf(msgHead));
BytesToRaw(buf, msgHead, SizeOf(msgHead));
case msgHead.Command of
c_Auth: // 客户向代理服务器验证
begin
AContext.Connection.IOHandler.ReadBytes(buf,
SizeOf(msg1) - SizeOf(msgHead));
BytesToRaw(buf, msg1, SizeOf(msg1));
if (msg1.Username = c_UserName) and (msg1.Password = c_Password) then
begin
msg101.Status := 0;
client := TClient.Create(Self);
client.ip := AContext.Binding.PeerIP;
client.port := AContext.Binding.PeerPort;
client.LastHeartBeat := GetTickCount;
FClientAuthList.AddObject(client.ip, client);
end
else
msg101.Status := 1;
msg101.Head.Command := c_auth_resp;
AContext.Connection.IOHandler.Write(RawToBytes(msg101, SizeOf(msg101)));
end;
c_ConnectMiddle: // 客户向代理服务器申请连接中间件
begin
if FClientAuthList.IndexOf(AContext.Binding.PeerIP)=-1 then
begin
msg102.Status := 1;
AContext.Connection.IOHandler.
Write(RawToBytes(msg102, SizeOf(msg102)));
AContext.Connection.Disconnect;
Exit;
end;
AContext.Connection.IOHandler.ReadBytes(buf,
SizeOf(msg2) - SizeOf(msgHead));
BytesToRaw(buf, msg2, SizeOf(msg2));
FCriticalSection.Enter;
try
iRec := GetRandom;
if iRec = -1 then
begin
msg102.Status := 1;
end
else
begin
cds.RecNo := iRec;
msg102.Status := 0;
StrPCopy(msg102.IP, AnsiString(cds.FieldByName('ip').Text));
msg102.Port := cds.FieldByName('port').AsInteger;
end;
finally
FCriticalSection.Leave;
end;
msg102.Head.Command := c_ConnectMiddle_Resp;
AContext.Connection.IOHandler.Write(RawToBytes(msg102, SizeOf(msg102)));
end;
c_MiddleHeartBeat:
begin
AContext.Connection.IOHandler.ReadBytes(buf,
SizeOf(msg5) - SizeOf(msgHead) );
BytesToRaw(buf, msg5, SizeOf(msg5));
FCriticalSection.Enter;
try
i := FMiddleList.IndexOf(string(msg5.IP));
if i <> -1 then
begin
TMiddle(FMiddleList.Objects[i]).LastHeartBeat := GetTickCount;
msg105.Status := 0;
end
else
begin
middle := TMiddle.Create(Self);
middle.ip := string(msg5.IP);
middle.port := msg5.Port;
middle.LastHeartBeat := GetTickCount;
FMiddleList.AddObject(middle.ip, middle);
cds.Append;
cds.FieldByName('ip').AsString := middle.ip;
cds.FieldByName('port').AsInteger := middle.port;
cds.Post;
end;
msg105.Head.Command := c_MiddleHeartBeat_Resp;
AContext.Connection.IOHandler.Write(RawToBytes(msg105, SizeOf(msg105)));
finally
FCriticalSection.Leave;
end;
end;
end;
end;
procedure TForm1.TimerHeartBeatTimer(Sender: TObject);
var
i: Integer;
begin
if cds.IsEmpty or (FMiddleList.Count <= 0) then
Exit;
for i:= 0 to FMiddleList.Count-1 do
begin
if ((GetTickCount - TMiddle(FMiddleList.Objects[i]).LastHeartBeat) / 1000)
>= c_MiddleOffLine then
begin
FCriticalSection.Enter;
try
if cds.Locate('ip', VarArrayOf([TMiddle(FMiddleList.Objects[i]).ip]), []) then
begin
cds.Delete;
end;
FMiddleList.Delete(i);
finally
FCriticalSection.Leave;
end;
end;
end;
end;
end.