Datei aus dem Internet herunterladen - geht nicht mehr!

[Rolf Frei]

Zitat von DieDolly:

Zitat:

Ja. Leider hatte ich Probleme, welche Delphi Version hast Du denn?

Delphi 10.3. Es lief auch mit 10.2.
XE 3 ist vielleicht einfach zu alt.

Wenn du nicht mehr als 5000 USD oder EUR, keine Ahnung, pro Jahr verdienst kannst du auch Delphi CE 10.3 runterladen. Das ist quasi eine Pro-Version.

Habe das eben mal in XE3 getestet und da lässt sich das anstandslos ohne Fehler kompilieren. Solange man nicht Indy 9 nutzt, geht das problemlos. Und Indy 10 war bei XE3 auch schon standartmässig dabei.

Ich habe einfach rasch eine neue VCL Anwendung erstellt und da in der Form1 im OnCreate den Aufruf platziert. Die Klassendefinition der Downloadkomponente habe ich auch einfach zum Testen direkt in der Unit1 platziert. Was aber noch fehlt sind die OPENSSL DLL's. Ohne die geht kein HTTPS.

Code:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
 IdComponent, IdHTTP, IdSSLOpenSSL;

type
 THTTPFileDownload = class(TIdHTTP)
 private
  FProgress: Integer;
  FWorkCount, FBytesTransfered, FBytesToTransfer, FBytesTransferedEnd: Int64;
  FOnChange, FOnEnd: TNotifyEvent;
  IOHndl: TIdSSLIOHandlerSocketOpenSSL;
  procedure ResetVars;
  procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
  procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  procedure HTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
  procedure SetProgress(const Value: Integer);
  procedure SetOnChange(const Value: TNotifyEvent);
  procedure SetOnEnd(const Value: TNotifyEvent);
 public
  constructor Create(AOwner: TComponent);
  destructor Destroy; override;
  function DownloadFile(const aFileUrl: string; const aDestinationFile: string): Boolean;

  property Progress: Integer read FProgress write SetProgress;
  property WorkCount: Int64 read FWorkCount write FWorkCount;
  property BytesTransfered: Int64 read FBytesTransfered write FBytesTransfered;
  property BytesTransferedEnd: Int64 read FBytesTransferedEnd write FBytesTransferedEnd;
  property BytesToTransfer: Int64 read FBytesToTransfer;
  property OnChange: TNotifyEvent read FOnChange write SetOnChange;
  property OnEnd: TNotifyEvent read FOnEnd write SetOnEnd;
 end;


constructor THTTPFileDownload.Create(AOwner: TComponent);
begin
 inherited;

 IOHndl := TIdSSLIOHandlerSocketOpenSSL.Create(nil);
 Request.BasicAuthentication := True;
 HandleRedirects := True;
 IOHandler := IOHndl;

 ReadTimeout := 3000;
 ConnectTimeout := 3000;
 IOHndl.ReadTimeout := 3000;
 IOHndl.ConnectTimeout := 3000;

 OnWork := HTTPWork;
 OnWorkBegin := HTTPWorkBegin;
 OnWorkEnd := HTTPWorkEnd;
end;

destructor THTTPFileDownload.Destroy;
begin
 IOHndl.Free;

 inherited;
end;

procedure THTTPFileDownload.ResetVars;
begin
 Progress := 0;
 FWorkCount := 0;
 FBytesToTransfer := 0;
 FBytesTransfered := 0;
end;

function THTTPFileDownload.DownloadFile(const aFileUrl: string; const aDestinationFile: string): Boolean;
var
 LDestStream: TFileStream;
 aPath: string;
begin
 try
  ResetVars;
  aPath := ExtractFilePath(aDestinationFile);

  if aPath <> '' then
   ForceDirectories(aPath);

  LDestStream := TFileStream.Create(aDestinationFile, fmCreate);
  try
   Get(aFileUrl, LDestStream);
   Result := True;
  finally
   FreeAndNil(LDestStream);
  end;
 except
  Result := False;
 end;
end;

procedure THTTPFileDownload.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
 if BytesToTransfer = 0 then // No Update File
  Exit;

 WorkCount := AWorkCount;
 Progress := Round((AWorkCount / BytesToTransfer) * 100);
 BytesTransfered := (BytesToTransfer div 100) * Progress;
end;

procedure THTTPFileDownload.HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
 FBytesToTransfer := AWorkCountMax;
end;

procedure THTTPFileDownload.HTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
 FBytesTransferedEnd := FBytesTransfered;
 if Assigned(FOnEnd) then
  FOnEnd(Self);

 FWorkCount := 0;
 FBytesToTransfer := 0;

 ResetVars;

 Progress := 100;
end;

procedure THTTPFileDownload.SetOnChange(const Value: TNotifyEvent);
begin
 FOnChange := Value;
end;

procedure THTTPFileDownload.SetOnEnd(const Value: TNotifyEvent);
begin
 FOnEnd := Value;
end;

procedure THTTPFileDownload.SetProgress(const Value: Integer);
begin
 FProgress := Value;

 if Assigned(FOnChange) then
  FOnChange(Self);
end;

//-----------------------

procedure TForm1.FormCreate(Sender: TObject);
var
  DL: THTTPFileDownload;
begin
  DL := THTTPFileDownload.Create(nil);
  try
    DL.DownloadFile('http:\\www.meinwebserver.com\test\test.zip', 'C:\Temp\test.txt');
  finally
    DL.Free;
  end;
end;

end.