Erro Unknown Protocol no componente IdHTTP do delphi 10.3

26/03/2020

0

Boa noite!
Estou precisando de ajuda, não consigo encontrar o erro, a principio o código esta correto.

uses
IdException,
// declarada para usar a função "InternetGetConnectedState"
WinInet,
// declarada para acessar os arquivos INI
IniFiles,
// declarada para executar a linha de comando do 7-zip
ShellAPI, Udados, uDadosWeb;

{$R *.dfm}
{ TForm1 }

function TFrmAtualiza.RetornaPorcentagem(ValorMaximo, ValorAtual: real): string;
var
resultado: real;
begin
resultado := ((ValorAtual * 100) / ValorMaximo);
Result := FormatFloat(''0%'', resultado);
end;

function TFrmAtualiza.RetornaKiloBytes(ValorAtual: real): string;
var
resultado: real;
begin
resultado := ((ValorAtual / 1024) / 1024);
Result := FormatFloat(''0.000 KBs'', resultado);
end;

procedure TFrmAtualiza.Carrega;
begin
edtURL.Text := Dados.qryParametroFTP_SERVIDOR.Value;
sNomeArquivoAtualizacao := ObterDiretorioDoExecutavel + ''update.zip'';
end;

function TFrmAtualiza.PodeAtualizar: Boolean;
var
DataBloqueio: TDate;
DataExe: string;
begin

Result := false;

if Dados.crypt(''D'', Dados.qryEmpresaCSENHA.asString) = ''S'' then
begin
// verifica se empresa esta liberada
if tag = 2 then
ShowMessage(''Não é possivel atualizar sistema com licença bloqueada!'');
exit;
end;

DataBloqueio := StrToDateDef(Dados.crypt(''D'',
Dados.qryEmpresaDATA_VALIDADE.Value), Date);

if DataBloqueio < Date then
begin
if tag = 2 then
ShowMessage(''Não é possivel atualizar sistema com licença vencida!'');

exit;
end;

Carrega;

try
IdHTTP.Head(edtURL.Text);
fnDate := FormatDateTime(''dd/mm/yyyy hh:mm:ss'',
IdHTTP.Response.LastModified);
except
on e: EIdHttpProtocolException do
begin
fnDate := '''';
end;
end;

try
if (trim(Dados.qryTerminalDT_VERSAO.Value) = '''') or
(Dados.qryTerminalDT_VERSAO.IsNull) then
DataExe := DateToStr(Date - 1000)
else
DataExe := Dados.qryTerminalDT_VERSAO.Value;
except
DataExe := DateToStr(Date - 1000);
end;

if fnDate <> '''' then
begin
if StrToDateTime(DataExe) < StrToDateTime(fnDate) then
Result := true
else
begin
if tag = 2 then
ShowMessage(''Não existem atualização disponivel!'');
end;

end;

end;

function ZipFileDecompress(FZipfile, APath: string): integer;
var
z: TZipFile;
begin
Result := 0;
z := TZipFile.Create;
try
if FileExists(FZipfile) then
z.Open(FZipfile, zmReadWrite)
else
raise exception.Create(''Não encontrei: '' + FZipfile);
z.ExtractAll(APath);
z.Close;
Result := 1;
finally
z.Free;
end;
end;

procedure TFrmAtualiza.BitBtn1Click(Sender: TObject);
begin

Close;
end;

procedure TFrmAtualiza.DescompactarAtualizacao;
begin
try
// deleta o backup anterior, ou melhor, de versões anteriores,
// evitando erro de arquivo já existente
if FileExists(Application.ExeName + ''(a)'') then
DeleteFile(Application.ExeName + ''(a)'');

// Renomeia o executável atual (desatualizado) para "Sistema_Backup.exe"
RenameFile(Application.ExeName, Application.ExeName + ''(a)'');

// armazena o nome do arquivo de atualização em uma variável
ZipFileDecompress(sNomeArquivoAtualizacao, ObterDiretorioDoExecutavel);
// executa a linha de comando do 7zip para descompactar o arquivo baixado
{ ShellExecute(0, nil, ''7z'', PWideChar('' e -aoa '' +
sNomeArquivoAtualizacao +'' -o'' + ObterDiretorioDoExecutavel), '''', SW_SHOW); }
except
RenameFile(Application.ExeName + ''(a)'', Application.ExeName);
end;
end;

procedure TFrmAtualiza.FormActivate(Sender: TObject);
begin
Dados.vForm := nil;
Dados.vForm := self;
Dados.GetComponentes;
end;

procedure TFrmAtualiza.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not vPodeFechar then
Action := caNone;
end;

procedure TFrmAtualiza.FormShow(Sender: TObject);
begin
vPodeFechar := false;
Carrega;
end;

procedure TFrmAtualiza.Baixar;
var
fileDownload: TFileStream;
// idant: TIdAntiFreeze;
begin
// idant := TIdAntiFreeze.Create(nil);
fileDownload := TFileStream.Create(ObterDiretorioDoExecutavel + ''update'' +
ExtractFileExt(edtURL.Text), fmCreate);
try
pbDownload.Visible := true;
lbStatus.Visible := true;
Label1.Visible := true;
btnAtualizacao.Enabled := false;
IdHTTP.Get(edtURL.Text, fileDownload);
finally
// idant.Active := false;
// FreeAndNil(idant);
FreeAndNil(fileDownload);
end;
end;

procedure TFrmAtualiza.btnAtualizacaoClick(Sender: TObject);
var
nNumeroVersaoLocal, nNumeroVersaoFTP: smallint;
begin
try // desativa o botão de atualização para evitar 2 ou mais conexões

if tag = 2 then
begin
if not PodeAtualizar then
exit;
end;

if (trim(Dados.qryParametroFTP_SERVIDOR.asString) = '''') or
(Dados.qryParametroFTP_SERVIDOR.IsNull) then
exit;

Label1.Caption := ''Baixando...'';
Dados.Tela := ''Clicou'';
lbStatus.Caption := ''Aguarde...'';
Application.ProcessMessages;

btnAtualizacao.Enabled := false;
BitBtn1.Enabled := false;

// processa a atualização
Baixar;
DescompactarAtualizacao;

Dados.qryTerminal.Edit;
Dados.qryTerminalDT_VERSAO.Value := fnDate;
Dados.qryTerminal.Post;

Label1.Caption := '''';
Dados.AtualizaTerminal;
Application.Terminate;
finally
vPodeFechar := true;
end;

end;

procedure TFrmAtualiza.IdFTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
var
nTamanhoTotal, nTransmitidos, nPorcentagem: real;
begin
if FnTamanhoTotal = 0 then
exit;

// obtém o tamanho total do arquivo em bytes
nTamanhoTotal := FnTamanhoTotal div 1024;

// obtém a quantidade de bytes já baixados
nTransmitidos := AWorkCount div 1024;

// calcula a porcentagem de download
nPorcentagem := (nTransmitidos * 100) / nTamanhoTotal;

// atualiza o componente TLabel com a porcentagem
lbStatus.Caption := ''Download: '' + format(''%s%%'',
[FormatFloat(''##0'', nPorcentagem)]);

// atualiza a barra de preenchimento do componente TProgressBar
pbDownload.Position := AWorkCount div 1024;

// processa as mensagens pendentes do sistema para atualizar os componentes
Application.ProcessMessages;
end;

procedure TFrmAtualiza.IdFTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
btnAtualizacao.Enabled := false;
pbDownload.Max := FnTamanhoTotal div 1024;
end;

procedure TFrmAtualiza.IdFTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
btnAtualizacao.Enabled := true;
end;

procedure TFrmAtualiza.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin
pbDownload.Position := AWorkCount;
lbStatus.Caption := ''Taxa de Transferência:'' + RetornaKiloBytes(AWorkCount);
Caption := ''Download em ... '' + RetornaPorcentagem(pbDownload.Max,
AWorkCount);
Application.ProcessMessages;
end;

procedure TFrmAtualiza.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
pbDownload.Max := AWorkCountMax;
end;

procedure TFrmAtualiza.IdHTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
pbDownload.Position := 0;
Caption := ''Finalizado ...'';
lbStatus.Caption := ''Download Finalizado ...'';
pbDownload.Visible := false;
Label1.Visible := false;

btnAtualizacao.Enabled := true;
BitBtn1.Enabled := true;
Label1.Caption := '''';

IdHTTP.Disconnect;
Application.ProcessMessages;

end;

function TFrmAtualiza.ObterDiretorioDoExecutavel: string;
begin
Result := ExtractFilePath(Application.ExeName);
end;

end.
Ana Soares

Ana Soares

Responder

Assista grátis a nossa aula inaugural

Assitir aula

Saiba por que programar é uma questão de
sobrevivência e como aprender sem riscos

Assistir agora

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar