{*******************************************************}
{      單元名：  UntUdpCtl.pas                          }
{      創建日期：2006-6-9 14:20:12                      }
{      創建者    馬敏釗                                 }
{      功能：    V1.0                                   }
{                UDP的安全傳輸控制類暫時基于NMUDP       }
{                 負責                                  }
{                  分包控制                             }
{                  應答控制                             }
{                  重發控制                             }
{            包頭大于CSafeUdpData的數據就是本類的       }
{            控制處理協議                               }
{*******************************************************}

unit UntUdpCtl;

interface

uses Classes, NMUDP, sysutils, Contnrs;

const
  CSafeUdpData = 100000; {UDP數據控制包的最低命令號}
  CSafeUdpData_Uses = 200000; {用戶使用的命令}
  CSafeUdpData_RecvResp = CSafeUdpData_Uses + 1; //回應收到命令
  CSafeUdpHeadSingl = 234;

type
  EUdpCtlReTryNoResp = class(Exception); {重試N次后報錯}
  EUdpCtlTimeOut = class(Exception); {一直重試直到超時}
  {丟包的處理方式}
  SHeadLv = (SDoDrop {重試N次后就不再發送}, SDoError {重試N次后報錯}, SDoTimeOut {一直重試直到超時});
  {包頭}
  PSafeUdphead = ^RSafeUdphead;
  RSafeUdphead = packed record
    Id: Integer; {命令號}
    Singl: Byte; {標志號234 用于判斷是否是屬于SafeUDP的包的標志}
    IsNeedResp: boolean; {是否需要回復}
    Part, TotPart: Word; {包的第幾部分,共有幾部分}
    Lv: SheadLv; {包的等級 0、 1、 2}
    PackedId: Cardinal; {包的ID號 ，如果此號大于0說明需要回應}
    Size: Cardinal; {大小}
  end;
  {數據包}
  PSafeUdpData = ^RSafeUdpData;
  RSafeUdpData = packed record
    Head: RSafeUdphead; {包頭}
    Data: Pointer; {包體}
    SendTime: Cardinal; {發送時間}
    ReTryCount: Byte; {重試次數}
  end;
  {混合包類}
  TDataMixer = class
  public
    Id: Cardinal; {包的ID}
    BeginTime: Cardinal; {開始混合的時間}
    TotPart, CurrPart: Byte; {包的總數，現有的包數}
    DataList: TStrings; {數據列表}
    constructor Create();
    destructor Destroy; override;
  end;

  SUDPSendKind = (SUSKFreeWindows {滑動窗口模式}, SUSKOnlyOne {每次只發送一個命令直到返回才繼續});
  SUdpCtlState = (SRaiseExpection {拋出異常}, SUseErrorEvent {執行錯誤事件}); {Udp控制狀態}
  TudpCtl = class;
  TUdpSenderThread = class(TThread) {數據發送處理線程}
  public
    Owner: TudpCtl;
    procedure Execute; override;
    constructor Create(ISStop: boolean; IOwner: TudpCtl);
  end;
  TUdpRecThread = class(TThread) {數據接收處理線程}
  public
    Owner: TudpCtl;
    procedure Execute; override;
    constructor Create(ISStop: boolean; IOwner: TudpCtl);
  end;
  TUdpSendedThread = class(TThread) {數據重發處理線程}
  public
    Owner: TudpCtl;
    procedure Execute; override;
    constructor Create(ISStop: boolean; IOwner: TudpCtl);
  end;

  TSafeUDPRecData = procedure(ISender: TudpCtl; IData: Pointer; ISize: Cardinal;
    IFromIP: string; IPort: integer) of object;
  TSafeUDPError = procedure(Sender: TObject; IData: PSafeUdpData; IErrorKind: SHeadLv) of object;
  TudpCtl = class(TNMUDP)
  private
    FSendKind: SUDPSendKind;
    FErrorKind: SUdpCtlState;
    FFreeWindowsCount: Byte;
    FPackedId: Cardinal;
    //SendCount, ErrorCount: Cardinal; {發包數量,錯包數量}
    procedure ClearOneData(iidx: Integer; IList: Tstrings); overload; {釋放一個包}
    procedure ClearList(IList: TStrings); {清空列表}
    procedure ClearQueue(IQueue: TQueue); {清空隊列}
    function GetAnPackedId: Cardinal; {獲取一個數據包ID}
    function GetAnPackedData(IDataSize: integer): PSafeUdpData; {獲取一個包}
    procedure OnData(Sender: TComponent; NumberBytes: Integer; FromIP: string; Port: integer); {處理接收數據}
  protected
    SenderThread: TUdpSenderThread; {發送處理線程}
    RecThread: TUdpRecThread; {接收處理線程}
    SendedThrad: TUdpSendedThread; {狀態處理線程}
    {已發送的數據列表，隊列中等待發送的數據列表,數據混合列表,數據接收列表}
    SendedList, SendingList, DataMixList: TStrings;
    RecQueue: TQueue; {接收隊列}
    SendMemory: TMemoryStream; {正在發送緩沖，和剩余發送緩沖}
