AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi Downloadgeschwindigkeit drosseln / beschränken
Thema durchsuchen
Ansicht
Themen-Optionen

Downloadgeschwindigkeit drosseln / beschränken

Ein Thema von schismatic1 · begonnen am 27. Mai 2009 · letzter Beitrag vom 30. Mai 2009
Antwort Antwort
schismatic1

Registriert seit: 24. Mai 2009
28 Beiträge
 
#1

Downloadgeschwindigkeit drosseln / beschränken

  Alt 27. Mai 2009, 19:54
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
  Mit Zitat antworten Zitat
schismatic1

Registriert seit: 24. Mai 2009
28 Beiträge
 
#2

Re: Downloadgeschwindigkeit drosseln / beschränken

  Alt 28. Mai 2009, 09:38
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.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.166 Beiträge
 
Delphi 12 Athens
 
#3

Re: Downloadgeschwindigkeit drosseln / beschränken

  Alt 28. Mai 2009, 10:05
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.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
schismatic1

Registriert seit: 24. Mai 2009
28 Beiträge
 
#4

Re: Downloadgeschwindigkeit drosseln / beschränken

  Alt 28. Mai 2009, 11:58
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.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.166 Beiträge
 
Delphi 12 Athens
 
#5

Re: Downloadgeschwindigkeit drosseln / beschränken

  Alt 28. Mai 2009, 13:06
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
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
schismatic1

Registriert seit: 24. Mai 2009
28 Beiträge
 
#6

Re: Downloadgeschwindigkeit drosseln / beschränken

  Alt 28. Mai 2009, 14:41
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?
  Mit Zitat antworten Zitat
Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.356 Beiträge
 
Delphi 11 Alexandria
 
#7

Re: Downloadgeschwindigkeit drosseln / beschränken

  Alt 28. Mai 2009, 15:09
Und der IOHandler, den du oben gepostet hat, der funktioniert nicht? Weil eigentlich sollte es doch reichen den zu erzeugen und an IOHandler zuzuweisen.
Sebastian Jänicke
Alle eigenen Projekte sind eingestellt, ebenso meine Homepage, Downloadlinks usw. im Forum bleiben aktiv!
  Mit Zitat antworten Zitat
Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#8

Re: Downloadgeschwindigkeit drosseln / beschränken

  Alt 28. Mai 2009, 15:25
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.
  Mit Zitat antworten Zitat
Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.356 Beiträge
 
Delphi 11 Alexandria
 
#9

Re: Downloadgeschwindigkeit drosseln / beschränken

  Alt 30. Mai 2009, 23:03
Crosspost:
http://www.delphi-forum.de/viewtopic.php?p=564192
Sebastian Jänicke
Alle eigenen Projekte sind eingestellt, ebenso meine Homepage, Downloadlinks usw. im Forum bleiben aktiv!
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:45 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz