在后台下载文件而不阻止gui

时间:2017-10-04 11:38:32

标签: delphi

我有一份记录清单。每条记录都有一个

  

网址:=字符串

字段。通过GUI,用户可以完全编辑revords甚至删除记录(行)。我想在一个线程的后台下载URL字段指向的所有在线文件​​。当然,我不想在线程下载文件时锁定GUI。那么,如何确保程序/用户无法访问线程当前处理的记录?

3 个答案:

答案 0 :(得分:3)

  

那么,我如何确保程序/用户无法访问记录   目前由线程处理?

现代" (正如我所认为的Delphi 2006)记录您可以像使用类一样使用getter和setter属性。在setter中,您可以阻止或允许更改基础字段。

一个天真的例子:

type
  TMyRecord = record
  private
    FURL: string;
    FDownloading: boolean;
    procedure SetTheURL(NewURL: string);
  public
    property TheURL: string read FURL write SetTheURL;
    procedure DownLoad;
  end;

procedure TMyRecord.SetTheURL(NewURL: string);
begin
  if not FDownloading then
    FURL := NewURL;
  else
    // signal inability to change
end;

procedure TMyRecord.DownLoad;
begin
  FDownLoading := True;
  // hand the downloading task to a thread
end;

此处记录下的documentation(高级)

答案 1 :(得分:2)

我真的很想使用BITS进行下载。 从Delphi轻松访问。在BITS中定义作业,在后台下载。准备就绪后,您可以调用EXE,您可以在空闲循环中轮询结果,或者您可以获得一个事件。

这是一个示例 - 你需要jedi lib! 该样本需要针对生产质量进行扩展(错误处理,日志记录,作业名称)!

unit uc_DownloadBits;

interface

uses
  ExtActns;

type
  TDownloadBits = class
  public
    class procedure DownloadForground(ziel, downloadurl: WideString; DownloadFeedback:TDownloadProgressEvent);
    class procedure DownloadBackground(ziel, downloadurl, ExeName, Params: WideString);
    class procedure CompleteJob(JobId: WideString);
  end;

implementation

uses
  ComObj, ActiveX, SysUtils,
  JwaBits, JwaBits1_5, Windows;

{ TDownloadBits }

class procedure TDownloadBits.CompleteJob(JobId: WideString);
var
  bi: IBackgroundCopyManager;
  job: IBackgroundCopyJob;
  g: TGuid;
begin
  bi:=CreateComObject(CLSID_BackgroundCopyManager) as IBackgroundCopyManager;
  g:=StringToGUID(jobid);
  bi.GetJob(g,job);
  job.Complete();
end;

class procedure TDownloadBits.DownloadBackground(ziel, downloadurl,
  ExeName, Params: WideString);

var
  bi: IBackgroundCopyManager;
  job: IBackgroundCopyJob;
  job2: IBackgroundCopyJob2;
  jobId: TGUID;
  r: HRESULT;

begin
  bi:=CreateComObject(CLSID_BackgroundCopyManager) as IBackgroundCopyManager;
  r:=bi.CreateJob('Updatedownload', BG_JOB_TYPE_DOWNLOAD, JobId, job);
  if not Succeeded(r) then
    raise Exception.Create('Create Job Failed');
  r:=Job.AddFile(PWideChar(downloadurl), PWideChar(ziel));
  if not Succeeded(r) then
    raise Exception.Create('Add File Failed');
  // Download starten
  Job.Resume();  

  Params:=Params+' '+GUIDToString(jobId);

  Job2 := Job as IBackgroundCopyJob2;
  Job2.SetNotifyCmdLine(pWideChar(ExeName), PWideChar(Params));
  Job.SetNotifyFlags(BG_NOTIFY_JOB_TRANSFERRED);
end;

class procedure TDownloadBits.DownloadForground(ziel, downloadurl: widestring; DownloadFeedback:TDownloadProgressEvent);
var
  bi: IBackgroundCopyManager;
  job: IBackgroundCopyJob;
  jobId: TGUID;
  r: HRESULT;

  // Status Zeug
  p: BG_JOB_PROGRESS;
  s: BG_JOB_STATE;

  // Timer Zeug
  hTimer: THandle;
  DueTime: TLargeInteger;
  c: boolean;
