Downloadlogik unter Firemonkey

[Peter666]

Danke,

ich habe jetzt einen Thread der sich um die Downloads kümmert und ich über eine thread sichere Liste den Callback und die URL übergebe. Jetzt gibt es aber ein Problem was vorher nicht ganz so dramatisch war. Angenommen ich lösche das Element, welches den Callback beinhaltet und das Bild im geladenen Zustand anzeigen soll. Jetzt lädt meine Downloadklasse und will die Callbackroutine aufrufen.
Ich habe schon probiert das ganze mit einem Event abzusichern und warte bis der Download fertig ist. Das kann aber bis zum Sank Nimmerleinstag sein, wenn der Download fehl schlägt oder gar nicht ausgeführt wird.

Peter

[himitsu]

Ich hab aktuell eine Laderoutine die hat eine globale Liste (Tasks) über die sie sich absichert.
Kann auch für z.B. die selbe Anzeige-Komponente, während einer läd was anderes laden und paralell dem ersten Sagen, dass seine Arbeit nicht mehr benötigt wird
und alles ohne Warten und somit auch ohne Deadlocks für den Benutzer.

Jeder Thread/Task der gestartet wird trägt sich in eine Liste ein, und den von dem er gestartet wurde, bzw. an wen er sich am Ende wieder wenden will.
Wer fertig ist, trägt sich aus der Liste wieder aus, bzw. wird automatisch ausgetragen (vor allem der Besitzer/Starter).
https://www.delphipraxis.net/203408-...ml#post1457779

Spätestens am Ende schauen die Threads dann nochmal nach, ob sie noch arbeiten sollen und wenn doch, erst dann wenden sie sich an an den Aufrufer. (wenn nicht, dann beenden und es ist egal, ob der Aufrufer noch existiert und der gespeicherte Zeiger/Callback schon ungültig ist)


PS: in den NextGen-Compilern (Android/iOS) verhalten sich Komponenten wie Interfaces, also di gibst die Form frei, aber da du noch einen Objektzeiger oder Callback (mit einem Objektzeiger drin) hast, existiert die Komponente dann immernoch



Ist zwar aktuell nur im VCL/Windows im Einsatz, aber sollte überall laufen.

Delphi-Quellcode:

TBackgroundTasks.Start(Image1, TLoadImageThread.Create(Filename));

// oder
TBackgroundTasks.Start<string>(Image1, LoadImageProc, Filename);

procedure TIrgendwas.LoadImageProc(ID: TTaskID; Owner: TObject; Filename: string);
var
  xxx: TBitmap;
begin
  // laden
  xxx.LoadFromUndMachIrgendwas(Filename);

  TBackgroundTasks.Synchronize(procedure
    begin
      if not TBackgroundTasks.Check(ID) then  // Aufgabe ist abgelaufen
        Exit;

      // anzeigen
      Image1.Picture.Bitmap.Assigned(xxx);
    end);
end;

Gibt im Prinzip nur 3 Funktionen,
* Start = Ausgabe starten
* Stop = Ausgabe für Beendet erklären
* Check = Prüfen ob Aufgabe noch läuft (von außen), bzw. ob sie sich beenden soll (von innen)
denen man Threads oder Prozeduren, Methoden oder Anonyme geben kann, die dann im Hintergrund werkeln und die sich selbst zentral organisieren,
wobei Stop automatisch ausgelöst wird, wenn der Owner verschwindet. (über das Syncronize am Ende wird sichergestellt, dass zwischen der Check-Abfrage und der Anzeige nicht doch noch der Owner verschindet, da das alles im Hauptthread läuft)

Ansonsten fängst du selber an über globale oder gegenseitige Kreutreferenzen und eine Threadsichere Synchronisierung
jeweils beim Gegenüber die Referenz auf sich selbst zu entfernen, bzw. dem Anderen zu sagen dass es nun vorbei ist. und mit etwas Glück schaffst du es dass jeder auf den Anderen wartet und es hängen bleibt.
Drum hatte ich mir diese asynchrone Unterhaltung gebaut, die nur ganz kurz beim Zugriff auf die Liste gesperrt wird.

Wem das mit dem "über das Syncronize am Ende wird sichergestellt" nicht gefällt, der muß da noch ein Lock/Unlock veröffentlichen, um die Liste für länger zu sperren (sperren, checken, machen, entsperren), aber als Prevention, dass so niemand einen Deadlock einbauen kann, hatte ich es garnicht erst eingebaut.
Also externer Zugriff auf die zentrale CriticalSection, bzw. diesem TMonitor.
(Achtung: System.TMonitor, nicht Forms.TMonitor ... k.A. wer auf die kranke Idee kam und diese Benaumng blind aus'm .NET geklaut hat)

Zitat:

Delphi-Quellcode:

// Start
TBackgroundTasks.Start(Self, ...);

// Stopp
TBackgroundTasks.Stop(Self);

// Restart
TBackgroundTasks.Stop(Self);
TBackgroundTasks.Start(Self, ...);

// läuft noch?
running := TBackgroundTasks.Check(Self);

// Stopp über ID
ID := TBackgroundTasks.Start(OnwerOrNil, ...);
...
TBackgroundTasks.Stop(ID);

// Stopp über Klassenmethode (gleiches bei TThread-Zeiger)
TBackgroundTasks.Start(OnwerOrNil, ThreadMethod);
...
TBackgroundTasks.Stop(ThreadMethod);

// Funktion starten
TBackgroundTasks.Stop(Self);
TBackgroundTasks.Start(Self, ThreadProcedur, ...);

// Thread starten (Create mit Suspended=True und im TBackgroundTasks.Start wird Thread.Start aufgerufen)
TBackgroundTasks.Stop(Self);
TBackgroundTasks.Start(Self, TBeispielThread.Create(...));

TBackgroundTasks.Stop(Self);
Thread := TBeispielThread.Create(...);
TBackgroundTasks.Start(Self, Thread);

// Parameter (Start)
TBackgroundTasks.Start(OwnerOrNil, Thread);           // suspended erstellte TThread-Instanz
TBackgroundTasks.Start(OwnerOrNil, Thread, True);     // manuell aus TBackgroundTasks entfernen, wenn Thread beendet (wenn Thread.OnTerminate<>nil)
TBackgroundTasks.Start(OwnerOrNil, Proc);             // Klassenmethode, anonyme Methode oder Prozedur
TBackgroundTasks.Start<A>(OwnerOrNil, Proc, ParamA);  // ... mit Parameter
TBackgroundTasks.Start<A,B>(OwnerOrNil, Proc, ParamA, ParamB);
TaskID := TBackgroundTasks.Start...;                  // ID für Check/Stop

// Parameter (Check und Stop)
TBackgroundTasks.StopAll;            // ALLE Threads
TBackgroundTasks.Stop(Owner);        // irgendwas am Owner (Threads oder Prozeduren)
TBackgroundTasks.Stop(TaskID);       // bestimmte ID (Result der Start)
TBackgroundTasks.Stop(Thread);       // bestimmter Thread
TBackgroundTasks.Stop(Method);       // bestimmte Methode, auch mehrfach (nur Klassenmethoden, keine Prozeduren oder anonyme Methoden)
TBackgroundTasks.Stop<...>(Method);  // ...

// Beispiel-Prozedur (Alternativen als Kommentar)
TBackgroundTasks.Start(Self, Beispiel, {ParamA, ParamB});

procedure TIrgendwas.BeispielProc(ID: TTaskID; Owner: TObject; {ParamA, ParamB: TIrgendwas});
begin
  TThread.NameThreadForDebugging(AnsiString(Format('TBackgroundTasks:BeispielProc TaskID=%d', [TaskID])));  // falls nicht, wurde es vorher nur mit der TaskID bereits erledigt

  { berechnen }
  ...
  if not TBackgroundTasks.Check(ID) then
    Exit;
  ...

  //TThread.Synchronize(nil, procedure
  TBackgroundTasks.Synchronize(procedure
    begin
      if not TBackgroundTasks.Check(ID) then  // Aufgabe ist abgelaufen
        Exit;
      { anzeigen }
      ...
    end);
  //TBackgroundTasks.Synchronize(ID, SyncProc);  //procedure {TIrgendwas.}SyncProc(ID: TTaskID; Owner: TObject; Value: Pointer);
  //TBackgroundTasks.Synchronize(ID, SyncProc, Value);
end;

// Beispiel-Thread (Optionales und Alternativen als Kommentar)
TBackgroundTasks.Start(Self, TBeispielThread.Create{(ParamA, ParamB)});

type
  TBeispielThread = class(TTaskThread)  // es geht auch jede andere TThread-Klasse
  private
    //FParamA, FParamB: TIrgendwas;
    procedure SyncProc;
  protected
    procedure Execute; override;
  public
    constructor Create{(ParamA, ParamB: TIrgendwas)};
    destructor Destroy; override;
  end;

procedure TBeispielThread.SyncProc;
begin
  //if not TBackgroundTasks.Check(TaskID_or_Self) then
  if not TaskCheck then  // Aufgabe ist abgelaufen
    Exit;
  { anzeigen }
  ...
end;

procedure TBeispielThread.Execute;
begin
  inherited;  // oder TThread.NameThreadForDebugging(AnsiString(Format('TBeispielThread ID=%d ...', [TaskID])));

  { berechnen }
  ...
  //if not TBackgroundTasks.Check(TaskID_or_Self) then
  if not TaskCheck then  // Aufgabe ist abgelaufen
    Exit;
  ...

  Synchronize(SyncProc);
  {Synchronize(procedure
    begin
      //if not TBackgroundTasks.Check(TaskID_or_Self) then
      if not TaskCheck then  // Aufgabe ist abgelaufen
        Exit;
      { anzeigen }
      ...
    end);}
end;

constructor TBeispielThread.Create{(ParamA, ParamB: TIrgendwas)}
begin
  inherited Create;
  //FParamA := ParamA;
  //FParamB := ParamB:
end;

destructor TBeispielThread.Destroy;
begin
  //ParamA.Free;
  inherited;
end;

// mit TThread-Klasse, wo OnTerminate nicht überschreibbar ist (ICallStopOnTerminate=True)
TBackgroundTasks.Start(OwnerOrNil, TMyThread.Create, True);

procedure TMyThread.Execute;
begin
  TThread.NameThreadForDebugging(AnsiString(Format('TMyThread ID=%d ...', [TaskID])));
  try
    ...
  finally
    //TBackgroundTasks.Stop(TaskID_or_Self);
    TaskStop;  // Thread ist fertig (alternativ das TaskStop im Thread.OnTerminate aufrufen)
  end;
end;

[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