Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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;
- 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 ):IAtualizaIbttax;
- function This:TAtualizaIbttax; overload;
- function This(Proc: array of TMyProc2<TProc>):TAtualizaIbttax; overload;
- end;
- var _HRef:IAtualizaIbttax;
- Type ThisAs = class function ThisAs: IAtualizaIbttax;
- 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): IAtualizaIbttax;
- begin
- result := TAtualizaIbttax.create(nil);
- _HRef:= 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;
- { ThisAs }
- function ThisAs.ThisAs: IAtualizaIbttax;
- var Obj: IAtualizaIbttax;
- begin
- result:= _HRef;
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement