代理服务器

// 单元功用：代理服务器协议
// 单元设计：陈新光
// 设计日期：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.