- 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.