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 

Tags: AdvPLProtheus