comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[Delphi] Project File X 0.2

  • 1 Respuestas
  • 1942 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Junio 29, 2013, 01:56:10 pm »
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: Delphi
  1. // Project File X 0.2
  2. // Coded By Doddy H
  3. // Credits :
  4. // Files Manager based on : http://www.swissdelphicenter.ch/torry/showcode.php?id=421
  5. // Upload file based on : http://delphiallimite.blogspot.com.ar/2007/06/subiendo-archivos-por-ftp-con-indy.html
  6. // Download file based : http://delphiallimite.blogspot.com.ar/2007/06/descargango-archivos-por-ftp-con-indy.html
  7.  
  8. unit ftp;
  9.  
  10. interface
  11.  
  12. uses
  13.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  14.   Dialogs, ImgList, sSkinManager, IdBaseComponent, IdComponent, IdTCPConnection,
  15.   IdTCPClient, IdExplicitTLSClientServerBase, IdFTP, ComCtrls, sListView,
  16.   StdCtrls, sButton, sEdit, sLabel, sGroupBox, acProgressBar, sStatusBar,
  17.   IdFTPList,
  18.   ShellAPI, sListBox, jpeg, ExtCtrls, Menus;
  19.  
  20. type
  21.   TForm1 = class(TForm)
  22.     IdFTP1: TIdFTP;
  23.     sSkinManager1: TsSkinManager;
  24.     ImageList1: TImageList;
  25.     sGroupBox1: TsGroupBox;
  26.     sLabel1: TsLabel;
  27.     sEdit1: TsEdit;
  28.     sButton1: TsButton;
  29.     sListView1: TsListView;
  30.     sGroupBox2: TsGroupBox;
  31.     sLabel2: TsLabel;
  32.     sEdit2: TsEdit;
  33.     sLabel3: TsLabel;
  34.     sEdit3: TsEdit;
  35.     sLabel4: TsLabel;
  36.     sEdit4: TsEdit;
  37.     sButton2: TsButton;
  38.     sStatusBar1: TsStatusBar;
  39.     sProgressBar1: TsProgressBar;
  40.     sGroupBox3: TsGroupBox;
  41.     sLabel5: TsLabel;
  42.     sEdit5: TsEdit;
  43.     sButton3: TsButton;
  44.     sListView2: TsListView;
  45.     ListBox1: TListBox;
  46.     ListBox2: TListBox;
  47.     ImageList2: TImageList;
  48.     sButton5: TsButton;
  49.     Image1: TImage;
  50.     sButton4: TsButton;
  51.  
  52.     PopupMenu1: TPopupMenu;
  53.     D1: TMenuItem;
  54.     R1: TMenuItem;
  55.     R2: TMenuItem;
  56.     M1: TMenuItem;
  57.     D2: TMenuItem;
  58.  
  59.     PopupMenu2: TPopupMenu;
  60.     C1: TMenuItem;
  61.     D3: TMenuItem;
  62.     D4: TMenuItem;
  63.     R3: TMenuItem;
  64.     R4: TMenuItem;
  65.     PopupMenu3: TPopupMenu;
  66.     A1: TMenuItem;
  67.     E1: TMenuItem;
  68.     procedure sButton3Click(Sender: TObject);
  69.     procedure sListView1DblClick(Sender: TObject);
  70.     procedure sButton1Click(Sender: TObject);
  71.     procedure sButton2Click(Sender: TObject);
  72.     procedure IdFTP1Connected(Sender: TObject);
  73.     procedure sListView2DblClick(Sender: TObject);
  74.     procedure sButton5Click(Sender: TObject);
  75.     procedure IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  76.       AWorkCount: Int64);
  77.     procedure IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  78.       AWorkCountMax: Int64);
  79.     procedure IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  80.     procedure FormCreate(Sender: TObject);
  81.     procedure sButton4Click(Sender: TObject);
  82.     procedure R1Click(Sender: TObject);
  83.     procedure R2Click(Sender: TObject);
  84.  
  85.     procedure D2Click(Sender: TObject);
  86.     procedure D1Click(Sender: TObject);
  87.     procedure M1Click(Sender: TObject);
  88.     procedure C1Click(Sender: TObject);
  89.     procedure D3Click(Sender: TObject);
  90.     procedure D4Click(Sender: TObject);
  91.     procedure R3Click(Sender: TObject);
  92.     procedure R4Click(Sender: TObject);
  93.     procedure D5Click(Sender: TObject);
  94.     procedure A1Click(Sender: TObject);
  95.     procedure E1Click(Sender: TObject);
  96.     procedure IdFTP1Disconnected(Sender: TObject);
  97.  
  98.   private
  99.  
  100.     { Private declarations }
  101.   public
  102.     { Public declarations }
  103.   end;
  104.  
  105. var
  106.   Form1: TForm1;
  107.  
  108. implementation
  109.  
  110. {$R *.dfm}
  111.  
  112. procedure listarftp(dirnownow2: string; sListView2: TsListView; IdFTP1: TIdFTP;
  113.   sListbox1: TListBox; sListbox2: TListBox; ImageList1: TImageList);
  114. var
  115.   i: integer;
  116.   Item: TIdFTPListItem;
  117.   listate2: TListItem;
  118.  
  119. begin
  120.  
  121.   sListView2.Items.Clear;
  122.   sListbox1.Clear;
  123.   sListbox2.Clear;
  124.  
  125.   listate2 := sListView2.Items.Add;
  126.  
  127.   IdFTP1.ChangeDir(dirnownow2);
  128.   IdFTP1.List('*.*', True);
  129.  
  130.   for i := 0 to IdFTP1.DirectoryListing.Count - 1 do
  131.   begin
  132.  
  133.     Item := IdFTP1.DirectoryListing.Items[i];
  134.     if Item.ItemType = ditFile then
  135.     begin
  136.       sListbox1.Items.Add(IdFTP1.DirectoryListing.Items[i].FileName);
  137.     end
  138.     else
  139.     begin
  140.       sListbox2.Items.Add(IdFTP1.DirectoryListing.Items[i].FileName);
  141.     end;
  142.  
  143.   end;
  144.  
  145.   sListView2.Items.Clear;
  146.  
  147.   for i := 0 to sListbox2.Count - 1 do
  148.   begin
  149.  
  150.     with sListView2 do
  151.  
  152.     begin
  153.  
  154.       listate2 := sListView2.Items.Add;
  155.       listate2.Caption := sListbox2.Items[i];
  156.       listate2.SubItems.Add('Directory');
  157.       listate2.ImageIndex := 0;
  158.  
  159.     end;
  160.   end;
  161.  
  162.   for i := 0 to sListbox1.Count - 1 do
  163.   begin
  164.  
  165.     with sListView2 do
  166.  
  167.     begin
  168.  
  169.       listate2 := sListView2.Items.Add;
  170.       listate2.Caption := sListbox1.Items[i];
  171.       listate2.SubItems.Add('File');
  172.       listate2.ImageIndex := 1;
  173.  
  174.     end;
  175.   end;
  176.  
  177. end;
  178.  
  179. procedure listar(dirnownow: string; sListView1: TsListView;
  180.   ImageList1: TImageList);
  181. var
  182.   buscar: TSearchRec;
  183.   Icon: TIcon;
  184.   listate: TListItem;
  185.   getdata: SHFILEINFO;
  186.   dirnow: string;
  187.  
  188. begin
  189.  
  190.   dirnow := StringReplace(dirnownow, '/', '\', [rfReplaceAll, rfIgnoreCase]);
  191.  
  192.   sListView1.Items.Clear;
  193.   Icon := TIcon.Create;
  194.   sListView1.Items.BeginUpdate;
  195.  
  196.   if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then
  197.   begin
  198.     repeat
  199.       if (buscar.Attr = faDirectory) then
  200.       begin
  201.  
  202.         with sListView1 do
  203.         begin
  204.  
  205.           if not(buscar.Name = '.') and not(buscar.Name = '..') then
  206.           begin
  207.  
  208.             listate := sListView1.Items.Add;
  209.  
  210.             SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf
  211.                 (getdata), SHGFI_DISPLAYNAME);
  212.             listate.Caption := getdata.szDisplayName;
  213.  
  214.             SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf
  215.                 (getdata), SHGFI_TYPENAME);
  216.             listate.SubItems.Add(getdata.szTypeName);
  217.  
  218.             SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf
  219.                 (getdata), SHGFI_ICON or SHGFI_SMALLICON);
  220.             Icon.Handle := getdata.hIcon;
  221.             listate.ImageIndex := ImageList1.AddIcon(Icon);
  222.  
  223.             DestroyIcon(getdata.hIcon);
  224.  
  225.           end;
  226.         end;
  227.  
  228.       end;
  229.     until FindNext(buscar) <> 0;
  230.     FindClose(buscar);
  231.   end;
  232.  
  233.   if FindFirst(dirnow + '*.*', faAnyFile, buscar) = 0 then
  234.   begin
  235.     repeat
  236.       if (buscar.Attr <> faDirectory) then
  237.       begin
  238.  
  239.         with sListView1 do
  240.         begin
  241.  
  242.           listate := sListView1.Items.Add;
  243.  
  244.           SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata)
  245.               , SHGFI_DISPLAYNAME);
  246.           listate.Caption := buscar.Name;
  247.  
  248.           SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata)
  249.               , SHGFI_TYPENAME);
  250.           listate.SubItems.Add(getdata.szTypeName);
  251.  
  252.           SHGetFileInfo(PChar(dirnow + buscar.Name), 0, getdata, SizeOf(getdata)
  253.               , SHGFI_ICON or SHGFI_SMALLICON);
  254.           Icon.Handle := getdata.hIcon;
  255.           listate.ImageIndex := ImageList1.AddIcon(Icon);
  256.  
  257.           DestroyIcon(getdata.hIcon);
  258.  
  259.         end;
  260.  
  261.       end
  262.  
  263.       until FindNext(buscar) <> 0;
  264.       FindClose(buscar);
  265.     end;
  266.  
  267.     sListView1.Items.EndUpdate;
  268.  
  269.   end;
  270.  
  271.   procedure TForm1.FormCreate(Sender: TObject);
  272.   begin
  273.     sProgressBar1.Max := 0;
  274.  
  275.     sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName)
  276.       + 'Data';
  277.     sSkinManager1.SkinName := 'matrix';
  278.     sSkinManager1.Active := True;
  279.  
  280.   end;
  281.  
  282.   procedure TForm1.A1Click(Sender: TObject);
  283.   begin
  284.     ShowMessage('Contact to lepuke[at]hotmail[com]');
  285.   end;
  286.  
  287.   procedure TForm1.C1Click(Sender: TObject);
  288.   var
  289.     newdir: string;
  290.   begin
  291.  
  292.     newdir := InputBox('Write the name', 'Directory : ', 'test');
  293.  
  294.     try
  295.       begin
  296.         IdFTP1.ChangeDir(sEdit5.Text);
  297.         IdFTP1.MakeDir(newdir);
  298.         ShowMessage('Directory created');
  299.       end
  300.     except
  301.       begin
  302.         ShowMessage('Error');
  303.       end;
  304.     end;
  305.  
  306.   end;
  307.  
  308.   procedure TForm1.D1Click(Sender: TObject);
  309.   begin
  310.  
  311.     try
  312.       begin
  313.         RmDir(sEdit1.Text + sListView1.Selected.Caption);
  314.         ShowMessage('Directory Deleted');
  315.       end;
  316.     except
  317.       begin
  318.         ShowMessage('Error');
  319.       end;
  320.  
  321.     end;
  322.  
  323.   end;
  324.  
  325.   procedure TForm1.D2Click(Sender: TObject);
  326.   begin
  327.  
  328.     if DeleteFile(sEdit1.Text + sListView1.Selected.Caption) then
  329.     begin
  330.       ShowMessage('File Deleted');
  331.     end
  332.     else
  333.     begin
  334.       ShowMessage('Error');
  335.     end;
  336.  
  337.   end;
  338.  
  339.   procedure TForm1.IdFTP1Connected(Sender: TObject);
  340.   begin
  341.     sStatusBar1.Panels[0].Text := '[+] OnLine';
  342.     Form1.sStatusBar1.Update;
  343.   end;
  344.  
  345.   procedure TForm1.IdFTP1Disconnected(Sender: TObject);
  346.   begin
  347.     sStatusBar1.Panels[0].Text := '[+] OffLine';
  348.     Form1.sStatusBar1.Update;
  349.   end;
  350.  
  351.   procedure TForm1.IdFTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  352.     AWorkCount: Int64);
  353.   begin
  354.  
  355.     sStatusBar1.Panels[0].Text := '[+] Working ...';
  356.     Form1.sStatusBar1.Update;
  357.  
  358.     sProgressBar1.Position := AWorkCount div 1024;
  359.   end;
  360.  
  361.   procedure TForm1.IdFTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  362.     AWorkCountMax: Int64);
  363.   begin
  364.  
  365.     sStatusBar1.Panels[0].Text := '[+] Working ..';
  366.     Form1.sStatusBar1.Update;
  367.  
  368.   end;
  369.  
  370.   procedure TForm1.IdFTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  371.   begin
  372.     sStatusBar1.Panels[0].Text := '[+] Finished';
  373.     Form1.sStatusBar1.Update;
  374.     sProgressBar1.Max := 0;
  375.   end;
  376.  
  377.   procedure TForm1.M1Click(Sender: TObject);
  378.   var
  379.     nombrecarpeta: string;
  380.   begin
  381.  
  382.     chdir(sEdit1.Text);
  383.     nombrecarpeta := InputBox('Write the name', 'Directory : ', 'test');
  384.     try
  385.       begin
  386.         MkDir(nombrecarpeta);
  387.         ShowMessage('Folder Created');
  388.       end;
  389.     except
  390.       begin
  391.         ShowMessage('Error');
  392.       end;
  393.  
  394.     end;
  395.  
  396.   end;
  397.  
  398.   procedure TForm1.R1Click(Sender: TObject);
  399.   var
  400.     nuevonombre: string;
  401.   begin
  402.     nuevonombre := InputBox('Write the name', 'New name : ', 'testar');
  403.  
  404.     chdir(sEdit1.Text);
  405.     if RenameFile(sListView1.Selected.Caption, nuevonombre) then
  406.     begin
  407.       ShowMessage('Ok');
  408.     end
  409.     else
  410.     begin
  411.       ShowMessage('Error');
  412.     end;
  413.   end;
  414.  
  415.   procedure TForm1.R2Click(Sender: TObject);
  416.   begin
  417.     listar(sEdit1.Text, sListView1, ImageList1);
  418.   end;
  419.  
  420.   procedure TForm1.R3Click(Sender: TObject);
  421.   var
  422.     newname: string;
  423.   begin
  424.  
  425.     newname := InputBox('Write the name', 'New name : ', 'testar');
  426.  
  427.     try
  428.       begin
  429.         IdFTP1.ChangeDir(sEdit5.Text);
  430.         IdFTP1.Rename(sListView2.Selected.Caption, newname);
  431.         ShowMessage('File rename');
  432.       end;
  433.     except
  434.       begin
  435.         ShowMessage('Error');
  436.       end;
  437.     end;
  438.   end;
  439.  
  440.   procedure TForm1.R4Click(Sender: TObject);
  441.   begin
  442.     listarftp(sEdit5.Text, sListView2, IdFTP1, ListBox1, ListBox2, ImageList2);
  443.   end;
  444.  
  445.   procedure TForm1.sButton1Click(Sender: TObject);
  446.   begin
  447.     listar(sEdit1.Text, sListView1, ImageList1);
  448.   end;
  449.  
  450.   procedure TForm1.sButton2Click(Sender: TObject);
  451.   begin
  452.  
  453.     sListView1.Items.Clear;
  454.     sListView2.Items.Clear;
  455.  
  456.     ListBox1.Clear;
  457.     ListBox2.Clear;
  458.  
  459.     if (sButton2.Caption = 'Disconnect') then
  460.     begin
  461.       IdFTP1.Disconnect;
  462.       sButton2.Caption := 'Connect';
  463.     end
  464.     else
  465.     begin
  466.  
  467.       IdFTP1.Host := sEdit2.Text;
  468.       IdFTP1.Username := sEdit3.Text;
  469.       IdFTP1.Password := sEdit4.Text;
  470.  
  471.       try
  472.         IdFTP1.Connect;
  473.         sButton2.Caption := 'Disconnect';
  474.       except
  475.         sStatusBar1.Panels[0].Text := '[-] Error';
  476.         Form1.sStatusBar1.Update;
  477.       end;
  478.     end;
  479.   end;
  480.  
  481.   procedure TForm1.sButton3Click(Sender: TObject);
  482.   begin
  483.     listarftp(sEdit5.Text, sListView2, IdFTP1, ListBox1, ListBox2, ImageList2);
  484.   end;
  485.  
  486.   procedure TForm1.sButton4Click(Sender: TObject);
  487.   var
  488.     fileabajar: string;
  489.   begin
  490.  
  491.     fileabajar := sListView2.Selected.Caption; ;
  492.     IdFTP1.OnWork := IdFTP1Work;
  493.     IdFTP1.ChangeDir(sEdit5.Text);
  494.  
  495.     sProgressBar1.Max := IdFTP1.Size(ExtractFileName(fileabajar)) div 1024;
  496.  
  497.     IdFTP1.Get(fileabajar, sEdit1.Text + '/' + fileabajar, False, False);
  498.  
  499.   end;
  500.  
  501.   procedure TForm1.sButton5Click(Sender: TObject);
  502.   var
  503.     fileasubir: string;
  504.     dirasubir: string;
  505.     cantidad: File of byte;
  506.   begin
  507.  
  508.     fileasubir := sEdit1.Text + sListView1.Selected.Caption;
  509.     dirasubir := sEdit5.Text;
  510.  
  511.     IdFTP1.OnWork := IdFTP1Work;
  512.  
  513.     AssignFile(cantidad, fileasubir);
  514.     Reset(cantidad);
  515.     sProgressBar1.Max := FileSize(cantidad) div 1024;
  516.     CloseFile(cantidad);
  517.  
  518.     IdFTP1.ChangeDir(dirasubir);
  519.     IdFTP1.Put(fileasubir, sListView1.Selected.Caption, False);
  520.  
  521.   end;
  522.  
  523.   procedure TForm1.sListView1DblClick(Sender: TObject);
  524.   var
  525.     dir: string;
  526.   begin
  527.  
  528.     dir := sEdit1.Text + sListView1.Selected.Caption + '/';
  529.     if (DirectoryExists(dir)) then
  530.     begin
  531.       sEdit1.Text := sEdit1.Text + sListView1.Selected.Caption + '/';
  532.       listar(dir, sListView1, ImageList1);
  533.     end;
  534.   end;
  535.  
  536.   procedure TForm1.sListView2DblClick(Sender: TObject);
  537.   var
  538.     dir: string;
  539.   begin
  540.     dir := sEdit5.Text + sListView2.Selected.Caption + '/';
  541.     sEdit5.Text := sEdit5.Text + sListView2.Selected.Caption + '/';
  542.     listarftp(dir, sListView2, IdFTP1, ListBox1, ListBox2, ImageList2);
  543.   end;
  544.  
  545.   procedure TForm1.D3Click(Sender: TObject);
  546.   begin
  547.     try
  548.       begin
  549.         IdFTP1.ChangeDir(sEdit5.Text);
  550.         IdFTP1.Delete(sListView2.Selected.Caption);
  551.         ShowMessage('File Deleted');
  552.       end;
  553.     except
  554.       begin
  555.         ShowMessage('Error');
  556.       end;
  557.     end;
  558.   end;
  559.  
  560.   procedure TForm1.D4Click(Sender: TObject);
  561.   begin
  562.  
  563.     try
  564.       begin
  565.         IdFTP1.ChangeDir(sEdit5.Text);
  566.         IdFTP1.RemoveDir(sListView2.Selected.Caption);
  567.         ShowMessage('Directory Deleted');
  568.       end
  569.     except
  570.       ShowMessage('Error');
  571.     end;
  572.  
  573.   end;
  574.  
  575.   procedure TForm1.D5Click(Sender: TObject);
  576.   begin
  577.     IdFTP1.Disconnect;
  578.   end;
  579.  
  580.   procedure TForm1.E1Click(Sender: TObject);
  581.   begin
  582.     Form1.Close();
  583.   end;
  584.  
  585. end.
  586.  
  587. // The End ?
  588.  

Si lo quieren bajar lo pueden hacer de aca

Desconectado ZanGetsu

  • *
  • Underc0der
  • Mensajes: 325
  • Actividad:
    1.67%
  • Reputación 0
  • I ZanGetsu
    • Ver Perfil
  • Skype: thenicox
  • Twitter: black_zangetsu
« Respuesta #1 en: Junio 29, 2013, 02:12:03 pm »
se ve muy bueno, lo probaré, gracias  !

 

¿Te gustó el post? COMPARTILO!



[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2049
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3258
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3490
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Creacion de un Server Builder con recursos

Iniciado por BigBear

Respuestas: 1
Vistas: 1477
Último mensaje Marzo 09, 2015, 07:56:20 pm
por Flemon
Poner splash screen con progress bar en delphi

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2977
Último mensaje Febrero 24, 2010, 04:54:23 pm
por ANTRAX