[+] Listar archivos del servidor FTP
[+] Permite moverse por los directorios
[+] Se pueden subir y bajar archivos
[+] Se pueden crear y borrar carpetas
[+] Se pueden renombrar y borrar archivos
Tambien tienen una tabla que les permite navegar por los directorios de sus computadoras para que les sea mas comodo bajar y subir archivos.
Una imagen :
El codigo
// Project File X 0.2
// Coded By Doddy H
// Credits :
// Files Manager based on : http://www.swissdelphicenter.ch/torry/showcode.php?id=421
// Upload file based on : http://delphiallimite.blogspot.com.ar/2007/06/subiendo-archivos-por-ftp-con-indy.html
// Download file based : http://delphiallimite.blogspot.com.ar/2007/06/descargango-archivos-por-ftp-con-indy.html
unit ftp;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, sSkinManager, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdExplicitTLSClientServerBase, IdFTP, ComCtrls, sListView,
StdCtrls, sButton, sEdit, sLabel, sGroupBox, acProgressBar, sStatusBar,
IdFTPList,
ShellAPI, sListBox, jpeg, ExtCtrls, Menus;
type
TForm1 = class(TForm)
IdFTP1: TIdFTP;
sSkinManager1: TsSkinManager;
ImageList1: TImageList;
sGroupBox1: TsGroupBox;
sLabel1: TsLabel;
sEdit1: TsEdit;
sButton1: TsButton;
sListView1: TsListView;
sGroupBox2: TsGroupBox;
sLabel2: TsLabel;
sEdit2: TsEdit;
sLabel3: TsLabel;
sEdit3: TsEdit;
sLabel4: TsLabel;
sEdit4: TsEdit;
sButton2: TsButton;
sStatusBar1: TsStatusBar;
sProgressBar1: TsProgressBar;
sGroupBox3: TsGroupBox;
sLabel5: TsLabel;
sEdit5: TsEdit;
sButton3: TsButton;
sListView2: TsListView;
ListBox1: TListBox;
ListBox2: TListBox;
ImageList2: TImageList;
sButton5: TsButton;
Image1: TImage;
sButton4: TsButton;
PopupMenu1: TPopupMenu;
D1: TMenuItem;
R1: TMenuItem;
R2: TMenuItem;
M1: TMenuItem;
D2: TMenuItem;
PopupMenu2: TPopupMenu;
C1: TMenuItem;
D3: TMenuItem;
D4: TMenuItem;
R3: TMenuItem;
R4: TMenuItem;
PopupMenu3: TPopupMenu;
A1: TMenuItem;
E1: TMenuItem;
procedure sButton3Click(Sender: TObject);
procedure sListView1DblClick(Sender: TObject);
procedure sButton1Click(Sender: TObject);
procedure sButton2Click(Sender: TObject);
procedure IdFTP1Connected(Sender: TObject);
procedure sListView2DblClick(Sender: TObject);
procedure sButton5Click(Sender: TObject);
procedure IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
procedure IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
procedure IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
procedure FormCreate(Sender: TObject);
procedure sButton4Click(Sender: TObject);
procedure R1Click(Sender: TObject);
procedure R2Click(Sender: TObject);
procedure D2Click(Sender: TObject);
procedure D1Click(Sender: TObject);
procedure M1Click(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure D3Click(Sender: TObject);
procedure D4Click(Sender: TObject);
procedure R3Click(Sender: TObject);
procedure R4Click(Sender: TObject);
procedure D5Click(Sender: TObject);
procedure A1Click(Sender: TObject);
procedure E1Click(Sender: TObject);
procedure IdFTP1Disconnected(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure listarftp(dirnownow2: string; sListView2: TsListView; IdFTP1: TIdFTP;
sListbox1: TListBox; sListbox2: TListBox; ImageList1: TImageList);
var
i: integer;
Item: TIdFTPListItem;
listate2: TListItem;
begin
sListView2.Items.Clear;
sListbox1.Clear;
sListbox2.Clear;
listate2 := sListView2.Items.Add;
IdFTP1.ChangeDir(dirnownow2);
IdFTP1.List('*.*', True);
for i := 0 to IdFTP1.DirectoryListing.Count - 1 do
begin
Item := IdFTP1.DirectoryListing.Items[i];
if Item.ItemType = ditFile then
begin
sListbox1.Items.Add(IdFTP1.DirectoryListing.Items[i].FileName);
end
else
begin
sListbox2.Items.Add(IdFTP1.DirectoryListing.Items[i].FileName);
end;
end;
sListView2.Items.Clear;
for i := 0 to sListbox2.Count - 1 do
begin
with sListView2 do
begin
listate2 := sListView2.Items.Add;
listate2.Caption := sListbox2.Items[i];
listate2.SubItems.Add('Directory');
listate2.ImageIndex := 0;
end;
end;
for i := 0 to sListbox1.Count - 1 do
begin
with sListView2 do
begin
listate2 := sListView2.Items.Add;
listate2.Caption := sListbox1.Items[i];
listate2.SubItems.Add('File');
listate2.ImageIndex := 1;
end;
end;
end;
procedure listar(dirnownow: string; sListView1: TsListView;
ImageList1: TImageList);
var
buscar: TSearchRec;
Icon: TIcon;
listate: TListItem;
getdata: SHFILEINFO;
dirnow: string;
begin
dirnow := StringReplace(dirnownow, '/', '\', [rfReplaceAll, rfIgnoreCase]);
sListView1.Items.Clear;
Icon := TIcon.Create;
sListView1.Items.BeginUpdate;
if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then
begin
repeat
if (buscar.Attr = faDirectory) then
begin
with sListView1 do
begin
if not(buscar.Name = '.') and not(buscar.Name = '..') then
begin
listate := sListView1.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 := ImageList1.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 sListView1 do
begin
listate := sListView1.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 := ImageList1.AddIcon(Icon);
DestroyIcon(getdata.hIcon);
end;
end
until FindNext(buscar) <> 0;
FindClose(buscar);
end;
sListView1.Items.EndUpdate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
sProgressBar1.Max := 0;
sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName)
+ 'Data';
sSkinManager1.SkinName := 'matrix';
sSkinManager1.Active := True;
end;
procedure TForm1.A1Click(Sender: TObject);
begin
ShowMessage('Contact to lepuke[at]hotmail[com]');
end;
procedure TForm1.C1Click(Sender: TObject);
var
newdir: string;
begin
newdir := InputBox('Write the name', 'Directory : ', 'test');
try
begin
IdFTP1.ChangeDir(sEdit5.Text);
IdFTP1.MakeDir(newdir);
ShowMessage('Directory created');
end
except
begin
ShowMessage('Error');
end;
end;
end;
procedure TForm1.D1Click(Sender: TObject);
begin
try
begin
RmDir(sEdit1.Text + sListView1.Selected.Caption);
ShowMessage('Directory Deleted');
end;
except
begin
ShowMessage('Error');
end;
end;
end;
procedure TForm1.D2Click(Sender: TObject);
begin
if DeleteFile(sEdit1.Text + sListView1.Selected.Caption) then
begin
ShowMessage('File Deleted');
end
else
begin
ShowMessage('Error');
end;
end;
procedure TForm1.IdFTP1Connected(Sender: TObject);
begin
sStatusBar1.Panels[0].Text := '[+] OnLine';
Form1.sStatusBar1.Update;
end;
procedure TForm1.IdFTP1Disconnected(Sender: TObject);
begin
sStatusBar1.Panels[0].Text := '[+] OffLine';
Form1.sStatusBar1.Update;
end;
procedure TForm1.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin
sStatusBar1.Panels[0].Text := '[+] Working ...';
Form1.sStatusBar1.Update;
sProgressBar1.Position := AWorkCount div 1024;
end;
procedure TForm1.IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
sStatusBar1.Panels[0].Text := '[+] Working ..';
Form1.sStatusBar1.Update;
end;
procedure TForm1.IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
sStatusBar1.Panels[0].Text := '[+] Finished';
Form1.sStatusBar1.Update;
sProgressBar1.Max := 0;
end;
procedure TForm1.M1Click(Sender: TObject);
var
nombrecarpeta: string;
begin
chdir(sEdit1.Text);
nombrecarpeta := InputBox('Write the name', 'Directory : ', 'test');
try
begin
MkDir(nombrecarpeta);
ShowMessage('Folder Created');
end;
except
begin
ShowMessage('Error');
end;
end;
end;
procedure TForm1.R1Click(Sender: TObject);
var
nuevonombre: string;
begin
nuevonombre := InputBox('Write the name', 'New name : ', 'testar');
chdir(sEdit1.Text);
if RenameFile(sListView1.Selected.Caption, nuevonombre) then
begin
ShowMessage('Ok');
end
else
begin
ShowMessage('Error');
end;
end;
procedure TForm1.R2Click(Sender: TObject);
begin
listar(sEdit1.Text, sListView1, ImageList1);
end;
procedure TForm1.R3Click(Sender: TObject);
var
newname: string;
begin
newname := InputBox('Write the name', 'New name : ', 'testar');
try
begin
IdFTP1.ChangeDir(sEdit5.Text);
IdFTP1.Rename(sListView2.Selected.Caption, newname);
ShowMessage('File rename');
end;
except
begin
ShowMessage('Error');
end;
end;
end;
procedure TForm1.R4Click(Sender: TObject);
begin
listarftp(sEdit5.Text, sListView2, IdFTP1, ListBox1, ListBox2, ImageList2);
end;
procedure TForm1.sButton1Click(Sender: TObject);
begin
listar(sEdit1.Text, sListView1, ImageList1);
end;
procedure TForm1.sButton2Click(Sender: TObject);
begin
sListView1.Items.Clear;
sListView2.Items.Clear;
ListBox1.Clear;
ListBox2.Clear;
if (sButton2.Caption = 'Disconnect') then
begin
IdFTP1.Disconnect;
sButton2.Caption := 'Connect';
end
else
begin
IdFTP1.Host := sEdit2.Text;
IdFTP1.Username := sEdit3.Text;
IdFTP1.Password := sEdit4.Text;
try
IdFTP1.Connect;
sButton2.Caption := 'Disconnect';
except
sStatusBar1.Panels[0].Text := '[-] Error';
Form1.sStatusBar1.Update;
end;
end;
end;
procedure TForm1.sButton3Click(Sender: TObject);
begin
listarftp(sEdit5.Text, sListView2, IdFTP1, ListBox1, ListBox2, ImageList2);
end;
procedure TForm1.sButton4Click(Sender: TObject);
var
fileabajar: string;
begin
fileabajar := sListView2.Selected.Caption; ;
IdFTP1.OnWork := IdFTP1Work;
IdFTP1.ChangeDir(sEdit5.Text);
sProgressBar1.Max := IdFTP1.Size(ExtractFileName(fileabajar)) div 1024;
IdFTP1.Get(fileabajar, sEdit1.Text + '/' + fileabajar, False, False);
end;
procedure TForm1.sButton5Click(Sender: TObject);
var
fileasubir: string;
dirasubir: string;
cantidad: File of byte;
begin
fileasubir := sEdit1.Text + sListView1.Selected.Caption;
dirasubir := sEdit5.Text;
IdFTP1.OnWork := IdFTP1Work;
AssignFile(cantidad, fileasubir);
Reset(cantidad);
sProgressBar1.Max := FileSize(cantidad) div 1024;
CloseFile(cantidad);
IdFTP1.ChangeDir(dirasubir);
IdFTP1.Put(fileasubir, sListView1.Selected.Caption, False);
end;
procedure TForm1.sListView1DblClick(Sender: TObject);
var
dir: string;
begin
dir := sEdit1.Text + sListView1.Selected.Caption + '/';
if (DirectoryExists(dir)) then
begin
sEdit1.Text := sEdit1.Text + sListView1.Selected.Caption + '/';
listar(dir, sListView1, ImageList1);
end;
end;
procedure TForm1.sListView2DblClick(Sender: TObject);
var
dir: string;
begin
dir := sEdit5.Text + sListView2.Selected.Caption + '/';
sEdit5.Text := sEdit5.Text + sListView2.Selected.Caption + '/';
listarftp(dir, sListView2, IdFTP1, ListBox1, ListBox2, ImageList2);
end;
procedure TForm1.D3Click(Sender: TObject);
begin
try
begin
IdFTP1.ChangeDir(sEdit5.Text);
IdFTP1.Delete(sListView2.Selected.Caption);
ShowMessage('File Deleted');
end;
except
begin
ShowMessage('Error');
end;
end;
end;
procedure TForm1.D4Click(Sender: TObject);
begin
try
begin
IdFTP1.ChangeDir(sEdit5.Text);
IdFTP1.RemoveDir(sListView2.Selected.Caption);
ShowMessage('Directory Deleted');
end
except
ShowMessage('Error');
end;
end;
procedure TForm1.D5Click(Sender: TObject);
begin
IdFTP1.Disconnect;
end;
procedure TForm1.E1Click(Sender: TObject);
begin
Form1.Close();
end;
end.
// The End ?