//------------------------------------------------------------------------------
// 自動觸發的事件 2006-6-5 馬敏釗
//------------------------------------------------------------------------------
    procedure OnReSendEvent(Sender: TObject); {到時重發事件}
    procedure OnTimeOutEvent(Sender: TObject); {接收超時事件}
//------------------------------------------------------------------------------
// 可供子類改寫的方法 2006-6-9 馬敏釗
//------------------------------------------------------------------------------
    procedure PackedData(var IBuff; ISize: Cardinal; Ilv: SheadLv); {包裹數據}
    procedure UnPackedData(IMixer: TDataMixer); {反包裹數據}
    procedure AddToSendList(IId: string; IData: Pointer);
    procedure DidSend(IData: PSafeUdpData); {實際的發送過程}
    function CheckPacked(IData: PSafeUdphead): Integer; {*檢查是否是SafeUdp的包}
    function MixData(IData: PSafeUdpData; Iidx: integer): boolean; {混合包}
    procedure InterSleep; {動態調整間隔時間}
    {安全控制數據處理過程 返回值為是否需要交給邏輯程序繼續處理}
    function CaseData(IData: Pointer; IPeerIP: string; IPeerPort, IDataLen:
      Integer): Boolean;
      {檢查發送的數據}
    procedure CheckData;
   {處理數據}
    procedure DidData;
    {發送數據}
    procedure SendData;
  public
    MaxReSendCount: Byte; {最大重試次數 默認為3}
    PeerSize: Word; {分包時每個包的大小 默認為1024}
    WaiteTimeOut, ReSendTime: Cardinal; {超時時間 默認為3000,丟包重發時間500}
    CurrRealData {當前的實際已經處理完畢的包}: TMemoryStream;
    CurrDataSize: Cardinal; {當前數據的大小}
    SleepTime: Cardinal; {內部睡眠時間}
    OnDataCase: TSafeUDPRecData; {用戶自己的處理事件}
    OnDataError: TSafeUDPError; {數據錯誤時觸發的事件}
//------------------------------------------------------------------------------
// 屬性 2006-6-9 馬敏釗
//------------------------------------------------------------------------------
   {錯誤處理方式 默認為使用事件}
    property ErrorKind: SUdpCtlState read FErrorKind write FErrorKind;
   {發送模式 默認為滑動窗口方式}
    property SendKind: SUDPSendKind read FSendKind write FSendKind;
   {滑動窗口數量 默認為10}
    property FreeWindowsCount: Byte read FFreeWindowsCount write FFreeWindowsCount;
//------------------------------------------------------------------------------
// 提供給外界的接口 2006-6-5 馬敏釗
//------------------------------------------------------------------------------
    class procedure ClearOneData(IData: PSafeUdpData); overload; {釋放一個包}
    {安全發送數據 自動分包}
    class function IsUdpCtlData(IData: Pointer; ISize: Integer): boolean;
    procedure SetCurrData(Idata: Pointer; ISize: Integer); {設置當前的數據}
    procedure SafeSendBuff(IIp: string; IPort: Word; var IBuff; ISize: Cardinal;
      Ilv: SheadLv); overload;
    procedure SafeSendBuff(var IBuff; ISize: Cardinal; Ilv: SheadLv = SDoError);
      overload;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

implementation

uses IniFiles, windows, untfunctions, UntProctol, pmybasedebug;

type
  {接收到的數據}
  TDataer = class
  public
    FromIP: string;
    Port: Word;
    Data: Pointer;
    Size: Cardinal;
    constructor Create(IFromIP: string; IPort: Word; ISource: Pointer; ISize: Cardinal);
    destructor Destroy; override;
  end;

function OrderShort(List: TStringList; Index1, Index2: Integer): Integer; {排序}
begin
  Result := IfThen(StrToInt(List.Strings[Index1]) > StrToInt(List.Strings[Index2]), 1, -1);
end;
{ TudpCtl }

constructor TudpCtl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SleepTime := 10;
  MaxReSendCount := 3;
  WaiteTimeOut := 3000;
  PeerSize := 1024; //512 + 256;
  FPackedId := 0;
  ReSendTime := 200;
  FSendKind := SUSKFreeWindows;
  FErrorKind := SUseErrorEvent;
  FFreeWindowsCount := 4;
  SendedList := THashedStringList.Create;
  SendingList := THashedStringList.Create;
  DataMixList := THashedStringList.Create;
  RecQueue := TQueue.Create;
  SendMemory := TMemoryStream.Create;
  CurrRealData := TMemoryStream.Create;
  SenderThread := TUdpSenderThread.Create(False, Self);
  RecThread := TUdpRecThread.Create(False, Self);
  SendedThrad := TUdpSendedThread.Create(False, Self);
  OnDataReceived := OnData;
end;

destructor TudpCtl.Destroy;
var
  i: Integer;
begin
  SenderThread.FreeOnTerminate := True;
  SenderThread.Terminate;
  RecThread.FreeOnTerminate := True;
  RecThread.Terminate;
  SendedThrad.FreeOnTerminate := True;
  SendedThrad.Terminate;
  Sleep(20);
  for i := 0 to DataMixList.Count - 1 do
    DataMixList.Objects[i].Free;
  DataMixList.Free;
  ClearQueue(RecQueue);
  RecQueue.Free;
  ClearList(SendingList);
  SendingList.Free;
  ClearList(SendedList);
  SendedList.Free;
  CurrRealData.Free;
  SendMemory.Free;
  inherited;
end;

function TudpCtl.CaseData(IData: Pointer; IPeerIP: string; IPeerPort, IDataLen:
  Integer): Boolean;
var
  LP: PChar;
  LData: PSafeUdpData;
  LReData: RSafeUdphead;
  LIndex: Integer;
  LIdx: string;
begin
  Result := False;
  LReData := PSafeUdphead(IData)^;
  CurrDataSize := LReData.Size;
  {判斷如果是回復包 則刪除等待回復的包}
  if LReData.Id = CSafeUdpData_RecvResp then begin
    LIdx := IntToStr(LReData.PackedId);
    LIdx := LIdx + '_' + IntToStr(LReData.Part);
    LIndex := SendedList.IndexOf(LIdx);
    if LIndex > -1 then
      SendedList.Delete(LIndex);
    exit;
  end;
  {判斷是否需要回復}
  if LReData.IsNeedResp then begin
    LReData.Id := CSafeUdpData_RecvResp;
    LReData.Singl := CSafeUdpHeadSingl;
    LReData.IsNeedResp := False;
    RemoteHost := IPeerIP;
    RemotePort := IPeerPort;
    SendBuffer(LReData, Sizeof(LReData));
   // Gob_Debug.AddLogShower('回復數據包--->:' + IntToStr(LReData.PackedId) + '_' + IntToStr(LReData.Part));
  end;
  {否則就是數據包}
  {判斷是否是需要組合的包}
  if LReData.TotPart > 1 then begin
    LIndex := CheckPacked(PsafeUdpHead(IData));
    if LIndex > -1 then begin
    {生成一個包}
    //Gob_Debug.AddLogShower('>>>%d-%d---%d', [PsafeUdpHead(IData)^.PackedId, PsafeUdpHead(IData)^.Part, PsafeUdpHead(IData)^.Size]);
      LData := GetAnPackedData(PsafeUdpHead(IData)^.Size);
      LData^.Head := PsafeUdpHead(IData)^;
      LP := IData;
      inc(LP, Sizeof(RSafeUdpHead));
      CopyMemory(LData^.Data, LP, LData^.Head.Size);
      Result := MixData(LData, LIndex);
    end;
  end
  else begin
    CurrRealData.SetSize(LReData.Size);
    LP := IData;
    inc(LP, Sizeof(RSafeUdpHead));
    CurrRealData.Position := 0;
    CurrRealData.WriteBuffer(Lp^, LReData.Size);
    Result := True;
  end;
