Clonar um grupo de perguntas no Protheus

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.

Grupo de Perguntas clonado

Grupo de Perguntas clonado

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.

Dan (Daniel Atilio)
Cristão de ramificação protestante. Especialista em Engenharia de Software pela FIB, graduado em Banco de Dados pela FATEC Bauru e técnico em informática pelo CTI da Unesp. Entusiasta de soluções Open Source e blogueiro nas horas vagas. Autor e mantenedor do portal Terminal de Informação.

2 Responses

  1. Humberto Pontes disse:

    Atilio, ele deleta original e restaura no final?

Deixe uma resposta

Terminal de Informação