Luciano Umbelino

Douglas a thread é muito grande vou ver se consigo postar apenas as partes principais, ok?! unit UthdRecebeArquivos; interface uses Windows, Classes, DateUtils, SysUtils, Forms,FMTBcd, DBXpress, DB, SqlExpr,IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,IdTCPClient, SyncObjs,IdExplicitTLSClientServerBase, IdMessageClient, IdText, IdAttachmentFile, IdSSLOpenSSL, IdIOHandler, ComCtrls, ExtCtrls, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdPOP3, IdAntiFreezeBase, IdAntiFreeze, IdFTP, IdFTPCommon, ShellAPI; type RecebeArquivos = class(TThread) private { Private declarations } //Declaração de Variáveis para conexao DB FBanco : String; FTP: TIdFTP; FIdAntiFreeze : TIdAntiFreeze; FConnRcp: TSQLConnection; FTransRcp: TTransactionDesc; FQueryRcp, FQueryRcp1, FQueryRcp2: TSQLQuery; NomeVideo, HostRecepcao, UsuarioRecepcao, SenhaUsuario, NmArqRecepParam, CanalGestor, CanalCE, NmArqRecepVideo, nmAnexo, HostFTP, PortaFTP, UsuarioFTP, SenhaFTP, PastaFDFTP: String; IdClienteCE, PortaRecepcao: Integer; QuebrouCanalFD, TemParametroRecepcao: Boolean; protected procedure Execute; override; procedure ObtemParametrosRecepcao; procedure RecepcionaArquivos; procedure ProcessaParametros(QtdParamRecebido: Integer); procedure ConectaProvedor; procedure AtualizaLogRecepcao(DtHrInicRecep, DtHrFinRecep : String); procedure FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); procedure FTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); procedure FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); public constructor Create(Banco: String); destructor Destroy; override; end; implementation uses UdtmConexao, Rotinas, UfrmLstLogRecepOcorr; var idp3POP : TIdPOP3; IdSSLPop : TIdSSLIOHandlerSocketOpenSSL; MsgPop : TIdMessage; QtdParam, TamanhoParam : Integer; MsgRecepcao, MsgThread : String; IncluiuParametro : Boolean; { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure RecebeParametrosCanalFD.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; } { RecebeParametrosCanalFD } //Aqui no Construtor monto a conexao com o Banco de dados constructor RecebeArquivos .Create(Banco: String); begin inherited Create(True); // Chama o contrutor herdado. Ele irá temporariamente colocar o thread em estado de espera para depois executá-lo. } FreeOnTerminate := True; // Libera o objeto após terminar. Priority := tpNormal; // Configura sua prioridade na lista de processos do Sistema operacional. } //Crio a Conexão com o banco de Dados FBanco := Banco; FConnRcp := TSQLConnection.Create(Nil); FConnRcp.Params.Values['DriverName'] := 'Interbase'; FConnRcp.Params.Values['Database'] := FBanco; FConnRcp.Params.Values['RoleName'] := 'RoleName'; FConnRcp.Params.Values['User_Name'] := 'sysdba'; FConnRcp.Params.Values['Password'] := 'masterkey'; FConnRcp.Params.Values['SQLDialect'] := '3'; FConnRcp.Params.Values['BlobSize'] := '-1'; FConnRcp.Params.Values['CommitRetain'] := 'False'; FConnRcp.Params.Values['WaitOnLocks'] := 'True'; FConnRcp.Params.Values['LocaleCode'] := '0000'; FConnRcp.Params.Values['Interbase TransIsolation'] := 'ReadCommited'; FConnRcp.Params.Values['Trim Char'] := 'False'; FConnRcp.ConnectionName := 'RecepCanal'; FConnRcp.DriverName := 'Interbase'; FConnRcp.GetDriverFunc := 'getSQLDriverINTERBASE'; FConnRcp.LibraryName := 'dbexpint.dll'; FConnRcp.VendorLib := 'gds32.dll'; FConnRcp.LoadParamsOnConnect := False; FConnRcp.LoginPrompt := False; FConnRcp.Connected := True; FConnRcp.KeepConnection := True; FTransRcp.TransactionID := 1; FQueryRcp := TSQLQuery.Create(Nil); FQueryRcp.SQLConnection := FConnRcp; FQueryRcp1 := TSQLQuery.Create(Nil); FQueryRcp1.SQLConnection := FConnRcp; FQueryRcp2 := TSQLQuery.Create(Nil); FQueryRcp2.SQLConnection := FConnRcp; idp3POP := TIdPOP3.Create(Nil); IdSSLPop := TIdSSLIOHandlerSocketOpenSSL.Create(Nil); MsgPop := TIdMessage.Create(Nil); if FTP = nil then begin //AntiFreeze FIdAntiFreeze := TIdAntiFreeze.Create(Nil); FIdAntiFreeze.Active := True; FIdAntiFreeze.ApplicationHasPriority := True; FIdAntiFreeze.IdleTimeOut := 250; FIdAntiFreeze.OnlyWhenIdle := True; //Configuração iniciais do FTP FTP := TIdFTP.Create(nil); FTP.AUTHCmd := tAuto; FTP.AutoLogin := True; FTP.Passive := False; FTP.ProxySettings.ProxyType := fpcmNone; FTP.TransferType := ftBinary; FTP.UseTLS := utNoTLSSupport; FTP.OnWork := FTPWork; FTP.OnWorkBegin := FTPWorkBegin; FTP.OnWorkEnd := FTPWorkEnd; end; Resume; // Inicia o Thread. end; //Aqui libero a conexão e os componentes indy que criei na Thread destructor RecebeArquivos .Destroy; begin inherited; FConnRcp.Free; FQueryRcp.Free; FQueryRcp1.Free; FQueryRcp2.Free; idp3POP.Free; IdSSLPop.Free; MsgPop.Free; FIdAntiFreeze.Free; FTP.Free; Terminate; end; procedure RecebeArquivos .Execute; begin { Place thread code here } TemParametroRecepcao := False; synchronize(ObtemParametrosRecepcao); if TemParametroRecepcao then RecepcionaArquivos; end; //Rotina Responsável pela reconecção ao provedor após a recepção procedure RecebeArquivos .ConectaProvedor; begin if idp3POP.Connected then idp3POP.Disconnect; try //****************************Tidp3POP*********************************** idp3POP.AutoLogin := True; idp3POP.Host := HostRecepcao; // ’pop3.dominio.com.br’; idp3POP.Username := UsuarioRecepcao; //Usuário idp3POP.Port := PortaRecepcao; idp3POP.Password := SenhaUsuario; // Senha; idp3POP.ConnectTimeout := 0; //*******************TIdSSLIOHandlerSocketOpenSSL********************** //Usado para Autenticação no gmail quando a porta for diferente da padrão 110 if (PortaRecepcao <> 110) and (HostRecepcao = 'pop.gmail.com') then begin idp3POP.IOHandler := IdSSLPop; idp3POP.UseTLS := utUseImplicitTLS; IdSSLPop.Destination := HostRecepcao + ':' + IntToStr(PortaRecepcao); IdSSLPop.Host := HostRecepcao; IdSSLPop.Port := PortaRecepcao; IdSSLPop.SSLOptions.Method := sslvSSLv2; IdSSLPop.SSLOptions.Mode := sslmUnassigned; end; //********************************************************************** idp3POP.Connect; except begin MsgThread := 'Erro na conexão com o provedor de email'; end; end; end; //Aqui faço a Recepção do arquivo, primeiro um Txt que contem o endereço de FTP do arquivo procedure RecebeArquivos .AtualizaLogRecepcao(DtHrInicRecep, DtHrFinRecep: String); var RegTransm : TextFile; TxtStrings : TStrings; sSql, NomeArquivo, Linha, NM_ARQUIVO, DTHR_INICIO_TRANSM, DTHR_FIM_TRANSM, CAMINHO, IdCliCanal, Status, DtaStatus : String; begin if not DirectoryExists(RtPastaVideoOcor) then ForceDirectories(RtPastaVideoOcor); //Atualizo a Tabela com o Log de Recepção da Ocorrência NomeArquivo := RtPastaRecebeLog + '\' + NmArqRecepVideo; AssignFile(RegTransm, NomeArquivo); Reset(RegTransm); try TxtStrings := TStringList.Create; try while not Eof(RegTransm) do begin Readln(RegTransm, Linha); ExtractStrings([';'],[' '],PChar(Linha),TxtStrings); //manipula as strings extraídas, como gravar seus valores em uma tabela do banco de dados NM_ARQUIVO := TxtStrings[0]; DTHR_INICIO_TRANSM := DtHrInicRecep; DTHR_FIM_TRANSM := DtHrFinRecep; CAMINHO := RtPastaArq + '\' + NM_ARQUIVO; NomeArq := RtPastaRecebeArq + '\' + NM_ARQUIVO; EmRecepcao := True; MsgRecepcao := 'Recebendo Arquivo: ' + NM_ARQUIVO; //Baixo o arquivo via FTP, depois atualizo o log de recepção com o Txt enviado pelo canal if FTP.Connected then FTP.Disconnect; try try begin FTP.Port := StrToInt(PortaFTP); FTP.Host := HostFTP; FTP.Username := UsuarioFTP; FTP.Password := SenhaFTP; FTP.Passive := True; FTP.TransferTimeout := 0; FTP.TransferType := ftBinary; FTP.Connect; FTP.ChangeDir(PastaFDFTP); if FTP.Size(NM_ARQUIVO) = -1 then //Não encontrou o video na Pasta FTP begin if idp3POP.Connected then //Deleto o Txt que referencia o Arquivo com a Ocorrencia begin //pois o video pode ter já sido baixado idp3POP.Delete(1); idp3POP.Disconnect; end; exit; end else begin TamanhoArqFTP := FTP.Size(NM_ARQUIVO); if FileExists(NomeArq) then //Caso o arquivo já exista na pasta deleto DeleteFile(NomeArq); //sempre movo a ocorrência que foi recebida, //incluída na tabela e será usada. DtHrInicRecep := FormatDateTime('dd.mm.yyyy hh:mm:ss', dtmConexao.getTimeStampSys); FTP.Get(NM_ARQUIVO, NomeArq, True); FTP.Delete(NM_ARQUIVO); DtHrFinRecep := FormatDateTime('dd.mm.yyyy hh:mm:ss', dtmConexao.getTimeStampSys); end; end; except begin if FTP.Connected then FTP.Disconnect; MsgThread := 'Erro FTP: ' + IntToStr(FTP.LastCmdResult.NumericCode) + ' - ' + FTP.LastCmdResult.DisplayName; if FTP.LastCmdResult.NumericCode = 550 then if idp3POP.Connected then begin idp3POP.Delete(1); idp3POP.Disconnect; end; exit; end; end; finally FTP.Disconnect end; try begin //Inicio da Transação FConnRcp.StartTransaction(FTransRcp); if IdClienteCE = StrToInt(IdCliCanal) then begin if idp3POP.Connected then begin idp3POP.Delete(1); idp3POP.Disconnect; end; if NaoEncontroArquivo(StrToInt(NR_OCORRENCIA)) then begin sSql := 'INSERT INTO TBLOG_RECEPCAO_VIDEO (NM_ARQUIVO, DTHR_INICIO_TRANSM, ' + 'DTHR_FIM_TRANSM, CAMINHO) VALUES (' + QuotedStr(NM_ARQUIVO) + ', ' + QuotedStr(DtHrInicRecep) + ', ' + QuotedStr(DtHrFinRecep) + ', ' + QuotedStr(CAMINHO) + ')'; FQueryRcp1.SQL.Clear; FQueryRcp1.SQL.Text := sSql; FQueryRcp1.Prepared := True; FQueryRcp1.ExecSQL; if FileExists(CAMINHO) then DeleteFile(CAMINHO); MoveFile(PChar(NomeArq), PChar(CAMINHO)); end else begin DeleteFile(NomeArq); end; //Após a recepção if frmLstLogRecepOcorr <> nil then begin frmLstLogRecepOcorr.pnlMsgRecep.Caption := ''; frmLstLogRecepOcorr.pnlMsgRecep.Visible := False; frmLstLogRecepOcorr.pnlGauge.Visible := False; frmLstLogRecepOcorr.Gauge1.Visible := False; synchronize(frmLstLogRecepOcorr.cdsLista.Refresh); //frmLstLogRecepOcorr.cdsLista.Refresh; end; //limpa o conteúdo da TStringList criada TxtStrings.Clear; end; FConnRcp.Commit(FTransRcp); end; except FConnRcp.Rollback(FTransRcp); end; end; finally TxtStrings.Free; end; finally EmRecepcao := False; CloseFile(RegTransm); DeleteFile(NomeArq); // Deleto o Txt com as informações da Arquivo end; end; procedure RecebeArquivos .FTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); begin if frmLstLogRecep <> nil then begin frmLstLogRecep .pnlMsgRecep.Caption := MsgRecepcao; frmLstLogRecep .pnlMsgRecep.Visible := True; frmLstLogRecep .pnlGauge.Visible := True; frmLstLogRecep .Gauge1.Visible := True; frmLstLogRecep .Gauge1.MaxValue := TamanhoArqFTP; frmLstLogRecep .Gauge1.Progress := AWorkCount; frmLstLogRecep .Gauge1.Refresh; Application.ProcessMessages; end; end; procedure RecebeArquivos .FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); begin if frmLstLogRecep <> nil then begin frmLstLogRecep .pnlMsgRecep.Caption := MsgRecepcao; frmLstLogRecep .pnlMsgRecep.Visible := True; frmLstLogRecep .pnlGauge.Visible := True; frmLstLogRecepOcorr.Gauge1.Visible := True; frmLstLogRecep .Gauge1.Progress := 0; if AWorkCountMax > 0 then TamanhoArqFTP := Integer(AWorkCountMax); frmLstLogRecep .Gauge1.MaxValue := TamanhoArqFTP; end; end; procedure RecebeArquivos .FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); begin if frmLstLogRecep <> nil then begin frmLstLogRecep .Gauge1.Progress := frmLstLogRecep .Gauge1.MaxValue; frmLstLogRecep .Gauge1.Refresh; Application.ProcessMessages; end; end; function RecebeArquivos .NaoEncontrouOcorrencia( NrOcorrencia: Integer): Boolean; var sSql : String; begin Result := False; sSql := 'Select NR_OCORRENCIA ' + 'from TBLOG_RECEPCAO_VIDEO ' + 'where NR_OCORRENCIA = ' + IntToStr(NrOcorrencia); FQueryRcp2.SQL.Clear; FQueryRcp2.SQL.Text := sSql; FQueryRcp2.Prepared := True; FQueryRcp2.Open; Result := FQueryRcp2.IsEmpty; FQueryRcp2.Close; end; end. Talvez não fique muito claro, algumas partes tive que excluir, mas qualquer dúvida pode perguntar que responderei se possível. Grato, Ainda não consegui resolver alguma dica? (Resolvido) Bem galera, acho que consegui resolver, por gentileza algum moderador pode colocar o tópico como resolvido. Tomei como base o post O Identificador da Janela é Invalido - Thread Downloads, postado pelo Douglas Soares, onde sincronizei os procedimentos que atualizavam o gauge no form e não está mais dando o erro. Galera este forum é muito bom, grato a todos.

