rotina para salvar aquivos

Delphi

Automação Comercial

Firebird

29/04/2016

boa tarde galera !

preciso de uma rotina que leia a extensão do aquivo, selecionado e crie uma pasta com este nome para melhorar a organização de um sistema de bkp. segue o que tentei fazer porem só cai na no "else"

function TForm1.SalvarArq: string;
var
salvardtbase, salvarXML, Arq: string;
begin
salvardtbase := 'BaseDados' +'_'+ FormatDateTime('dd-mm-yyyy hh;mm', Now);
salvarXML := 'XML' +'_'+ FormatDateTime('dd-mm-yyyy hh;mm', Now);
Arq := ExtractFileExt('');

if Arq = '.FDB' then
begin
result := salvardtbase
end else
result := salvarXML;

end;

chamando assim

if not DirectoryExists(SalvarArq) then
ForceDirectories(SalvarArq);
Peterson

Peterson

Curtidas 0

Respostas

Mateus Ribeiro

Mateus Ribeiro

29/04/2016

Bom dia!

O problema é que você não está determinando a extensão do dito cujo:
Arq := ExtractFileExt('');


A variável ARQ está sempre SEM VALOR, por isso cai no else...
GOSTEI 0
Natanael Ferreira

Natanael Ferreira

29/04/2016

Altere sua função recebendo o arquivo como parâmetro:

function TForm1.SalvarArq(Arquivo: string): string;
var
  salvardtbase, salvarXML, Arq: string;
begin
  salvardtbase := 'BaseDados' + '_' + FormatDateTime('dd-mm-yyyy hh;mm', Now);
  salvarXML := 'XML' + '_' + FormatDateTime('dd-mm-yyyy hh;mm', Now);

  Arq := ExtractFileExt(Arquivo);

  if UpperCase(Arq) = '.FDB' then
    result := salvardtbase
  else
    result := salvarXML;
end;


Acrescente um OpenDialog e chame a função assim:

var
  Arquivo, TipoPasta, CaminhoCompleto: string;
begin
  if OpenDialog1.Execute then
  begin
    Arquivo := OpenDialog1.FileName;
    TipoPasta := SalvarArq(Arquivo);
    CaminhoCompleto := ExtractFilePath(Arquivo) + TipoPasta;

    if not DirectoryExists(CaminhoCompleto) then
      ForceDirectories(CaminhoCompleto);
  end;
end;
GOSTEI 0
Peterson

Peterson

29/04/2016

function TForm1.SalvarArq(Origem, Destino: string): string;
var
      Arq, Copia : string;
begin
      Arq     := ExtractFileExt(Origem);
      Copia   := copy(Arq,pos('.',Arq)+1,length(Arq));      // para não copiar o ".", SOMENTE EXTENSAO DO ARQUIVO
      Result  := Destino + edtNomeClie.Text +'\'+ Copia  +'_'+ FormatDateTime('dd-mm-yyyy hh;mm', Now)+ '\';

      if not DirectoryExists(Result) then
      ForceDirectories(Result);
 end;

// CHAMANDO A FUNÇÃO 

Caminho := SalvarArq(edtLocaldoArquivo.Text, edtSalvarArquivo.Text);

//Onclick

Memobkp.Lines.Add('Backup salvo em ' + '- ' + caminho + edtNomedoArquivo.Text);
GOSTEI 0
Peterson

Peterson

29/04/2016

ola essa foi a forma que consegui, obrigado pelo help, afinal foi tiquim de um e tiquin de outro.

function TForm1.SalvarArq(Origem, Destino: string): string;
var
      Arq, Copia : string;
begin
      Arq     := ExtractFileExt(Origem);
      Copia   := copy(Arq,pos('.',Arq)+1,length(Arq));      // para não copiar o ".", SOMENTE EXTENSAO DO ARQUIVO
      Result  := Destino + edtNomeClie.Text +'\'+ Copia  +'_'+ FormatDateTime('dd-mm-yyyy hh;mm', Now)+ '\';

      if not DirectoryExists(Result) then
      ForceDirectories(Result);
 end;

// CHAMANDO A FUNÇÃO 

Caminho := SalvarArq(edtLocaldoArquivo.Text, edtSalvarArquivo.Text);

//Onclick

Memobkp.Lines.Add('Backup salvo em ' + '- ' + caminho + edtNomedoArquivo.Text);
GOSTEI 0
POSTAR