盒子论坛 v2.1

interface

uses
  Windows, Messages, SysUtils,Classes, NMUDP,WinSock,ExtCtrls,GlobalU;

const
  SERVICE_LIST_LENGTH  = 200;
  MAX_UDP_BUFFER = 1024;

type
  TApplyType = (atServer,atAssign,atClient);
// TWindowWait = record
//   WinID:  Integer;
//   WinNum: Integer;      {在全局单元GlobalU单元中申明}
// end;

  TServiceList = record
    ServiceID: String;
    ServiceName: String;
  end;

  TEventFindHost = procedure(FromIP: String;var Handle: Boolean) of Object;
  TEventReCall = procedure(WindowID: Integer) of Object;
  TEventCancel = procedure(WindowID: Integer) of Object;
  TEventPause = procedure(WindowID: Integer;var Amount: Integer;var ServiceID: String) of Object;
  TEventCallNext = procedure(WindowID: Integer;var QueueCode,Wait,Amount: Integer;var ServiceID,ServiceName: String;var WinWaitList: array of TWindowWait) of Object;
  TEventSelectCall = procedure(WindowID: Integer;var QueueCode,Wait,Amount: Integer;var ServiceID,ServiceName: String;var WinWaitList: array of TWindowWait) of Object;
  TEventRemove = procedure(WindowID: Integer;ServiceID,MoveWindowID: String) of Object;
  TEventGetWait = procedure(WindowID: Integer;var Wait: Integer) of Object;
  TEventGetServiceList = procedure(var ServiceList: String) of Object;
  TEventGetWindowList = procedure(var WindowList: String) Of Object;
  TEventAssignCode = procedure(Button: Integer;var ServiceID: String;var QueueCode,Wait: Integer;var ServiceName,GetCodeTime,Description: String) of Object;
  TEventNewWindow = procedure(WindowID: Integer;var ServiceID: String;var QueueCode,Wait,Amount: Integer) of Object;
  TEventServerQuit = procedure(IPAddress: String);

  TResultOfNormal = procedure(Success: Boolean) of Object;
  TResultOfCall = procedure(QueueCode,Wait,Ammount: Integer;ServiceID: String) of Object;
  TResultOfFindHost = procedure(FromIP: String;Success: Boolean) of Object;
  TResultOfNewWindow = procedure(ServiceID: String;QueueCode,Wait,Amount: Integer) of Object;
  TResultOfPause = procedure(Ammount: Integer;ServiceID: String) of Object;
  TResultOfGetWait = procedure(WindowID,Wait: Integer) of Object;
  TResultOfBCWait = procedure(ServiceID: String;Wait: Integer) of Object;
  TResultOfAssignCode = procedure(QueueCode,Wait: Integer;ServiceName,GetCodeTime,Description: String) of Object;

  TResultOfGetServiceList = procedure(ServiceList: String) Of Object;
  TResultOfGetWindowList = procedure(WindowList: String) of Object;
  TResultOfServerQuit = procedure(ServerIP: String) of Object;
  TResultOfTimeOut = procedure(Sender: TObject) of Object;

  TCommunicate = class(TNMUDP)
  private
    FApplyType: TApplyType;
    FTimer: TTimer;

    FOnFindHost: TEventFindHost;
    FOnNewWindow: TEventNewWindow;
    FOnCallNext: TEventCallNext;
    FOnSelectCall: TEventSelectCall;

    FOnReCall: TEventReCall;
    FOnCancel: TEventCancel;
    FOnPause: TEventPause;
    FOnRemove: TEventRemove;
    FOnGetWait: TEventGetWait;
    FOnGetServiceList: TEventGetServiceList;
    FOnGetWindowList: TEventGetWindowList;
    FOnAssignCode: TEventAssignCode;
    FOnServerQuit: TEventServerQuit;

    FOnResultOfFindHost: TResultOfFindHost;
    FOnResultOfNewWindow: TResultOfNewWindow;
    FOnResultOfCall: TResultOfCall;

    FOnResultOfReCall: TResultOfNormal;
    FOnResultOfCancel: TResultOfNormal;
    FOnResultOfRemove: TResultOfNormal;
    FOnResultOfPause:  TResultOfPause;
    FOnResultOfGetWait: TResultOfGetWait;
    FOnResultOfBCWait: TResultOfBCWait;
    FOnResultOfGetServiceList: TResultOfGetServiceList;
    FOnResultOfGetWindowList: TResultOfGetWindowList;
    FOnResultOfAssignCode: TResultOfAssignCode;
    FOnResultOfServerQuit: TResultOfServerQuit;
    FOnResultOfTimeOut: TResultOfTimeOut;
    procedure TimerOnTime(Sender: TObject);

    procedure ResponseCallNext(FromIP,Param: String);
    procedure ResponseReCall(FromIP,Param: String);
    procedure ResponseCancel(FromIP,Param: String);
    procedure ResponsePause(FromIP,Param: String);
    procedure ResponseFindHost(FromIP,Param: String);
    procedure ResponseNewWindow(FromIP,Param: String);
    procedure ResponseGetWait(FromIP,Param: String);

    procedure ResponseRemove(FromIP,Param: String);
    procedure ResponseSelectCall(FromIP,Param: String);
    procedure ResponseGetServiceList(FromIP,Param: String);
    procedure ResponseGetWindowList(FromIp,Param: String);
    procedure ResponseServerQuit(FromIP,Param: String);

    procedure ResultOfCall(FromIP,Param: String);
    procedure ResultOfFindHost(FromIP,Param: String);
    procedure ResultOfNewWindow(FromIP,Param: String);
    procedure ResultOfReCall(FromIP,Param: String);
    procedure ResultOfCancel(FromIP,Param: String);
    procedure ResultOfRemove(FromIP,Param: String);
    procedure ResultOfGetServiceList(FromIP,Param: String);
    procedure ResultOfGetWindowList(FromIP,Param: String);
    procedure ResultOfGetWait(FromIP,Param: String);
    procedure ResultOFBCWait(FromIP,Param: String);
    procedure ResultOfPause(FromIP,Param: String);
    procedure ResultOfAssignCode(FromIP,Param: String);
    procedure ResultOfServerQuit(FromIP,Param: String);

    function AnalyzeParameter(Value: String;Param: Integer): String;
    procedure SendString(IPAddr,Str: String);
    procedure DataReceived(Sender: TComponent;NumberBytes: Integer; FromIP: String; Port: Integer);
    procedure BufferInvalid(var handled: Boolean;var Buff: array of Char; var length: Integer);
    procedure InvalidHost(var handled: Boolean);
  protected
    procedure QueueServerQuit;
  public
    constructor Create(AOwner: TComponent;AApplyType: TApplyType);
    destructor Destroy;override;

    function GetBroadCastIP(IPAddr: String; BCType: Integer): String;
    function GetLocalIP: String;
    procedure QueueFindHost; overload;
    procedure QueueFindHost(HostPort: Integer); overload;
    procedure QueueNewWindow(WindowID: Integer);
    procedure QueueCallNex(WindowID: Integer);
    procedure QueueCancel(WindowID: Integer);
    procedure QueueReCall(WindowID: Integer);
    procedure QueuePause(WindowID: Integer);
    procedure QueueSelectCall(WindowID,QueueCode: Integer);
    procedure QueueRemove(WindowID: Integer;MoveServiceID,MoveWinID:String);
    procedure QueueGetServiceList;
    procedure QueueGetWindowList;
    procedure QueueBroadCastWait(ServiceID: String;Wait: Integer);
    procedure QueueSendWait(WindowID,Wait: Integer);
    procedure QueueAssignCode(ButtonID: Integer;ServiceID: String);

    property OnFindHost: TEventFindHost read FOnFindHost write FOnFindHost;        //寻找服务器
    property OnNewWindow: TEventNewWindow read FOnNewWindow write FOnNewWindow;    //新窗口连接
    property OnCallNext: TEventCallNext read FOnCallNext write FOnCallNext;        //有取号
    property OnReCall: TEventReCall read FOnReCall write FOnReCall;                //有重呼
    property OnCancel: TEventCancel read FOnCancel write FOnCancel;                //取消
    property OnPause: TEventPause read FOnPause write FOnPause;                    //有窗口暂停
    property OnGetServiceList: TEventGetServiceList read FOnGetServiceList write FOnGetServiceList; //取业务列表
    property OnGetWindowList: TEventGetWindowList read FOnGetWindowList write FOnGetWindowList;     //取窗口列表
    property OnAssignCode: TEventAssignCode read FOnAssignCode write FOnAssignCode;                 //派号
    property OnSelectCall: TEventSelectCall read FOnSelectCall write FOnSelectCall;                 //选呼
    property OnRemove: TEventRemove read FOnRemove write FOnRemove;                                 //转号
    property OnGetWait: TEventGetWait read FOnGetWait write FOnGetWait;                             //取等待人数

    property OnResultOfBCWait: TResultOfBCWait read FOnResultOfBCWait write FOnResultOfBCWait;      //接收到广播的等待人数

    property OnResultOfFindHost: TResultOfFindHost read FOnResultOFFindHost write FOnResultOfFindHost;      //寻找服务器返回
    property OnResultOfNewWindow: TResultOfNewWindow read FOnResultOfNewWindow write FOnResultOfNewWindow;  //新窗口置之不连接返回
    property OnResultOfCall: TResultOfCall read FOnResultOfCall write FOnResultOfCall;                      //取号返回包括顺呼选呼
    property OnResultOfReCall: TResultOfNormal read FOnResultOfReCall write FOnResultOfReCall;              //重呼返回
    property OnResultOfCancel: TResultOfNormal read FOnResultOfCancel write FOnResultOfCancel;
    property OnResultOfPause: TResultOfPause read FOnResultOfPause write FOnResultOfPause;
    property OnResultOfRemove: TResultOfNormal read FOnResultOfRemove write FOnResultOfRemove;
    property OnResultOfGetServiceList: TResultOfGetServiceList read FOnResultOfGetServiceList write FOnResultOfGetServiceList;
    property OnResultOfGetWindowList: TResultOfGetWindowList read FOnResultOfGetWindowList write FOnResultOfGetWindowList;
    property OnResultOfAssignCode: TResultOfAssignCode read FOnResultOfAssignCode write FOnResultOfAssignCode;
    property OnResultOfGetWait: TResultOfGetWait read FOnResultOfGetWait write FOnResultOfGetWait;
    property OnServerQuit: TResultOfServerQuit read FOnResultOfServerQuit write FOnResultOfServerQuit;
    property OnTimeOut: TResultOfTimeOut read FOnResultOfTimeOut write FOnResultOfTimeOut;
  end;
