ProgressBar while FTP retreive

[zsleo]

I need users to download large files (up to 800 MB)  using Indy FTP.

I am able to update the progress bar using TTask for some other lengthy processes but as soon as I start the FTP get file the procress bar stops updating.

Like most components in Indy, TIdFTP blocks the calling thread until the requested operation is finished.  Are you performing the FTP transfer in the context of the main UI thread or a worker thread?

If the former, are you using TIdAntiFreeze to keep servicing the main UI message queue while the FTP transfer is busy?

If the latter, are you synchronizing with the main UI thread, such as with TThread.Synchronize()/TThread.Notify(), or TIdSync/TIdNotify, etc?

Can you provide your actual FTP code?

TidAntiFreeze is in the ServerController.  

I have TidFTPClient in UserSessionUnit with the following events

Code:

procedure TIWUserSession.idftp1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  gv_FTPFilePercent := round((AWorkCount / gv_FTPFileSize) * 100);
end;

procedure TIWUserSession.idftp1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  gv_FTPDownloading := True;

end;

procedure TIWUserSession.idftp1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  gv_FTPDownloading := False;
end;

procedure TIWUserSession.GetFile(ip_FN: string);
begin
  Ret := 0;
  gv_FetchCompleted := False;
  idftp1.Host := 'ftp.mednet.com.au';
  idftp1.Username := [UserName];
  idftp1.Password := [Password];
  idftp1.Port := 21;
  idftp1.Passive := True;
  idftp1.TransferType := ftBinary;

  try
    idftp1.Connect;

    if FileExists(sv_AppDir + ip_FN) then
      Delete_File(sv_AppDir + ip_FN);
    gv_FTPFileSize := idftp1.Size([FTP_Path] + ip_FN);
    idftp1.Get([FTP_Path] + ip_FN, sv_AppDir + ip_FN, True, True);
    idftp1.Disconnect;

    if FileExists(sv_AppDir + ip_FN) then
      gv_FetchCompleted := Z7Extract(sv_AppDir, sv_AppDir + ip_FN);

  except
    on E: Exception do
    begin
      if idftp1.Connected then
        idftp1.Disconnect;
      if sv_Testing then
        doEventNotify(nt_Error, E.Message);
    end;
  end;
end;

In my Main Form I have an TIWTimer and Button with its OnClick calls the following procedure

Code:

procedure TiwfrmMain.OnDoFTP(Sender: TObject; AParams: TStringList);
begin

  UserSession.gv_FTPFilePercent := 0;

  TTask.Run(
    procedure
    begin
      while not gv_ToStop do
      begin
        sleep(200);
      end;
    end);

  iwtmr1.Tag := 1;
  iwtmr1.Enabled := True;

end;

TIWTimer.Interval is set to 200 and the async event as follows

Code:

procedure TiwfrmMain.iwtmr1AsyncTimer(Sender: TObject; EventParams: TStringList);
var
  lv_S: string;
  lv_I: integer;
begin
  if iwtmr1.Tag = 1 then
  begin
    iwtmr1.Tag := 0;
      UserSession.gv_FTPDownloading := True;
      UserSession.GetFile([File_to_get]);

  end
  else
    iwcgjqsyprgrs1.SetProgress(UserSession.gv_FTPFilePercent / 100); { <<< updating the progress bar}

 
  if not UserSession.gv_FTPDownloading then
  begin
    iwtmr1.Enabled := False;
    gv_ToStop := True;

    {Extract the ZIP File}
    
  end;

end;