end;

procedure TudpCtl.SafeSendBuff(IIp: string; IPort: Word; var IBuff; ISize:
  Cardinal; Ilv: SheadLv);
begin
  RemoteHost := IIp;
  RemotePort := IPort;
  SafeSendBuff(IBuff, ISize, Ilv);
end;

function TudpCtl.GetAnPackedId: Cardinal;
begin
  inc(FPackedId);
  Result := FPackedId;
  if FPackedId = high(Cardinal) then
    FPackedId := 0;
end;

procedure TudpCtl.OnReSendEvent(Sender: TObject);
begin

end;

procedure TudpCtl.OnTimeOutEvent(Sender: TObject);
begin

end;

procedure TudpCtl.CheckData;
var
  I: Integer;
  LData: PSafeUdpData;
begin
  {檢查每一個發送出去并且需要回應的數據}
  for I := SendedList.Count - 1 downto 0 do begin // Iterate
    try
      LData := PSafeUdpData(SendedList.Objects[i]);
      {判斷時間是否超過 ReSendTime 超過了才去檢查}
      if (GetTickCount - LData^.SendTime < ReSendTime) then begin
        Continue;
      end;
      {重試N次后就不再發送,重試N次后報錯,一直重試直到超時}
      case LData^.Head.Lv of //
        SDoDrop: begin
            if LData^.ReTryCount <= MaxReSendCount then begin
              LData^.SendTime := GetTickCount;
              Inc(LData^.ReTryCount);
              SendBuffer(LData^.Data^, LData^.Head.Size);
              InterSleep;
            end
            else begin
              //丟棄當前包
              SendedList.Delete(i);
              if FErrorKind = SUseErrorEvent then
                if assigned(OnDataError) then
                  OnDataError(Self, LData, SDoDrop);
            end;
          end;
        SDoError: begin
            if LData^.ReTryCount <= MaxReSendCount then begin
              LData^.SendTime := GetTickCount;
              Inc(LData^.ReTryCount);
              SendBuffer(LData^.Data^, LData^.Head.Size);
              InterSleep;
            end
            else begin
              SendedList.Delete(i);
              if FErrorKind = SUseErrorEvent then begin
                if assigned(OnDataError) then
                  OnDataError(Self, LData, SDoError);
              end else
                raise EUdpCtlReTryNoResp.CreateFmt('數據包在重試%d次后仍然無回應', [MaxReSendCount]);
            end;
          end;
        SDoTimeOut: begin
            if GetTickCount - LData^.SendTime >= WaiteTimeOut then begin
              if FErrorKind = SUseErrorEvent then begin
                if assigned(OnDataError) then
                  OnDataError(Self, LData, SDoTimeOut);
              end else
                raise EUdpCtlTimeOut.CreateFmt('數據包回應超時<%d>', [WaiteTimeOut]);
            end
            else begin
              LData^.SendTime := GetTickCount;
              Inc(LData^.ReTryCount);
              SendBuffer(LData^.Data^, LData^.Head.Size);
            end;
          end;
      end; // case
    except

    end;
  end; // for
end;


procedure TudpCtl.ClearOneData(iidx: Integer; IList: Tstrings);
var
  LP: PSafeUdpData;
begin
  LP := Pointer(SendedList.Objects[iidx]);
  ClearOneData(LP);