implementation

{ TCommunicate }

function TCommunicate.AnalyzeParameter(Value: String;Param: Integer): String;
var
  ii: Integer;
begin
  if Trim(Value) = ' then Exit;
  for ii := 1 to Param do
  begin
    if Pos(',',Value) > 0 then
    Result := Copy(Value,1,Pos(',',Value) - 1)
    else
    Result := Value;
    Value := Copy(Value,Pos(',',Value) + 1,MAXWORD);
  end;
end;

procedure TCommunicate.BufferInvalid(var handled: Boolean;
  var Buff: array of Char; var length: Integer);
begin

end;

constructor TCommunicate.Create(AOwner: TComponent;AApplyType: TApplyType);
begin
  inherited Create(AOwner);
  FApplyType := AApplyType;
  if FApplyType = atServer then
  begin
    LocalPort := 6010;
    RemotePort := 6011;
  end;
  if FApplyType = atClient then
  begin
    LocalPort := 6011;
    RemotePort := 6010;
  end;

  if FApplyType = atAssign then
  begin
    LocalPort := 6011;
    RemotePort := 6010;
  end;

  FTimer := TTimer.Create(Self);
  FTimer.Enabled := False;
  FTimer.Interval := 20000;
  FTimer.OnTimer := TimerOnTime;

  OnDataReceived := DataReceived;
end;

procedure TCommunicate.DataReceived(Sender: TComponent;NumberBytes: Integer; FromIP: String; Port: Integer);
var
  Buf: array[0..MAX_UDP_BUFFER] of Char;
  iCount: Integer;
  Str: String;
begin
  ReadBuffer(Buf,iCount);
  if (Buf[0] <> '#') OR (Buf[1] <> '#') OR (iCount < 3) then Exit;
  Str := Copy(Buf,3,iCount - 2);

  if FApplyType = atServer then
  case Str[1] of
    'F':  ResponseFindHost(FromIP,Str);      //响应F:Find     寻找主机
    'W':  ResponseGetWait(FromIP,Str);      //响应W:Wait     请求等待人数
    'N':  ResponseNewWindow(FromIP,Str);       //响应N:New      新窗口注册
    'C':  ResponseCallNext(FromIP,Str);      //响应C:Call     取下一号
    'R':  ResponseReCall(FromIP,Str);      //响应R:ReCall   重呼
    'P':  ResponsePause(FromIP,Str);       //响应暂停
    'L':  ResponseCancel(FromIP,Str);          //响应取消
    'Y':  ResponseGetServiceList(FromIP,Str);  //响应取业务列表
    'K':  ResponseGetWindowList(FromIP,Str);   //响应取窗口列表
    'E':  ResponseSelectCall(FromIP,Str);      //响应选呼
    'V':  ResponseRemove(FromIP,Str);          //响应转号
  end;

  FTimer.Enabled := FApplyType = atServer;     //停止超时计时

  if FApplyType = atClient then
  case Str[1] of
    'F':  ResultOfFindHost(FromIP,Str);       //寻找主机返回
    'W':  ResultOfGetWait(FromIP,Str);        //取等待人数返回
    'B':  ResultOFBCWait(FromIP,Str);         //收到广播等待人数
    'N':  ResultOfNewWindow(FromIP,Str);      //新开窗口
    'C':  ResultOfCall(FromIP,Str);           //顺呼返回
    'R':  ResultOfReCall(FromIP,Str);         //重呼返回
    'P':  ResultOfPause(FromIP,Str);          //暂停返回
    'L':  ResultOfCancel(FromIP,Str);          //取消返回
    'Y':  ResultOfGetServiceList(FromIP,Str); //取得业务列表
    'K':  ResultOfGetWindowList(FromIP,Str);  //取窗口列表
    'E':  ResultOfCall(FromIP,Str);           //选呼返回
    'V':  ResultOfRemove(FromIP,Str);         //转号返回
    'Q':  ResultOfServerQuit(FromIP,Str);     //服务器退出通知
  end;

  if FApplyType = atAssign then
  case Str[1] of
    'F':  ResultOfFindHost(FromIP,Str);        //响应F:Find     寻找主机
    'Y':  ResultOfGetServiceList(FromIP,Str);  //取业务列表
    'A':  ResultOfAssignCode(FromIP,Str);      //派号返回
    'Q':  ResultOfServerQuit(FromIP,Str);     //服务器退出通知
  end;

end;
procedure TCommunicate.QueueBroadCastWait(ServiceID: String;Wait: Integer);
begin
  SendString(GetBroadCastIP(GetLocalIP,0),'##B' + ServiceID + ',' + IntToStr(Wait));
end;

procedure TCommunicate.SendString(IPAddr, Str: String);
var
  Buf: array[0..1023] of Char;
begin
  StrPCopy(Buf,Str);
  RemoteHost := IPAddr;
  SendBuffer(Buf,Length(Str));
  FTimer.Enabled := FApplyType <> atServer;   //如果不是服务端则开始超时计时
end

----------------------------------------------

信息

登陆以后才能回复