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.

Eu prefiro criar um campo a mais na tabela onde ficara o gauge... esteticamente fica mais apresentavel então seguindo esse raciocinio : 1 - acrescente um campo na sua tabela com o nome de gauge do tipo string com 20 posições 2 - coloque um componente Panel e dentro dele coloque um componente Gauge, ajustando o seu tamanho dentro do Panel ... O panel é necessário, pois o gauge ficaria atras do dbgrid e não seria mostrado 3 - defina o tamanho do Panel para que se ajuste ao tamanho do campo da celula do dbgrid ( campo gauge ) 3 - coloque no evento OnDrawCell do DBGrid o codigo abaixo: procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState); var DrawState: Integer; DrawRect: TRect; begin if (gdFocused in State) then begin if (Column.Field.FieldName = 'GAUGE') then begin Panel1.Left := Rect.Left + DBGrid1.Left + 2; Panel1.Top := Rect.Top + DBGrid1.top + 2; Panel1.Width := Rect.Right - Rect.Left; Panel1.Height := Rect.Bottom - Rect.Top; Panel1.Visible := True; end end else begin if (Column.Field.FieldName = 'GAUGE') then begin DrawRect:=Rect; InflateRect(DrawRect,-1,-1); DBGrid1.Canvas.FillRect(Rect); DrawFrameControl(DBGrid1.Canvas.Handle, DrawRect, DFC_BUTTON, DrawState); end; end; end; OBS: ao clicar em uma linha de registro, o gauge aparecerá nessa linha ... o resto é só adaptar abraço (Resolvido) Grande Jhonas!!! Fiz algumas modificações apenas para já exibir o gauge, pois o arquivo é transmitido assim que entra na lista, sem haver intervenção do usuário, e está funcionando bem a contento. Pode colocar o post como resolvido por gentileza. Amigo, super agradecido, que bom poder contar com pessoas de boa vontade. Espero que você continue a ter a disponibilidade de auxiliar a quem precisa. Quem recebe o bem é quem sabe o bem que tem. Grato, bom natal e felicidade a todos.

Olá Jhonas, boa tarde, primeiramente grato pela sua atenção e boa vontade. Então, uma coisa que quero é realmente fazer com que o gauge aparece na linha onde o arquivo que esta sendo transmitido apareça. Mas para efeito de teste, pelo menos para ver o bendito gauge, fiz como você indicou e nem assim apareceu o bendito gauge, com certeza estou fazendo alguma coisa errada que ainda não descobri, estou basicamente a dois dias nisso sem uma solução satisfatória, se você tiver mais alguma dica ou algum caminho a seguir, será bem vinda. Grato. Bem evoluiu a situação, estava acontecendo que o align do dbgrid estava alClient, portanto o bendito do gauge não aparecia. Graças a dica do Jhonas verifiquei isso e ví que o gauge está funcionando. Pois bem a questão agora é como colocar esse gauge na linha do dbgrid que indica o arquivo que está sendo transmitido, de maneira que o gauge sobreponha o dbgrid e fique visivel?

Olá Jhonas, boa tarde, primeiramente grato pela sua atenção e boa vontade. Então, uma coisa que quero é realmente fazer com que o gauge aparece na linha onde o arquivo que esta sendo transmitido apareça. Mas para efeito de teste, pelo menos para ver o bendito gauge, fiz como você indicou e nem assim apareceu o bendito gauge, com certeza estou fazendo alguma coisa errada que ainda não descobri, estou basicamente a dois dias nisso sem uma solução satisfatória, se você tiver mais alguma dica ou algum caminho a seguir, será bem vinda. Grato.

Pessoal bom dia, Estou precisando de um auxílio, tenho uma thread que transmite via FTP(Indy 10), arquivos que estão em linhas de um dbgrid, quero faze um gauge mostrando o andamento da transferência na linha que aponta o arquivo que está sendo transmitido. O FTP está funcionando e coloquei o incrementação do gauge no eveno OnWork, só que está acontecendo que o gauge não está sendo exibido, peço a quem puder que me auxilie a resolver esse problema. Farei uma breve descrição dos eventos OnWorkBegin, OnWork e OnWokEnd: Essas procedures estão na minha thread que responsável pela transmissão efetivamente. procedure EnviaArquivo.FTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); begin if frmLstLogTransm <> nil then //Aqui eu verifico se o form está criado para evitar acces violation begin frmLstLogTransm.Gauge1.Visible := True; frmLstLogTransm.Gauge1.Progress := 0; if AWorkCountMax > 0 then frmLstLogTransm.Gauge1.MaxValue := AWorkCountMax else frmLstLogTransm.Gauge1.MaxValue := TamanhoArqFTP; end; end; procedure EnviaArquivoFTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); begin if frmLstLogTransm <> nil then begin // frmLstLogTransm.Gauge1.Progress := AWorkCount; //havia tentando a incrementação dessa maneira mas vi que neste campo só contem //o tamanho total do arquivo frmLstLogTransm.Gauge1.Progress := frmLstLogTransm.Gauge1.Progress + 1; //Por isso fiz dessa outra maneira application .processmessages; end; end; procedure EnviaOcorrenciasCanalFD.FTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); begin if frmLstLogTransm <> nil then frmLstLogTransm.Gauge1.Progress := TamanhoArqFTP; end; frmlstLogTransm é o form que contem o dbgrid com a relação de arquivos a serem transmitidos. Está acontecendo que no dbGrid não aparece o gauge com o progresso da transmissão. Bem, desde já agradeço.