Função para cadastro de dados em um arquivo DBF

Olá pessoal…

Hoje vou mostrar uma rotina para manipular os dados de um arquivo DBF via AdvPL (como se fosse uma AxCadastro em Grid).


Primeiramente quero agradecer a ajuda do meu amigo Lyster Machado na construção da rotina.

Ao abrir a função, a primeira tela é para a escolha do arquivo .dbf.

Escolha do arquivo DBF

Escolha do arquivo DBF

Em seguida, o arquivo será processado e aberto uma tela com grid e dois botões, onde toda a alteração realizada (desde exclusão, até inclusão ou alteração), será salvo no arquivo .dbf.

Manipulação do arquivo

Manipulação do arquivo

Abaixo o código fonte utilizado.

//Bibliotecas
#Include "Protheus.ch"
#Include "TopConn.ch"

/*/{Protheus.doc} zEditTmp
Função para manipulação de registros .dbf
@author Atilio
@since 06/08/2016
@version 1.0
	@example
	u_zEditTmp()
/*/

User Function zEditTmp()
	Local aArea    := GetArea()
	Local cArqDBF  := cGetFile(	"Arquivo DBF .dbf | *.dbf ",;                      //Máscara
									"Arquivo...",;                                     //Título
									,;                                                 //Número da máscara
									,;                                                 //Diretório Inicial
									.F.,;                                              //.F. == Abrir; .T. == Salvar
									,;                                                 //Tipo
									.T.)                                               //Exibe diretório do servidor
	
	//Se o arquivo não existir
	If ! File(cArqDBF)
		MsgStop("Arquivo <b>'"+cArqDBF+"'</b> não existe!", "Atenção")
		Return
	EndIf
	
	//Processando as informações e montando a Dialog
	Processa({|| u_zEditDBF(cArqDBF) }, "Aguarde...")
	
	RestArea(aArea)
Return


/*/{Protheus.doc} zEditDBF
Função para manipular o arquivo .dbf
@type function
@author Atilio
@since 06/08/2016
@version 1.0
	@param cArqDBF, character, Caminho do arquivo .dbf
	@example
	u_zEditDBF("\system\teste.dbf")
/*/

