?? unit1.dfm
字號:
'FErrorKind;'
' {'#21457#36865#27169#24335' '#40664#35748#20026#28369#21160#31383#21475#26041#24335'}'
' property SendKind: SUDPSendKind read FSendKind write '
'FSendKind;'
' {'#28369#21160#31383#21475#25968#37327' '#40664#35748#20026'3}'
' property FreeWindowsCount: Byte read FFreeWindowsCount '
'write FFreeWindowsCount;'
'//--------------------------------------------------------------' +
'----------------'
'// '#25552#20379#32473#22806#30028#30340#25509#21475' 2006-6-5 '#39532#25935#38026
'//--------------------------------------------------------------' +
'----------------'
' class procedure ClearOneData(IData: PSafeUdpData); '
'overload; {'#37322#25918#19968#20010#21253'}'
' {'#23433#20840#21457#36865#25968#25454' '#33258#21160#20998#21253'}'
' class function IsUdpCtlData(IData: Pointer; ISize: Integer):' +
' '
'boolean;'
' procedure SetCurrData(Idata: Pointer; ISize: Integer); {'#35774#32622
#24403#21069#30340#25968#25454'}'
' procedure SafeSendBuff(IIp: string; IPort: Word; var IBuff; '
'ISize: Cardinal;'
' Ilv: SheadLv); overload;'
' procedure SafeSendBuff(var IBuff; ISize: Cardinal; Ilv: '
'SheadLv = SDoError);'
' overload;'
' {'#23433#20840#25511#21046#25968#25454#22788#29702#36807#31243' '#36820#22238#20540#20026#26159#21542#38656#35201#20132#32473
#36923#36753#31243
#24207#32487#32493#22788#29702'}'
' function CaseData(IData: Pointer; IPeerIP: string; IPeerPort' +
', '
'IDataLen:'
' Integer): Boolean;'
' constructor Create(AOwner: TComponent); override;'
' destructor Destroy; override;'
' end;'
''
'implementation'
''
'uses IniFiles, windows, untfunctions, UntProctol, '
'pmybasedebug;'
''
'function OrderShort(List: TStringList; Index1, Index2: Integer):' +
' '
'Integer; {'#25490#24207'}'
'begin'
' try'
' Result := IfThen(StrToInt(List.Strings[Index1]) > '
'StrToInt(List.Strings[Index2]), 1, -1);'
' except'
' end;'
'end;'
'{ TudpCtl }'
''
'constructor TudpCtl.Create(AOwner: TComponent);'
'begin'
' inherited Create(AOwner);'
' MaxReSendCount := 3;'
' WaiteTimeOut := 3000;'
' PeerSize := 1024; //512 + 256;'
' FPackedId := 0;'
' ReSendTime := 500;'
' FSendKind := SUSKFreeWindows;'
' FErrorKind := SUseErrorEvent;'
' FFreeWindowsCount := 10;'
' SendedList := THashedStringList.Create;'
' SendingList := THashedStringList.Create;'
' DataMixList := THashedStringList.Create;'
' SendMemory := TMemoryStream.Create;'
' CurrRealData := TMemoryStream.Create;'
' SenderThread := TUdpSenderThread.Create(False, Self);'
' OnDataReceived := OnData;'
'end;'
''
'destructor TudpCtl.Destroy;'
'var'
' i: Integer;'
'begin'
' SenderThread.FreeOnTerminate := True;'
' SenderThread.Terminate;'
' Sleep(20);'
' for i := 0 to DataMixList.Count - 1 do'
' DataMixList.Objects[i].Free;'
' 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'}'
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -