|
Registriert seit: 11. Aug 2007 357 Beiträge |
#6
Vielen Lieben Dank,
ich hab das ganze jetzt erst einmal folgendermaßen "gelöst".
Delphi-Quellcode:
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.
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. Peter Geändert von Peter666 (23. Feb 2020 um 10:42 Uhr) |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs 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
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |