Travamento de thread

22/01/2016

2

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
Responder
×
+1 DevUP
Acesso diário, +1 DevUP
Parabéns, você está investindo na sua carreira