I implented it directly into the Main-Form like this: var Form1: TForm1; {some variables} MYCounterMax:Integer; MYLastProgressTime:Integer; MYLastProgressCount:Integer; MYLastMaxRate:Integer; MYLastSleep:Integer; MYLastChunkSize:Integer; MyLastCountValue:Integer; BytesReadIn:Integer; TimeToReadIn:Integer; MYXError:Real;
... implementation uses const var Function GetTimerTicksNT98 : Integer; Begin Result := GetTickCount; End; Function TSMThrottle_Delay(Count:Integer;BytesPerSecMax:Integer;ForceSleep:Boolean):Integer; Var CurrProgressCount,CurrProgressTime:Integer; X:Integer; BytesPerMSec,MSec,RX,Rate:Real; MsgHandles:THandle; Procedure CalculateSleepTime; Begin { { Use BytesRead and TimeToRead as a guideline { Bytes Per MSec = BytesToRead/TimeToRead { 2 = 2048 / 1000 { 0.5 = 2048 / 4000 { 95 = 100K / 1020 { MaxRate=500*1024 { { 500000 bytes needed per second { 135000 bytes per second (NEED 500000) } If MYLastMaxRate=BytesPerSecMax Then Begin { { 95.01 = 100K / 1020} { Get current rate of speed } Rate:=BytesReadIn/TimeToReadIn; If Rate=0.0 Then Rate:=0.001; If MyLastSleep=0 Then MyLastSleep:=1; BytesPerMSec:=BytesPerSecMax/1000; MSec:=BytesPerMSec/Rate; { { Adjust MS based on last sleep time { BytesRead = 2048 { TimeToRead=6 { Rate=341 bytes per ms { { BytesPerMSec=512 needed { MSec=1.501 { MyLastSleep=5 { RX=3.997 { X=3 { Error=997 } RX:=(MYLastSleep/MSec)+MyXError; X:=Trunc(RX); MyXError:=RX-X; End Else Begin MYLastMaxRate:=BytesPerSecMax; X:=Trunc((BytesReadIn*1000.0)/BytesPerSecMax); Case X Of 0..2:MyCounterMax:=50; 3..5:MyCounterMax:=30; 6..10:MyCounterMax:=10; Else MyCounterMax:=1; End; If MyCounterMax>1 Then Begin MyCounter:=0; X:=Trunc((BytesReadIn*1000.0)/(BytesPerSecMax/MyCounterMax)); MYLastProgressCount:=Count-MyLastChunkSize; End; { { Maximum sleep of 5 seconds for every 2K means that { 0.4K per second minimum rate } If X>10000 Then X:=5000; End; If X>=0 Then Begin If ForceSleep Then Sleep(X) Else MsgWaitForMultipleObjects(0,msgHandles,False,X,QS_SENDMESSAGE); End; MYLastSleep:=X; Result:=X; End; Begin Result:=-1; CurrProgressTime:=GetTimerTicksNT98; CurrProgressCount:=Count; MYLastChunkSize:=Count-MyLastCountValue; Try If (MYLastProgressCount<>0) Then Begin Inc(MyCounter); If MyCounter>=MyCounterMax Then Begin MyCounter:=0; BytesReadIn:=Count-MyLastProgressCount; TimeToReadIn:=CurrProgressTime-MyLastProgressTime; MYLastProgressCount:=CurrProgressCount; MYLastProgressTime:=CurrProgressTime; If TimeToReadIn=0 Then TimeToReadIn:=1; If BytesPerSecMax<>-1 Then CalculateSleepTime; End End; Except End; MYLastCountValue:=CurrProgressCount; If MyCounterMax=1 Then Begin MYLastProgressTime:=CurrProgressTime; MYLastProgressCount:=CurrProgressCount; End; End; ... Download.call MYLastCountValue:=0; MYLastChunkSize:=0; MyCounter:=0; MyCounterMax:=1; MYLastProgressTime:=0; MYLastProgressCount:=0; MYLastMaxRate:=0; MyLastSleep:=0; MYXError:=0; BytesReadIn:=5; TimeToReadIn:=1; Start download ... procedure TForm1.FtpClient1Progress(Sender: TObject; Count: Integer; var Abort: Boolean); var S: String; TotalTime: TDateTime; H, M, Sec, MS: Word; DLTime: Double; i: real; begin TSMThrottle_Delay(Count,20000,true); FProgressCount := Count; TotalTime := Now - sTime; DecodeTime(TotalTime, H, M, Sec, MS); Sec := Sec + M * 60 + H * 3600; DLTime := Sec + MS / 1000; if DLTime > 0 then if resume.checked=true then AverageSpeed := ((FProgressCount-strtoint(edit4.text)) / 1024) / DLTime else AverageSpeed := (FProgressCount / 1024) / DLTime; S := FormatFloat('0.00 KB/s', AverageSpeed); listview1.Items[strtoint(edit1.text)].SubItems[3]:=s; { Be sure to update screen only once every second } if FLastProgress < GetTickCount then begin FLastProgress := GetTickCount + 1000; progressbar1.Max:=FtpClient1.SizeResult; Progressbar1.position := FProgressCount; i:=(Progressbar1.position/1024)/1024; listview1.Items[strtoint(edit1.text)].SubItems[1]:= FloatToStrF(i, ffNumber, 8, 2)+' MB'; end; end; I used this for example to get only 20 kb/s: TSMThrottle_Delay(Count,20000,true); When the Delayfunction starts to work the whole amp starts to freeze like apps using Indy without antifreeze. Can somebody help me? -- Handyrechnung zu hoch? Tipp: SMS und MMS mit GMX Seien Sie so frei: Alle Infos unter http://www.gmx.net/de/go/freesms -- To unsubscribe or change your settings for TWSocket mailing list please goto http://www.elists.org/mailman/listinfo/twsocket Visit our website at http://www.overbyte.be