Olá pessoal…
Hoje vou mostrar como copiar / clonar um grupo de perguntas no Protheus, utilizando uma função escrita em AdvPL.
O objetivo de clonar um grupo de perguntas, é não correr o risco de alterar um grupo padrão, por exemplo, é feito o download de códigos fontes de relatórios no portal da TOTVS, e existiam 10 parâmetros originais, então o desenvolvedor adiciona mais 5 parâmetros, totalizando 15. A TOTVS lança uma versão nova do relatório com 13 parâmetros, o que vai acontecer? Os parâmetros irão se perder, e entrarão em conflito. Para isso, podemos clonar o grupo de perguntas, e utilizar este que foi clonado.
Abaixo uma imagem de exemplo da pergunta original e da pergunta clonada.
Para realizar a cópia, basta utilizar u_zCpySX1, e passar o nome do grupo original, o do clone, e se irá excluir o clone antes da cópia.
Abaixo o código fonte desenvolvido.
//Bibliotecas #Include "Protheus.ch" /*/{Protheus.doc} zCpySX1 Copia um grupo de perguntas para um novo grupo, clonando seus conteúdos @author Atilio @since 10/08/2015 @version 1.0 @param cPergAnt, Caracter, Código da Pergunta antiga @param cPergNov, Caracter, Código da Pergunta nova @param lExcNov, Lógico, Define se será excluído o grupo de perguntas novo antes da cópia @example u_zCpySX1("RELLAS", "X_RELLAS", .T.) u_zCpySX1("PERG01", "X_PERG01", .T.) u_zCpySX1("X_PRINTER", "X_PRINTER2", .T.) /*/ User Function zCpySX1(cPergAnt, cPergNov, lExcNov) Local aArea := GetArea() Local aAreaX1 := SX1->(GetArea()) Local aX1Estr := SX1->(DbStruct()) Local aAreaAux Local nColuna := 0 Local aConteu := {} Default cPergAnt := "" Default cPergNov := "" Default lExcNov := .T. DbSelectArea("SX1") SX1->(DbSetOrder(1)) //X1_GRUPO + X1_ORDEM SX1->(DbGoTop()) //Se a pergunta antiga ou a nova estiverem em branco, mostra mensagem de erro If Empty(cPergAnt) .Or. Empty(cPergNov) MsgStop("Pergunta antiga e/ou nova estão em branco!", "Atenção") //Senão, se as perguntas forem iguais, mostra erro ElseIf Alltrim(cPergAnt) == Alltrim(cPergNov) MsgStop("Pergunta antiga é igual à nova!", "Atenção") //Senão, define que as perguntas terão um tamanho de 10 de caracteres, pega a estrutura da SX1 e efetua a cópia Else cPergAnt := PadR(cPergAnt, Len(SX1->X1_GRUPO)) cPergNov := PadR(cPergNov, Len(SX1->X1_GRUPO)) //Se o grupo de perguntas não existir, mostra mensagem de erro If !SX1->(DbSeek(cPergAnt)) MsgStop("Pergunta antiga não existe! Logo, não pode ser copiada!", "Atenção") //Senão prossegue com a cópia Else aAreaAux := SX1->(GetArea()) //Se for para excluir o grupo novo If lExcNov //Posiciona no grupo novo If SX1->(DbSeek(cPergNov)) //Enquanto não for fim da tabela e tiver registros da pergunta nova While !SX1->(EoF()) .And. SX1->X1_GRUPO == cPergNov RecLock("SX1", .F.) DbDelete() SX1->(MsUnlock()) SX1->(DbSkip()) EndDo EndIf EndIf RestArea(aAreaAux) //Enquanto não for o fim da tabela e tiver registros na pergunta antiga While !SX1->(EoF()) .And. SX1->X1_GRUPO == cPergAnt aAreaAux := SX1->(GetArea()) aConteu := {} //Primeiro é armazenado tudo em um array, para não divergir os ponteiros de registros For nColuna := 1 To Len(aX1Estr) //Se a coluna for a X1_GRUPO, define o nome da pergunta nova If Alltrim(aX1Estr[nColuna][1]) == "X1_GRUPO" aAdd(aConteu, cPergNov) //Senão, efetua a cópia da coluna Else aAdd(aConteu, &("SX1->"+aX1Estr[nColuna][1])) EndIf Next //Gravando os dados na tabela nova, conforme estrutura da SX1 RecLock("SX1", .T.) For nColuna := 1 To Len(aX1Estr) &(aX1Estr[nColuna][1]) := aConteu[nColuna] Next SX1->(MsUnlock()) //Restaurando a área da pergunta antiga RestArea(aAreaAux) SX1->(DbSkip()) EndDo EndIf EndIf RestArea(aAreaX1) RestArea(aArea) Return
Bom pessoal, por hoje é só.
Abraços e até a próxima.
Atilio, ele deleta original e restaura no final?
Bom dia Beto.
Não, a original não é deletada, somente a cópia, se já existir e você passar o parâmetro se quer excluir.
Abraços.