User Function zEditDBF(cArqDBF)
	Local cDirSrv    := ""
	Local aArea      := GetArea()
	Local nTamBtn    := 50
	Private cTabTmp  := "TMP_"+RetCodUsr()
	Private nColunas := 0
	Private nLinhas  := 0
	Private aDados   := {}
	Private oDlgPvt
	Private oMsGet
	Private aHeader  := {}
	Private aCols    := {}
	Private aEdit    := {}
	Private aStrut   := {}
	Private aAux     := {}
	//Tamanho da Janela
	Private aTamanho := MsAdvSize()
	Private nJanLarg := aTamanho[5]
	Private nJanAltu := aTamanho[6]
	Private nColMeio := (nJanLarg)/4

	//Usando o dbf como tabela temporária
	dbUseArea(.T., "DBFCDXADS", cArqDBF, cTabTmp, .T., .F.)
	Count To nLinhas
	nColunas := fCount()
	aStrut   := (cTabTmp)->(DbStruct())
	(cTabTmp)->(DbGoTop())
	
	//Percorrendo a estrutura, para adicionar as colunas
	For nAtual := 1 To Len(aStrut)
		//Cabeçalho ...	Titulo							Campo					Mask		Tamanho				Dec							Valid	Usado	Tip						F3	CBOX
		aAdd(aHeader,{	Capital(aStrut[nAtual][1]),	aStrut[nAtual][1],	"",			aStrut[nAtual][3],	aStrut[nAtual][4],		".T.",	".T.",	aStrut[nAtual][2],	"",	""})
		aAdd(aEdit, aStrut[nAtual][1])
	Next
	
	//Percorrendo as linhas e adicionando no aCols
	While ! (cTabTmp)->(EoF())
		//Montando a linha atual
		aAux := Array(Len(aHeader)+1)
		For nAtual := 1 To Len(aStrut)
			aAux[nAtual] := &((cTabTmp)->(aEdit[nAtual]))
		Next
		aAux[Len(aHeader)+1] := .F.
		
		//Adiciona no aCols
		aAdd(aCols, aClone(aAux))
		
		(cTabTmp)->(DbSkip())
	EndDo
	
	//Montando a tela
	DEFINE MSDIALOG oDlgPvt TITLE "Arquivo DBF..." FROM 000, 000  TO nJanAltu, nJanLarg COLORS 0, 16777215 PIXEL
		//Dados
		@ 003, 003  GROUP oGrpDad TO (nJanAltu/2)-033, (nJanLarg/2)-003  PROMPT "Dados: "  OF oDlgPvt PIXEL
			oMsGet := MsNewGetDados():New(	010,;          					//nTop
												006,;          					//nLeft
												(nJanAltu/2)-033,;        		//nBottom
												(nJanLarg/2)-006,;       		//nRight
												GD_INSERT+GD_DELETE+GD_UPDATE,;	//nStyle
												"AllwaysTrue()",;       			//cLinhaOk
												,;           						//cTudoOk
												"",;          					//cIniCpos
												aEdit,;          					//aAlter
												,;           						//nFreeze
												9999999,;         				//nMax
												,;           						//cFieldOK
												,;           						//cSuperDel
												,;           						//cDelOk
												oDlgPvt,;     					//oWnd
												aHeader,;        					//aHeader
												aCols)         					//aCols
			
		//Ações
		@ (nJanAltu/2)-025, 003  GROUP oGrpAco TO (nJanAltu/2)-003, (nJanLarg/2)-003  PROMPT "Ações: "  OF oDlgPvt PIXEL
			@ (nJanAltu/2)-19, (nJanLarg/2)-((nTamBtn*1)+06) BUTTON oBtnConf PROMPT "Cancelar"   SIZE nTamBtn, 013 OF oDlgPvt ACTION(oDlgPvt:End())     PIXEL
			@ (nJanAltu/2)-19, (nJanLarg/2)-((nTamBtn*2)+09) BUTTON oBtnLimp PROMPT "Salvar"     SIZE nTamBtn, 013 OF oDlgPvt ACTION(fSalvar())         PIXEL
	ACTIVATE MSDIALOG oDlgPvt CENTERED
	 
	(cTabTmp)->(DbCloseArea())
	RestArea(aArea)
Return

/*---------------------------------------------------------------------*
 | Func:  fSalvar                                                      |
 | Autor: Daniel Atilio                                                |
 | Data:  06/08/2016                                                   |
 | Desc:  Função para salvar os dados do dbf                           |
 *---------------------------------------------------------------------*/

Static Function fSalvar()
	Local aColsAux := oMsGet:aCols
	Local nAtual   := 0
	Local nAux     := 0
	
	//Percorre os dados e exclui tudo que existir
	(cTabTmp)->(DbGoTop())
	While !(cTabTmp)->(EoF())
		RecLock(cTabTmp, .F.)
			DbDelete()
		(cTabTmp)->(MsUnlock())
		
		(cTabTmp)->(DbSkip())
	EndDo
	
	//Agora percorre o aCols
	For nAtual := 1 To Len(aColsAux)
		//Se não tiver excluído, inclui o registro
		If !(aColsAux[nAtual][Len(aHeader)+1])
			RecLock(cTabTmp, .T.)
				For nAux := 1 To Len(aStrut)
					&(aStrut[nAux][1]) := aColsAux[nAtual][nAux]
				Next
			(cTabTmp)->(MsUnlock())
		EndIf
	Next
	
	oDlgPvt:End()
	MsgInfo("Gravação completa!", "Atenção")
Return

Esses e outros códigos, estão disponíveis gratuitamente no nosso GitHub, acesse em github.com/dan-atilio/AdvPL.

Bom pessoal, por hoje é só.
Abraços e até a próxima.

About Dan_Atilio

Analista e desenvolvedor de sistemas na TOTVS Oeste Paulista Bauru. Técnico em Informática pelo CTI da Unesp. Graduado em Banco de Dados pela Fatec Bauru. Entusiasta de soluções Open Source e blogueiro nas horas vagas. Autor do projeto Terminal de Informação, onde são postados tutoriais e notícias envolvendo o mundo da tecnologia.

Deixe uma resposta