Olá pessoal…

Hoje vou mostrar uma função desenvolvida para compactar arquivos em AdvPL com a extensão .rar ou .zip (utilizando o WinRAR).

Primeiramente, instale o WinRAR, e coloque ele nas variáveis de ambiente (leia o artigo Como utilizar o WinRAR pelo Prompt de Comando).

Agora, basta compilar a rotina e usar, ela recebe 3 parâmetros, o diretório dentro da Protheus Data com os arquivos (por exemplo, \diretorio\*.pdf), se será .rar ou .zip e qual é o nome do arquivo (teste.rar).

Abaixo um print da pasta antes de executar a rotina:

Arquivos sem compactação

E abaixo um print depois de compactar os arquivos.

Arquivos compactados

Abaixo o código fonte completo.

//Bibliotecas
#Include "Protheus.ch"
 
/*/{Protheus.doc} zCompacta
Função para compactar arquivos utilizando .rar ou .zip
@type function
@author Atilio
@since 21/09/2016
@version 1.0
    @param cDirArqs, character, Diretório de arquivos dentro da Protheus Data (ex.: "\_diretorio\*.pdf")
    @param lRar, lógico, Define se será com a extensão .rar (.T.) ou .zip (.F.)
    @param cArqNovo, character, Nome do arquivo a ser gerado
    @example
    u_zCompacta("\x_arquivos\*.txt", .T., "teste.rar")
    u_zCompacta("\x_arquivos\*.pdf", .F., "teste.zip")
/*/
 
User Function zCompacta(cDirArqs, lRar, cArqNov)
    Local aArea       := GetArea()
    Local cDirRar     := SuperGetMV("MV_X_RAR", .F., "C:\Program Files\WinRAR\")
    Local cComando    := ""
    Local cDirSrv     := Alltrim(GetSrvProfString("RootPath",""))
    Local cDirResto   := ""
    Default cDirArqs  := ""
    Default lRar      := .T.
    Default cArqNov   := "arquivo_novo."+Iif(lRar, "rar", "zip")
     
    //Se tiver arquivos para compactar
    If !Empty(cDirArqs)
        cDirResto := SubStr(cDirArqs, 1, RAt("\", cDirArqs))
         
        //Se for com a extensão rar
        If lRar
            cComando := "rar a "+cArqNov+" "+cDirSrv+cDirArqs+" -ep -df"
         
        //Senão, será zip
        Else
            cComando := "winrar a -afzip "+cArqNov+" "+cDirSrv+cDirArqs+" -ep -df"
        EndIf
         
        //Executando o comando no servidor
        WaitRunSrv(cDirRar+cComando, .T., cDirSrv+cDirResto)
    EndIf
     
    RestArea(aArea)
Return

Update 08/02/2017:
Conforme sugestão do Luciano Silva, coloquei no fonte na variável cDirRar para buscar o conteúdo de um parâmetro, pois pode variar dependendo das versões do Windows e até mesmo do tipo (32 bits ou 64 bits).

Update Agosto de 2023:

Recentemente o Fábio Veiga Oliva, montou uma função baseada na de cima, para poder fazer a descompactação de arquivos usando o winrar com o AdvPL. Abaixo o código fonte em que ele gentilmente disponibilizou:

User Function zDesCompacta(cDirArqs, lRar, cArqNov)
Local aArea       := GetArea()
Local cDirRar     := SuperGetMV("MV_X_RAR", .F., "C:\Program Files\WinRAR\")
Local cComando    := ""
Local cDirSrv     := Alltrim(GetSrvProfString("RootPath",""))
Local cDirResto   := ""
Default cDirArqs  := ""
Default lRar      := .T.
Default cArqNov   := "arquivo_novo."+Iif(lRar, "rar", "zip")

//Se tiver arquivos para compactar
If !Empty(cDirArqs)
	cDirResto := SubStr(cDirArqs, 1, RAt("\", cDirArqs))
	
	cComando := "unrar x "+cDirArqs+cArqNov+" "+cDirArqs+" -y"
	
	cComando1 := "c:"+chr(13)+chr(10)
	cComando1 += "cd\program files\winrar"+chr(13)+chr(10)
	cComando1 += cComando
	
	Memowrit(cDirArqs+"abre.bat",cComando1)
    ShellExecute("Open",  "abre.bat" , "" , cDirArqs , 1 )
EndIf

RestArea(aArea)
Return

Bom pessoal, por hoje é só.
Abraços e até a próxima.

Tags: AdvPL