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.
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.
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.
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