AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Downloadlogik unter Firemonkey

Ein Thema von Peter666 · begonnen am 20. Feb 2020 · letzter Beitrag vom 23. Feb 2020
Antwort Antwort
Peter666

Registriert seit: 11. Aug 2007
357 Beiträge
 
#1

Downloadlogik unter Firemonkey

  Alt 20. Feb 2020, 17:15
Hallo,

ich habe mal eine Frage wie ihr folgendes Problem lösen würdet. Bei einem Projekt lade ich diverse Grafiken von einem Server zeige diese in einer Grid an. Damit das UI keinen Herzinfarkt bekommt, lade ich die Bilder im Hintergrund. Mein Code ist folgender:

Delphi-Quellcode:
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;

procedure RetrieveImage(ALogo: String; const AZip: TZipFile;
  const AOnAvailable: TOnStreamAvailable; const ACached: Boolean);
begin
  if assigned(AOnAvailable) then
    RetrieveImage(ALogo, AZip,
      procedure(const AStream: TStream)
      begin
        AOnAvailable(AStream);
      end, ACached);
end;

procedure RetrieveImage(ALogo: String; const AZip: TZipFile;
const AOnAvailable: TOnStreamAvailableDirect; const ACached: Boolean);
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
      FLock.Enter;
      AZip.Read(ALogo, Stream, LocalHeader);
      FLock.Leave;
      AOnAvailable(Stream);
      Stream.DisPoseOf;
    end;
  end
  else if (Pos('http://', ALogo) > 0) or (Pos('https://', ALogo) > 0) then
  begin
    TTask.Run(
      procedure()
      var
        Stream: TMemoryStream;
        Filename: String;
      begin
        Filename := TPath.Combine(TPath.GetTempPath, IntToStr(Crc32(ALogo)) +
          ExtractFileExt(ALogo));
        Stream := TMemoryStream.Create;
        if (ACached) and FileExists(Filename) then
          try
            Stream.LoadFromFile(Filename)
          except
          end
        else if GetHtml(ALogo, Stream) and ACached then
          try
            Stream.SaveToFile(Filename);
          except
          end;
        Stream.Position := 0;

        TThread.Queue(nil,
          procedure()
          begin
            if assigned(AOnAvailable) then
              AOnAvailable(Stream);
            Stream.Free;
          end);
      end).Start;
  end;
end;
Ich bin nicht richtig glücklich damit, da unter Umständen ein Bild doppelt geladen werden kann und ich im schlimmsten Fall das Bild speichere und gleichzeitig in einem anderen Thread schon lade. Man müsste das jetzt absichern. Mein Ansatz wäre eine CriticalSection beim speichern und laden zu verwenden und in einem Dictionary Url und Dateiname zu hinterlegen. Kennt jemand eventuell eine elegantere Variante?

Das zweite Problem sind defekte Downloads. Ich kriege die ja nicht mit und ab und wenn man jetzt ein kaputtes Bild einem TBitmap.CreateFromStream oder LoadFromStream übergibt, gibts eine Exception. Nach einiger Zeit hilft aber kein try except end und die Anwendung wird klaglos beendet. Zumindest auf Android. Schaut man dann in die Konsole steht meist irgendwas mit OpenGL fatal irgendwas als Grund für das Schließen der App. Ich hab absolut keine Ahnung inwieweit ich die Validität der geladenen Bilder überprüfe und bei offensichtlichem Unsinn ignoriere.

Das dritte Problem ist wie und wann lösche ich den temporären Pfad? Muss ich dass überhaupt, oder säubert das Android bzw. IOS von alleine?

Peter
  Mit Zitat antworten Zitat
Rollo62

Registriert seit: 15. Mär 2007
4.094 Beiträge
 
Delphi 12 Athens
 
#2

AW: Downloadlogik unter Firemonkey

  Alt 20. Feb 2020, 17:25
Wieso kann den ein File zweimal geladen werden, Liegt dan an Windows/Unix case sensitivity ?

Falls ja, vielleicht müsste man darauf im FileExists Rücksicht nehmen,
und "Hallo.jpg", "hAlLo.jpg" und "haLLo.jpg" als drei verschiedene Files erkennen.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

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

AW: Downloadlogik unter Firemonkey

  Alt 20. Feb 2020, 17:26
In einer Liste speichern was gerade geladen wird, dann kannst du nachfolgende Aufrufe entweder abbrechen, bzw. sie warten lassen, bis der andere fertig ist und dann dort dessen Bild zurückgeben.

@Rollo, wenn du nur in das Erbegnis schaust und davon abhängig eine Aktion ausführst, dann kann was doppelt passieren,
also braucht man auch eine Liste war gerade äuft, also demnächst da ist.

> ich schau in die Dateiliste, Datei ist nicht da, also laden und "anschließend" speichern
> nun schau ich paralell in die Dateiliste, seh die Datei nicht, also laden und anschließend speichern (weiß ja nicht, dass es grade schon jemand macht)


Ob nun eine eigene Liste oder schon ein "vorläufiger" Dummy-Eintrag in Zielliste, das ist erstmal egal, also:
Erst die leere Datei erstellen/öffnen, dann das Laden beginnen und später den Inhalt abspeichern,
dann sieht der Nächste dass die Datei schon "existiert" und sie hoffentlich bald da ist.
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PoSex im Delphi viel seltener praktiziert.

Geändert von himitsu (20. Feb 2020 um 17:31 Uhr)
  Mit Zitat antworten Zitat
Peter666

Registriert seit: 11. Aug 2007
357 Beiträge
 
#4

AW: Downloadlogik unter Firemonkey

  Alt 21. Feb 2020, 14:19
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
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

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

AW: Downloadlogik unter Firemonkey

  Alt 21. Feb 2020, 15:38
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;
Angehängte Dateien
Dateityp: pas h5u.ThreadingAndSynchronize.pas (24,7 KB, 3x aufgerufen)
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PoSex im Delphi viel seltener praktiziert.

Geändert von himitsu (21. Feb 2020 um 15:59 Uhr)
  Mit Zitat antworten Zitat
Peter666

Registriert seit: 11. Aug 2007
357 Beiträge
 
#6

AW: Downloadlogik unter Firemonkey

  Alt 23. Feb 2020, 11:29
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

Geändert von Peter666 (23. Feb 2020 um 11:42 Uhr)
  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:24 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