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

Reply via email to