Nesse artigo, iremos demonstrar uma customização que criamos, onde é feito a limpeza dos registros apagados das tabelas (o famoso Pack).

A premissa do Pack é apagar realmente, os registros que ficam marcados com o asterisco no campo D_E_L_E_T_.

Sempre que precisamos fazer a limpeza, temos que ir pelo APSDU, abrir tabela a tabela que deseja fazer a limpeza, e executar o Pack.

Pensando nisso, otimizamos o processo para executar em todas as tabelas em massa. Essa função chamamos de zPack. Ao executar ela, é necessário confirmar se realmente deseja prosseguir.

Pergunta exibida se deseja continuar

Ao confirmar, será efetuado uma busca no sysobjects do SQL Server, para retornar todas as tabelas existentes no Protheus, e então será percorrido uma a uma.

Barra de Progresso exibida

A cada tabela, será feito uma query, buscando os registros deletados, e ao finalizar será exibido uma mensagem demonstrando quais tabelas que foram executados o Pack.

Log do resultado

Abaixo o código fonte desenvolvido:

//Bibliotecas
#Include "TOTVS.ch"
#Include "TopConn.ch"
 
/*/{Protheus.doc} User Function zPack
Função para realizar o Pack em todas as tabelas do sistema
@type  Function
@author Atilio
@since 29/09/2022
@obs Como pré requisito, é necessário compilar o fonte zLogGeneric.prw na base, disponível em https://terminaldeinformacao.com/2022/03/07/criar-um-log-em-txt-de-forma-generica-ti-responde-003/
/*/
 
User Function zPack()
    If FWAlertYesNo("Você deseja realmente fazer a limpeza (pack) nos registros deletados das tabelas?", "Continua?")
        Processa({|| fProcessa()}, "Limpando...")
    EndIf
Return
 
Static Function fProcessa()
    Local aArea     := FWGetArea()
    Local cTabAlias := ""
    Local cTabSQL   := ""
    Local cPasta    := GetTempPath()
    Local cArquivo  := "log_pack_" + dToS(Date()) + "_" + StrTran(Time(), ":", "-") + ".txt"
    Local lHora     := .T.
    Local oLogGen   := Nil
    Local cQryTabs  := ""
    Local nAtual    := 0
    Local nTotal    := 0
    Local cQryDelet := ""
    Local cMascDel  := "@E 999,999,999,999,999"
 
    //Efetua uma busca em todas as tabelas do Protheus (tamanho 6 e com final XX0 onde XX é o número da empresa, exemplo SB1XX0)
    //   Observacao: é desconsiderado as SX* e XX* devido a integridade dos dados
    cQryTabs := " SELECT  " + CRLF
    cQryTabs += "     name as TABNAME  " + CRLF
    cQryTabs += " FROM  " + CRLF
    cQryTabs += "     sysobjects " + CRLF
    cQryTabs += " WHERE " + CRLF
    cQryTabs += "     xtype = 'U'  " + CRLF
    cQryTabs += "     AND category = 0 " + CRLF
    cQryTabs += "     AND LEN(RTRIM(name)) = 6 " + CRLF
    cQryTabs += "     AND RIGHT(RTRIM(name), 3) = '" + cEmpAnt + "0' " + CRLF
    cQryTabs += "     AND LEFT(name, 2) != 'SX' " + CRLF
    cQryTabs += "     AND LEFT(name, 2) != 'XX' " + CRLF
    cQryTabs += " ORDER BY " + CRLF
    cQryTabs += "     TABNAME " + CRLF
    TCQuery cQryTabs New Alias "QRYTABS"
 
    //Se houver dados
    If ! QRYTABS->(EoF())
        //Cria o log
        oLogGen  := zLogGeneric():New(cPasta, cArquivo, lHora)
        oLogGen:AddText("zPack : Limpeza das tabelas do Protheus")
 
        //Define o tamanho da régua
        Count To nTotal
        ProcRegua(nTotal)
        QRYTABS->(DbGoTop())
 
        //Percorre todas as tabelas
        While ! QRYTABS->(EoF())
 
            //Atualiza as variáveis usadas
            cTabSQL   := Alltrim(QRYTABS->TABNAME)
            cTabAlias := Left(cTabSQL, 3)
 
            //Incrementa a régua
            nAtual++
            IncProc('Analisando tabela "' + cTabAlias + '" (registro ' + cValToChar(nAtual) + ' de ' + cValToChar(nTotal) + ')...')
 
            //Busca se a tabela tem registros excluidos
            cQryDelet := " SELECT " + CRLF
            cQryDelet += "     COUNT(D_E_L_E_T_) AS DELETADOS " + CRLF
            cQryDelet += " FROM " + CRLF
            cQryDelet += "     " + cTabSQL + " TAB " + CRLF
            cQryDelet += " WHERE " + CRLF
            cQryDelet += "     TAB.D_E_L_E_T_ = '*' " + CRLF
            TCQuery cQryDelet New Alias "QRYDELET"
 
            //Caso haja registros excluidos, terá de ser feito a limpeza
            If QRYDELET->DELETADOS > 0
 
                //Se a tabela já estiver aberta, fecha para depois abrir em modo exclusivo
                If Select(cTabAlias) > 0
                    (cTabAlias)->(DbCloseArea())
                EndIf
 
                //Tenta Abrir em modo Exclusivo
                USE (cTabSQL) ALIAS (cTabAlias) EXCLUSIVE NEW VIA "TOPCONN"
                If ! NetErr()
 
                    //Aciona o Pack e Commit
                    (cTabAlias)->(__DBPack())
                    (cTabAlias)->(DbCommitAll())
                    oLogGen:AddText('Tabela "' + cTabAlias + '" - pack executado, existia "' + Transform(QRYDELET->DELETADOS, cMascDel) + '" registros que foram apagados')
 
                Else
                    oLogGen:AddText('Tabela "' + cTabAlias + '" - não foi possível abrir em modo Exclusivo')
                EndIf
                (cTabAlias)->(DbCloseArea())
            EndIf
            QRYDELET->(DbCloseArea())
 
            QRYTABS->(DbSkip())
        EndDo
 
        //Encerra o log e mostra o txt
        oLogGen:Finish()
        FWAlertSuccess("Procedimento de Pack finalizado", "Sucesso")
 
    Else
        FWAlertError("Não foi possível buscar a listagem de tabelas!", "Atenção")
    EndIf
    QRYTABS->(DbCloseArea())
 
    FWRestArea(aArea)
Return 

Obs.: Para o correto funcionamento do exemplo acima, baixe a classe zLogGeneric, disponível nesse link: https://terminaldeinformacao.com/2022/03/07/criar-um-log-em-txt-de-forma-generica-ti-responde-003/

Bom pessoal, por hoje é só.

Abraços e até a próxima.

Tags: AdvPLProtheus