[Delphi] Project File X 0.2

Un simple cliente FTP que eh estado haciendo en Delphi con las siguientes opciones :
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
Código
// 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 ?
Si lo quieren bajar lo pueden hacer de aca