Luciano Umbelino
-
Total de itens
19 -
Registro em
-
Última visita
Posts postados por Luciano Umbelino
-
-
Poste o código da Thread por favor :rolleyes:
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?
-
Poste o código da Thread por favor :rolleyes:
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,
-
Esse erro acontece muito comigo ¬¬, é um saco, faz o seguinte...
Creio que a sua thread continua sendo executada quando você fecha o programa, por isso ele dá o erro ao fechar pois ela tenta acessar os componentes de um form que não existe mais... tente para-la no OnClose do form que deve resolver o problema!
Abraços
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,
-
Esse erro acontece muito comigo ¬¬, é um saco, faz o seguinte...
Creio que a sua thread continua sendo executada quando você fecha o programa, por isso ele dá o erro ao fechar pois ela tenta acessar os componentes de um form que não existe mais... tente para-la no OnClose do form que deve resolver o problema!
Abraços
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.
-
Veja esse exemplo, vai te ajudar
http://www.devmedia.com.br/post-2300-Utili...--internet.html
Download do código
http://www.devmedia.com.br/download/down.asp?id=2300&cb=
abraço
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.
Veja esse exemplo, vai te ajudarhttp://www.devmedia.com.br/post-2300-Utili...--internet.html
Download do código
http://www.devmedia.com.br/download/down.asp?id=2300&cb=
abraço
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.
-
Veja esse exemplo, vai te ajudar
http://www.devmedia.com.br/post-2300-Utili...--internet.html
Download do código
http://www.devmedia.com.br/download/down.asp?id=2300&cb=
abraço
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,
-
Veja esse exemplo, vai te ajudar
http://www.devmedia.com.br/post-2300-Utili...--internet.html
Download do código
http://www.devmedia.com.br/download/down.asp?id=2300&cb=
abraço
Vou dar uma olhada.
Grato,
-
Sim... se o teste funcionar, voce pode implementar o resultado na thread.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?
fechar ou minimizar ... se fechar o processamento é interrompido ... se minimizar nãoNa realidade o que eu quero é poder fechar essa tela e quando abrir novamento o gauge continua atualizado com o percentual atual.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.
-
Com poucas alterações no seu código, acho que vai funcionar
OBS: Mantenha as configurações atuais para o idFTP e joque o conteudo do idPOP3 dentro do ListBox e faça o teste
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, Gauges; type TForm1 = class(TForm) IdFTP1: TIdFTP; Button1: TButton; ListBox1: TListBox; Gauge1: TGauge; procedure Button1Click(Sender: TObject); procedure IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); private { Private declarations } public { Public declarations } end; var Form1: TForm1; bytesToTransfer: integer; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var indice : integer; begin try if IdFTP1.Connected then IdFTP1.Disconnect; IdFTP1.Connect(); IdFTP1.List(ListBox1.Items,'*.pdf',false); // Listar somente arquivos com extensão .pdf if ListBox1.Items.Count = 0 then Abort; for indice:= 0 to ListBox1.Items.Count -1 do begin try ListBox1.Selected[indice] := true; bytesToTransfer := IdFTP1.Size(ListBox1.Items.Strings[indice]); IdFTP1.Get(ListBox1.Items.Strings[indice],'' + ListBox1.Items.Strings[indice],true); except on e:exception do showmessage(e.Message); end; end; finally IdFTP1.Disconnect; end; end; procedure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); begin Gauge1.Progress := 0; if AWorkCountMax > 0 then Gauge1.MaxValue := AWorkCountMax else Gauge1.MaxValue := bytesToTransfer; end; procedure TForm1.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); begin Gauge1.Progress := AWorkCount; end; end.abraço
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.
-
Experimente sem esse comando
synchronize(frmLstLogRecepArq .Gauge1.Refresh); // <-- Quando faz a atualização do Gauge a aplicação trava
abraço
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!!!!
-
Experimente sem esse comando
synchronize(frmLstLogRecepArq .Gauge1.Refresh); // <-- Quando faz a atualização do Gauge a aplicação trava
abraço
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.
-
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?
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.
-
De forma simples seria
procedure TForm1.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); begin Gauge1.Progress := AWorkCount; Gauge1.Refresh; // comandos end; procedure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); begin Gauge1.MaxValue := AWorkCountMax; // comandos end;
OBS: o componente Gauge deve ficar fora do DBgrid
abraço
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?
-
De forma simples seria
procedure TForm1.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); begin Gauge1.Progress := AWorkCount; Gauge1.Refresh; // comandos end; procedure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); begin Gauge1.MaxValue := AWorkCountMax; // comandos end;
OBS: o componente Gauge deve ficar fora do DBgrid
abraço
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.
(Resolvido) Erro 1400 - Identificador de Janela Inválido quando fecho
em Delphi, Kylix
Postado
(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.