Downloadlogik unter Firemonkey

[Peter666]

Vielen Lieben Dank,

ich hab das ganze jetzt erst einmal folgendermaßen "gelöst".

Delphi-Quellcode:

unit System.Net.Downloader;

interface

uses System.SysUtils, System.SyncObjs, System.Net.HttpClient, System.Classes,
  System.Generics.Collections, System.Zip;

const
  MAX_DOWNLOADS = 5;

type
  TOnStreamAvailable = procedure(const AStream: TStream) of object;
  TOnStreamAvailableDirect = reference to procedure(const AStream: TStream);

function GetHtml(const AUri: String; Stream: TStream): Boolean; overload;
function GetHtml(const AUri: String): String; overload;

function PostHtml(const AUri, ARequest: String; Stream: TStream;
  AContentType: String = ''): Boolean;

procedure RetrieveImage(ALogo: String; const AZip: TZipFile;
  const AOnAvailable: TOnStreamAvailable; const AOwner: TObject = nil);
  overload;
procedure RetrieveImage(ALogo: String; const AZip: TZipFile;
  const AOnAvailable: TOnStreamAvailableDirect;
  const AOwner: TObject = nil); overload;
procedure CancelRetrieveImage(const AOwner: TObject);

implementation

uses System.IOUtils, System.Hash, System.NetConsts, System.Net.UrlClient
{$IFDEF USEINDY}, idHttp {$ENDIF};

{ ============================================================================== }
function PostHtml(const AUri, ARequest: String; Stream: TStream;
  AContentType: String = ''): Boolean;
var
{$IFDEF USEINDY}
  http: TidHttp;
{$ELSE}
  http: THttpClient;
{$ENDIF}
  Source: TStringStream;
begin
  Result := false;
  http := {$IFDEF USEINDY} TidHttp.Create(nil) {$ELSE} THttpClient.Create
{$ENDIF};
  Source := TStringStream.Create(ARequest);
  try
    try
      if AContentType <> '' then
      begin
{$IFDEF USEINDY}
        http.Response.ContentType := AContentType;
{$ELSE}
        http.ContentType := AContentType;
{$ENDIF}
      end;

      http.Post(AUri, Source, Stream);
      Result := true;
      Stream.Position := 0;
    except
    end;
  finally
    Source.Free;
    http.DisPoseOf;
  end;
end;

{ ============================================================================== }
function GetHtml(const AUri: String; Stream: TStream): Boolean;
var
{$IFDEF USEINDY}
  http: TidHttp;
{$ELSE}
  http: THttpClient;
{$ENDIF}
begin
  Result := false;
  http := {$IFDEF USEINDY} TidHttp.Create(nil) {$ELSE} THttpClient.Create
{$ENDIF};
  try
    try
      http.Get(AUri, Stream);
      Result := true;
      Stream.Position := 0;
    except
    end;
  finally
    http.DisPoseOf;
  end;
end;

{ ============================================================================== }
function GetHtml(const AUri: String): String;
var
  Stream: TStringStream;
begin
  Stream := TStringStream.Create;
  if GetHtml(AUri, Stream) then
    Result := Stream.DataString
  else
    Result := '';
  Stream.Free;
end;

{ ============================================================================== }

type
  TQueueItem = class
    Filename: String;
    Callback: TOnStreamAvailableDirect;
    Owner: TObject;
  end;

  TDownloadThread = class(TThread)
  protected
    FLock: TCriticalSection;
    FList: TObjectList<TQueueItem>;

    FEvent: TEvent;
    FCached: Boolean;
    FLastRemovedOwner: TObject;
    FMaxDownloads: Integer;
    FThreadCount: Integer;

    function GetTempFilename(const AUri: String): String;
    procedure Execute; override;

    procedure DoUpdate(const AStream: TStream;
      const ACallback: TOnStreamAvailableDirect; const AOwner: TObject);

    function Pop(out AFilename: String; out ACallback: TOnStreamAvailableDirect;
      out AOwner: TObject): Boolean;

    procedure PerformDownload(const AFilename: String;
      const ACallback: TOnStreamAvailableDirect; const AOwner: TObject);
  public
    constructor Create(const ACached: Boolean);
    destructor Destroy; override;
    procedure Add(const AFilename: String;
      const ACallback: TOnStreamAvailableDirect; const AOwner: TObject);
    procedure RemoveOwner(const AOwner: TObject);
    property MaxDownloads: Integer read FMaxDownloads write FMaxDownloads;
  end;

  { TDownloadThread }
