📄 unit1.dfm
字号:
' DataMixList.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: PSafeUdphead;'
' LIndex: Integer;'
' LIdx: string;'
'begin'
' LReData := IData;'
' Gob_Debug.AddLogShower('#39'--->>>'#39');'
' Gob_Debug.AddLogShower(IntToStr(LReData^.PackedId) + '
#39'-'#39' + IntToStr(LReData^.Part));'
' Result := False;'
' {'#21028#26029#22914#26524#26159#22238#22797#21253' '#21017#21024#38500#31561#24453#22238#22797#30340#21253'}'
' if LReData^.Id = CSafeUdpData_RecvResp then begin'
' LIdx := IntToStr(LReData^.PackedId);'
' LIdx := LIdx + '#39'_'#39' + IntToStr(LReData^.Part);'
' LIndex := SendedList.IndexOf(LIdx);'
' if LIndex > -1 then'
' SendedList.Delete(LIndex);'
' exit;'
' end;'
' {'#21542#21017#23601#26159#25968#25454#21253'}'
' {'#21028#26029#26159#21542#38656#35201#22238#22797'}'
' if (LReData^.PackedId > 0) then begin'
' LReData.Id := CSafeUdpData_RecvResp;'
' RemoteHost := IPeerIP;'
' RemotePort := IPeerPort;'
' SendBuffer(LReData^, Sizeof(LReData^));'
' end;'
' {'#21028#26029#26159#21542#26159#38656#35201#32452#21512#30340#21253'}'
' if LReData^.TotPart > 1 then begin'
' LIndex := CheckPacked(PsafeUdpHead(IData));'
' if LIndex > -1 then begin'
' {'#29983#25104#19968#20010#21253'}'
' Gob_Debug.AddLogShower('#39'>>>%d-%d---%d'#39', '
'[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);'
' CurrRealData.Position := 0;'
' LP := IData;'
' inc(LP, Sizeof(RSafeUdpHead));'
' CurrRealData.WriteBuffer(Lp^, LReData^.Size);'
' CurrRealData.Position := 0;'
' 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.CheckState;'
'var'
' I: Integer;'
' LData: PSafeUdpData;'
'begin'
' {'#26816#26597#27599#19968#20010#21457#36865#20986#21435#24182#19988#38656#35201#22238#24212#30340#25968#25454'}'
' for I := SendedList.Count - 1 downto 0 do begin // Iterate'
' try'
' LData := PSafeUdpData(SendedList.Objects[i]);'
' {'#21028#26029#26102#38388#26159#21542#36229#36807' ReSendTime '#36229#36807#20102#25165#21435#26816#26597
'}'
' if (GetTickCount - LData^.SendTime < ReSendTime) then '
'begin'
' Continue;'
' end;'
' {'#37325#35797'N'#27425#21518#23601#19981#20877#21457#36865','#37325#35797'N'#27425#21518#25253#38169','#19968#30452#37325
#35797#30452#21040
#36229#26102'}'
' 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);'
' end'
' else begin'
' //'#20002#24323#24403#21069#21253
' 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);'
' end'
' else begin'
' SendedList.Delete(i);'
' if FErrorKind = SUseErrorEvent then begin'
' if assigned(OnDataError) then'
' OnDataError(Self, LData, SDoError);'
' end else'
' raise EUdpCtlReTryNoResp.CreateFmt('#39#25968#25454#21253#22312
#37325
#35797'%d'#27425#21518#20173#28982#26080#22238#24212#39', [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('#39#25968#25454#21253#22238#24212#36229
#26102'<%d>'#39', [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);'
' SendedList.Delete(iidx);'
'end;'
''
'function TudpCtl.GetAnPackedData(IDataSize: integer): '
'PSafeUdpData;'
'var'
' LData: PSafeUdpData;'
'begin'
' if IDataSize < 1 then'
' raise Exception.Create('#39#30003#35831#20869#23384#26102#21457#29616#30003#35831#22823#23567#20026'0'
#65292#25243
#20986#24322#24120#39');'
' 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;'
' {'#24320#22987#20998#21253'}'
' LTotPart := Trunc(ISize / PeerSize); {'#33719#21462#20998#20026#20960#20010#21253'}'
' 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 {'#22914#26524#26159#26368#21518#19968#20010#21253' '#21017#35843#25972#21253
#20026#27491
#30830#30340#22823#23567'}'
' LSize := ISize - (LTotPart - 1) * PeerSize;'
' {'#35774#32622#21253#22836'}'
' 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;'
' CopyMemory(LData.Data, LP, LSize);'
' {'#31227#21160#25351#38024'}'
' inc(LP, LSize);'
' Gob_Debug.AddLogShower('#39'%s---%d'#39', '
'[IntToStr(LData^.Head.PackedId) + '#39'_'#39' + '
'IntToStr(LData^.Head.Part), LSize]);'
' {'#21152#20837#21457#36865#38431#21015'}'
' SendingList.AddObject(IntToStr(LData^.Head.PackedId) + '#39'_'#39' '
'+ IntToStr(LData^.Head.Part), TObject(LData));'
' // AddToSendList(IntToStr(LData^.Head.PackedId) + '#39'_'#39' + '
'IntToStr(LData^.Head.Part), TObject(LData));'
' end; // for'
'end;'
''
'procedure TudpCtl.DidSend(IData: PSafeUdpData);'
'begin'
' 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);'
' {'#21028#26029#26159#21542#38656#35201#36820#22238'}'
' if IData^.Head.PackedId > 0 then begin'
' IData^.SendTime := GetTickCount;'
' SendedList.AddObject(IntToStr(IData^.Head.PackedId) + '#39'_'#39' '
'+ IntToStr(IData^.Head.Part), TObject(IData));'
' end;'
' {'#21457#36865'}'
' SendBuffer(SendMemory.Memory^, SendMemory.Size);'
'end;'
''
'function TudpCtl.MixData(IData: PSafeUdpData; Iidx: integer): '
'boolean;'
'var'
' Lbuff: TDataMixer;'
'begin'
' Result := False;'
' {'#28155#21152#21040#21508#20010#21253#30340#21508#20010#37096#20998'}'
' Lbuff := TDataMixer(DataMixList.Objects[Iidx]);'
' Inc(Lbuff.CurrPart);'
' Lbuff.BeginTime := GetTickCount;'
' Lbuff.DataList.AddObject(IntToStr(Idata^.Head.Part), '
'TObject(IData));'
' //Gob_Debug.AddLogShower('#39'Check'#39');'
' //Gob_Debug.AddLogShower(Lbuff.CurrPart);'
' if Lbuff.CurrPart = Lbuff.TotPart then begin'
' UnPackedData(Lbuff);'
' {'#22914#26524#32452#21253#25104#21151' '#21017#36820#22238'True'#20801#35768#32487#32493#20256#36882#25968#25454'}'
' Result := True;'
' end;'
'end;'
''
'procedure TudpCtl.UnPackedData(IMixer: TDataMixer);'
'var'
' i: Integer;'
' LTOT: Cardinal;'
' Lbuff: PSafeUdpData;'
' Lp: Pchar;'
' LFun: TStringListSortCompare;'
'begin'
' with IMixer do begin'
' try'
' LFun := @OrderShort;'
' TStringList(DataList).CustomSort(LFun);'
' CurrRealData.Position := 0;'
' LTOT := 0;'
' Gob_Debug.AddLogShower('#39'Begin Cmb'#39');'
' 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('#39#32452#21253#26102#21457#29983#24322#24120#39');'
' end;'
' CurrDataSize := LTOT;'
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -