FtpApp

unit Instalador.Model;

interface
 uses Classes,
 {$IF DEFINED(CLR)}
  System.Security.Permissions,
{$ENDIF}
  Winapi.Windows, Winapi.Messages, System.SysUtils, Vcl.Controls, Vcl.Graphics,
  Vcl.Forms, Vcl.Menus, Vcl.StdCtrls, Vcl.Buttons,IdFTP, IdAntiFreeze,IdFTPCommon, IdComponent, IdAntiFreezeBase, ZLib,
  IdFTPList,JvExComCtrls, JvComCtrls, JvExExtCtrls,JvExtComponent,
  ComCtrls,Dialogs;

  type TClientApp = class( Tcomponent )

  strict private
  type TOnStatusFtp = procedure(ASender: TObject; const AStatus: TIdStatus;
   const AStatusText: string) of object;
  type TOnListenDirectory = procedure( const Value: UnicodeString ) of object;
  type TOnWorkFtpProgress = procedure(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64) of object;
  type TOnWorkEndEvent    = procedure(ASender: TObject; AWorkMode: TWorkMode) of object;
  type TWorkBeginEvent    = procedure(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64;
                                      Const NomeArquivo: Unicodestring; FinishFolder: Boolean ) of object;
  type TAmmountListDirectory = procedure( NodeRaiz: TJvTreeNode; TreeView: TJvTreeView) of object;

  type TDownloader = class

    strict private
    Client: TIdFTP;
    AntiFreeze: TIdAntiFreeze;
    FDiretorio: string;
    FPassword: string;
    FHost: string;
    FUser: string;
    FPassive: Boolean;
    FPort: Word;
    FTOnStatusFtp: TOnStatusFtp;
    FNameArquivo: UnicodeString;
    FTamanhoArquivo: Int64;
    FDirectoryCount: integer;
    FNroArquivos: InT64;
    FContinue: Boolean;
    FTreeView: TJvTreeView;
    FTreeNode: TJvTreeNode;

    procedure OnStatusFtpClientL(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
    procedure Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure WorkBeginEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    function ListenWork(const NomeFolderRoot , Destino: UnicodeString): Boolean;
    procedure DownloadFolder(AFTP: TIdFtp; ARemotePath, ALocalPath: string; bOverwrite: Boolean);

      private

        FTOnListenDirectory: TOnListenDirectory;
        FOnWorkFtpProgress: TOnWorkFtpProgress;
        FTOnWorkEndEvent: TOnWorkEndEvent;
        FTWorkBeginEvent: TWorkBeginEvent;
        FTAmmountListDirectory: TAmmountListDirectory;


  public

    constructor Create;
        procedure AfterConstruction; override;
        procedure BeforeDestruction; override;

  published


    procedure ListenDirectory;
    property Tree: TJvTreeView                        read  FTreeView             write FTreeView;
    property OnAmmountTree: TAmmountListDirectory     read FTAmmountListDirectory write FTAmmountListDirectory;
    property OnListemDirectory: TOnListenDirectory    read FTOnListenDirectory    write FTOnListenDirectory;
    property OnStatusFtpCliente: TOnStatusFtp         read FTOnStatusFtp          write FTOnStatusFtp;
    property OnWorkFtpProgress: TOnWorkFtpProgress    read FOnWorkFtpProgress     write FOnWorkFtpProgress;
    property OnWorkEndEventLeopard: TOnWorkEndEvent   read FTOnWorkEndEvent       write FTOnWorkEndEvent;
    property OnWorkBeginEventLeopard: TWorkBeginEvent read FTWorkBeginEvent       write FTWorkBeginEvent;
    Function StartDownload: Boolean;

    property FTPHost: string     read FHost      write FHost;
    property Port:    Word       read FPort      write FPort;
    property FTPUser: string     read FUser      write FUser;
    property FTPPassword: string read FPassword  write FPassword;
    property FTPDir: string      read FDiretorio write FDiretorio;
    property FTPPassive: Boolean read FPassive   write FPassive;

  end;

(*--------------------------------------------------------------------------------------------------------------------*)

   strict private
   type TAfterTerminateWork = procedure of object;
   type TFolderArray   = Array of UnicodeString ;
   type TOnWorkCreateFolders = procedure( MaxCount,Count: integer;NameFolder: UnicodeString ) of Object;


   type TStructureFolder = class( TObject )
       strict private
        FTFolderArray:TFolderArray;
        FDirectory: UnicodeString;
        procedure CriarDiretorios;
      protected
        procedure Execute;
      public
        destructor Destroy; override;
        property  Directory: UnicodeString read FDirectory write FDirectory;
        procedure AfterConstruction; override;
        procedure BeforeDestruction; override;
        constructor Create;

   end;

   strict private
    FTFolderArray:    TFolderArray;
    FStart: Boolean;
    FTAfterTerminateWork: TAfterTerminateWork;
    FTOnWorkCreateFolders: TOnWorkCreateFolders;
    FTDownloader: TDownloader;
    procedure CriarListadePastas(V: TFolderArray);
    procedure setFStart(const Value: Boolean);

  public

    property FTP: TDownloader read FTDownloader write FTDownloader;
    property OnWorkCreateFolders: TOnWorkCreateFolders read FTOnWorkCreateFolders write FTOnWorkCreateFolders;
    property AfterTerminateJobs: TAfterTerminateWork read FTAfterTerminateWork write FTAfterTerminateWork;
    property Listadepastas: TFolderArray read FTFolderArray write FTFolderArray;
    property Start: Boolean read FStart write setFStart;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    constructor Create(AOwner: TComponent); override;

  end;

  var FTClientApp: TClientApp;

implementation

{ TClientApp.TStructureFolder }

procedure TClientApp.TStructureFolder.AfterConstruction;
begin
  inherited AfterConstruction;

end;

procedure TClientApp.TStructureFolder.BeforeDestruction;
begin
  inherited BeforeDestruction;

end;

constructor TClientApp.TStructureFolder.Create;
begin
  inherited Create;
   sleep(10);
end;

procedure TClientApp.TStructureFolder.CriarDiretorios;
begin
 if not DirectoryExists(Directory)then begin
   if not CreateDir(Directory) then begin
          ForceDirectories(Directory);
  end;
 end;
end;


 destructor TClientApp.TStructureFolder.Destroy;
begin

  inherited Destroy;
end;

procedure TClientApp.TStructureFolder.Execute;
begin
  inherited;
   CriarDiretorios;
end;

{ TClientApp }

procedure TClientApp.AfterConstruction;
begin
  inherited AfterConstruction;
  FTDownloader := TDownloader.Create;

end;



procedure TClientApp.BeforeDestruction;
begin
  inherited BeforeDestruction;
  FreeAndNil(FTDownloader);
end;

constructor TClientApp.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

end;

procedure TClientApp.CriarListadePastas(V: TFolderArray);
 var I: integer;
     FTStructureFolder:TStructureFolder;
begin
 FTStructureFolder:= TStructureFolder.Create;
 try
   for I := Low(V) to High(V) do
   begin

    FTStructureFolder.Directory := V[i];
    FTStructureFolder.Execute;
    if Assigned(FTOnWorkCreateFolders) then
    begin
      FTOnWorkCreateFolders(Length(V),I,V[i]);
    end;
   end;
 finally
   FreeAndNil( FTStructureFolder);
 end;

  if Assigned(FTAfterTerminateWork) then
     FTAfterTerminateWork;
end;

procedure TClientApp.setFStart(const Value: Boolean);
begin
  FStart := Value;
  if Value then
  begin
   CriarListadePastas(FTFolderArray);
  end;
end;

{ TClientApp.TDownloader }

procedure TClientApp.TDownloader.AfterConstruction;
begin
  inherited AfterConstruction;
  Client:= TIdFTP.Create(nil);
  AntiFreeze:= TIdAntiFreeze.Create(nil);
  Client.OnWork := Work;
  Client.OnWorkBegin := WorkBeginEvent;
  Client.OnWorkEnd   := WorkEnd;
end;

procedure TClientApp.TDownloader.BeforeDestruction;
begin
  inherited BeforeDestruction;

end;

constructor TClientApp.TDownloader.Create;
begin
  inherited Create;

end;

procedure TClientApp.TDownloader.DownloadFolder(AFTP: TIdFtp; ARemotePath, ALocalPath: string; bOverwrite: Boolean);
var
 I: Integer;
 SubFolders: TStringList;

begin

 SubFolders:= TStringList.Create;
 AFTP.ChangeDir(ARemotePath);
 ALocalPath := IncludeTrailingPathDelimiter(ALocalPath);
 ForceDirectories(ALocalPath);
 if ARemotePath[Length(ARemotePath)] <> '/' then ARemotePath := ARemotePath +'/';

 try
  AFTP.List;
 except
  on E:Exception do MessageDlg(E.Message, mtError, [mbOk], 0);
 end;

 for I := 0 to AFTP.DirectoryListing.Count -1 do
 begin
  // = File Handling
     if Assigned(FTOnListenDirectory) then
     begin
        FTOnListenDirectory(Aftp.DirectoryListing[i].FileName);
     end;
   if AFTP.DirectoryListing[i].ItemType = ditFile then
   begin
    FNroArquivos    :=  Client.DirectoryListing.Count;
    FNameArquivo    := Client.DirectoryListing[i].FileName;
    FTamanhoArquivo := Client.Size(Client.DirectoryListing[i].FileName);
    if bOverwrite then
    begin
     if Fileexists(ALocalPath +AFTP.DirectoryListing[i].FileName) then DeleteFile(ALocalPath +AFTP.DirectoryListing[i].FileName);
     AFTP.Get(AFTP.DirectoryListing[i].FileName, ALocalPath +AFTP.DirectoryListing[i].FileName);
    end;
   end;

  // = Folder Handling
   if AFTP.DirectoryListing[i].ItemType = ditDirectory then
    begin
     if SubFolders = nil then SubFolders := TStringList.Create;
        SubFolders.Add(AFTP.DirectoryListing[i].FileName);
    end;

 end;

// = Subfolder Handling
 if SubFolders <> nil then
  begin
   for I := 0 to Pred(SubFolders.Count) do
    begin
     AFTP.ChangeDir(SubFolders[I]);
     DownloadFolder(AFTP, ARemotePath + SubFolders[I], ALocalPath +SubFolders[I],bOverwrite);
     AFTP.ChangeDirUp;
    end;
  end;

end;


procedure TClientApp.TDownloader.ListenDirectory;
begin

  ListenWork('','');
end;

function TClientApp.TDownloader.ListenWork(const NomeFolderRoot , Destino: UnicodeString): Boolean;
begin

  DownloadFolder(Client,'/','c:\Leopard',True);
end;

procedure TClientApp.TDownloader.OnStatusFtpClientL(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
 if Assigned(FTOnStatusFtp) then
   FTOnStatusFtp(ASender,AStatus,AStatusText);
end;

function TClientApp.TDownloader.StartDownload: Boolean;
begin
  Client.OnStatus := OnStatusFtpClientL;
  Client.Host     := FHost;
  Client.Password := FPassword;
  Client.Passive  := FPassive;
  Client.Username := FUser;
  Client.Port     := FPort;
  Client.TransferType:= ftBinary;
  Client.Connect;
  Result:= Client.Connected;
  ListenDirectory;
end;

procedure TClientApp.TDownloader.Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
 if Assigned(FOnWorkFtpProgress) then
     FOnWorkFtpProgress(ASender,AWorkMode,AWorkCount);
end;

procedure TClientApp.TDownloader.WorkBeginEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  if Assigned(FTWorkBeginEvent) then
     FTWorkBeginEvent(ASender,AWorkMode,(FTamanhoArquivo div 1024 ),FNameArquivo,FContinue);

end;

procedure TClientApp.TDownloader.WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  if Assigned(FTOnWorkEndEvent) then
     FTOnWorkEndEvent(ASender,AWorkMode);
end;

initialization
 if not Assigned( FTClientApp )  then
       FTClientApp:= TClientApp.Create(nil);

 finalization

end.