begin
  bi:=CreateComObject(CLSID_BackgroundCopyManager) as IBackgroundCopyManager;
  r:=bi.CreateJob('Updatedownload', BG_JOB_TYPE_DOWNLOAD, JobId, job);
  if not Succeeded(r) then
    raise Exception.Create('Create Job Failed');
  r:=Job.AddFile(PWideChar(downloadurl), PWideChar(ziel));
  if not Succeeded(r) then
    raise Exception.Create('Add File Failed');
  // Download starten
  Job.Resume();

  DueTime:=-10000000;
  hTimer:=CreateWaitableTimer(nil, false, 'EinTimer');
  SetWaitableTimer(hTimer, DueTime, 1000, nil, nil, false);
  while True do
  begin
    Job.GetState(s);

    if s in [BG_JOB_STATE_TRANSFERRING, BG_JOB_STATE_TRANSFERRED] then
    begin
      Job.GetProgress(p);
      DownloadFeedback(nil, p.BytesTransferred, p.BytesTotal, dsDownloadingData, '', c);
      if c then
        break;
    end;

    if s in [BG_JOB_STATE_TRANSFERRED,
      BG_JOB_STATE_ERROR,
      BG_JOB_STATE_TRANSIENT_ERROR] then
        break;

    WaitForSingleObject(hTimer, INFINITE);
  end;
  CancelWaitableTimer(hTimer);
  CloseHandle(hTimer);
  if s=BG_JOB_STATE_TRANSFERRED then
    job.Complete();

  job:=nil;
  bi:=nil;
end;

end.

答案 2 :(得分:2)

以下是基于Tom Brunberg使用记录的解决方案。想法记录将通过TThread开始下载(根据我的理解,下载本身的实现是不可能的)。这可能有点粗糙,如果在处理线程时存在严重错误,请告诉我。

下载时,数据无法访问,我决定在访问时抛出异常,但这取决于GUI的实现细节。 property IsDownLoading: Boolean可用于例如禁用通常会使数据可访问的控件。

但是,用户可以随时更改URL,如果正在处理则终止当前下载。

TDownloadThread只应在需要时出现。如果有很多这些记录,这应该减少不需要的资源。

unit Unit1;

interface

uses
  System.Classes, System.SysUtils;

type
  TDownLoadThread = class(TThread)
  private
    FURL: string;
    FData: Variant;
    procedure SetURL(const Value: string);
  protected
    procedure Execute; override;    
  public
    property Data: Variant read FData;
    property URL: string read FURL write SetURL;
  end;

  TDownLoadRecord = record
  private
    FData: Variant;
    FURL: string;
    FDownLoadThread: TDownLoadThread;
    procedure DownLoadThreadTerminate(Sender: TObject);
    function GetIsDownLoading: Boolean;
    procedure SetURL(const Value: string);
    procedure URLChanged;
    function GetData: Variant;
  public
    property Data: Variant read GetData;  
    property URL: string read FURL write SetURL;
    property IsDownLoading: Boolean read GetIsDownLoading;
  end;

implementation

{ TDownLoadRecord }

procedure TDownLoadRecord.DownLoadThreadTerminate(Sender: TObject);
begin
  FData := FDownLoadThread.Data;
  FDownLoadThread := nil;
end;

function TDownLoadRecord.GetData: Variant;
begin
  if not IsDownLoading then
    Result := FData
  else
    raise Exception.Create('Still downloading');
end;

function TDownLoadRecord.GetIsDownLoading: Boolean;
begin
  Result := (FDownLoadThread <> nil) and not FDownLoadThread.Finished;
end;

procedure TDownLoadRecord.SetURL(const Value: string);
begin
  if FURL <> Value then
  begin
    FURL := Value;
    URLChanged;
  end;
end;

procedure TDownLoadRecord.URLChanged;
begin
  if FURL <> '' then
  begin
    if FDownLoadThread <> nil then
      TDownLoadThread.Create(True)
    else
      if not FDownLoadThread.CheckTerminated then
        FDownLoadThread.Terminate;
    FDownLoadThread.URL := FURL;
    FDownLoadThread.FreeOnTerminate := True;
    FDownLoadThread.OnTerminate := DownLoadThreadTerminate;
    FDownLoadThread.Start;
  end;
end;

{ TDownLoadThread }

procedure TDownLoadThread.Execute;
begin
  // Download
end;

procedure TDownLoadThread.SetURL(const Value: string);
begin
  FURL := Value;
end;

end.