How to write a simple FTP program with Delphi 2007

This is a simple program with Deplhi 2007,

you can download the exe file from (Download FTPUpload.exe)

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdExplicitTLSClientServerBase, IdFTP, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    IdFTP1: TIdFTP;
    btnAdd: TBitBtn;
    Label1: TLabel;
    ListBox1: TListBox;
    Label2: TLabel;
    txtUsername: TEdit;
    txtPassword: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    btnStart: TButton;
    lblStatus: TLabel;
    txtServer: TEdit;
    Label5: TLabel;
    txtLogs: TMemo;
    OpenDialog1: TOpenDialog;
    ProgressBar1: TProgressBar;
    btnDelete: TBitBtn;
    Label6: TLabel;
    procedure btnStartClick(Sender: TObject);
    procedure IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: string);
    procedure IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Integer);
    procedure btnAddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnAddClick(Sender: TObject);
var
  i: Integer;
begin
  if (OpenDialog1.Execute) then
  begin
    for i := 0 to ListBox1.Count - 1 do
      if(ListBox1.Items.Strings[i] = OpenDialog1.FileName) then ListBox1.Items.Delete(i);
    ListBox1.Items.Append(OpenDialog1.FileName);
  end;
  btnStart.Enabled := ListBox1.Count > 0;
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
begin
  ListBox1.Items.Delete(ListBox1.ItemIndex);
end;

procedure TForm1.btnStartClick(Sender: TObject);
var
  F : TFileStream;
  i : Integer;
  S : String;
begin
  IdFTP1.Host := txtServer.Text;
  IdFTP1.Username := txtUsername.Text;
  IdFTP1.Password := txtPassword.Text;
  btnStart.Enabled := False;
  try
    IdFTP1.Connect;
    IdFTP1.Login;
    for i:= 0 to ListBox1.Items.Count-1 do
    begin
      S := ListBox1.Items.Strings[i];
      if(FileExists(S)) then
      begin
        try
          lblStatus.Caption := 'Uploading '+ ExtractFileName(S);
          F := TFileStream.Create(S,fmOpenRead);
          ProgressBar1.Max := F.Size;
          ListBox1.Items.Strings[i] := '(Uploading) '+ S;
          IdFTP1.Put(F,ExtractFileName(S));
          ListBox1.Items.Strings[i] := '(Uploaded) '+ S;
        finally
          lblStatus.Caption := 'Upload completed';
          F.Free;
        end;
      end
      else
      begin
        ListBox1.Items.Strings[i] := '(Not found) '+ S;
      end;
    end;
  except on E:Exception do
    MessageDlg(e.Message,mtError,[mbOK],0);
  end;
  btnStart.Enabled := True;
end;

procedure TForm1.IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  txtLogs.Lines.Append(DateTimeToStr(Now)+' : ' + AStatusText);
end;

procedure TForm1.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Integer);
begin
  ProgressBar1.Position := AWorkCount;
  txtLogs.Lines.Append(DateTimeToStr(Now)+' : '+IntToStr(AWorkCount));
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  btnDelete.Enabled := (ListBox1.ItemIndex > -1);
  btnStart.Enabled := ListBox1.Count > 0;
end;

end.
This entry was posted in Thinking. Bookmark the permalink.

Comments are closed.