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 :
(http://doddyhackman.webcindario.com/images/ftp_manager_10.jpg)
El codigo :
// 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 (https://sourceforge.net/projects/ftp-manager/).