Douglas a thread é muito grande vou ver se consigo postar apenas as partes principais, ok?! unit UthdRecebeArquivos; interface uses Windows, Classes, DateUtils, SysUtils, Forms,FMTBcd, DBXpress, DB, SqlExpr,IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,IdTCPClient, SyncObjs,IdExplicitTLSClientServerBase, IdMessageClient, IdText, IdAttachmentFile, IdSSLOpenSSL, IdIOHandler, ComCtrls, ExtCtrls, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdPOP3, IdAntiFreezeBase, IdAntiFreeze, IdFTP, IdFTPCommon, ShellAPI; type RecebeArquivos = class(TThread) private { Private declarations } //Declaração de Variáveis para conexao DB FBanco : String; FTP: TIdFTP; FIdAntiFreeze : TIdAntiFreeze; FConnRcp: TSQLConnection; FTransRcp: TTransactionDesc; FQueryRcp, FQueryRcp1, FQueryRcp2: TSQLQuery; NomeVideo, HostRecepcao, UsuarioRecepcao, SenhaUsuario, NmArqRecepParam, CanalGestor, CanalCE, NmArqRecepVideo, nmAnexo, HostFTP, PortaFTP, UsuarioFTP, SenhaFTP, PastaFDFTP: String; IdClienteCE, PortaRecepcao: Integer; QuebrouCanalFD, TemParametroRecepcao: Boolean; protected procedure Execute; override; procedure ObtemParametrosRecepcao; procedure RecepcionaArquivos; procedure ProcessaParametros(QtdParamRecebido: Integer); procedure ConectaProvedor; procedure AtualizaLogRecepcao(DtHrInicRecep, DtHrFinRecep : String); procedure FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); procedure FTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); procedure FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); public constructor Create(Banco: String); destructor Destroy; override; end; implementation uses UdtmConexao, Rotinas, UfrmLstLogRecepOcorr; var idp3POP : TIdPOP3; IdSSLPop : TIdSSLIOHandlerSocketOpenSSL; MsgPop : TIdMessage; QtdParam, TamanhoParam : Integer; MsgRecepcao, MsgThread : String; IncluiuParametro : Boolean; { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure RecebeParametrosCanalFD.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; } { RecebeParametrosCanalFD } //Aqui no Construtor monto a conexao com o Banco de dados constructor RecebeArquivos .Create(Banco: String); begin inherited Create(True); // Chama o contrutor herdado. Ele irá temporariamente colocar o thread em estado de espera para depois executá-lo. } FreeOnTerminate := True; // Libera o objeto após terminar. Priority := tpNormal; // Configura sua prioridade na lista de processos do Sistema operacional. } //Crio a Conexão com o banco de Dados FBanco := Banco; FConnRcp := TSQLConnection.Create(Nil); FConnRcp.Params.Values['DriverName'] := 'Interbase'; FConnRcp.Params.Values['Database'] := FBanco; FConnRcp.Params.Values['RoleName'] := 'RoleName'; FConnRcp.Params.Values['User_Name'] := 'sysdba'; FConnRcp.Params.Values['Password'] := 'masterkey'; FConnRcp.Params.Values['SQLDialect'] := '3'; FConnRcp.Params.Values['BlobSize'] := '-1'; FConnRcp.Params.Values['CommitRetain'] := 'False'; FConnRcp.Params.Values['WaitOnLocks'] := 'True'; FConnRcp.Params.Values['LocaleCode'] := '0000'; FConnRcp.Params.Values['Interbase TransIsolation'] := 'ReadCommited'; FConnRcp.Params.Values['Trim Char'] := 'False'; FConnRcp.ConnectionName := 'RecepCanal'; FConnRcp.DriverName := 'Interbase'; FConnRcp.GetDriverFunc := 'getSQLDriverINTERBASE'; FConnRcp.LibraryName := 'dbexpint.dll'; FConnRcp.VendorLib := 'gds32.dll'; FConnRcp.LoadParamsOnConnect := False; FConnRcp.LoginPrompt := False; FConnRcp.Connected := True; FConnRcp.KeepConnection := True; FTransRcp.TransactionID := 1; FQueryRcp := TSQLQuery.Create(Nil); FQueryRcp.SQLConnection := FConnRcp; FQueryRcp1 := TSQLQuery.Create(Nil); FQueryRcp1.SQLConnection := FConnRcp; FQueryRcp2 := TSQLQuery.Create(Nil); FQueryRcp2.SQLConnection := FConnRcp; idp3POP := TIdPOP3.Create(Nil); IdSSLPop := TIdSSLIOHandlerSocketOpenSSL.Create(Nil); MsgPop := TIdMessage.Create(Nil); if FTP = nil then begin //AntiFreeze FIdAntiFreeze := TIdAntiFreeze.Create(Nil); FIdAntiFreeze.Active := True; FIdAntiFreeze.ApplicationHasPriority := True; FIdAntiFreeze.IdleTimeOut := 250; FIdAntiFreeze.OnlyWhenIdle := True; //Configuração iniciais do FTP FTP := TIdFTP.Create(nil); FTP.AUTHCmd := tAuto; FTP.AutoLogin := True; FTP.Passive := False; FTP.ProxySettings.ProxyType := fpcmNone; FTP.TransferType := ftBinary; FTP.UseTLS := utNoTLSSupport; FTP.OnWork := FTPWork; FTP.OnWorkBegin := FTPWorkBegin; FTP.OnWorkEnd := FTPWorkEnd; end; Resume; // Inicia o Thread. end; //Aqui libero a conexão e os componentes indy que criei na Thread destructor RecebeArquivos .Destroy; begin inherited; FConnRcp.Free; FQueryRcp.Free; FQueryRcp1.Free; FQueryRcp2.Free; idp3POP.Free; IdSSLPop.Free; MsgPop.Free; FIdAntiFreeze.Free; FTP.Free; Terminate; end; procedure RecebeArquivos .Execute; begin { Place thread code here } TemParametroRecepcao := False; synchronize(ObtemParametrosRecepcao); if TemParametroRecepcao then RecepcionaArquivos; end; //Rotina Responsável pela reconecção ao provedor após a recepção procedure RecebeArquivos .ConectaProvedor; begin if idp3POP.Connected then idp3POP.Disconnect; try //****************************Tidp3POP*********************************** idp3POP.AutoLogin := True; idp3POP.Host := HostRecepcao; // ’pop3.dominio.com.br’; idp3POP.Username := UsuarioRecepcao; //Usuário idp3POP.Port := PortaRecepcao; idp3POP.Password := SenhaUsuario; // Senha; idp3POP.ConnectTimeout := 0; //*******************TIdSSLIOHandlerSocketOpenSSL********************** //Usado para Autenticação no gmail quando a porta for diferente da padrão 110 if (PortaRecepcao <> 110) and (HostRecepcao = 'pop.gmail.com') then begin idp3POP.IOHandler := IdSSLPop; idp3POP.UseTLS := utUseImplicitTLS; IdSSLPop.Destination := HostRecepcao + ':' + IntToStr(PortaRecepcao); IdSSLPop.Host := HostRecepcao; IdSSLPop.Port := PortaRecepcao; IdSSLPop.SSLOptions.Method := sslvSSLv2; IdSSLPop.SSLOptions.Mode := sslmUnassigned; end; //********************************************************************** idp3POP.Connect; except begin MsgThread := 'Erro na conexão com o provedor de email'; end; end; end; //Aqui faço a Recepção do arquivo, primeiro um Txt que contem o endereço de FTP do arquivo procedure RecebeArquivos .AtualizaLogRecepcao(DtHrInicRecep, DtHrFinRecep: String); var RegTransm : TextFile; TxtStrings : TStrings; sSql, NomeArquivo, Linha, NM_ARQUIVO, DTHR_INICIO_TRANSM, DTHR_FIM_TRANSM, CAMINHO, IdCliCanal, Status, DtaStatus : String; begin if not DirectoryExists(RtPastaVideoOcor) then ForceDirectories(RtPastaVideoOcor); //Atualizo a Tabela com o Log de Recepção da Ocorrência NomeArquivo := RtPastaRecebeLog + '\' + NmArqRecepVideo; AssignFile(RegTransm, NomeArquivo); Reset(RegTransm); try TxtStrings := TStringList.Create; try while not Eof(RegTransm) do begin Readln(RegTransm, Linha); ExtractStrings([';'],[' '],PChar(Linha),TxtStrings); //manipula as strings extraídas, como gravar seus valores em uma tabela do banco de dados NM_ARQUIVO := TxtStrings[0]; DTHR_INICIO_TRANSM := DtHrInicRecep; DTHR_FIM_TRANSM := DtHrFinRecep; CAMINHO := RtPastaArq + '\' + NM_ARQUIVO; NomeArq := RtPastaRecebeArq + '\' + NM_ARQUIVO; EmRecepcao := True; MsgRecepcao := 'Recebendo Arquivo: ' + NM_ARQUIVO; //Baixo o arquivo via FTP, depois atualizo o log de recepção com o Txt enviado pelo canal if FTP.Connected then FTP.Disconnect; try try begin FTP.Port := StrToInt(PortaFTP); FTP.Host := HostFTP; FTP.Username := UsuarioFTP; FTP.Password := SenhaFTP; FTP.Passive := True; FTP.TransferTimeout := 0; FTP.TransferType := ftBinary; FTP.Connect; FTP.ChangeDir(PastaFDFTP); if FTP.Size(NM_ARQUIVO) = -1 then //Não encontrou o video na Pasta FTP begin if idp3POP.Connected then //Deleto o Txt que referencia o Arquivo com a Ocorrencia begin //pois o video pode ter já sido baixado idp3POP.Delete(1); idp3POP.Disconnect; end; exit; end else begin TamanhoArqFTP := FTP.Size(NM_ARQUIVO); if FileExists(NomeArq) then //Caso o arquivo já exista na pasta deleto DeleteFile(NomeArq); //sempre movo a ocorrência que foi recebida, //incluída na tabela e será usada. DtHrInicRecep := FormatDateTime('dd.mm.yyyy hh:mm:ss', dtmConexao.getTimeStampSys); FTP.Get(NM_ARQUIVO, NomeArq, True); FTP.Delete(NM_ARQUIVO); DtHrFinRecep := FormatDateTime('dd.mm.yyyy hh:mm:ss', dtmConexao.getTimeStampSys); end; end; except begin if FTP.Connected then FTP.Disconnect; MsgThread := 'Erro FTP: ' + IntToStr(FTP.LastCmdResult.NumericCode) + ' - ' + FTP.LastCmdResult.DisplayName; if FTP.LastCmdResult.NumericCode = 550 then if idp3POP.Connected then begin idp3POP.Delete(1); idp3POP.Disconnect; end; exit; end; end; finally FTP.Disconnect end; try begin //Inicio da Transação FConnRcp.StartTransaction(FTransRcp); if IdClienteCE = StrToInt(IdCliCanal) then begin if idp3POP.Connected then begin idp3POP.Delete(1); idp3POP.Disconnect; end; if NaoEncontroArquivo(StrToInt(NR_OCORRENCIA)) then begin sSql := 'INSERT INTO TBLOG_RECEPCAO_VIDEO (NM_ARQUIVO, DTHR_INICIO_TRANSM, ' + 'DTHR_FIM_TRANSM, CAMINHO) VALUES (' + QuotedStr(NM_ARQUIVO) + ', ' + QuotedStr(DtHrInicRecep) + ', ' + QuotedStr(DtHrFinRecep) + ', ' + QuotedStr(CAMINHO) + ')'; FQueryRcp1.SQL.Clear; FQueryRcp1.SQL.Text := sSql; FQueryRcp1.Prepared := True; FQueryRcp1.ExecSQL; if FileExists(CAMINHO) then DeleteFile(CAMINHO); MoveFile(PChar(NomeArq), PChar(CAMINHO)); end else begin DeleteFile(NomeArq); end; //Após a recepção if frmLstLogRecepOcorr <> nil then begin frmLstLogRecepOcorr.pnlMsgRecep.Caption := ''; frmLstLogRecepOcorr.pnlMsgRecep.Visible := False; frmLstLogRecepOcorr.pnlGauge.Visible := False; frmLstLogRecepOcorr.Gauge1.Visible := False; synchronize(frmLstLogRecepOcorr.cdsLista.Refresh); //frmLstLogRecepOcorr.cdsLista.Refresh; end; //limpa o conteúdo da TStringList criada TxtStrings.Clear; end; FConnRcp.Commit(FTransRcp); end; except FConnRcp.Rollback(FTransRcp); end; end; finally TxtStrings.Free; end; finally EmRecepcao := False; CloseFile(RegTransm); DeleteFile(NomeArq); // Deleto o Txt com as informações da Arquivo end; end; procedure RecebeArquivos .FTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); begin if frmLstLogRecep <> nil then begin frmLstLogRecep .pnlMsgRecep.Caption := MsgRecepcao; frmLstLogRecep .pnlMsgRecep.Visible := True; frmLstLogRecep .pnlGauge.Visible := True; frmLstLogRecep .Gauge1.Visible := True; frmLstLogRecep .Gauge1.MaxValue := TamanhoArqFTP; frmLstLogRecep .Gauge1.Progress := AWorkCount; frmLstLogRecep .Gauge1.Refresh; Application.ProcessMessages; end; end; procedure RecebeArquivos .FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); begin if frmLstLogRecep <> nil then begin frmLstLogRecep .pnlMsgRecep.Caption := MsgRecepcao; frmLstLogRecep .pnlMsgRecep.Visible := True; frmLstLogRecep .pnlGauge.Visible := True; frmLstLogRecepOcorr.Gauge1.Visible := True; frmLstLogRecep .Gauge1.Progress := 0; if AWorkCountMax > 0 then TamanhoArqFTP := Integer(AWorkCountMax); frmLstLogRecep .Gauge1.MaxValue := TamanhoArqFTP; end; end; procedure RecebeArquivos .FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); begin if frmLstLogRecep <> nil then begin frmLstLogRecep .Gauge1.Progress := frmLstLogRecep .Gauge1.MaxValue; frmLstLogRecep .Gauge1.Refresh; Application.ProcessMessages; end; end; function RecebeArquivos .NaoEncontrouOcorrencia( NrOcorrencia: Integer): Boolean; var sSql : String; begin Result := False; sSql := 'Select NR_OCORRENCIA ' + 'from TBLOG_RECEPCAO_VIDEO ' + 'where NR_OCORRENCIA = ' + IntToStr(NrOcorrencia); FQueryRcp2.SQL.Clear; FQueryRcp2.SQL.Text := sSql; FQueryRcp2.Prepared := True; FQueryRcp2.Open; Result := FQueryRcp2.IsEmpty; FQueryRcp2.Close; end; end. Talvez não fique muito claro, algumas partes tive que excluir, mas qualquer dúvida pode perguntar que responderei se possível. Grato, Ainda não consegui resolver alguma dica?

