untudpctl.pas

一个有关Delphi 中 UDP协议的实列

  SendedList.Delete(iidx);
end;

function TudpCtl.GetAnPackedData(IDataSize: integer): PSafeUdpData;
var
  LData: PSafeUdpData;
begin
  if IDataSize < 1 then
    raise Exception.Create('申请内存时发现申请大小为0，抛出异常');
  New(ldata);
  LData^.Data := GetMemory(IDataSize);
  LData^.SendTime := GetTickCount;
  LData^.ReTryCount := 0;
  Result := LData;
end;

procedure TudpCtl.AddToSendList(IId: string; IData: Pointer);
begin
  SendingList.AddObject(IId, IData);
end;

procedure TudpCtl.ClearList(IList: TStrings);
var
  i: Integer;
begin
  for I := 0 to IList.Count - 1 do begin // Iterate
    try
      ClearOneData(i, IList);
    except
    end;
  end; //     try
  IList.Clear;
end;


procedure TudpCtl.PackedData(var IBuff; ISize: Cardinal; Ilv: SheadLv);
var
  I: Cardinal;
  LData: PSafeUdpData;
  LTotPart, LSize, LPackedID: Cardinal;
  Lp: PChar;
begin
  LP := @ibuff;
  {开始分包}
  LTotPart := Trunc(ISize / PeerSize); {获取分为几个包}
  if LTotPart * PeerSize <> ISize then
    Inc(LTotPart);
  LPackedID := GetAnPackedId;
  for I := 0 to LTotPart - 1 do begin // Iterate
    LSize := PeerSize;
    if i = LTotPart - 1 then {如果是最后一个包 则调整包为正确的大小}
      LSize := ISize - (LTotPart - 1) * PeerSize;
    {设置包头}
    LData := GetAnPackedData(LSize);
    LData^.Head.Id := CSafeUdpData;
    LData^.Head.PackedId := LPackedID;
    LData^.Head.Lv := Ilv;
    LData^.Head.Part := I;
    LData^.Head.TotPart := LTotPart;
    LData^.Head.Size := LSize;
    LData^.Head.IsNeedResp := True;
    CopyMemory(LData.Data, LP, LSize);
    {移动指针}
    inc(LP, LSize);
    Gob_Debug.AddLogShower('%s---%d', [IntToStr(LData^.Head.PackedId) + '_' + IntToStr(LData^.Head.Part), LSize]);
    {加入发送队列}
    SendingList.AddObject(IntToStr(LData^.Head.PackedId) + '_' + IntToStr(LData^.Head.Part), TObject(LData));
   // AddToSendList(IntToStr(LData^.Head.PackedId) + '_' + IntToStr(LData^.Head.Part), TObject(LData));
  end; // for
end;

procedure TudpCtl.DidSend(IData: PSafeUdpData);
begin
  IData^.Head.Singl := CSafeUdpHeadSingl;
  SendMemory.SetSize(Sizeof(IData^.Head) + IData^.Head.Size);
  SendMemory.Position := 0;
  SendMemory.WriteBuffer(IData^.Head, Sizeof(IData^.Head));
  SendMemory.WriteBuffer(IData^.Data^, IData^.Head.Size);
  {判断是否需要返回}
//  if IData^.Head.PackedId > 0 then begin
//  end;
  {发送}
  SendBuffer(SendMemory.Memory^, SendMemory.Size);
  IData^.SendTime := GetTickCount;
  SendedList.AddObject(IntToStr(IData^.Head.PackedId) + '_' + IntToStr(IData^.Head.Part), TObject(IData));
  Gob_Debug.AddLogShower('发送数据包' + IntToStr(IData^.Head.PackedId) + '_' + IntToStr(IData^.Head.Part));
  InterSleep;
end;

function TudpCtl.MixData(IData: PSafeUdpData; Iidx: integer): boolean;
var
  Lbuff: TDataMixer;
begin
  Result := False;
  {添加到各个包的各个部分}
  Lbuff := TDataMixer(DataMixList.Objects[Iidx]);
  Inc(Lbuff.CurrPart);
  //Lbuff.BeginTime := GetTickCount;
  Lbuff.DataList.AddObject(IntToStr(Idata^.Head.Part), TObject(IData));
  //Gob_Debug.AddLogShower('Check');
  //Gob_Debug.AddLogShower(Lbuff.CurrPart);
  if Lbuff.CurrPart = Lbuff.TotPart then begin
    UnPackedData(Lbuff);
    Gob_Debug.AddLogShower('组包花费%d毫秒', [GetTickCount - Lbuff.BeginTime]);
    {如果组包成功 则返回True允许继续传递数据}
    Result := True;
  end;
end;

procedure TudpCtl.UnPackedData(IMixer: TDataMixer);
var
  i: Integer;
  LTOT: Cardinal;
  Lbuff: PSafeUdpData;
  LFun: TStringListSortCompare;
begin
  with IMixer do begin
    try
      LFun := @OrderShort;
      TStringList(DataList).CustomSort(LFun);
      CurrRealData.Position := 0;
      LTOT := 0;
      Gob_Debug.AddLogShower('Begin Cmb');
      for i := 0 to DataList.Count - 1 do begin // Iterate
        Gob_Debug.AddLogShower(DataList.Strings[i]);
        Lbuff := PSafeUdpData(DataList.Objects[i]);
        CurrRealData.WriteBuffer(lbuff^.Data^, lbuff^.Head.Size);
        inc(LTOT, lbuff^.Head.Size);
        ClearOneData(Lbuff);
      end; // for
      DataList.Clear;
    except
      raise Exception.Create('组包时发生异常');
    end;
    CurrDataSize := LTOT;
    CurrRealData.Position := 0;
  end;
end;

class procedure TudpCtl.ClearOneData(IData: PSafeUdpData);
var
  LP: PSafeUdpData;
begin
  LP := IData;
  FreeMem(LP^.Data);
  Dispose(LP);
end;

class function TudpCtl.IsUdpCtlData(IData: Pointer; ISize: Integer): boolean;
begin
  Result := True;
  if (ISize < Sizeof(RSafeUdphead)) or (Pinteger(IData)^ < CSafeUdpData) then
    Result := False
  else if ISize >= Sizeof(RSafeUdphead) then
    if PSafeUdphead(IData)^.Singl <> CSafeUdpHeadSingl then
      Result := False;
{  if Result then begin
    Gob_Debug.AddLogShower('收到数据包:' + IntToStr(PSafeUdphead(IData)^.PackedId) + '_' + IntToStr(PSafeUdphead(IData)^.Part));
  end;}
end;

procedure TudpCtl.SetCurrData(Idata: Pointer; ISize: Integer);
begin
  CurrRealData.SetSize(ISize);
  CurrRealData.Position := 0;
  CurrRealData.WriteBuffer(idata^, ISize);
  CurrRealData.Position := 0;
end;

procedure TudpCtl.SafeSendBuff(var IBuff; ISize: Cardinal; Ilv:
  SheadLv = SDoError);
begin
  {处理加工数据}
  PackedData(IBuff, ISize, Ilv);
end;

procedure TudpCtl.OnData(Sender: TComponent; NumberBytes: Integer;
  FromIP: string; Port: integer);
begin
  if NumberBytes > 0 then begin
    {接收到队列后先压入队列}
    with TudpCtl(Sender) do begin
      if NumberBytes > CurrRealData.Size then
        CurrRealData.SetSize(NumberBytes);
      ReadBuffer(CurrRealData.Memory^, NumberBytes);
      RecQueue.Push(TDataer.Create(FromIP, Port, CurrRealData.Memory, NumberBytes));
    end; // with
  end;
end;


function TudpCtl.CheckPacked(IData: PSafeUdphead): Integer;
var
  Lidx: Integer;
  Lbuff: TDataMixer;
begin
  Result := -1;
 // if IData^.TotPart > 0 then begin
  Lidx := DataMixList.IndexOf(IntToStr(Idata^.PackedId));
  if Lidx = -1 then begin {*没有这个包}
    Lbuff := TDataMixer.Create;
    Lbuff.Id := Idata^.PackedId;
    Lbuff.TotPart := Idata^.TotPart;
    Lbuff.BeginTime := GetTickCount;
    Lidx := DataMixList.AddObject(IntToStr(Lbuff.Id), lbuff);
  end;
  Lbuff := TDataMixer(DataMixList.Objects[Lidx]);
  if Lbuff.DataList.IndexOf(IntToStr(Idata^.Part)) > -1 then Exit;
  Result := Lidx;