constructor TDownloadThread.Create(const ACached: Boolean);
begin
  inherited Create(false);
  FCached := ACached;
  FLock := TCriticalSection.Create;
  FList := TObjectList<TQueueItem>.Create(true);
  FEvent := TEvent.Create(nil, false, false, '');
  FLastRemovedOwner := nil;
  FMaxDownloads := MAX_DOWNLOADS;
  FThreadCount := 0;
end;

destructor TDownloadThread.Destroy;
begin
  Terminate;
  FEvent.SetEvent;
  WaitFor;
  FList.Free;
  FLock.Free;
  FEvent.Free;
  inherited;
end;

function TDownloadThread.Pop(out AFilename: String;
  out ACallback: TOnStreamAvailableDirect; out AOwner: TObject): Boolean;
begin
  FLock.Enter;
  try
    Result := FList.Count > 0;
    if Result then
    begin
      AFilename := FList[0].Filename;
      ACallback := FList[0].Callback;
      AOwner := FList[0].Owner;
      FList.Delete(0);
    end
    else
    begin
      AFilename := '';
      ACallback := nil;
      AOwner := nil;
    end;

  finally
    FLock.Leave;
  end;
end;

procedure TDownloadThread.Add(const AFilename: String;
  const ACallback: TOnStreamAvailableDirect; const AOwner: TObject);
var
  Item: TQueueItem;
begin
  FLock.Enter;
  try
    Item := TQueueItem.Create;
    Item.Filename := AFilename;
    Item.Callback := ACallback;
    Item.Owner := AOwner;
    FList.Add(Item);
    if FThreadCount<FMaxDownloads then
     FEvent.SetEvent;
  finally
    FLock.Leave;
  end;

end;

function TDownloadThread.GetTempFilename(const AUri: string): String;
var
  ext: string;
begin
  ext := ExtractFileExt(AUri);
 
  if (ext = '') or (length(ext) > 4) then
    ext := '.png';

  Result := TPath.Combine(TPath.GetTempPath,
    THashMD5.GetHashString(AUri) + ext);
end;

procedure TDownloadThread.DoUpdate(const AStream: TStream;
  const ACallback: TOnStreamAvailableDirect; const AOwner: TObject);
var
  bIgnore: Boolean;
begin
  AStream.Position := 0;

  FLock.Enter;
  bIgnore := ((FLastRemovedOwner <> nil) and (FLastRemovedOwner = AOwner)) or
    not assigned(ACallback);
  FLock.Leave;

  if not bIgnore then
    TThread.Synchronize(TThread.CurrentThread,
      procedure()
      begin
        try
          ACallback(AStream);
        except
        end;
        AStream.Free;
      end)
  else
    AStream.Free;
end;

procedure TDownloadThread.RemoveOwner(const AOwner: TObject);
var
  i: Integer;
begin
  FLock.Enter;
  for i := FList.Count - 1 downto 0 do
    if FList[i].Owner = AOwner then
      FList.Delete(i);

  FLastRemovedOwner := AOwner;
  FLock.Leave;
end;

procedure TDownloadThread.Execute;
var
  Filename: string;
  Callback: TOnStreamAvailableDirect;
  Owner: TObject;