Douglas a thread é muito grande vou ver se consigo postar apenas as partes principais, ok?! unit UthdRecebeArquivos; interface uses Windows, Classes, DateUtils, SysUtils, Forms,FMTBcd, DBXpress, DB, SqlExpr,IdMessage, IdBaseComponent, IdComponent, IdTCPConnection,IdTCPClient, SyncObjs,IdExplicitTLSClientServerBase, IdMessageClient, IdText, IdAttachmentFile, IdSSLOpenSSL, IdIOHandler, ComCtrls, ExtCtrls, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdPOP3, IdAntiFreezeBase, IdAntiFreeze, IdFTP, IdFTPCommon, ShellAPI; type RecebeArquivos = class(TThread) private { Private declarations } //Declaração de Variáveis para conexao DB FBanco : String; FTP: TIdFTP; FIdAntiFreeze : TIdAntiFreeze; FConnRcp: TSQLConnection; FTransRcp: TTransactionDesc; FQueryRcp, FQueryRcp1, FQueryRcp2: TSQLQuery; NomeVideo, HostRecepcao, UsuarioRecepcao, SenhaUsuario, NmArqRecepParam, CanalGestor, CanalCE, NmArqRecepVideo, nmAnexo, HostFTP, PortaFTP, UsuarioFTP, SenhaFTP, PastaFDFTP: String; IdClienteCE, PortaRecepcao: Integer; QuebrouCanalFD, TemParametroRecepcao: Boolean; protected procedure Execute; override; procedure ObtemParametrosRecepcao; procedure RecepcionaArquivos; procedure ProcessaParametros(QtdParamRecebido: Integer); procedure ConectaProvedor; procedure AtualizaLogRecepcao(DtHrInicRecep, DtHrFinRecep : String); procedure FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); procedure FTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); procedure FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); public constructor Create(Banco: String); destructor Destroy; override; end; implementation uses UdtmConexao, Rotinas, UfrmLstLogRecepOcorr; var idp3POP : TIdPOP3; IdSSLPop : TIdSSLIOHandlerSocketOpenSSL; MsgPop : TIdMessage; QtdParam, TamanhoParam : Integer; MsgRecepcao, MsgThread : String; IncluiuParametro : Boolean; { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure RecebeParametrosCanalFD.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; } { RecebeParametrosCanalFD } //Aqui no Construtor monto a conexao com o Banco de dados constructor RecebeArquivos .Create(Banco: String); begin inherited Create(True); // Chama o contrutor herdado. Ele irá temporariamente colocar o thread em estado de espera para depois executá-lo. } FreeOnTerminate := True; // Libera o objeto após terminar. Priority := tpNormal; // Configura sua prioridade na lista de processos do Sistema operacional. } //Crio a Conexão com o banco de Dados FBanco := Banco; FConnRcp := TSQLConnection.Create(Nil); FConnRcp.Params.Values['DriverName'] := 'Interbase'; FConnRcp.Params.Values['Database'] := FBanco; FConnRcp.Params.Values['RoleName'] := 'RoleName'; FConnRcp.Params.Values['User_Name'] := 'sysdba'; FConnRcp.Params.Values['Password'] := 'masterkey'; FConnRcp.Params.Values['SQLDialect'] := '3'; FConnRcp.Params.Values['BlobSize'] := '-1'; FConnRcp.Params.Values['CommitRetain'] := 'False'; FConnRcp.Params.Values['WaitOnLocks'] := 'True'; FConnRcp.Params.Values['LocaleCode'] := '0000'; FConnRcp.Params.Values['Interbase TransIsolation'] := 'ReadCommited'; FConnRcp.Params.Values['Trim Char'] := 'False'; FConnRcp.ConnectionName := 'RecepCanal'; FConnRcp.DriverName := 'Interbase'; FConnRcp.GetDriverFunc := 'getSQLDriverINTERBASE'; FConnRcp.LibraryName := 'dbexpint.dll'; FConnRcp.VendorLib := 'gds32.dll'; FConnRcp.LoadParamsOnConnect := False; FConnRcp.LoginPrompt := False; FConnRcp.Connected := True; FConnRcp.KeepConnection := True; FTransRcp.TransactionID := 1; FQueryRcp := TSQLQuery.Create(Nil); FQueryRcp.SQLConnection := FConnRcp; FQueryRcp1 := TSQLQuery.Create(Nil); FQueryRcp1.SQLConnection := FConnRcp; FQueryRcp2 := TSQLQuery.Create(Nil); FQueryRcp2.SQLConnection := FConnRcp; idp3POP := TIdPOP3.Create(Nil); IdSSLPop := TIdSSLIOHandlerSocketOpenSSL.Create(Nil); MsgPop := TIdMessage.Create(Nil); if FTP = nil then begin //AntiFreeze FIdAntiFreeze := TIdAntiFreeze.Create(Nil); FIdAntiFreeze.Active := True; FIdAntiFreeze.ApplicationHasPriority := True; FIdAntiFreeze.IdleTimeOut := 250; FIdAntiFreeze.OnlyWhenIdle := True; //Configuração iniciais do FTP FTP := TIdFTP.Create(nil); FTP.AUTHCmd := tAuto; FTP.AutoLogin := True; FTP.Passive := False; FTP.ProxySettings.ProxyType := fpcmNone; FTP.TransferType := ftBinary; FTP.UseTLS := utNoTLSSupport; FTP.OnWork := FTPWork; FTP.OnWorkBegin := FTPWorkBegin; FTP.OnWorkEnd := FTPWorkEnd; end; Resume; // Inicia o Thread. end; //Aqui libero a conexão e os componentes indy que criei na Thread destructor RecebeArquivos .Destroy; begin inherited; FConnRcp.Free; FQueryRcp.Free; FQueryRcp1.Free; FQueryRcp2.Free; idp3POP.Free; IdSSLPop.Free; MsgPop.Free; FIdAntiFreeze.Free; FTP.Free; Terminate; end; procedure RecebeArquivos .Execute; begin { Place thread code here } TemParametroRecepcao := False; synchronize(ObtemParametrosRecepcao); if TemParametroRecepcao then RecepcionaArquivos; end; //Rotina Responsável pela reconecção ao provedor após a recepção procedure RecebeArquivos .ConectaProvedor; begin if idp3POP.Connected then idp3POP.Disconnect; try //****************************Tidp3POP*********************************** idp3POP.AutoLogin := True; idp3POP.Host := HostRecepcao; // ’pop3.dominio.com.br’; idp3POP.Username := UsuarioRecepcao; //Usuário idp3POP.Port := PortaRecepcao; idp3POP.Password := SenhaUsuario; // Senha; idp3POP.ConnectTimeout := 0; //*******************TIdSSLIOHandlerSocketOpenSSL********************** //Usado para Autenticação no gmail quando a porta for diferente da padrão 110 if (PortaRecepcao <> 110) and (HostRecepcao = 'pop.gmail.com') then begin idp3POP.IOHandler := IdSSLPop; idp3POP.UseTLS := utUseImplicitTLS; IdSSLPop.Destination := HostRecepcao + ':' + IntToStr(PortaRecepcao); IdSSLPop.Host := HostRecepcao; IdSSLPop.Port := PortaRecepcao; IdSSLPop.SSLOptions.Method := sslvSSLv2; IdSSLPop.SSLOptions.Mode := sslmUnassigned; end; //********************************************************************** idp3POP.Connect; except begin MsgThread := 'Erro na conexão com o provedor de email'; end; end; end; //Aqui faço a Recepção do arquivo, primeiro um Txt que contem o endereço de FTP do arquivo procedure RecebeArquivos .AtualizaLogRecepcao(DtHrInicRecep, DtHrFinRecep: String); var RegTransm : TextFile; TxtStrings : TStrings; sSql, NomeArquivo, Linha, NM_ARQUIVO, DTHR_INICIO_TRANSM, DTHR_FIM_TRANSM, CAMINHO, IdCliCanal, Status, DtaStatus : String; begin if not DirectoryExists(RtPastaVideoOcor) then ForceDirectories(RtPastaVideoOcor); //Atualizo a Tabela com o Log de Recepção da Ocorrência NomeArquivo := RtPastaRecebeLog + '\' + NmArqRecepVideo; AssignFile(RegTransm, NomeArquivo); Reset(RegTransm); try TxtStrings := TStringList.Create; try while not Eof(RegTransm) do begin Readln(RegTransm, Linha); ExtractStrings([';'],[' '],PChar(Linha),TxtStrings); //manipula as strings extraídas, como gravar seus valores em uma tabela do banco de dados NM_ARQUIVO := TxtStrings[0]; DTHR_INICIO_TRANSM := DtHrInicRecep; DTHR_FIM_TRANSM := DtHrFinRecep; CAMINHO := RtPastaArq + '\' + NM_ARQUIVO; NomeArq := RtPastaRecebeArq + '\' + NM_ARQUIVO; EmRecepcao := True; MsgRecepcao := 'Recebendo Arquivo: ' + NM_ARQUIVO; //Baixo o arquivo via FTP, depois atualizo o log de recepção com o Txt enviado pelo canal if FTP.Connected then FTP.Disconnect; try try begin FTP.Port := StrToInt(PortaFTP); FTP.Host := HostFTP; FTP.Username := UsuarioFTP; FTP.Password := SenhaFTP; FTP.Passive := True; FTP.TransferTimeout := 0; FTP.TransferType := ftBinary; FTP.Connect; FTP.ChangeDir(PastaFDFTP); if FTP.Size(NM_ARQUIVO) = -1 then //Não encontrou o video na Pasta FTP begin if idp3POP.Connected then //Deleto o Txt que referencia o Arquivo com a Ocorrencia begin //pois o video pode ter já sido baixado idp3POP.Delete(1); idp3POP.Disconnect; end; exit; end else begin TamanhoArqFTP := FTP.Size(NM_ARQUIVO); if FileExists(NomeArq) then //Caso o arquivo já exista na pasta deleto DeleteFile(NomeArq); //sempre movo a ocorrência que foi recebida, //incluída na tabela e será usada. DtHrInicRecep := FormatDateTime('dd.mm.yyyy hh:mm:ss', dtmConexao.getTimeStampSys); FTP.Get(NM_ARQUIVO, NomeArq, True); FTP.Delete(NM_ARQUIVO); DtHrFinRecep := FormatDateTime('dd.mm.yyyy hh:mm:ss', dtmConexao.getTimeStampSys); end; end; except begin if FTP.Connected then FTP.Disconnect; MsgThread := 'Erro FTP: ' + IntToStr(FTP.LastCmdResult.NumericCode) + ' - ' + FTP.LastCmdResult.DisplayName; if FTP.LastCmdResult.NumericCode = 550 then if idp3POP.Connected then begin idp3POP.Delete(1); idp3POP.Disconnect; end; exit; end; end; finally FTP.Disconnect end; try begin //Inicio da Transação FConnRcp.StartTransaction(FTransRcp); if IdClienteCE = StrToInt(IdCliCanal) then begin if idp3POP.Connected then begin idp3POP.Delete(1); idp3POP.Disconnect; end; if NaoEncontroArquivo(StrToInt(NR_OCORRENCIA)) then begin sSql := 'INSERT INTO TBLOG_RECEPCAO_VIDEO (NM_ARQUIVO, DTHR_INICIO_TRANSM, ' + 'DTHR_FIM_TRANSM, CAMINHO) VALUES (' + QuotedStr(NM_ARQUIVO) + ', ' + QuotedStr(DtHrInicRecep) + ', ' + QuotedStr(DtHrFinRecep) + ', ' + QuotedStr(CAMINHO) + ')'; FQueryRcp1.SQL.Clear; FQueryRcp1.SQL.Text := sSql; FQueryRcp1.Prepared := True; FQueryRcp1.ExecSQL; if FileExists(CAMINHO) then DeleteFile(CAMINHO); MoveFile(PChar(NomeArq), PChar(CAMINHO)); end else begin DeleteFile(NomeArq); end; //Após a recepção if frmLstLogRecepOcorr <> nil then begin frmLstLogRecepOcorr.pnlMsgRecep.Caption := ''; frmLstLogRecepOcorr.pnlMsgRecep.Visible := False; frmLstLogRecepOcorr.pnlGauge.Visible := False; frmLstLogRecepOcorr.Gauge1.Visible := False; synchronize(frmLstLogRecepOcorr.cdsLista.Refresh); //frmLstLogRecepOcorr.cdsLista.Refresh; end; //limpa o conteúdo da TStringList criada TxtStrings.Clear; end; FConnRcp.Commit(FTransRcp); end; except FConnRcp.Rollback(FTransRcp); end; end; finally TxtStrings.Free; end; finally EmRecepcao := False; CloseFile(RegTransm); DeleteFile(NomeArq); // Deleto o Txt com as informações da Arquivo end; end; procedure RecebeArquivos .FTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); begin if frmLstLogRecep <> nil then begin frmLstLogRecep .pnlMsgRecep.Caption := MsgRecepcao; frmLstLogRecep .pnlMsgRecep.Visible := True; frmLstLogRecep .pnlGauge.Visible := True; frmLstLogRecep .Gauge1.Visible := True; frmLstLogRecep .Gauge1.MaxValue := TamanhoArqFTP; frmLstLogRecep .Gauge1.Progress := AWorkCount; frmLstLogRecep .Gauge1.Refresh; Application.ProcessMessages; end; end; procedure RecebeArquivos .FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); begin if frmLstLogRecep <> nil then begin frmLstLogRecep .pnlMsgRecep.Caption := MsgRecepcao; frmLstLogRecep .pnlMsgRecep.Visible := True; frmLstLogRecep .pnlGauge.Visible := True; frmLstLogRecepOcorr.Gauge1.Visible := True; frmLstLogRecep .Gauge1.Progress := 0; if AWorkCountMax > 0 then TamanhoArqFTP := Integer(AWorkCountMax); frmLstLogRecep .Gauge1.MaxValue := TamanhoArqFTP; end; end; procedure RecebeArquivos .FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); begin if frmLstLogRecep <> nil then begin frmLstLogRecep .Gauge1.Progress := frmLstLogRecep .Gauge1.MaxValue; frmLstLogRecep .Gauge1.Refresh; Application.ProcessMessages; end; end; function RecebeArquivos .NaoEncontrouOcorrencia( NrOcorrencia: Integer): Boolean; var sSql : String; begin Result := False; sSql := 'Select NR_OCORRENCIA ' + 'from TBLOG_RECEPCAO_VIDEO ' + 'where NR_OCORRENCIA = ' + IntToStr(NrOcorrencia); FQueryRcp2.SQL.Clear; FQueryRcp2.SQL.Text := sSql; FQueryRcp2.Prepared := True; FQueryRcp2.Open; Result := FQueryRcp2.IsEmpty; FQueryRcp2.Close; end; end. Talvez não fique muito claro, algumas partes tive que excluir, mas qualquer dúvida pode perguntar que responderei se possível. Grato,

Vou experimentar isso. Não funcionou, coloquei o Terminate no evento Destroy da Thread, mas continuou dando o mesmo erro. destructor RecebeArquivos.Destroy; begin inherited; FConnRcp.Free; FQueryRcp.Free; FQueryRcp1.Free; FQueryRcp2.Free; idp3POP.Free; IdSSLPop.Free; MsgPop.Free; FIdAntiFreeze.Free; FTP.Free; Terminate; end; Caso alguém tenha mais alguma dica, ainda estou precisando resolver este problema. Grato,

Vou experimentar isso.

Olá Sr(a)s, bom dia, Numa aplicação que estou desenvolvendo está acontecendo um erro, que apesar de estar pesquisando muito, ainda não consegui resolver, vou tentar resumir: Na minha aplicação tem um form com uma lista de arquivos que foram recebidos via FTP, sendo que a recepção desses arquivos é feita por uma thread independente. Esta thread identifica que existem arquivos a serem baixados e se encarrega de efetuar o download do arquivo. No momento que está sendo efetuado o downlado a thread incrementa um gauge no form, que contem a lista dos arquivos que foram recebidos, indicando o percentual do download. Não permito fechar esta tela com a lista, enquanto está ocorrendo o download. Bem até ae tudo bem, o download é feito, a tabela é atualizada, tudo corre como eu quero, mas após o download, quando permito o fechamento desta tela de consulta, quando tento fecha-la acontece esse erro 1400 Identificador de Janela Inválido. Seguem os códigos que coloquei nos eventos OnCloseQuery e OnDestroy procedure TfrmLstLogRecepArq .FormDestroy(Sender: TObject); begin inherited; frmLstLogRecepArq .Release; frmLstLogRecepArq := nil; end; procedure TfrmLstLogRecepArq .FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin inherited; if EmRecepcao then begin MyMessageDlg('Ainda estão sendo executados procedimentos de recepção de arquivos.' + #13 + 'Aguarde o término da recepção para poder fechar este formulário.' , mtWarning, [mbOk], 0); CanClose := False; end else CanClose := True; end; Fiz um debug e vi que esses dois eventos são executados normalmente, mas num determinado momento acontece o erro. Também percebi que após o erro quando tento fechar a aplicação, oevento frmLstLogRecepOcorr.FormDestroy, volta a ser chamado, parece que o form frmLstLogRecepArq não foi fechado realmente. Amigos se alguém tiver alguma pista ou alguma solução que eu possa adotar, ficarei agradecido pelo auxilio. Desde já agradeço a todos.

Vou dar uma olhada. Grato, Olá Jhonas, bom dia, Dei uma olhada no exemplo que você me mandou, mas infelizmente ainda não é a solução que preciso, pois o o FTP(OnWorkBegin, OnWork e OnWorkEnd) e o Gauge estão no mesmo form e por se tratar de um único form o usuário não o fecha, no meu caso é um fom de consulta, o FTP e os eventos OnWorkBegin, OnWork e OnWorkEnd ficam numa thread, justamente para que a aplicação fique liberada para outras ações. Pois bem, quando quando o FTP inicia começo a incrementar o gauge, a tela onde o gauge está até fica liberada, mas se eu a fechar, congela toda a aplicação, esse é o problema que tenho que resolver. Se eu faço o FTP sem o gauge, a aplicação funciona normalmente, podendo abrir e fechar essa tela de consulta que contem a relação de arquivos baixados. De qualquer forma agradeço o seu auxílio, Um abraço, Bem pessoal, como não consegui nenhuma solução que atendesse ao que eu estava querendo acabei adotando uma "solução alternativa". O FTP está funcionando bem a aplicação estava congelando quando o GET FTP (download) era iniciado e o gauge na tela de consulta mostrava o percentual do arquivo que já estava baixado. Se esta tela era fechada toda a aplicação congelava, então como solução alternativa não permito mais que a tela de consulta seja fechada, enquanto o arquivo estiver sendo baixado. A tela pode ser minimizada, não fechada, dessa maneira a thread que faz o download e incremento do gauge trabalha normalmente sem congelar a aplicação. Essa foi a "solução alternativa" encontrada, pelo menos até que encontre uma solução melhor e mais elegante. Amigos agradeço a todos pelo auxílio prestado, ok?! Um abraço e tenham um novo ano repleto de boas realizações e sucesso. Vou dar uma olhada. Grato, Olá Jhonas, bom dia, Dei uma olhada no exemplo que você me mandou, mas infelizmente ainda não é a solução que preciso, pois o o FTP(OnWorkBegin, OnWork e OnWorkEnd) e o Gauge estão no mesmo form e por se tratar de um único form o usuário não o fecha, no meu caso é um fom de consulta, o FTP e os eventos OnWorkBegin, OnWork e OnWorkEnd ficam numa thread, justamente para que a aplicação fique liberada para outras ações. Pois bem, quando quando o FTP inicia começo a incrementar o gauge, a tela onde o gauge está até fica liberada, mas se eu a fechar, congela toda a aplicação, esse é o problema que tenho que resolver. Se eu faço o FTP sem o gauge, a aplicação funciona normalmente, podendo abrir e fechar essa tela de consulta que contem a relação de arquivos baixados. De qualquer forma agradeço o seu auxílio, Um abraço, (resolvido) Bem pessoal, como não consegui nenhuma solução que atendesse ao que eu estava querendo acabei adotando uma "solução alternativa". O FTP está funcionando bem a aplicação estava congelando quando o GET FTP (download) era iniciado e o gauge na tela de consulta mostrava o percentual do arquivo que já estava baixado. Se esta tela era fechada toda a aplicação congelava, então como solução alternativa não permito mais que a tela de consulta seja fechada, enquanto o arquivo estiver sendo baixado. A tela pode ser minimizada, não fechada, dessa maneira a thread que faz o download e incremento do gauge trabalha normalmente sem congelar a aplicação. Essa foi a "solução alternativa" encontrada, pelo menos até que encontre uma solução melhor e mais elegante. Amigos agradeço a todos pelo auxílio prestado, ok?! Um abraço e tenham um novo ano repleto de boas realizações e sucesso.

Vou dar uma olhada. Grato, Olá Jhonas, bom dia, Dei uma olhada no exemplo que você me mandou, mas infelizmente ainda não é a solução que preciso, pois o o FTP(OnWorkBegin, OnWork e OnWorkEnd) e o Gauge estão no mesmo form e por se tratar de um único form o usuário não o fecha, no meu caso é um fom de consulta, o FTP e os eventos OnWorkBegin, OnWork e OnWorkEnd ficam numa thread, justamente para que a aplicação fique liberada para outras ações. Pois bem, quando quando o FTP inicia começo a incrementar o gauge, a tela onde o gauge está até fica liberada, mas se eu a fechar, congela toda a aplicação, esse é o problema que tenho que resolver. Se eu faço o FTP sem o gauge, a aplicação funciona normalmente, podendo abrir e fechar essa tela de consulta que contem a relação de arquivos baixados. De qualquer forma agradeço o seu auxílio, Um abraço,

Vou dar uma olhada. Grato,

Sim... se o teste funcionar, voce pode implementar o resultado na thread. fechar ou minimizar ... se fechar o processamento é interrompido ... se minimizar não abraço Olá Jhonas, Então amigo, acho que a grande questão mesmo é a atualização do gauge, já que o FTP com a thread funciona corretamente sem o gauge, quando colodo o gauge para funcionar é que trava a aplicação, não a tela que tem o gauge a aplicação quando fecho essa tela. Por ser uma tela de consulta não posso impedir que o usuário a feche, pois pode até acontecer que ele não a abra. O download dos arquivos acontecem de forma transparente para o usuário, quando ele entra na aplicação, independente dele consultar os arquivos que já foram baixados, a aplicação identifica que existem arquivos para download e começa a baixar, quero apenas poder mostrar para o usuário que no momento existe um arquivo sendo baixado, por isso não posso colocar o FTP neste form, por isso coloquei os procedimentos de FTP dentro dessa thread. Isso de colocar um gauge para que o usuário veja que está sendo baixado um determinado arquivo é um plus, que está me dando um bocado de trabalho e um monte de horas de pesquisa, sem contar nas horas de aluguel de amigos de boa vontade, que estão se dispondo a auxiliar, do jeito que você está fazendo. Vou tentar mais um pouco, mas se não conseguir vai sem gauge mesmo, que coisa mais complicada. Seu auxílio esta valendo amigo, grato.

Pelo que entendi, você está dizendo para colocar o FTP direto no form, não deixar dentro da thread que hj é responsável por isso e usar o componente visual do indy 10? Basicamente o que minha thread faz é isso, mas vou experimentar. Agora tenho uma pergunta o form onde listo os arquivos que já foram baixados, não os que ainda restam a baixar pois o usuário não tem nenhuma ação em relação a isso, pois os arquivos são baixados automáticamente sem intervenção do usuário. Esta tela serve apenas como consulta, para que ele veja quais arquivos já estão no disco e saber que existe algum download em andamento. Se eu fechar esta tela de consulta, não vai interromper o download em andamento? Se a resposta for sim, foi pensando nisso que coloquei o FTP numa thread, separada. De qualquer forma agradeço pelo auxílio vou experimentar a solução proposta para ver se tenho um bom resultado. PS. Pude verificar uma coisa interessante a tela onde o gauge é atualizado, propriamente não congela, a aplicação toda congela quando fecho essa tela com o gauge, isso é que é estranho. Na realidade o que eu quero é poder fechar essa tela e quando abrir novamento o gauge continua atualizado com o percentual atual. Consigo fazer isso com o Put sem problema já com o get, vixi, está parecendo até um parto.

Amigo grato pela sua atenção. Fiz os seguintes testes: retirei o synchronize deixando apenas o refresh do gauge frmLstLogRecepArq .Gauge1.Refresh; Inibi também o refresh //frmLstLogRecepArq .Gauge1.Refresh; mesmo assim a aplicação continua congelando. Alguma dica em relação ao que possa estar acontecendo? Grato, E ae galera, alguém tem alguma dica, ainda não consegui resolver esse problema. Help!!!!

Amigo grato pela sua atenção. Fiz os seguintes testes: retirei o synchronize deixando apenas o refresh do gauge frmLstLogRecepArq .Gauge1.Refresh; Inibi também o refresh //frmLstLogRecepArq .Gauge1.Refresh; mesmo assim a aplicação continua congelando. Alguma dica em relação ao que possa estar acontecendo? Grato,

Olá amigos, bom dia, espero e desejo que todos tenham tido um ótimo natal junto com seus familiares. Bem pouco tempo atrás postei um tópico com o título Colocar o "Gauge na Linha Selecionada de um DBGrid", com o auxílio dos senhores consegui resolver a contento. Segui o mesmo raciocínio para fazer o get FTP com gauge para acompanhar o percentual de downloado do arquivo, sendo que a diferença é que o gauge coloquei fora do dbgrid. O download é feito por uma thread, uso o componente indy 10, a atualização do gauge no evento FTPOnWork. Acontece que quando mando atualizar(incrementar) o Gauge a aplicação congela, mesmo colocando Application.ProcessMessages, neste caso o form não congela mas o restante de aplicação sim. Quando faço o GetFTP sem atualização do gauge, toda aplicação fica liberada. Segue os códigos dos eventos: procedure RecebeArquivo.FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); begin if frmLstLogRecepArq <> nil then // <-- frmLstLogRecepArq é o form onde mostro o gauge com o percentual da recepção begin frmLstLogRecepArq .pnlMsgRecep.Caption := MsgRecepcao; frmLstLogRecepArq .pnlMsgRecep.Visible := True; frmLstLogRecepArq .pnlGauge.Visible := True; frmLstLogRecepArq .Gauge1.Visible := True; frmLstLogRecepArq .Gauge1.Progress := 0; if AWorkCountMax > 0 then TamanhoArqFTP := Integer(AWorkCountMax); frmLstLogRecepArq .Gauge1.MaxValue := TamanhoArqFTP; end; end; procedure RecebeArquivo.FTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); begin if frmLstLogRecepArq <> nil then begin frmLstLogRecepArq .pnlMsgRecep.Caption := MsgRecepcao; frmLstLogRecepArq .pnlMsgRecep.Visible := True; frmLstLogRecepArq .pnlMsgRecep.Visible := True; frmLstLogRecepArq .pnlGauge.Visible := True; frmLstLogRecepArq .Gauge1.MaxValue := TamanhoArqFTP; frmLstLogRecepArq .Gauge1.Progress := AWorkCount; synchronize(frmLstLogRecepArq .Gauge1.Refresh); // <-- Quando faz a atualização do Gauge a aplicação trava Application.ProcessMessages; end; end; procedure RecebeArquivo.FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); begin if frmLstLogRecepArq <> nil then frmLstLogRecepArq .Gauge1.Progress := frmLstLogRecepArq .Gauge1.MaxValue; end; Preciso resolver isso o quanto antes, fazer o GetFTP com o Gauge sem congelar a aplicação, desde já agradeço o auxílio que possam me prestar.

Amigo, verifique se o usuário que está logado tem direito de escrita na pasta onde os arquivos serão baixados.