Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Indy FTP doesn't load correctly a progress bar

Tags:

delphi

A friend of mine asked me an help because he wanted a progressbar that indicates the uploading/downloading of some text files. Here you can see the code I used:

procedure TForm1.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
 Application.ProcessMessages;
 ProgressBar1.Position:= AWorkCount;
 Label6.Caption:=IntToStr(ProgressBar1.Position);
end;

procedure TForm1.IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
 if(AWorkCountMax>0) then
  begin
    ProgressBar1.Max:=AWorkCountMax;
  end;
  ProgressBar1.Position:=0;
end;

procedure TForm1.IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
 ProgressBar1.Position:=0;
end;

On my Form I also have 2 labels: the first indicates the progression and is called Label6 and the other simply has a caption like "%" as you can see below. The Label 6 should have a value that goes from 0 to 100.

enter image description here

The text file he sends are small now but they're going to be bigger. My problem is that I don't see the bar progression on the program (the green rectangle) and also, the value on label 6 goes over 100 and arrives to 700. What should I do?

like image 584
Alberto Miola Avatar asked Feb 16 '23 00:02

Alberto Miola


1 Answers

AWorkCountMax and AWorkCount are byte counts, not percentages. You need to take that into account when updating your UI, especially if you want to display a percentage.

With that said, AWorkCountMax will only be valid on uploads, never on downloads. The reason for this is because The FTP protocol does not transmit the file size during transfers, so TIdFTP does not know the size of a file being downloaded, only the size of the local file being uploaded. For a download, you will have to retrieve the file size manually first, either with TIdFTP.Size(), TIdFTP.List(), or TIdFTP.ExtListItem().

And stay away from Application.ProcessMessages() altogether. If you want to trigger a repaint, use Update() instead.

Try this:

procedure TForm1.IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  if AWorkMode = wmWrite then
    ProgressBar1.Max := AWorkCountMax
  else;
    ProgressBar1.Max := ...; // value retrieved beforehand...
  ProgressBar1.Position := 0;
end;

procedure TForm1.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  if ProgressBar1.Max > 0 then
  begin
    ProgressBar1.Position := AWorkCount;
    Label6.Caption := IntToStr((ProgressBar1.Position * 100) div ProgressBar1.Max) + '%';
  end else
    Label6.Caption := IntToStr(AWorkCount) + ' bytes';
  Update;
end;

procedure TForm1.IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  ProgressBar1.Position := 0;
end;

Alternatively:

var
  WorkMax: Int64;

procedure TForm1.IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  if AWorkMode = wmWrite then
    WorkMax := AWorkCountMax
  else;
    WorkMax := := ...; // value retrieved beforehand...
  ProgressBar1.Min := 0;
  ProgressBar1.Max := 100;
  ProgressBar1.Position := 0;
end;

procedure TForm1.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
  if WorkMax > 0 then
  begin
    ProgressBar1.Position := (AWorkCount * 100) div WorkMax;
    Label6.Caption := IntToStr(ProgressBar1.Position) + '%';
  end else
    Label6.Caption := IntToStr(AWorkCount) + ' bytes';
  Update;
end;

procedure TForm1.IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  ProgressBar1.Position := 0;
end;
like image 157
Remy Lebeau Avatar answered Feb 23 '23 02:02

Remy Lebeau