Advertisement
filhotecmail

FtpApp

Sep 20th, 2018
372
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 11.13 KB | None | 0 0
  1. unit Instalador.Model;
  2.  
  3. interface
  4.  uses Classes,
  5.  {$IF DEFINED(CLR)}
  6.   System.Security.Permissions,
  7. {$ENDIF}
  8.   Winapi.Windows, Winapi.Messages, System.SysUtils, Vcl.Controls, Vcl.Graphics,
  9.   Vcl.Forms, Vcl.Menus, Vcl.StdCtrls, Vcl.Buttons,IdFTP, IdAntiFreeze,IdFTPCommon, IdComponent, IdAntiFreezeBase, ZLib,
  10.   IdFTPList,JvExComCtrls, JvComCtrls, JvExExtCtrls,JvExtComponent,
  11.   ComCtrls,Dialogs;
  12.  
  13.   type TClientApp = class( Tcomponent )
  14.  
  15.   strict private
  16.   type TOnStatusFtp = procedure(ASender: TObject; const AStatus: TIdStatus;
  17.    const AStatusText: string) of object;
  18.   type TOnListenDirectory = procedure( const Value: UnicodeString ) of object;
  19.   type TOnWorkFtpProgress = procedure(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64) of object;
  20.   type TOnWorkEndEvent    = procedure(ASender: TObject; AWorkMode: TWorkMode) of object;
  21.   type TWorkBeginEvent    = procedure(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64;
  22.                                       Const NomeArquivo: Unicodestring; FinishFolder: Boolean ) of object;
  23.   type TAmmountListDirectory = procedure( NodeRaiz: TJvTreeNode; TreeView: TJvTreeView) of object;
  24.  
  25.   type TDownloader = class
  26.  
  27.     strict private
  28.     Client: TIdFTP;
  29.     AntiFreeze: TIdAntiFreeze;
  30.     FDiretorio: string;
  31.     FPassword: string;
  32.     FHost: string;
  33.     FUser: string;
  34.     FPassive: Boolean;
  35.     FPort: Word;
  36.     FTOnStatusFtp: TOnStatusFtp;
  37.     FNameArquivo: UnicodeString;
  38.     FTamanhoArquivo: Int64;
  39.     FDirectoryCount: integer;
  40.     FNroArquivos: InT64;
  41.     FContinue: Boolean;
  42.     FTreeView: TJvTreeView;
  43.     FTreeNode: TJvTreeNode;
  44.  
  45.     procedure OnStatusFtpClientL(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
  46.     procedure Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  47.     procedure WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  48.     procedure WorkBeginEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
  49.     function ListenWork(const NomeFolderRoot , Destino: UnicodeString): Boolean;
  50.     procedure DownloadFolder(AFTP: TIdFtp; ARemotePath, ALocalPath: string; bOverwrite: Boolean);
  51.  
  52.       private
  53.  
  54.         FTOnListenDirectory: TOnListenDirectory;
  55.         FOnWorkFtpProgress: TOnWorkFtpProgress;
  56.         FTOnWorkEndEvent: TOnWorkEndEvent;
  57.         FTWorkBeginEvent: TWorkBeginEvent;
  58.         FTAmmountListDirectory: TAmmountListDirectory;
  59.  
  60.  
  61.   public
  62.  
  63.     constructor Create;
  64.         procedure AfterConstruction; override;
  65.         procedure BeforeDestruction; override;
  66.  
  67.   published
  68.  
  69.  
  70.     procedure ListenDirectory;
  71.     property Tree: TJvTreeView                        read  FTreeView             write FTreeView;
  72.     property OnAmmountTree: TAmmountListDirectory     read FTAmmountListDirectory write FTAmmountListDirectory;
  73.     property OnListemDirectory: TOnListenDirectory    read FTOnListenDirectory    write FTOnListenDirectory;
  74.     property OnStatusFtpCliente: TOnStatusFtp         read FTOnStatusFtp          write FTOnStatusFtp;
  75.     property OnWorkFtpProgress: TOnWorkFtpProgress    read FOnWorkFtpProgress     write FOnWorkFtpProgress;
  76.     property OnWorkEndEventLeopard: TOnWorkEndEvent   read FTOnWorkEndEvent       write FTOnWorkEndEvent;
  77.     property OnWorkBeginEventLeopard: TWorkBeginEvent read FTWorkBeginEvent       write FTWorkBeginEvent;
  78.     Function StartDownload: Boolean;
  79.  
  80.     property FTPHost: string     read FHost      write FHost;
  81.     property Port:    Word       read FPort      write FPort;
  82.     property FTPUser: string     read FUser      write FUser;
  83.     property FTPPassword: string read FPassword  write FPassword;
  84.     property FTPDir: string      read FDiretorio write FDiretorio;
  85.     property FTPPassive: Boolean read FPassive   write FPassive;
  86.  
  87.   end;
  88.  
  89. (*--------------------------------------------------------------------------------------------------------------------*)
  90.  
  91.    strict private
  92.    type TAfterTerminateWork = procedure of object;
  93.    type TFolderArray   = Array of UnicodeString ;
  94.    type TOnWorkCreateFolders = procedure( MaxCount,Count: integer;NameFolder: UnicodeString ) of Object;
  95.  
  96.  
  97.    type TStructureFolder = class( TObject )
  98.        strict private
  99.         FTFolderArray:TFolderArray;
  100.         FDirectory: UnicodeString;
  101.         procedure CriarDiretorios;
  102.       protected
  103.         procedure Execute;
  104.       public
  105.         destructor Destroy; override;
  106.         property  Directory: UnicodeString read FDirectory write FDirectory;
  107.         procedure AfterConstruction; override;
  108.         procedure BeforeDestruction; override;
  109.         constructor Create;
  110.  
  111.    end;
  112.  
  113.    strict private
  114.     FTFolderArray:    TFolderArray;
  115.     FStart: Boolean;
  116.     FTAfterTerminateWork: TAfterTerminateWork;
  117.     FTOnWorkCreateFolders: TOnWorkCreateFolders;
  118.     FTDownloader: TDownloader;
  119.     procedure CriarListadePastas(V: TFolderArray);
  120.     procedure setFStart(const Value: Boolean);
  121.  
  122.   public
  123.  
  124.     property FTP: TDownloader read FTDownloader write FTDownloader;
  125.     property OnWorkCreateFolders: TOnWorkCreateFolders read FTOnWorkCreateFolders write FTOnWorkCreateFolders;
  126.     property AfterTerminateJobs: TAfterTerminateWork read FTAfterTerminateWork write FTAfterTerminateWork;
  127.     property Listadepastas: TFolderArray read FTFolderArray write FTFolderArray;
  128.     property Start: Boolean read FStart write setFStart;
  129.     procedure AfterConstruction; override;
  130.     procedure BeforeDestruction; override;
  131.     constructor Create(AOwner: TComponent); override;
  132.  
  133.   end;
  134.  
  135.   var FTClientApp: TClientApp;
  136.  
  137. implementation
  138.  
  139. { TClientApp.TStructureFolder }
  140.  
  141. procedure TClientApp.TStructureFolder.AfterConstruction;
  142. begin
  143.   inherited AfterConstruction;
  144.  
  145. end;
  146.  
  147. procedure TClientApp.TStructureFolder.BeforeDestruction;
  148. begin
  149.   inherited BeforeDestruction;
  150.  
  151. end;
  152.  
  153. constructor TClientApp.TStructureFolder.Create;
  154. begin
  155.   inherited Create;
  156.    sleep(10);
  157. end;
  158.  
  159. procedure TClientApp.TStructureFolder.CriarDiretorios;
  160. begin
  161.  if not DirectoryExists(Directory)then begin
  162.    if not CreateDir(Directory) then begin
  163.           ForceDirectories(Directory);
  164.   end;
  165.  end;
  166. end;
  167.  
  168.  
  169.  destructor TClientApp.TStructureFolder.Destroy;
  170. begin
  171.  
  172.   inherited Destroy;
  173. end;
  174.  
  175. procedure TClientApp.TStructureFolder.Execute;
  176. begin
  177.   inherited;
  178.    CriarDiretorios;
  179. end;
  180.  
  181. { TClientApp }
  182.  
  183. procedure TClientApp.AfterConstruction;
  184. begin
  185.   inherited AfterConstruction;
  186.   FTDownloader := TDownloader.Create;
  187.  
  188. end;
  189.  
  190.  
  191.  
  192. procedure TClientApp.BeforeDestruction;
  193. begin
  194.   inherited BeforeDestruction;
  195.   FreeAndNil(FTDownloader);
  196. end;
  197.  
  198. constructor TClientApp.Create(AOwner: TComponent);
  199. begin
  200.   inherited Create(AOwner);
  201.  
  202. end;
  203.  
  204. procedure TClientApp.CriarListadePastas(V: TFolderArray);
  205.  var I: integer;
  206.      FTStructureFolder:TStructureFolder;
  207. begin
  208.  FTStructureFolder:= TStructureFolder.Create;
  209.  try
  210.    for I := Low(V) to High(V) do
  211.    begin
  212.  
  213.     FTStructureFolder.Directory := V[i];
  214.     FTStructureFolder.Execute;
  215.     if Assigned(FTOnWorkCreateFolders) then
  216.     begin
  217.       FTOnWorkCreateFolders(Length(V),I,V[i]);
  218.     end;
  219.    end;
  220.  finally
  221.    FreeAndNil( FTStructureFolder);
  222.  end;
  223.  
  224.   if Assigned(FTAfterTerminateWork) then
  225.      FTAfterTerminateWork;
  226. end;
  227.  
  228. procedure TClientApp.setFStart(const Value: Boolean);
  229. begin
  230.   FStart := Value;
  231.   if Value then
  232.   begin
  233.    CriarListadePastas(FTFolderArray);
  234.   end;
  235. end;
  236.  
  237. { TClientApp.TDownloader }
  238.  
  239. procedure TClientApp.TDownloader.AfterConstruction;
  240. begin
  241.   inherited AfterConstruction;
  242.   Client:= TIdFTP.Create(nil);
  243.   AntiFreeze:= TIdAntiFreeze.Create(nil);
  244.   Client.OnWork := Work;
  245.   Client.OnWorkBegin := WorkBeginEvent;
  246.   Client.OnWorkEnd   := WorkEnd;
  247. end;
  248.  
  249. procedure TClientApp.TDownloader.BeforeDestruction;
  250. begin
  251.   inherited BeforeDestruction;
  252.  
  253. end;
  254.  
  255. constructor TClientApp.TDownloader.Create;
  256. begin
  257.   inherited Create;
  258.  
  259. end;
  260.  
  261. procedure TClientApp.TDownloader.DownloadFolder(AFTP: TIdFtp; ARemotePath, ALocalPath: string; bOverwrite: Boolean);
  262. var
  263.  I: Integer;
  264.  SubFolders: TStringList;
  265.  
  266. begin
  267.  
  268.  SubFolders:= TStringList.Create;
  269.  AFTP.ChangeDir(ARemotePath);
  270.  ALocalPath := IncludeTrailingPathDelimiter(ALocalPath);
  271.  ForceDirectories(ALocalPath);
  272.  if ARemotePath[Length(ARemotePath)] <> '/' then ARemotePath := ARemotePath +'/';
  273.  
  274.  try
  275.   AFTP.List;
  276.  except
  277.   on E:Exception do MessageDlg(E.Message, mtError, [mbOk], 0);
  278.  end;
  279.  
  280.  for I := 0 to AFTP.DirectoryListing.Count -1 do
  281.  begin
  282.   // = File Handling
  283.      if Assigned(FTOnListenDirectory) then
  284.      begin
  285.         FTOnListenDirectory(Aftp.DirectoryListing[i].FileName);
  286.      end;
  287.    if AFTP.DirectoryListing[i].ItemType = ditFile then
  288.    begin
  289.     FNroArquivos    :=  Client.DirectoryListing.Count;
  290.     FNameArquivo    := Client.DirectoryListing[i].FileName;
  291.     FTamanhoArquivo := Client.Size(Client.DirectoryListing[i].FileName);
  292.     if bOverwrite then
  293.     begin
  294.      if Fileexists(ALocalPath +AFTP.DirectoryListing[i].FileName) then DeleteFile(ALocalPath +AFTP.DirectoryListing[i].FileName);
  295.      AFTP.Get(AFTP.DirectoryListing[i].FileName, ALocalPath +AFTP.DirectoryListing[i].FileName);
  296.     end;
  297.    end;
  298.  
  299.   // = Folder Handling
  300.    if AFTP.DirectoryListing[i].ItemType = ditDirectory then
  301.     begin
  302.      if SubFolders = nil then SubFolders := TStringList.Create;
  303.         SubFolders.Add(AFTP.DirectoryListing[i].FileName);
  304.     end;
  305.  
  306.  end;
  307.  
  308. // = Subfolder Handling
  309.  if SubFolders <> nil then
  310.   begin
  311.    for I := 0 to Pred(SubFolders.Count) do
  312.     begin
  313.      AFTP.ChangeDir(SubFolders[I]);
  314.      DownloadFolder(AFTP, ARemotePath + SubFolders[I], ALocalPath +SubFolders[I],bOverwrite);
  315.      AFTP.ChangeDirUp;
  316.     end;
  317.   end;
  318.  
  319. end;
  320.  
  321.  
  322. procedure TClientApp.TDownloader.ListenDirectory;
  323. begin
  324.  
  325.   ListenWork('','');
  326. end;
  327.  
  328. function TClientApp.TDownloader.ListenWork(const NomeFolderRoot , Destino: UnicodeString): Boolean;
  329. begin
  330.  
  331.   DownloadFolder(Client,'/','c:\Leopard',True);
  332. end;
  333.  
  334. procedure TClientApp.TDownloader.OnStatusFtpClientL(ASender: TObject; const AStatus: TIdStatus;
  335.   const AStatusText: string);
  336. begin
  337.  if Assigned(FTOnStatusFtp) then
  338.    FTOnStatusFtp(ASender,AStatus,AStatusText);
  339. end;
  340.  
  341. function TClientApp.TDownloader.StartDownload: Boolean;
  342. begin
  343.   Client.OnStatus := OnStatusFtpClientL;
  344.   Client.Host     := FHost;
  345.   Client.Password := FPassword;
  346.   Client.Passive  := FPassive;
  347.   Client.Username := FUser;
  348.   Client.Port     := FPort;
  349.   Client.TransferType:= ftBinary;
  350.   Client.Connect;
  351.   Result:= Client.Connected;
  352.   ListenDirectory;
  353. end;
  354.  
  355. procedure TClientApp.TDownloader.Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  356. begin
  357.  if Assigned(FOnWorkFtpProgress) then
  358.      FOnWorkFtpProgress(ASender,AWorkMode,AWorkCount);
  359. end;
  360.  
  361. procedure TClientApp.TDownloader.WorkBeginEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
  362. begin
  363.   if Assigned(FTWorkBeginEvent) then
  364.      FTWorkBeginEvent(ASender,AWorkMode,(FTamanhoArquivo div 1024 ),FNameArquivo,FContinue);
  365.  
  366. end;
  367.  
  368. procedure TClientApp.TDownloader.WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  369. begin
  370.   if Assigned(FTOnWorkEndEvent) then
  371.      FTOnWorkEndEvent(ASender,AWorkMode);
  372. end;
  373.  
  374. initialization
  375.  if not Assigned( FTClientApp )  then
  376.        FTClientApp:= TClientApp.Create(nil);
  377.  
  378.  finalization
  379.  
  380. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement