Array Procedure Anonima

unit Atualizador.Ibptax;

interface

 uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
      Forms,IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
      IdExplicitTLSClientServerBase, IdFTP,IdGlobal,  IdException, IdFTPCommon,IdFTPList,
      IdAntiFreezeBase, Vcl.IdAntiFreeze,Dialogs,System.Rtti;
 type
   TAtualizaIbttax = class;

   TProcMethodo = reference to procedure;
   TOnStatus = procedure(const AStatusText: string) of object;
   TOnConnected = procedure(Sender: TObject) of object;
   TOnWorkFtp   = procedure(AWorkCount: Int64) of object;
   TOnWorkBeginFtp = procedure(AWorkCountMax: Int64) of Object;
   TOnWorkEndFtp   = procedure(AWorkMode: TWorkMode) of Object;
   TMyProc2<T> = reference to procedure;


   IAtualizaIbttax = interface

   ['{F7059E39-7253-432C-9CA1-4668100C9F9A}']
    function Conecta(Proc: TProc; Proc2: TOnConnected ): IAtualizaIbttax;
    function BaixarTabela(Proc: TProc): IAtualizaIbttax;
    function getFTOnStatus: TOnStatus;
    procedure setFTOnStatus(const Value: TOnStatus);
    property OnStatus: TOnStatus read getFTOnStatus write setFTOnStatus;
    function SetEvents(Proc: TOnStatus): IAtualizaIbttax;
    function OnConnec(proc:TOnConnected ):IAtualizaIbttax; overload;
    function OnConnec(proc:Tproc ):IAtualizaIbttax; overload;
    function getFProcEventBegin: TOnWorkBeginFtp;
    function getFprocEventWork: TOnWorkFtp;
    function getFprocEventEnd: TOnWorkEndFtp;
    procedure setFProcEventBegin(const Value: TOnWorkBeginFtp);
    procedure setFprocEventEnd(const Value: TOnWorkEndFtp);
    procedure setFprocEventWork(const Value: TOnWorkFtp);

    property OnWorkEvent:      TOnWorkFtp      read getFprocEventWork  write setFprocEventWork;
    property OnWorkBeginEvent: TOnWorkBeginFtp read getFProcEventBegin write setFProcEventBegin;
    property OnWorkEnd:        TOnWorkEndFtp   read getFprocEventEnd   write setFprocEventEnd;

    function This:TAtualizaIbttax; overload;
    function This(Proc: array of TMyProc2<TProc>):TAtualizaIbttax; overload;

 end;

  TAtualizaIbttax = class(TComponent,IAtualizaIbttax)

  strict private

    FCliente: TIDFtp;
    FProc: TProc;
    FTOnStatus: TOnStatus;
    FTOnConnected: TOnConnected;
    FTMyProc2: TMyProc2<TProc>;
    FStreamFile: TMemoryStream;
    FAntifreeze: TIdAntiFreeze;
    FProcEventBegin : TOnWorkBeginFtp;
    FprocEventWork  : TOnWorkFtp;
    FprocEventEnd   : TOnWorkEndFtp;
    FTamanhoArquivo: Int64;
    FNomeArquivo: UnicodeString;
    FRefCount: Integer;

    function getFTOnStatus: TOnStatus;
    procedure setFTOnStatus(const Value: TOnStatus);
    procedure OnStatusLeopard(ASender: TObject; const AStatus: TIdStatus;
                               const AStatusText: string);
    procedure OnConnected(Sender: TObject);

    procedure WorkBeginEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure WorkEndEvent(ASender: TObject; AWorkMode: TWorkMode);
    procedure WorkEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
  private
    function getFProcEventBegin: TOnWorkBeginFtp;
    function getFprocEventWork: TOnWorkFtp;
    function getFprocEventEnd: TOnWorkEndFtp;
    procedure setFProcEventBegin(const Value: TOnWorkBeginFtp);
    procedure setFprocEventEnd(const Value: TOnWorkEndFtp);
    procedure setFprocEventWork(const Value: TOnWorkFtp);
    function StreamToString(const Stream: TStream; const Encoding: TEncoding): string;
    function MemoryStreamToOleVariant(Strm: TMemoryStream):OleVariant;

    function GetData: String;
  protected
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; override; stdcall;
  public

    function OnConnec(proc:TOnConnected ):IAtualizaIbttax; overload;
    function OnConnec(proc:Tproc ):IAtualizaIbttax; overload;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    property OnWorkEvent:      TOnWorkFtp      read getFprocEventWork  write setFprocEventWork;
    property OnWorkBeginEvent: TOnWorkBeginFtp read getFProcEventBegin write setFProcEventBegin;
    property OnWorkEnd:        TOnWorkEndFtp   read getFprocEventEnd   write setFprocEventEnd;

    property OnStatus: TOnStatus read getFTOnStatus write setFTOnStatus;
    function Conecta(Proc: TProc; Proc2: TOnConnected ): IAtualizaIbttax;
    function BaixarTabela(Proc: TProc): IAtualizaIbttax;
    function SetEvents(Proc: TOnStatus): IAtualizaIbttax;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function new(Proc: TOnStatus; proc1: TOnWorkFtp; proc2: TOnWorkBeginFtp; proc3: TOnWorkEndFtp; out Instance:IAtualizaIbttax ): IAtualizaIbttax;
    function This:TAtualizaIbttax; overload;
    function This(Proc: array of TMyProc2<TProc>):TAtualizaIbttax; overload;

 end;

implementation

{ TAtualizaIbttax }

procedure TAtualizaIbttax.AfterConstruction;
begin
  inherited AfterConstruction;
 // Release the constructor's implicit refcount. Thread-safe increase is
// achieved using Win API call to InterlockedDecrement in place of Dec
  InterlockedDecrement(FRefCount);
  FCliente:= TIdFTP.Create(nil);
  FCliente.OnStatus    := OnStatusLeopard;
  FCliente.OnConnected := OnConnected;
  FCliente.OnWork      := WorkEvent;
  FCliente.OnWorkBegin := WorkBeginEvent;
  FCliente.OnWorkEnd   := WorkEndEvent;

  FAntifreeze:= TIdAntiFreeze.Create(nil);
end;

function TAtualizaIbttax.BaixarTabela(Proc: TProc): IAtualizaIbttax;
 var I: Integer;
begin
 Result := self;
 Application.ProcessMessages;
 FStreamFile:= TMemoryStream.Create;
 FStreamFile.Position := 0;
 FCliente.List(nil);

 for i := 0 to FCliente.DirectoryListing.Count -1 do
   begin
     if FCliente.DirectoryListing.Items[i].ItemType <> ditDirectory then
     begin
       FNomeArquivo   := FCliente.DirectoryListing.Items[i].FileName;
       FTamanhoArquivo:= FCliente.DirectoryListing.Items[i].Size;
      if pos('.csv',FNomeArquivo) <> 0 then
      begin
       FCliente.Get(FCliente.DirectoryListing.Items[i].FileName,
                     FStreamFile, true);
      end;
     end;
   end;
    GetData;
 if Assigned(Proc) then
    Proc;

end;

procedure TAtualizaIbttax.BeforeDestruction;
begin
  inherited BeforeDestruction;

  if Assigned(FCliente) then
  begin
     FCliente.Free;
     FCliente:= nil;
  end;
  if Assigned(FAntifreeze) then
     FreeAndNil(FAntifreeze);
end;

function TAtualizaIbttax.Conecta(Proc: TProc; Proc2: TOnConnected ): IAtualizaIbttax;
begin
 Result:= self;
 FCliente.Username := 'Tabelaibpt';
 FCliente.Password := 'a1b2c3d4e5';
 FCliente.Host     := '187.22.9.135';
 FCliente.Port     := 2121;
 FCliente.TransferType := ftBinary;
 FCliente.Passive  := True;
 Application.ProcessMessages;
 FCliente.Connect;
 if FCliente.Connected then
  if Assigned(Proc) then
     Proc;

end;

function TAtualizaIbttax.GetData: String;
begin
  FStreamFile.SaveToFile(ExtractFilePath(Application.ExeName)+'TabelaIBPTaxSP.csv');
  Result:= ExtractFilePath(Application.ExeName)+'TabelaIBPTaxSP.csv';
  FreeAndNil(FStreamFile);
end;

function TAtualizaIbttax.getFProcEventBegin: TOnWorkBeginFtp;
begin
  Result := FProcEventBegin;
end;

