Travamento de thread
22/01/2016
0
Boa tarde a todos,
Estou migrando de Delphi 7 para Delphi XE8 e uma thread que funcionava no Delphi 7 no XE trava a aplicação.
unit ThreadFTP;
interface
uses
Classes, IdFTP, StdCtrls, SysUtils,Dialogs,forms, windows;
type
TUpload = class(TThread)
private
{ Private declarations }
CFTP : TidFTP;
CEdit : string;
CNome : string;
CTipo : string;
CIp : string;
protected
procedure Execute; override;
procedure FazUpload;
procedure FazDownload;
public
constructor Criar(ftp : Tidftp; caminho : string; nome: string; tipo: string; ip: string);
end;
implementation
uses UMain, uDMX;
{ 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 TUpload.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ TUpload }
constructor TUpload.Criar(ftp: Tidftp; caminho: string; nome: string; tipo: string; ip: string);
begin
inherited Create(True);
FreeOnTerminate := True;
CFTP := ftp;
CEdit := caminho;
CNome:= nome;
CTipo:= tipo;
CIp:= ip;
Resume;
end;
procedure TUpload.Execute;
begin
If (Not Terminated) Then begin
if CTipo = 'Up' then
FazUpload;
if CTipo = 'UpEmail' then
FazUpload;
if CTipo = 'Down' then
FazDownload;
end;
end;
procedure TUpload.FazDownload;
var Tam: Integer;
conectou: integer;
begin
With CFTP Do
Begin
Try
// If not Connected Then
Try
Disconnect;
UserName := 'usuario';
Password := 'senha';
Host := '192.168.1.10';
Port:= 21;
Connect;
conectou:=0;
FMain.sGauge1.Suffix:= '% - SD1';
except
Try
Disconnect;
UserName := 'usuario';
Password := 'senha';
if DMX.TabEmpresaIPSERVIDOR.AsString <> '' then
Host:= dmx.TabEmpresaIPSERVIDOR.AsString else
Host := 'host';
Port:= 21;
Connect;
conectou:=1;
FMain.sGauge1.Suffix:= '% - SH';
except
Disconnect;
UserName := 'senha';
Password := 'usuario';
if cip <> '' then
host := cip else
Host := 'senha';
Port:= 8221;
Connect;
conectou:=0;
FMain.sGauge1.Suffix:= '% - SD2';
end;
end;
except
On E : Exception do
Begin
FMain.sPanel5.Visible:= false;
ShowMessage2('Não conectou : ' + E.Message);
Exit;
End;
end;
Try
Try
if Conectou = 0 then begin
try
makeDir('/public_html');
except
//
end;
changedir('/public_html');
end else
changedir('/public_html');
FMain.BytesparaTransferir:= Size('Atualiza.exe');
Get('Atualiza.exe', CEdit, true);
except
on E : Exception do begin
if copy(Trim(e.Message), 1,11) = 'Access viol' then
//
else begin
FMain.sPanel5.Visible:= false;
ShowMessage2('Erro ao fazer Download: ' + E.Message);
end;
end;
end;
Finally
Quit;
tam:= 0;
repeat
Application.ProcessMessages;
try
Tam:= FMain.TamArquivo(CEdit);
except
FMain.Label1.Caption:= IntToStr(Tam);
end;
until
Tam > 0;
FMain.SLabel5.Caption:= 'Abrindo Programa de Atualização';
FMain.ExecandWait(CEdit, '', sw_normal);
FMain.sPanel5.Visible:= false;
End;
End;
end;
procedure TUpload.FazUpload;
var conectou: integer;
begin
With CFTP Do
Begin
Try
// If not Connected Then
// Connect;
Try
Disconnect;
UserName := 'usuario';
Password := 'senha';
Host := '192.168.1.10';
Port:= 21;
Connect;
conectou:=0;
FMain.sGauge1.Suffix:= '% - SD1';
except
Try
Disconnect;
UserName := 'usuario';
Password := 'senha';
if cip <> '' then
host := cip else
Host := 'host';
Port:= 8221;
Connect;
conectou:=1;
FMain.sGauge1.Suffix:= '% - SD';
except
Disconnect;
UserName := 'nomeusuario';
Password := 'senha';
if DMX.TabEmpresaIPSERVIDOR.AsString <> '' then
Host:= dmx.TabEmpresaIPSERVIDOR.AsString else
Host := '108.179.253.57';
Port:= 21;
Connect;
conectou:=2;
FMain.sGauge1.Suffix:= '% - SH';
end;
end;
except
On E : Exception do
Begin
FMain.sPanel5.Visible:= false;
ShowMessage2('Não conectou : ' + E.Message);
Exit;
End;
end;
Try
Try
changedir('/');
if Copy(cNome,Length(cNome), Length(cNome)) = '.' then
cNome:= copy (cNome,1,Length(cNome)-1);
Try
MakeDir('/public_html/' +cNome);
except
//
end;
// if CTipo = 'UpEmail' then
changedir('/public_html/' + cnome {DMX.TabEmpresaSERIAL.AsString + '-' + DMX.TabEmpresaEMPRESA.Value});// else
// changedir('/'+ cNome);
Put(CEdit, ExtractFileName(CEdit));
except
on E : Exception do begin
if copy(Trim(e.Message), 1,11) = 'Access viol' then
//
else begin
FMain.sPanel5.Visible:= false;
ShowMessage2('Erro ao fazer Upload: ' + E.Message);
END;
end;
end;
Finally
Quit;
FMain.sPanel5.Visible:= false;
End;
End;
end;
end.
O que será que mudou?
Grato
Estou migrando de Delphi 7 para Delphi XE8 e uma thread que funcionava no Delphi 7 no XE trava a aplicação.
unit ThreadFTP;
interface
uses
Classes, IdFTP, StdCtrls, SysUtils,Dialogs,forms, windows;
type
TUpload = class(TThread)
private
{ Private declarations }
CFTP : TidFTP;
CEdit : string;
CNome : string;
CTipo : string;
CIp : string;
protected
procedure Execute; override;
procedure FazUpload;
procedure FazDownload;
public
constructor Criar(ftp : Tidftp; caminho : string; nome: string; tipo: string; ip: string);
end;
implementation
uses UMain, uDMX;
{ 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 TUpload.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ TUpload }
constructor TUpload.Criar(ftp: Tidftp; caminho: string; nome: string; tipo: string; ip: string);
begin
inherited Create(True);
FreeOnTerminate := True;
CFTP := ftp;
CEdit := caminho;
CNome:= nome;
CTipo:= tipo;
CIp:= ip;
Resume;
end;
procedure TUpload.Execute;
begin
If (Not Terminated) Then begin
if CTipo = 'Up' then
FazUpload;
if CTipo = 'UpEmail' then
FazUpload;
if CTipo = 'Down' then
FazDownload;
end;
end;
procedure TUpload.FazDownload;
var Tam: Integer;
conectou: integer;
begin
With CFTP Do
Begin
Try
// If not Connected Then
Try
Disconnect;
UserName := 'usuario';
Password := 'senha';
Host := '192.168.1.10';
Port:= 21;
Connect;
conectou:=0;
FMain.sGauge1.Suffix:= '% - SD1';
except
Try
Disconnect;
UserName := 'usuario';
Password := 'senha';
if DMX.TabEmpresaIPSERVIDOR.AsString <> '' then
Host:= dmx.TabEmpresaIPSERVIDOR.AsString else
Host := 'host';
Port:= 21;
Connect;
conectou:=1;
FMain.sGauge1.Suffix:= '% - SH';
except
Disconnect;
UserName := 'senha';
Password := 'usuario';
if cip <> '' then
host := cip else
Host := 'senha';
Port:= 8221;
Connect;
conectou:=0;
FMain.sGauge1.Suffix:= '% - SD2';
end;
end;
except
On E : Exception do
Begin
FMain.sPanel5.Visible:= false;
ShowMessage2('Não conectou : ' + E.Message);
Exit;
End;
end;
Try
Try
if Conectou = 0 then begin
try
makeDir('/public_html');
except
//
end;
changedir('/public_html');
end else
changedir('/public_html');
FMain.BytesparaTransferir:= Size('Atualiza.exe');
Get('Atualiza.exe', CEdit, true);
except
on E : Exception do begin
if copy(Trim(e.Message), 1,11) = 'Access viol' then
//
else begin
FMain.sPanel5.Visible:= false;
ShowMessage2('Erro ao fazer Download: ' + E.Message);
end;
end;
end;
Finally
Quit;
tam:= 0;
repeat
Application.ProcessMessages;
try
Tam:= FMain.TamArquivo(CEdit);
except
FMain.Label1.Caption:= IntToStr(Tam);
end;
until
Tam > 0;
FMain.SLabel5.Caption:= 'Abrindo Programa de Atualização';
FMain.ExecandWait(CEdit, '', sw_normal);
FMain.sPanel5.Visible:= false;
End;
End;
end;
procedure TUpload.FazUpload;
var conectou: integer;
begin
With CFTP Do
Begin
Try
// If not Connected Then
// Connect;
Try
Disconnect;
UserName := 'usuario';
Password := 'senha';
Host := '192.168.1.10';
Port:= 21;
Connect;
conectou:=0;
FMain.sGauge1.Suffix:= '% - SD1';
except
Try
Disconnect;
UserName := 'usuario';
Password := 'senha';
if cip <> '' then
host := cip else
Host := 'host';
Port:= 8221;
Connect;
conectou:=1;
FMain.sGauge1.Suffix:= '% - SD';
except
Disconnect;
UserName := 'nomeusuario';
Password := 'senha';
if DMX.TabEmpresaIPSERVIDOR.AsString <> '' then
Host:= dmx.TabEmpresaIPSERVIDOR.AsString else
Host := '108.179.253.57';
Port:= 21;
Connect;
conectou:=2;
FMain.sGauge1.Suffix:= '% - SH';
end;
end;
except
On E : Exception do
Begin
FMain.sPanel5.Visible:= false;
ShowMessage2('Não conectou : ' + E.Message);
Exit;
End;
end;
Try
Try
changedir('/');
if Copy(cNome,Length(cNome), Length(cNome)) = '.' then
cNome:= copy (cNome,1,Length(cNome)-1);
Try
MakeDir('/public_html/' +cNome);
except
//
end;
// if CTipo = 'UpEmail' then
changedir('/public_html/' + cnome {DMX.TabEmpresaSERIAL.AsString + '-' + DMX.TabEmpresaEMPRESA.Value});// else
// changedir('/'+ cNome);
Put(CEdit, ExtractFileName(CEdit));
except
on E : Exception do begin
if copy(Trim(e.Message), 1,11) = 'Access viol' then
//
else begin
FMain.sPanel5.Visible:= false;
ShowMessage2('Erro ao fazer Upload: ' + E.Message);
END;
end;
end;
Finally
Quit;
FMain.sPanel5.Visible:= false;
End;
End;
end;
end.
O que será que mudou?
Grato
Rodrigo Ogioni
Curtir tópico
+ 0
Responder
Clique aqui para fazer login e interagir na Comunidade :)