//  end;
end;

procedure TudpCtl.InterSleep;
begin
  Sleep(10);
end;

procedure TudpCtl.ClearQueue(IQueue: TQueue);
var
  Lp: TDataer;
begin
  while IQueue.Count > 0 do begin
    try
      Lp := IQueue.Pop;
      Lp.Free;
    except

    end;
  end; // while
end;

procedure TudpCtl.DidData;
var
  LDataer: TDataer;
begin
  while RecQueue.Count > 0 do begin
    LDataer := TDataer(RecQueue.Pop);
    with LDataer do begin
      if IsUdpCtlData(Data, Size) then begin
        if not CaseData(Data, FromIP, Port, Size) then
          exit;
      end;
      if assigned(OnDataCase) then
        OnDataCase(Self, CurrRealData.Memory, CurrRealData.Size, FromIP, Port);
    end; // with
  end; // while
end;

procedure TudpCtl.SendData;
var
  GLData: PSafeUdpData;
begin
  if (SendingList.Count > 0) {and (SendedList.Count = 0)} then begin
    while SendedList.Count < FFreeWindowsCount do begin
        {判断发送模式}
      case SendKind of //
        SUSKFreeWindows: begin
                {如果已发送列表内数据小于滑动窗口数量 则开始发送}
            if SendedList.Count < FreeWindowsCount then begin
              GLData := PSafeUdpData(SendingList.Objects[0]);
              DidSend(GLData);
              SendingList.Delete(0);
            end
            else
              Sleep(10);
          end;
        SUSKOnlyOne: begin
            if SendedList.Count = 0 then begin
              GLData := PSafeUdpData(SendingList.Objects[0]);
              DidSend(GLData);
              SendingList.Delete(0);
            end
            else begin
              Sleep(10); Break; end;
          end;
      end; // case
    end;
  end
  else
    Sleep(10);
end;

{ TUdpSenderThread }

constructor TUdpSenderThread.Create(ISStop: boolean; IOwner: TudpCtl);
begin
  inherited Create(ISStop);
  Owner := IOwner;
end;

procedure TUdpSenderThread.Execute;
begin
  while not Terminated do begin
    try
      with Owner do begin
        {处理接收到的数据}
        DidData;
        {检查发送出去的列表中的状态}
        CheckData;
        {当有需要发送的数据时循环}
        SendData;
      end; // with
    except
      Sleep(10);
    end; // try
  end; // while
end;

{ TDataMixer }

constructor TDataMixer.Create;
begin
  DataList := THashedStringList.Create;
end;

destructor TDataMixer.Destroy;
var
  i: Integer;
begin
  for i := 0 to DataList.Count - 1 do // Iterate
    TudpCtl.ClearOneData(PsafeUdpData(DataList.Objects[i]));
  DataList.Free;
  inherited;
end;

{ TDataer }

constructor TDataer.Create(IFromIP: string; IPort: Word; ISource: Pointer;
  ISize: Cardinal);
begin
  FromIP := IFromIP;
  Port := IPort;
  Data := GetMemory(ISize);
  CopyMemory(Data, ISource, ISize);
  Size := ISize;
end;

destructor TDataer.Destroy;
begin
  FreeMemory(Data);
  inherited;
end;

{ TUdpSendedThread }

constructor TUdpSendedThread.Create(ISStop: boolean; IOwner: TudpCtl);
begin
  inherited Create(ISStop);
  Owner := IOwner;
end;

procedure TUdpSendedThread.Execute;
begin
  while not Terminated do begin
    try
      with Owner do begin
        {处理接收到的数据}
        CheckData;
      end; // with
      Sleep(10);
    except
      Sleep(10);
    end; // try
  end; // while
end;

{ TUdpRecThread }

constructor TUdpRecThread.Create(ISStop: boolean; IOwner: TudpCtl);
begin
  inherited Create(ISStop);
  Owner := IOwner;
end;

procedure TUdpRecThread.Execute;
begin
  while not Terminated do begin
    try
      with Owner do begin
        {处理接收到的数据}
        DidData;
      end; // with
      Sleep(10);
    except
      Sleep(10);
    end; // try
  end; // while
end;

end.