function TAtualizaIbttax.getFprocEventEnd: TOnWorkEndFtp;
begin
  Result := FprocEventEnd;
end;

function TAtualizaIbttax.getFprocEventWork: TOnWorkFtp;
begin
  Result := FprocEventWork;
end;

function TAtualizaIbttax.getFTOnStatus: TOnStatus;
begin
  Result := FTOnStatus;
end;

function TAtualizaIbttax.MemoryStreamToOleVariant(Strm: TMemoryStream): OleVariant;
var
   Data: PByteArray;
begin
  Result := VarArrayCreate ([0, Strm.Size - 1], varByte);
  Data := VarArrayLock(Result);
  try
    Strm.Position := 0;
    Strm.ReadBuffer(Data^, Strm.Size);
  finally
    VarArrayUnlock(Result);
  end;
end;

class function TAtualizaIbttax.new(Proc: TOnStatus; proc1: TOnWorkFtp; proc2: TOnWorkBeginFtp; proc3: TOnWorkEndFtp; out Instance:IAtualizaIbttax ): IAtualizaIbttax;
begin

  result := TAtualizaIbttax.create(nil);
  Instance:= Result;
  result.OnStatus:= Proc;
  Result.OnWorkBeginEvent :=  proc2;
  Result.OnWorkEvent      :=  proc1;
  result.OnWorkEnd        :=  proc3;

end;

function TAtualizaIbttax.OnConnec(proc: Tproc): IAtualizaIbttax;
begin
 Result:= Self;
  if Assigned(Proc) then
     Proc;
end;

procedure TAtualizaIbttax.OnConnected(Sender: TObject);
begin
  if Assigned(FTOnConnected) then
     FTOnConnected(sender);
end;

function TAtualizaIbttax.OnConnec(proc: TOnConnected): IAtualizaIbttax;
begin
   Result:= Self;
 FTOnConnected := proc;
end;


procedure TAtualizaIbttax.OnStatusLeopard(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
begin
 if Assigned(FTOnStatus) then
     FTOnStatus(AStatusText);
end;


function TAtualizaIbttax.QueryInterface(const IID: TGUID; out Obj): HRESULT;
begin
   if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TAtualizaIbttax.SetEvents(Proc: TOnStatus): IAtualizaIbttax;
begin
  Result:= self;
  FTOnStatus:= Proc;
end;

procedure TAtualizaIbttax.setFProcEventBegin(const Value: TOnWorkBeginFtp);
begin
  FProcEventBegin := Value;
end;

procedure TAtualizaIbttax.setFprocEventEnd(const Value: TOnWorkEndFtp);
begin
  FprocEventEnd := Value;
end;

procedure TAtualizaIbttax.setFprocEventWork(const Value: TOnWorkFtp);
begin
  FprocEventWork := Value;
end;

procedure TAtualizaIbttax.setFTOnStatus(const Value: TOnStatus);
begin
 FTOnStatus:= Value;
end;

function TAtualizaIbttax.StreamToString(const Stream: TStream; const Encoding: TEncoding): string;
var
  StringBytes: TBytes;
begin
  Stream.Position := 0;
  SetLength(StringBytes, Stream.Size);
  Stream.ReadBuffer(StringBytes, Stream.Size);
  Result := Encoding.GetString(StringBytes);

end;

function TAtualizaIbttax.This(Proc: array of TMyProc2<TProc>): TAtualizaIbttax;
 var i: integer;
begin
  Result:= Self;
  for I := Low(Proc) to high(proc) do
  begin
   FTMyProc2 := proc[i];
   FTMyProc2;
  end;
end;

procedure TAtualizaIbttax.WorkBeginEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
 if Assigned(FProcEventBegin) then
     FProcEventBegin(FTamanhoArquivo);
end;

procedure TAtualizaIbttax.WorkEndEvent(ASender: TObject; AWorkMode: TWorkMode);
begin
 if Assigned(FprocEventEnd) then
     FprocEventEnd(AWorkMode);
end;

procedure TAtualizaIbttax.WorkEvent(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
   if Assigned(FprocEventWork) then
      FprocEventWork(AWorkCount);
end;

function TAtualizaIbttax._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function TAtualizaIbttax._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  if Result = 0 then
    Destroy;
end;

function TAtualizaIbttax.This: TAtualizaIbttax;
begin
 result:= Self;
end;



end.