Fórum Compactando aquivos #459663

Amigo..

Hoje eu to com tempo... então veja isso;...
Espero ter ajudado



procedure TForm1.BitBtn1Click(Sender: TObject);
begin
CompactarArquivo(ArquivoDestino, LocalCompactar: string);
end;

procedure TForm1.CompactarArquivo(ArquivoDestino, LocalCompactar: string);
var
proc_info: TProcessInformation;
startinfo: TStartupInfo;
ExitCode: LongWord;
winrar: string;
begin
// Rotina de compactação que adiciona arquivo a um rar, executando o winrar em segundo plano
if FileExists('C:\Program Files\WinRAR\WINRAR.EXE') then
begin
// Verifica se tem o winrar local
winrar := 'C:\Program Files\WinRAR\WINRAR.EXE';
end
else
begin
// Utiliza o winrar do servidor
winrar := '\\caminho\Winrar\WINRAR.EXE';
end;
FillChar(proc_info, sizeof(TProcessInformation), 0);
FillChar(startinfo, sizeof(TStartupInfo), 0);
startinfo.cb := sizeof(TStartupInfo);
startinfo.wShowWindow := SW_HIDE;
if (CreateProcess(nil, PChar(winrar + ' a -inul -ibck ' + ArquivoDestino + ' ' + LocalCompactar),
nil, nil, False, REALTIME_PRIORITY_CLASS, nil, nil, startinfo, proc_info)) then
begin // Cria processo de compactação
WaitForSingleObject(proc_info.hProcess, INFINITE);
// Aguarda a finalização do thread do processo para continuar
GetExitCodeProcess(proc_info.hProcess, ExitCode);
CloseHandle(proc_info.hThread);
CloseHandle(proc_info.hProcess);
end;
end;

Pode fechar o tópico, ja descobri como faz, basta colocar "winrar a -ep", compacta somente o conteúdo do diretório.