begin
  while not terminated do
  begin
    while (FEvent.WaitFor(INFINITE) = TWaitResult.wrSignaled) and
      (Pop(Filename, Callback, Owner)) do
    begin
      PerformDownload(Filename, Callback, Owner);
      sleep(0);
    end;
    sleep(10);
  end;
end;

procedure TDownloadThread.PerformDownload(const AFilename: String;
const ACallback: TOnStreamAvailableDirect; const AOwner: TObject);
begin
  TThread.CreateAnonymousThread(
    procedure()
    var
      bLoaded: Boolean;
      TempFile: String;
      Stream: TStream;
    begin
      bLoaded := false;

      FLock.Enter;
      inc(FThreadCount);
      FLock.Leave;

      Stream := TMemoryStream.Create;
      TempFile := GetTempFilename(AFilename);

      if (FCached) and FileExists(TempFile) then
      begin
        try
          TMemoryStream(Stream).LoadFromFile(TempFile);
          bLoaded := true;
        except
        end
      end;

      if (not bLoaded) then
      begin
        if (FCached) then
          TMemoryStream(Stream).SaveToFile(TempFile);

        if GetHtml(AFilename, Stream) and (FCached) then
        begin
          TMemoryStream(Stream).SaveToFile(TempFile)
        end
        else
        begin
          if FCached then
            DeleteFile(TempFile);
        end;
      end;
      DoUpdate(Stream, ACallback, AOwner);

      FLock.Enter;
      dec(FThreadCount);

      if (FList.Count > 0) and (FThreadCount < FMaxDownloads) then
        FEvent.SetEvent;

      FLock.Leave;
    end).Start;
end;

var
  FDownloadThread: TDownloadThread;

function DownloadThread: TDownloadThread;
begin
  if not assigned(FDownloadThread) then
    FDownloadThread := TDownloadThread.Create(true);
  Result := FDownloadThread;
end;

{ ============================================================================== }

procedure CancelRetrieveImage(const AOwner: TObject);
begin
  DownloadThread.RemoveOwner(AOwner);
end;

procedure RetrieveImage(ALogo: String; const AZip: TZipFile;
const AOnAvailable: TOnStreamAvailable; const AOwner: TObject = nil);
begin
  if assigned(AOnAvailable) then
    RetrieveImage(ALogo, AZip,
      procedure(const AStream: TStream)
      begin
        AOnAvailable(AStream);
      end, AOwner);
end;

procedure RetrieveImage(ALogo: String; const AZip: TZipFile;
const AOnAvailable: TOnStreamAvailableDirect; const AOwner: TObject = nil);
var
  Stream: TStream;
  LocalHeader: TZipHeader;
begin
  if not assigned(AOnAvailable) then
    exit;
  if (Pos('://', ALogo) = 0) and FileExists(ALogo) then
  begin
    Stream := TMemoryStream.Create;
    try
      TMemoryStream(Stream).LoadFromFile(ALogo);
    except
    end;
    AOnAvailable(Stream);
    Stream.DisPoseOf;
  end
  else if assigned(AZip) and (Pos('zip://', ALogo) > 0) then
  begin
    ALogo := StringReplace(ALogo, 'zip://', '', [rfReplaceAll]);
    if AZip.IndexOf(ALogo) > -1 then
    begin
      AZip.Read(ALogo, Stream, LocalHeader);
      AOnAvailable(Stream);
      Stream.Free;
    end;
  end
  else if (Pos('http://', ALogo) > 0) or (Pos('https://', ALogo) > 0) then
    DownloadThread.Add(ALogo, AOnAvailable, AOwner);
end;

initialization

finalization

FreeAndNil(FDownloadThread);

end.

So richtig zufrieden bin ich damit noch nicht, aber ich musste nicht zu viel bei meinem bestehenden Code ändern. Über CancelRetrieveImage kann ich in einem Destructor meiner Komponente den Download beenden, sofern er noch aktiv ist.

Peter