Ir para conteúdo
Fórum Script Brasil
  • 0

(Resolvido) Erro 1400 - Identificador de Janela Inválido quando fecho

Luciano Umbelino

Perguntado por Luciano Umbelino,

 Share

Pergunta

Luciano Umbelino

Luciano Umbelino

Postado
Postado

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.

Link para o comentário
Compartilhar em outros sites

7 respostass a esta questão

Posts Recomendados

  • 0
Douglas Soares

Douglas Soares

Postado
Postado

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

Link para o comentário
Compartilhar em outros sites
  • 0
Luciano Umbelino

Luciano Umbelino

Postado
  • Autor
Postado
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.

Link para o comentário
Compartilhar em outros sites
  • 0
Luciano Umbelino

Luciano Umbelino

Postado
  • Autor
Postado
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,

Link para o comentário
Compartilhar em outros sites
  • 0
Luciano Umbelino

Luciano Umbelino

Postado
  • Autor
Postado
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,

Link para o comentário
Compartilhar em outros sites
  • 0
Luciano Umbelino

Luciano Umbelino

Postado
  • Autor
Postado
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?

Link para o comentário
Compartilhar em outros sites
  • 0
Luciano Umbelino

Luciano Umbelino

Postado
  • Autor
Postado
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?

(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.

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...