[Delphi] FTP Manager 1.0

Un cliente FTP en Delphi con las siguientes opciones :
Se puede conectar a cualquier servidor FTP
Navegar y listar los directorios de nuestra computadora
Navegar y listar los directorios del servidor FTP
Se puede crear,renombrar,eliminar archivos y directorios de nuestra computadora
Se puede crear,renombrar,eliminar archivos y directorios del servidor FTP
Se puede bajar y subir archivos del servidor FTP comodamente
Una imagen :
El codigo :
Código
// FTP Manager 1.0
// (C) Doddy Hackman 2016
 
unit ftp;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, Shellapi, Vcl.ImgList, IdFTPList,
  Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.Menus, Vcl.Styles.Utils.ComCtrls,
  Vcl.Styles.Utils.Menus,
  Vcl.Styles.Utils.SysStyleHook,
  Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
  Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips;
 
type
  TFormHome = class(TForm)
    gbFTP_Data: TGroupBox;
    lblHost: TLabel;
    txtHost: TEdit;
    lblUsername: TLabel;
    txtUsername: TEdit;
    lblPassword: TLabel;
    txtPassword: TEdit;
    btnConnect: TButton;
    gbMyFiles: TGroupBox;
    lblDirectory1: TLabel;
    txtMe_Directory: TEdit;
    btnListMe: TButton;
    lvLocalFiles: TListView;
    gbFTP_Files: TGroupBox;
    lblDirectory2: TLabel;
    txt_FTP_Directory: TEdit;
    btnList_FTP: TButton;
    lv_FTP_Files: TListView;
    btnUpload: TButton;
    btnDownload: TButton;
    directorios: TListBox;
    archivos: TListBox;
    status: TStatusBar;
    local_iconos: TImageList;
    ftp_client: TIdFTP;
    ftp_iconos: TImageList;
    progreso: TProgressBar;
    imgLogo: TImage;
    menu_local: TPopupMenu;
    MakeDirectory1: TMenuItem;
    Rename1: TMenuItem;
    Delete1: TMenuItem;
    Refresh1: TMenuItem;
    menu_ftp: TPopupMenu;
    MakeDirectory2: TMenuItem;
    Rename2: TMenuItem;
    Delete2: TMenuItem;
    Refresh2: TMenuItem;
    ilIconos: TImageList;
    procedure btnConnectClick(Sender: TObject);
    procedure btnListMeClick(Sender: TObject);
    procedure btnList_FTPClick(Sender: TObject);
    procedure btnUploadClick(Sender: TObject);
    procedure ftp_clientWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure ftp_clientWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    procedure ftp_clientWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure btnDownloadClick(Sender: TObject);
    procedure lvLocalFilesDblClick(Sender: TObject);
    procedure lv_FTP_FilesDblClick(Sender: TObject);
    procedure MakeDirectory1Click(Sender: TObject);
    procedure Rename1Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure Refresh1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MakeDirectory2Click(Sender: TObject);
    procedure Rename2Click(Sender: TObject);
    procedure Delete2Click(Sender: TObject);
    procedure Refresh2Click(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  FormHome: TFormHome;
 
implementation
 
{$R *.dfm}
 
procedure listar(dirnownow: string; ListaDeArchivos: TListView;
  ListaDeIconos: TImageList);
var
  buscar: TSearchRec;
  Icon: TIcon;
  listate: TListItem;
  getdata: SHFILEINFO;
  dirnow: string;
 
begin
 
  if (DirectoryExists(dirnownow)) then
  begin
    ListaDeIconos.Clear;
 
    dirnow := StringReplace(dirnownow, '/', '\', [rfReplaceAll, rfIgnoreCase]);
 
    ListaDeArchivos.Items.Clear;
    Icon := TIcon.Create;
    ListaDeArchivos.Items.BeginUpdate;
 
    if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then
    begin
      repeat
        if (buscar.Attr = faDirectory) then
        begin
 
          with ListaDeArchivos do
          begin
 
            if not(buscar.Name = '.') and not(buscar.Name = '..') then
            begin
 
              listate := ListaDeArchivos.Items.Add;
 
              SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
                SizeOf(getdata), SHGFI_DISPLAYNAME);
              listate.Caption := getdata.szDisplayName;
 
              SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
                SizeOf(getdata), SHGFI_TYPENAME);
              listate.SubItems.Add(getdata.szTypeName);
 
              SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
                SizeOf(getdata), SHGFI_ICON or SHGFI_SMALLICON);
              Icon.Handle := getdata.hIcon;
              listate.ImageIndex := ListaDeIconos.AddIcon(Icon);
 
              DestroyIcon(getdata.hIcon);
 
            end;
          end;
 
        end;
      until FindNext(buscar) <> 0;
      FindClose(buscar);
    end;
 
    if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then
    begin
      repeat
        if (buscar.Attr <> faDirectory) then
        begin
 
          with ListaDeArchivos do
          begin
 
            listate := ListaDeArchivos.Items.Add;
 
            SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
              SizeOf(getdata), SHGFI_DISPLAYNAME);
            listate.Caption := buscar.Name;
 
            SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
              SizeOf(getdata), SHGFI_TYPENAME);
            listate.SubItems.Add(getdata.szTypeName);
 
            SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata,
              SizeOf(getdata), SHGFI_ICON or SHGFI_SMALLICON);
            Icon.Handle := getdata.hIcon;
            listate.ImageIndex := ListaDeIconos.AddIcon(Icon);
 
            DestroyIcon(getdata.hIcon);
 
          end;
 
        end
 
        until FindNext(buscar) <> 0;
        FindClose(buscar);
      end;
 
      ListaDeArchivos.Items.EndUpdate;
    end;
 
  end;
 
  procedure listarftp(dirnownow2: string; ListaDeArchivosFTP: TListView;
    ftp: TIdFTP; DirectoriosEncontrados: TListBox;
    ArchivosEncontrados: TListBox);
  var
    i: integer;
    Item: TIdFTPListItem;
    listate2: TListItem;
 
  begin
 
    ListaDeArchivosFTP.Items.Clear;
    DirectoriosEncontrados.Clear;
    ArchivosEncontrados.Clear;
 
    listate2 := ListaDeArchivosFTP.Items.Add;
 
    ftp.ChangeDir(dirnownow2);
    ftp.List('*.*', True);
 
    for i := 0 to ftp.DirectoryListing.Count - 1 do
    begin
 
      Item := ftp.DirectoryListing.Items[i];
      if Item.ItemType = ditFile then
      begin
        DirectoriosEncontrados.Items.Add(ftp.DirectoryListing.Items[i]
          .FileName);
      end
      else
      begin
        ArchivosEncontrados.Items.Add(ftp.DirectoryListing.Items[i].FileName);
      end;
 
    end;
 
    ListaDeArchivosFTP.Items.Clear;
 
    for i := 0 to ArchivosEncontrados.Count - 1 do
    begin
 
      with ListaDeArchivosFTP do
 
      begin
 
        listate2 := ListaDeArchivosFTP.Items.Add;
        listate2.Caption := ArchivosEncontrados.Items[i];
        listate2.SubItems.Add('Directory');
        listate2.ImageIndex := 0;
 
      end;
    end;
 
    for i := 0 to DirectoriosEncontrados.Count - 1 do
    begin
 
      with ListaDeArchivosFTP do
 
      begin
 
        listate2 := ListaDeArchivosFTP.Items.Add;
        listate2.Caption := DirectoriosEncontrados.Items[i];
        listate2.SubItems.Add('File');
        listate2.ImageIndex := 1;
 
      end;
    end;
 
  end;
 
  procedure TFormHome.btnConnectClick(Sender: TObject);
  begin
 
    lv_FTP_Files.Items.Clear;
 
    directorios.Clear;
    archivos.Clear;
 
    if (btnConnect.Caption = 'Disconnect') then
    begin
      ftp_client.Disconnect;
      btnConnect.Caption := 'Connect';
      status.Panels[0].Text := '[+] Disconnected';
      FormHome.status.Update;
      txt_FTP_Directory.Text := '';
      MessageBox(0, 'Disconnected', 'FTP Manager 1.0', MB_ICONINFORMATION);
    end
    else
    begin
 
      ftp_client.host := txtHost.Text;
      ftp_client.username := txtUsername.Text;
      ftp_client.password := txtPassword.Text;
 
      try
        ftp_client.connect;
        btnConnect.Caption := 'Disconnect';
        status.Panels[0].Text := '[+] Connected';
        FormHome.status.Update;
 
        txt_FTP_Directory.Text := '/';
        listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client, directorios,
          archivos);
 
        MessageBox(0, 'Connected', 'FTP Manager 1.0', MB_ICONINFORMATION);
      except
        status.Panels[0].Text := '[-] Error connecting to server';
        FormHome.status.Update;
        MessageBox(0, 'Error connecting to server', 'FTP Manager 1.0',
          MB_ICONERROR);
      end;
    end;
 
  end;
 
  procedure TFormHome.Delete1Click(Sender: TObject);
  var
    archivo: string;
  begin
    if Assigned(lvLocalFiles.Selected) then
    begin
      archivo := lvLocalFiles.Selected.Caption;
      if DeleteFile(txtMe_Directory.Text + '/' + archivo) then
      begin
        if not(txtMe_Directory.Text = '') then
        begin
          listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
        end;
        MessageBox(0, 'Deleted', 'FTP Manager 1.0', MB_ICONINFORMATION);
      end
      else
      begin
        MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
      end;
    end;
  end;
 
  procedure TFormHome.Delete2Click(Sender: TObject);
  var
    archivo: string;
  begin
    if Assigned(lv_FTP_Files.Selected) then
    begin
      archivo := lv_FTP_Files.Selected.Caption;
      ftp_client.ChangeDir(txt_FTP_Directory.Text);
      try
        begin
          ftp_client.Delete(archivo);
          if not(txt_FTP_Directory.Text = '') then
          begin
            listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client,
              directorios, archivos);
          end;
          MessageBox(0, 'Deleted', 'FTP Manager 1.0', MB_ICONINFORMATION);
        end;
      except
        MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
      end;
    end;
  end;
 
  procedure TFormHome.btnDownloadClick(Sender: TObject);
  var
    fileabajar: string;
  begin
 
    if Assigned(lv_FTP_Files.Selected) then
    begin
      try
        begin
          fileabajar := lv_FTP_Files.Selected.Caption;;
          ftp_client.OnWork := ftp_clientWork;
          ftp_client.ChangeDir(txt_FTP_Directory.Text);
 
          progreso.Max := ftp_client.Size(ExtractFileName(fileabajar)) div 1024;
 
          ftp_client.Get(fileabajar, txtMe_Directory.Text + '/' + fileabajar,
            False, False);
 
          if not(txtMe_Directory.Text = '') then
          begin
            listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
          end;
 
          MessageBox(0, 'Action completed successfully', 'FTP Manager 1.0',
            MB_ICONINFORMATION);
        end;
      except
        MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
      end;
    end
    else
    begin
      MessageBox(0, 'Select File to download', 'FTP Manager 1.0',
        MB_ICONINFORMATION);
    end;
  end;
 
  procedure TFormHome.FormCreate(Sender: TObject);
  begin
    UseLatestCommonDialogs := False;
    txtMe_Directory.Text := GetCurrentDir + '\';
    listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
  end;
 
  procedure TFormHome.ftp_clientWork(ASender: TObject; AWorkMode: TWorkMode;
    AWorkCount: Int64);
  begin
    status.Panels[0].Text := '[+] Working ...';
    FormHome.status.Update;
 
    progreso.Position := AWorkCount div 1024;
  end;
 
  procedure TFormHome.ftp_clientWorkBegin(ASender: TObject;
    AWorkMode: TWorkMode; AWorkCountMax: Int64);
  begin
    status.Panels[0].Text := '[+] Working ..';
    FormHome.status.Update;
  end;
 
  procedure TFormHome.ftp_clientWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  begin
    status.Panels[0].Text := '[+] Finished';
    FormHome.status.Update;
    progreso.Max := 0;
  end;
 
  procedure TFormHome.lv_FTP_FilesDblClick(Sender: TObject);
  begin
    if Assigned(lv_FTP_Files.Selected) then
    begin
      if (lv_FTP_Files.Selected.SubItems.Strings[0] = 'Directory') then
      begin
        ftp_client.ChangeDir(txt_FTP_Directory.Text +
          lv_FTP_Files.Selected.Caption + '/');
        listarftp(txt_FTP_Directory.Text + lv_FTP_Files.Selected.Caption + '/',
          lv_FTP_Files, ftp_client, directorios, archivos);
        txt_FTP_Directory.Text := ftp_client.RetrieveCurrentDir + '/';
      end;
    end
    else
    begin
      MessageBox(0, 'Write path', 'FTP Manager 1.0', MB_ICONINFORMATION);
    end;
  end;
 
  procedure TFormHome.btnList_FTPClick(Sender: TObject);
  begin
    if not(txt_FTP_Directory.Text = '') then
    begin
      listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client, directorios,
        archivos);
    end
    else
    begin
      MessageBox(0, 'Write path', 'FTP Manager 1.0', MB_ICONINFORMATION);
    end;
  end;
 
  procedure TFormHome.btnListMeClick(Sender: TObject);
  begin
    if not(txtMe_Directory.Text = '') then
    begin
      listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
    end
    else
    begin
      MessageBox(0, 'Write path', 'FTP Manager 1.0', MB_ICONINFORMATION);
    end;
  end;
 
  procedure TFormHome.lvLocalFilesDblClick(Sender: TObject);
  begin
    if Assigned(lvLocalFiles.Selected) then
    begin
      if (DirectoryExists(txtMe_Directory.Text + lvLocalFiles.Selected.Caption +
        '/')) then
      begin
        Chdir(txtMe_Directory.Text + lvLocalFiles.Selected.Caption + '/');
        listar(txtMe_Directory.Text + lvLocalFiles.Selected.Caption + '/',
          lvLocalFiles, local_iconos);
        txtMe_Directory.Text := GetCurrentDir + '\';
      end;
    end
    else
    begin
      MessageBox(0, 'Select Path', 'FTP Manager 1.0', MB_ICONINFORMATION);
    end;
  end;
 
  procedure TFormHome.MakeDirectory1Click(Sender: TObject);
  var
    directorio: string;
  begin
    directorio := InputBox('FTP Manager 1.0', 'Directory : ', '');
    try
      begin
        MkDir(txtMe_Directory.Text + '/' + directorio);
        if not(txtMe_Directory.Text = '') then
        begin
          listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
        end;
        MessageBox(0, 'Directory created', 'FTP Manager 1.0',
          MB_ICONINFORMATION);
      end;
    except
      MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
    end;
  end;
 
  procedure TFormHome.MakeDirectory2Click(Sender: TObject);
  var
    directorio: string;
  begin
    directorio := InputBox('FTP Manager 1.0', 'Directory : ', '');
    try
      begin
        ftp_client.ChangeDir(txt_FTP_Directory.Text);
        ftp_client.MakeDir(directorio);
        if not(txt_FTP_Directory.Text = '') then
        begin
          listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client,
            directorios, archivos);
        end;
        MessageBox(0, 'Directory created', 'FTP Manager 1.0',
          MB_ICONINFORMATION);
      end;
    except
      MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
    end;
  end;
 
  procedure TFormHome.Refresh1Click(Sender: TObject);
  begin
    if not(txtMe_Directory.Text = '') then
    begin
      listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
    end
    else
    begin
      MessageBox(0, 'Write path', 'FTP Manager 1.0', MB_ICONINFORMATION);
    end;
  end;
 
  procedure TFormHome.Refresh2Click(Sender: TObject);
  begin
    if not(txt_FTP_Directory.Text = '') then
    begin
      listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client, directorios,
        archivos);
    end;
  end;
 
  procedure TFormHome.Rename1Click(Sender: TObject);
  var
    original, new_name: string;
  begin
    if Assigned(lvLocalFiles.Selected) then
    begin
      original := lvLocalFiles.Selected.Caption;
      new_name := InputBox('FTP Manager 1.0', 'New name : ', '');
      if RenameFile(txtMe_Directory.Text + '/' + original,
        txtMe_Directory.Text + '/' + new_name) then
      begin
        if not(txtMe_Directory.Text = '') then
        begin
          listar(txtMe_Directory.Text, lvLocalFiles, local_iconos);
        end;
        MessageBox(0, 'Changed', 'FTP Manager 1.0', MB_ICONINFORMATION);
      end
      else
      begin
        MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
      end;
    end;
  end;
 
  procedure TFormHome.Rename2Click(Sender: TObject);
  var
    original, new_name: string;
  begin
    if Assigned(lv_FTP_Files.Selected) then
    begin
      original := lv_FTP_Files.Selected.Caption;
      new_name := InputBox('FTP Manager 1.0', 'New name : ', '');
      try
        begin
          ftp_client.ChangeDir(txt_FTP_Directory.Text);
          ftp_client.Rename(original, new_name);
          if not(txt_FTP_Directory.Text = '') then
          begin
            listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client,
              directorios, archivos);
          end;
          MessageBox(0, 'Changed', 'FTP Manager 1.0', MB_ICONINFORMATION);
        end;
      except
        MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
      end;
    end;
 
  end;
 
  procedure TFormHome.btnUploadClick(Sender: TObject);
  var
    fileasubir: string;
    dirasubir: string;
    cantidad: File of byte;
  begin
 
    if Assigned(lvLocalFiles.Selected) then
    begin
      try
        begin
          fileasubir := txtMe_Directory.Text + lvLocalFiles.Selected.Caption;
          dirasubir := txt_FTP_Directory.Text;
 
          ftp_client.OnWork := ftp_clientWork;
 
          AssignFile(cantidad, fileasubir);
          Reset(cantidad);
          progreso.Max := FileSize(cantidad) div 1024;
          CloseFile(cantidad);
 
          ftp_client.ChangeDir(dirasubir);
          ftp_client.Put(fileasubir, lvLocalFiles.Selected.Caption, False);
 
          if not(txt_FTP_Directory.Text = '') then
          begin
            listarftp(txt_FTP_Directory.Text, lv_FTP_Files, ftp_client,
              directorios, archivos);
          end;
 
          MessageBox(0, 'Action completed successfully', 'FTP Manager 1.0',
            MB_ICONINFORMATION);
        end;
      except
        MessageBox(0, 'Error', 'FTP Manager 1.0', MB_ICONERROR);
      end;
    end
    else
    begin
      MessageBox(0, 'Select File to upload', 'FTP Manager 1.0',
        MB_ICONINFORMATION);
    end;
  end;
 
end.
 
// The End ?
Si quieren bajar el programa lo pueden hacer de aca.