Re: Problems creating a progress bar for TidFTP

Giganews Newsgroups
Subject: Re: Problems creating a progress bar for TidFTP
Posted by:  Remy Lebeau (TeamB) (no.spam@no.spam.com)
Date: Thu, 28 Apr 2005

"Burnett" <raven_b72@hotmailDOTcom> wrote in message
news:B05EA85DBFC8E240raven_b72@hotmailDOTcom...

> It also only get one OnWork event that contains the final byte
> count of the file being uploaded and this happens before the upload
> is complete.

How large is the file to begin with?  If small enough, there could
potentially be only 1 event triggered, yes.

>    OnStatus:= Form1.IdFTP1Status;                    { Can I do this? }

Technically yes, but I would not advise it because the code inside the
OnStatus handler is not thread-safe.  You cannot safely access GUI
components directly from the context of a worker thread.  Only the main
thread should be doing that.  You will need to use either the
TThread.Synchronize() method or Indy's TIdSync class in order to access the
GUI from a worker thread.

>  FTPClient.Connect;
>  FTPClient.Put('myFile.txt','',true);
>  FTPClient.Disconnect;
>  FTPClient.Free;

You should wrap those operations in try..finally and/or try..except blocks.
There are many situations that can occur which throw exceptions.  If that
happens, your code will not clean up after itself properly.

With all of that said, try the following code instead:

    const
        WM_FTP_STATUS = WM_APP+100;
        WM_FTP_WORK_BEGIN = WM_APP+101;
        WM_FTP_WORK = WM_APP+102;
        WM_FTP_WORK_END = WM_APP+103;

    type
        TForm1 = class(TForm)
        published
            Button1: TButton;
            Memo1: TMemo;
            ProgressBar1: TProgressBar;
            procedure Button1Click(Sender: TObject);
        private
            procedure WMFTPStatus(var Message: TMessage); message
WM_FTP_STATUS;
            procedure WMFTPWorkBegin(var Message: TMessage); message
WM_FTP_WORK_BEGIN;
            procedure WMFTPWork(var Message: TMessage); message WM_FTP_WORK;
            procedure WMFTPWorkEnd(var Message: TMessage); message
WM_FTP_WORK_END;
        end;

        TFTPThread = class(TThread)
        private
            procedure FTPStatus(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
            procedure FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
            procedure FTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
            procedure FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
        protected
            procedure Execute; override;
        public
            constructor Create; override;
        end;

    constructor TFTPThread.Create;
    begin
        FreeOnTerminate := True;
        inherited Create(False);
    end;

    procedure TFTPThread.Execute;
    begin
        try
            with TIdFTP.Create(nil) do try
                Host := 'ftp.somewhere.com';
                Username := 'username';
                Password := 'password';
                OnStatus := FTPStatus;
                OnWorkBegin := Form1.IdFTP1WorkBegin;
                OnWork := FTPWork;
                OnWorkEnd := FTPWorkEnd;
                Connect;
                try
                    Put('myFile.txt','',true);
                finally
                    Disconnect;
                end;
            finally
                Free;
            end;
        except
            on E: Exception do
                SendMessage(Application.MainForm.Handle, WM_FTP_STATUS, 0,
Longint(PChar(E.Message)));
        end;
    end;

    procedure TFTPThread.FTPStatus(ASender: TObject; const AStatus:
TIdStatus; const AStatusText: String);
    begin
        SendMessage(Application.MainForm.Handle, WM_FTP_STATUS, 0,
Longint(PChar(AStatusText)));
    end;

    procedure TFTPThread.FTPWorkBegin(ASender: TObject; AWorkMode:
TWorkMode; AWorkCountMax: Integer);
    begin
        SendMessage(Application.MainForm.Handle, WM_FTP_WORK_BEGIN,
AWorkMode, AWorkCountMax);
    end;

    procedure TFTPThread.FTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
    begin
        SendMessage(Application.MainForm.Handle, WM_FTP_WORK, AWorkMode,
AWorkCount);
    end;

    procedure TFTPThread.FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    begin
        SendMessage(Application.MainForm.Handle, WM_FTP_WORK_END, AWorkMode,
0);
    end;

    procedure TForm1.Button1Click(Sender: TObject);
    begin
        TFTPThread.Create;
    end;

    procedure TForm1.WMFTPStatus(var Message: TMessage);
    begin
        Memo1.Lines.Add(PChar(Message.LParam));
    end;

    procedure TForm1.WMFTPWorkBegin(var Message: TMessage);
    begin
        if Message.WParam = wmWrite then
        begin
            ProgressBar1.Max := Message.LParam;
            ProgressBar1.Position := 0;
            Memo1.Lines.Add('Begin: ' + IntToStr(Message.LParam));
        end;
    end;

    procedure TForm1.WMFTPWork(var Message: TMessage);
    begin
        if Message.WParam = wmWrite then
        begin
            if ProgressBar1.Max > 0 then ProgressBar1.Position :=
Message.LParam;
            Memo1.Lines.Add('Work: ' + IntToStr(Message.LParam));
        end;
    end;

    procedure TForm1.WMFTPWorkEnd(var Message: TMessage);
    begin
        if Message.WParam = wmWrite then
            Memo1.Lines.Add('Work end');
    end;

Gambit

Replies

In response to

Problems creating a progress bar for TidFTP posted by Burnett on Thu, 28 Apr 2005