Aguardar ShellExecute terminar Cópia

21/03/2014

0

Delphi

Beleza galera. Estou com uma duvida no ShellExecute, gostaria de uma ajuda de vocês.
Seguinte, eu criei uma aplicação com serviço do Windows, para fazer um backup automático, utilizei serviço porque os servidores não são monitorados (ninguém faz logon). Logo para conseguir copiar os arquivos estou usando o ShellExecute, após a cópia, eu compacto, porem não estou conseguindo fazer com que o Delphi aguarde a finalização do ShellExecute para executar o próximo procedimento.
Como faço para fazer o Delphi aguardar a finalização da Cópia?
Meu código:

procedure Copia(Origem, Destino: String);
var
   Parametros: Pchar;
   I: integer;
begin
  try
   Parametros := Pchar('"' + Origem + '" "' + Destino + '" /S /Y ');
   I:=ShellExecute(0, '', 'xCopy', Parametros, '', SW_SHOW);
  Except
    on E:Exception do
      GeraLog('Erro ao copiar: '+E.Message);
  end;
end;
Rawgleison

Rawgleison

Responder

Post mais votado

21/03/2014

achei essa função nessa semana e pra mim funcionou:

function ShellExecuteAndWait(Operation, FileName, Parameter, Directory: String; Show: Word; bWait: Boolean): Longint;
var
  bOK: Boolean;
  Info: TShellExecuteInfo;
begin
  FillChar(Info, SizeOf(Info), Chr(0));
  Info.cbSize := SizeOf(Info);
  Info.fMask := SEE_MASK_NOCLOSEPROCESS;
  Info.lpVerb := PChar(Operation);
  Info.lpFile := PChar(FileName);
  Info.lpParameters := PChar(Parameter);
  Info.lpDirectory := PChar(Directory);
  Info.nShow := Show;
  bOK := Boolean(ShellExecuteEx(@Info));
  if bOK then
  begin
    if bWait then
    begin
      while WaitForSingleObject(Info.hProcess, 100) = WAIT_TIMEOUT do
        Application.ProcessMessages;
      bOK := GetExitCodeProcess(Info.hProcess, DWORD(Result));
    end
    else
      Result := 0;
  end;
  if not bOK then
    Result := -1;
end;


uso:

procedure Copia(Origem, Destino: String);
var
   Parametros: Pchar;
   I: integer;
begin
  try
   Parametros := Pchar('"' + Origem + '" "' + Destino + '" /S /Y ');
   I := ShellExecuteAndWait('open', 'xCopy', Parametros, '', SW_SHOW, True);
  Except
    on E:Exception do
      GeraLog('Erro ao copiar: '+E.Message);
  end;
end;

Alan Souza

Alan Souza
Responder
Gostei + 1

Mais Posts

22/03/2014

Rawgleison

Alanps, Funcionou perfeitamente, muito obrigado......

[RESOLVIDO]
Responder
Gostei + 0

25/03/2014

Rawgleison

Alguém sabe me falar como eu fecho um tópico e coloco [Resolvido] no titulo?
Responder
Gostei + 0

26/12/2019

Felipe

achei essa função nessa semana e pra mim funcionou:

function ShellExecuteAndWait(Operation, FileName, Parameter, Directory: String; Show: Word; bWait: Boolean): Longint;
var
  bOK: Boolean;
  Info: TShellExecuteInfo;
begin
  FillChar(Info, SizeOf(Info), Chr(0));
  Info.cbSize := SizeOf(Info);
  Info.fMask := SEE_MASK_NOCLOSEPROCESS;
  Info.lpVerb := PChar(Operation);
  Info.lpFile := PChar(FileName);
  Info.lpParameters := PChar(Parameter);
  Info.lpDirectory := PChar(Directory);
  Info.nShow := Show;
  bOK := Boolean(ShellExecuteEx(@Info));
  if bOK then
  begin
    if bWait then
    begin
      while WaitForSingleObject(Info.hProcess, 100) = WAIT_TIMEOUT do
        Application.ProcessMessages;
      bOK := GetExitCodeProcess(Info.hProcess, DWORD(Result));
    end
    else
      Result := 0;
  end;
  if not bOK then
    Result := -1;
end;


uso:

procedure Copia(Origem, Destino: String);
var
   Parametros: Pchar;
   I: integer;
begin
  try
   Parametros := Pchar('"' + Origem + '" "' + Destino + '" /S /Y ');
   I := ShellExecuteAndWait('open', 'xCopy', Parametros, '', SW_SHOW, True);
  Except
    on E:Exception do
      GeraLog('Erro ao copiar: '+E.Message);
  end;
end;


O que seria a origem e o destino nã tendi muito bem o algoritmo
Responder
Gostei + 0

27/12/2019

Natanael Ferreira

achei essa função nessa semana e pra mim funcionou:

function ShellExecuteAndWait(Operation, FileName, Parameter, Directory: String; Show: Word; bWait: Boolean): Longint;
var
  bOK: Boolean;
  Info: TShellExecuteInfo;
begin
  FillChar(Info, SizeOf(Info), Chr(0));
  Info.cbSize := SizeOf(Info);
  Info.fMask := SEE_MASK_NOCLOSEPROCESS;
  Info.lpVerb := PChar(Operation);
  Info.lpFile := PChar(FileName);
  Info.lpParameters := PChar(Parameter);
  Info.lpDirectory := PChar(Directory);
  Info.nShow := Show;
  bOK := Boolean(ShellExecuteEx(@Info));
  if bOK then
  begin
    if bWait then
    begin
      while WaitForSingleObject(Info.hProcess, 100) = WAIT_TIMEOUT do
        Application.ProcessMessages;
      bOK := GetExitCodeProcess(Info.hProcess, DWORD(Result));
    end
    else
      Result := 0;
  end;
  if not bOK then
    Result := -1;
end;


uso:

procedure Copia(Origem, Destino: String);
var
   Parametros: Pchar;
   I: integer;
begin
  try
   Parametros := Pchar('"' + Origem + '" "' + Destino + '" /S /Y ');
   I := ShellExecuteAndWait('open', 'xCopy', Parametros, '', SW_SHOW, True);
  Except
    on E:Exception do
      GeraLog('Erro ao copiar: '+E.Message);
  end;
end;


O que seria a origem e o destino nã tendi muito bem o algoritmo


Neste caso que está fazendo uma cópia:

Origem = Caminho completo do arquivo que será copiado
Destino = Caminho completo onde salvará o novo arquivo copiado

Exemplo, copiando o arquivo teste.txt da Pasta1 para Pasta2:

Copia('C:\\Pasta1\\teste.txt', 'C:\\Pasta2\\teste.txt')
Responder
Gostei + 0

02/07/2020

Maiquel Parisotto

Pessoal, achei esta função.
O único problema é que a tela chamada externa não fica em frente ao programa em execução, ela fica por trás.
Alguém sabe o porque?
Responder
Gostei + 0

13/03/2023

Sismais Tecnologia

Maiquel, respondendo à sua dúvida, é preciso passar nas propriedades do TShellExecuteInfo o valor do Handle (Handle da janela ou aplicação que está chamando o ShellExecute):

function ShellExecuteAndWait(AHandle: HWND; Operation, ...
...
  Info.lpFile := PChar(FileName);
  Info.Wnd := AHandle; //<<< Aqui.
...
Responder
Gostei + 0

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

Aceitar