Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Netzwerke (https://www.delphipraxis.net/14-netzwerke/)
-   -   Delphi Downloadgeschwindigkeit drosseln / beschränken (https://www.delphipraxis.net/134723-downloadgeschwindigkeit-drosseln-beschraenken.html)

schismatic1 27. Mai 2009 19:54


Downloadgeschwindigkeit drosseln / beschränken
 
Abend!

Ich arbeite aktuell an einem Downloadmanager der für mich zurechtgeschnitten ist. Das einzige was mir noch zu meinem Glück fehlt ist die beschränkung der Downloadgeschwindigkeit. Zum herunterladen nutze ich folgenden Code

Delphi-Quellcode:
procedure DownloadFile(URL, DestinationFile, Username, Password : string);
var
  temp: String;
  HTTP : TIdHTTP;
begin
  HTTP := TIdHTTP.Create;
  HTTP.Request.BasicAuthentication := true;
  HTTP.Request.Username := Username;
  HTTP.Request.Password := Password;
  HTTP.HandleRedirects := true;
  temp := HTTP.Get(URL);
  HTTP.Free;
end;
Was ich bisher herausgefunden habe ist, dass es wohl keine Komponente gibt mit der man das einfach regeln kann sondern es mittels der maximalen Schreibgeschwindigkeit in einen String beeinflussen muss. Nur bin ich da ein wenig überfordert da ich keinerlei Tutorial oder Beispiel nach intensiver Suche dafür gefunden habe :(

Jemand eine Idee wie ich die Geschwindigkeit abbremsen kann? Müssen keine exakten Werte dabei herauskommen, aber die Tatsache das mein Tool die komplette Bandbreite nutzt ist blöd. Eine Notfalllösung habe ich mittel NetLimiter. Aber nunja. Das ist halt ein externes Programm :roll:

schismatic1 28. Mai 2009 09:38

Re: Downloadgeschwindigkeit drosseln / beschränken
 
Ich habe hier heut morgen einen interessanten Quelltext gefunden der die ganze Sache wohl regelt. Nur scheitert es bei mit an der Implementierung :X

Jemand eine Idee wie man es idiotensicher unterbekommt? ^^


Delphi-Quellcode:
unit IdIOHandlerThrottle;

interface
uses
  Classes,
  IdComponent, IdGlobal, IdIOHandler;

type
  TIdIOHandlerThrottle = class(TIdIOHandler)
  protected
    FChainedHandler : TIdIOHandler;
    FBytesPerSec : Cardinal;
    FRate: double;
    FRealRate: double;
    FLastTime: cardinal;
    FLastRateTime: cardinal;
    FTotalBytes: integer;
    FActivated: boolean;
    function GetBitsPerSec : Cardinal;
    procedure SetBitsPerSec(AValue : Cardinal);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    procedure Close; override;
    procedure ConnectClient(const AHost: string; const APort: Integer; const ABoundIP: string;
     const ABoundPort: Integer; const ABoundPortMin: Integer; const ABoundPortMax: Integer;
     const ATimeout: Integer = IdTimeoutDefault); override;
    function Connected: Boolean; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open; override;
    function Readable(AMSec: integer = IdTimeoutDefault): boolean; override;
    function Recv(var ABuf; ALen: integer): integer; override;
    function Send(var ABuf; ALen: integer): integer; override;
  published
    property BytesPerSec : Cardinal read FBytesPerSec write FBytesPerSec;
    property BitsPerSec : Cardinal read GetBitsPerSec write SetBitsPerSec;
    property ChainedHandler : TIdIOHandler read FChainedHandler write FChainedHandler;
    property CurrentRate: double read FRate;
    property Activated: boolean read FActivated write FActivated;
  end;

implementation
uses IdException, IdResourceStrings, SysUtils;

type EIdThrottleNoChainedIOHandler = class(EIdException);

{ TIdIOHandlerThrottle }

procedure TIdIOHandlerThrottle.Close;
begin
  inherited;
  if Assigned(FChainedHandler) then
  begin
    FChainedHandler.Close;
  end;
end;

procedure TIdIOHandlerThrottle.ConnectClient(const AHost: string;
  const APort: Integer; const ABoundIP: string; const ABoundPort,
  ABoundPortMin, ABoundPortMax, ATimeout: Integer);
begin
  inherited;
  if Assigned(FChainedHandler) then
  begin
    FChainedHandler.ConnectClient(AHost,APort,ABoundIP,ABoundPort,ABoundPortMin,ABoundPortMax,ATimeout);
  end
  else
  begin
    raise EIdThrottleNoChainedIOHandler.Create(RSIHTChainedNotAssigned);
  end;
end;

function TIdIOHandlerThrottle.Connected: Boolean;
begin
  if Assigned(FChainedHandler) then
  begin
    Result := FChainedHandler.Connected;
  end
  else
  begin
    Result := False;
  end;
end;

constructor TIdIOHandlerThrottle.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TIdIOHandlerThrottle.Destroy;
begin
  Close;
  ChainedHandler.Free;
  ChainedHandler := nil;
  inherited Destroy;
end;

function TIdIOHandlerThrottle.GetBitsPerSec: Cardinal;
begin
  Result := FBytesPerSec * 8;
end;


procedure TIdIOHandlerThrottle.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if (Operation = opRemove) then begin
    if (AComponent = FChainedHandler) then begin
      FChainedHandler := nil;
    end;
  end;
  inherited;
end;

procedure TIdIOHandlerThrottle.Open;
begin
  inherited Open;
  if Assigned(FChainedHandler) then
  begin
    FChainedHandler.Open;
  end
  else
  begin
    raise EIdThrottleNoChainedIOHandler.Create(RSIHTChainedNotAssigned);
  end;
end;

function TIdIOHandlerThrottle.Readable(AMSec: integer): boolean;
begin
  if Assigned(FChainedHandler) then
  begin
    Result := FChainedHandler.Readable(AMSec);
  end
  else
  begin
    Result := False;
  end;
end;

function TIdIOHandlerThrottle.Recv(var ABuf; ALen: integer): integer;
var LWaitTime : Cardinal;
    LRecVTime : Cardinal;
begin
  if Assigned(FChainedHandler) then
  begin
    if FBytesPerSec > 0 then begin
      LRecvTime := IdGlobal.GetTickCount;
      Result := FChainedHandler.Recv(ABuf, ALen);
      LRecvTime := GetTickDiff(LRecvTime, IdGlobal.GetTickCount);
      LWaitTime := Cardinal(Result * 1000) div FBytesPerSec;
      if LWaitTime > LRecVTime then begin
        IdGlobal.Sleep(LWaitTime - LRecvTime);
      end;
    end else begin
      Result := FChainedHandler.Recv(ABuf, ALen);
    end;
  end
  else
  begin
    Result := 0;
  end;
end;

function TIdIOHandlerThrottle.Send(var ABuf; ALen: integer): integer;
var WaitTime : Cardinal;
    SendTime : Cardinal;
    NewRate: double;
begin
  if Assigned(FChainedHandler) then
  begin
    if FBytesPerSec > 0 then
    begin
      WaitTime := Cardinal(ALen * 1000) div FBytesPerSec;
      SendTime := IdGlobal.GetTickCount;
      Result := FChainedHandler.Send(ABuf,ALen);
      SendTime := GetTickDiff(SendTime,IdGlobal.GetTickCount);
      if WaitTime = 0 then
        FRate := 0
      else
        FRate := ALen / WaitTime;
      if WaitTime > SendTime then
        IdGlobal.Sleep(WaitTime - SendTime);
    end
    else
    begin
      SendTime := IdGlobal.GetTickCount;
      if FLastTime = 0 then
      begin
        FLastTime := SendTime;
        FTotalBytes := ALen;
        FRate := 0;
      end
      else
      begin
        if SendTime - FLastTime > 1000 then
        begin
          NewRate := FTotalBytes / (SendTime - FLastTime);
          FTotalBytes := ALen;
          FLastTime := SendTime;
          if FRealRate = 0 then
          begin
            FRealRate := NewRate;
            FRate := NewRate;
          end
          else
          begin
            FRate := (FRealRate + NewRate) / (SendTime - FLastRateTime) * 1000 / 2;
            FRealRate := NewRate;
          end;
          FLastRateTime := SendTime;
        end
        else
          FTotalBytes := FTotalBytes + ALen;
      end;
      Result := FChainedHandler.Send(ABuf,ALen);
    end;
  end
  else
  begin
    Result := 0;
  end;
end;

procedure TIdIOHandlerThrottle.SetBitsPerSec(AValue: Cardinal);
begin
  FBytesPerSec := AValue div 8;
end;

end.

himitsu 28. Mai 2009 10:05

Re: Downloadgeschwindigkeit drosseln / beschränken
 
IdHTTP scheint wohl nichts anzubieten, wo man selber stückchenweise in einen Puffer schreiben kann?

bei der Berechnung im Sleep bin ich mir aber nicht sicher
Delphi-Quellcode:
type TForm2 = class(TForm)
    ...
  private
    MaxBytesPerSecond, WorkTime: LongWord;
    CountAtLastWorkEvent: Int64;
    procedure WorkEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  end;

procedure TForm2.WorkEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var i: Integer;
begin
  i := (AWorkCount - CountAtLastWorkEvent) * 1000 div (GetTickCount - WorkTime);
  If i > MaxBytesPerSecond Then
    Sleep((GetTickCount - WorkTime) * (i - MaxBytesPerSecond) div MaxBytesPerSecond);
  WorkTime := GetTickCount;
  CountAtLastWorkEvent := AWorkCount;
end;

procedure TForm2.FormCreate(Sender: TObject);
var HTTP: TIdHTTP;
  temp: String;
begin
  HTTP := TIdHTTP.Create;
  try
    HTTP.Request.BasicAuthentication := true;
    HTTP.Request.Username := Username;
    HTTP.Request.Password := Password;
    HTTP.HandleRedirects := true;
    HTTP.OnWork := WorkEvent;
    MaxBytesPerSecond := 1024;
    WorkTime := GetTickCount;
    CountAtLastWorkEvent := 0;
    temp := HTTP.Get(URL);
  finally
    HTTP.Free;
  end;
end;
ansonsten könnte man da auch einfach einen modifizierten TStream-Nachkömmling nehmen, der bremst (Sleep), wenn er zu schnell gefüllt wird ... praktisch das Selber wie hier im Event, nur dort halt im .Write des Streams.

oder eine andere Komponente nehmen

bei direkter Nutzung der WinAPI MSDN-Library durchsuchenInternetReadFile konnte ich sowas über eine passende Puffergröße und eventuell eine Pause nach jedem Aufruf recht leicht lösen.

schismatic1 28. Mai 2009 11:58

Re: Downloadgeschwindigkeit drosseln / beschränken
 
Hm...

Habe das jetzt so implementiert aber nach etwa 30 Sekunden kommt die Fehlermeldung "Division by Zero" :X

Habe deswegen nun noch ein "+ 1 " eingefügt:

Delphi-Quellcode:
begin
  i := (AWorkCount - CountAtLastWorkEvent) * 1000 div (GetTickCount - WorkTime + 1); // <--- hier +1
  If i > MaxBytesPerSecond Then
    Sleep((GetTickCount - WorkTime) * (i - MaxBytesPerSecond) div MaxBytesPerSecond);
  WorkTime := GetTickCount;
  CountAtLastWorkEvent := AWorkCount;
end;
Mal schaun ob das jetzt klappt :)

EDIT:

Hm... Also der Download ist schoneinmal reduziert. Auf etwa 0.5 - 1.0 kb/s. Jedoch unabhängig davon welchen Wert ich bei 'MaxBytesPerSecond' eingebe.

himitsu 28. Mai 2009 13:06

Re: Downloadgeschwindigkeit drosseln / beschränken
 
also in i sollte drinstehn, wieviel ByteProSekunde es seit dem letzten Aufruf waren
und Sleep sollte dann einfach nur solange warten, bis die Rate stimmt ... also bis soviel Zeit abgelaufen ist, wie zuletzt Daten übertragen wurden...

OK, die ein 1 Millisekunde kann man zur Behebung des 0-Fehlers ruhig pauschal einrechnen ... macht wohl sonst nicht soviel aus.

probieren wir es mal so
Delphi-Quellcode:
begin
  i := (AWorkCount - CountAtLastWorkEvent) * 1000 div (GetTickCount - WorkTime + 1);
  If i > MaxBytesPerSecond Then
    Sleep((AWorkCount - CountAtLastWorkEvent) * 1000 div MaxBytesPerSecond
      - (GetTickCount - WorkTime));
  WorkTime := GetTickCount;
  CountAtLastWorkEvent := AWorkCount;
end;
// zeit, welche für diese Datenmenge benötig hätte werden müssen
(AWorkCount - CountAtLastWorkEvent) * 1000 div MaxBytesPerSecond
// abzüglich der Zeit, welche schon vergangen ist
- (GetTickCount - WorkTime)

// glaub ich

schismatic1 28. Mai 2009 14:41

Re: Downloadgeschwindigkeit drosseln / beschränken
 
Hm... immmernoch keinerlei Veränderung. (Überwache den Downloadvorgang mittels NetLimiter 2 welches mir den genauen Down- und Upstream eines Programms anzeigt)

Im Endeffekt muss die Prozedur ja so aussehen:


1. eine Variable welche den bisherigen Downloadfortschritt (Dateigröße in Byte) beinhaltet (AWorkCount)
2. eine Variable welche den Downloadfortschritt (in Byte) seit dem letzen Aufruf beinhaltet (AWorkCount - AWorkCountALT)
3. eine Variable welche die Zeit seit dem Downloadbegin (WorkTime in Millisekunden)
4. eine Variable welche die Zeit seit dem letzten Aufruf beinhaltet (WorkTimeALT)
5. eine Variable welche die Maximalen Byte pro Sekunde beeinhaltet (MaxBytePerSecound)


Delphi-Quellcode:
if ((AWorkCount - AWorkCountALT) div (WorkTime - WorkTimeALT + 1)) > (MaxBytePerSecound div 1.000) then
  // solange warten bis das Verhältnis von verrichteter Arbeit zu verstrichener Zeit gleich dem Verhältnis von MaxBytePerSecounds zu 1.000 ms ist
  sleep((AWorkCount - AWorkCountALT - MaxBytePerSecound) * 1.000 div MaxBytePerSecound);            
  WorkTimeALT := WorkTime;
  AWorkCountALT := AWorkCount;
end;

Zahlenbeispiel

Delphi-Quellcode:
//Eine Sekunde Download (mit 100.000 byte / s) ---> Erster Aufruf:

{AWorkCount = 100.000
AWorkCountALT = 0
WorkTimeALT = 0
WorkTime = 1.000
MaxBytePerSecound = 1.000}

if ((100.000 - 0) div (1.000 - 0 + 1)) > (1.000 div 1.000) then // 99 > 1
   sleep((100.000 - 0 - 1.000) * 1.000 div 1.000);              // 99.000 ms
   WorkTimeALT := WorkTime;
   AWorkCountALT := 100.000;
end;

//Zweiter Aufruf:

{AWorkCount = 200.000
AWorkCountALT = 100.000
WorkTimeALT = 100.000
WorkTime = 101.000
MaxBytePerSecoound = 1.000}

if ((200.000 - 100.000) div (101.000 - 100.000 + 1)) > (1.000 div 1.000) // 99 > 1
  sleep((200.000 - 100.000 - 1.000) * 1.000 div 1.000)                  // 99.000 ms
  WorkTImeALT := WorkTime;
  AWorkCountALT := 200.000;
end;
Ich denke so funktioniert das. Die Frage ist nur welche echte Variable zählt die ganze Zeit in Millisekunden wieviel Zeit vergangen ist und welche echte Variable zählt die größe der heruntergeladenen Datei in Byte? Gibt es da bereits vordefinierte? Sind es vielleicht sogar WorkTime und AWorkCount?

jaenicke 28. Mai 2009 15:09

Re: Downloadgeschwindigkeit drosseln / beschränken
 
Und der IOHandler, den du oben gepostet hat, der funktioniert nicht? Weil eigentlich sollte es doch reichen den zu erzeugen und an IOHandler zuzuweisen.

Namenloser 28. Mai 2009 15:25

Re: Downloadgeschwindigkeit drosseln / beschränken
 
So würde ich es machen (Pseudocode, ka ob es funktioniert):

Delphi-Quellcode:
function WriteHTTP(DataStream, HTTPOut: TStream; MaxDataRate: cardinal);
var
  StartTime, ResumeTime: cardinal;
  Buffer: packed array[0..64] of byte;
begin
  ResumeTime := 0;
  while DataStream.Read(@Buffer[0], length(Buffer)) > 0
  begin
    while GetTime() < ResumeTime do sleep(1);

    StartTime := GetTime();
    HTTPOut.Write(@Buffer[0], Length(Buffer));
    ResumeTime := StartTime + 1000 / (DataRate / MaxDataRate);
  end;
end;
So ähnlich habe ich zumindest die FPS-Beschränkung in einem Spiel implementiert, was sehr gut funktionierte.

jaenicke 30. Mai 2009 23:03

Re: Downloadgeschwindigkeit drosseln / beschränken
 
Crosspost:
http://www.delphi-forum.de/viewtopic.php?p=564192


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:54 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz