Downloadgeschwindigkeit drosseln / beschränken

[schismatic1]

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.