Como deixar informações de uma tela pré-salvas antes de gravar no banco de dados

No artigo de hoje, vou mostrar como deixar informações pré salvas antes de efetivar um cadastro.

Em um cliente, tem um usuário que fazia pedidos de compras, e digitava cerca de 300 a 400 itens, e as vezes ele precisava ter que resolver alguma coisa em outro setor, e o timeout da rede da empresa às vezes encerrava a conexão dele.

Cogitamos em aumentar o timeout, mas como na parte da rede eles não podiam mexer, então solicitaram para que a alternativa fosse feita no ERP.

Para isso, foi criado a seguinte lógica:

  1. Criar uma ação no Outras Ações do Pedidos de Compras
  2. Essa função irá abrir uma tela com uma grid, e aqui começa nossa mágica
  3. Se existir um arquivo texto na temporária do Windows, irá carregar as informações desse arquivo para a grid, se não existir, irá criar o arquivo em branco
  4. Na alteração entre as linhas para cima ou para baixo, será feito um laço de repetição, copiando todas as informações e jogando para esse arquivo texto

Dessa forma, se cair a conexão do usuário, ou até mesmo ele fechar propositalmente o Protheus, ao abrir novamente, o arquivo texto será lido, processado e a grid será atualizada com as informações.

Abaixo o exemplo do código fonte desenvolvido:

//Bibliotecas
#Include "TOTVS.ch"

/*/{Protheus.doc} User Function MT121BRW
Ponto de entrada para adicionar outras ações no Pedido de Compras
@type  Function
@author Atilio
@since 10/03/2018
@version version
/*/

User Function MT121BRW()
	Local aArea := GetArea()

	aAdd(aRotina,{"* Incluir Pedido"              ,"U_ACOMM01" , 0, 2, 0, Nil })
	
	RestArea(aArea)
Return

/*/{Protheus.doc} User Function ACOMM01
Facilitador para inclusão de pedidos de compras que ficam sempre na memória os itens
@type  Function
@author Atilio
@since 10/03/2018
@version version
/*/

User Function ACOMM01()
    Local aArea := GetArea()
    Local oDlgPed
    Local cMaskQtd := PesqPict('SC7', 'C7_QUANT')
    //Fontes
    Local cFontPad    := "Tahoma"
    Local oFontMod    := TFont():New(cFontPad, , -38)
	Local oFontSub    := TFont():New(cFontPad, , -20)
	Local oFontSubN   := TFont():New(cFontPad, , -20, , .T.)
    //Tamanho de componentes
    Local aTamanho := MsAdvSize()
    Local nJanLarg := aTamanho[5] - 100
    Local nJanAltu := aTamanho[6] - 200
    Local nLargBtn := 50
    //Fornecedor e loja
    Private cFornPad := "F00001"
    Private cLojaPad := "01"
    Private cTabePad := "001"
    //Variaveis privadas da tela
    Private oSayModulo, cSayModulo := 'COM'
    Private oSayTitulo, cSayTitulo := 'Inclusão de'
    Private oSaySubTit, cSaySubTit := 'Pedidos de Compras'
    Private oMsGetCom
    Private aHeaderCom := {}
    Private aColsCom := {}
    Private aColsEdit := {"XX_PRODUTO", "XX_PRAZO", "XX_QTDE", "XX_OBSERV"}
    //Posições das colunas
    Private nPosProd := 1
    Private nPosDesc := 2
    Private nPosQtde := 3
    Private nPosObse := 4
    Private nPosBlan := 5
    Private nPosDele := 6
    //Diretório e arquivos temporários
    Private cPastaTmp := GetTempPath()
    Private cArquiTmp := "pedido_compra_ACOMM01.txt"

    //Monta o aHeader das Interações
    //					Titulo			Campo			Picture	    Tamanho						Dec		                    Valid	Usado	Tipo	F3
    aAdd(aHeaderCom,{	"Produto",		"XX_PRODUTO",	"",			TamSX3('C7_PRODUTO')[01],	0,		                    "u_zVldCo01(1)",	".T.",	"C",	"SB1", ""} )
    aAdd(aHeaderCom,{	"Descricao",	"XX_DESCRIC",	"",			30,	                        0,		                    ".F.",	".F.",	"C",	"",    ""} )
    aAdd(aHeaderCom,{	"Quantidade",	"XX_QTDE",	    cMaskQtd,	TamSX3('C7_QUANT')[01],	    TamSX3('C7_QUANT')[02],		"Positivo()",	".T.",	"N",	"",    ""} )
    aAdd(aHeaderCom,{	"Observação",	"XX_OBSERV",	"",			TamSX3('C7_OBS')[01],	    0,		                    ".T.",	".T.",	"C",	"",    ""} )
    aAdd(aHeaderCom,{	" ",	        "XX_BLANK",	    "",			1,	                        0,		                    ".F.",	".F.",	"C",	"",    ""} )

    If File(cPastaTmp + cArquiTmp)
        Processa( {|| fBuscaDad()}, "Buscando informações...")
    EndIf

    oDlgPed := TDialog():New(0, 0, nJanAltu, nJanLarg, "Novo Pedido de Compra", , , , , CLR_BLACK, RGB(250, 250, 250), , , .T.)
        //Títulos e SubTítulos
        oSayModulo := TSay():New(004, 003, {|| cSayModulo}, oDlgPed, "", oFontMod,  , , , .T., RGB(149, 179, 215), , 200, 30, , , , , , .F., , )
        oSayTitulo := TSay():New(004, 045, {|| cSayTitulo}, oDlgPed, "", oFontSub,  , , , .T., RGB(031, 073, 125), , 200, 30, , , , , , .F., , )
        oSaySubTit := TSay():New(014, 045, {|| cSaySubTit}, oDlgPed, "", oFontSubN, , , , .T., RGB(031, 073, 125), , 300, 30, , , , , , .F., , )

        //Botões
        oBtnFech := TButton():New(006, (nJanLarg/2-001)-((nLargBtn+2)*01), "Fechar",        oDlgPed, {|| oDlgPed:End()},  nLargBtn, 018, , , , .T., , , , , , )
        oBtnConf := TButton():New(006, (nJanLarg/2-001)-((nLargBtn+2)*02), "Confirmar",     oDlgPed, {|| fConfirmar()},  nLargBtn, 018, , , , .T., , , , , , )
        oBtnFech := TButton():New(006, (nJanLarg/2-001)-((nLargBtn+2)*03), "Limpar",        oDlgPed, {|| fLimpar()},  nLargBtn, 018, , , , .T., , , , , , )

        //Grid dos produtos
        oMsGetCom := MsNewGetDados():New(;
            027,;									    //nTop
            003,;										//nLeft
            (nJanAltu/2) - 3,;					        //nBottom
            (nJanLarg/2) - 3,;				            //nRight
            GD_INSERT + GD_UPDATE + GD_DELETE,;			//nStyle
            "AllwaysTrue()",;							//cLinhaOk
            ,;											//cTudoOk
            "",;										//cIniCpos
            aColsEdit,;	        						//aAlter
            ,;											//nFreeze
            99999999,;									//nMax
            ,;											//cFieldOK
            ,;											//cSuperDel
            ,;											//cDelOk
            oDlgPed,;									//oWnd
            aHeaderCom,;								//aHeader
            aColsCom)									//aCols
        oMsGetCom:bChange := {|| fGravaTemp() }

    oDlgPed:Activate(, , , .T., {|| .T.}, , {|| } )

    RestArea(aArea)
Return

/*/{Protheus.doc} User Function zVldCo01
Função para validar as colunas da grid
@type  Function
@author Atilio
@since 31/03/2021
@version version
/*/
User Function zVldCo01(nTipo)
    Local aArea := GetArea()
    Local lRet := .T.
    Local nLinha := oMsGetCom:nAt
    Local aColsAux := oMsGetCom:aCols
    Local cCodProd := ""
    Default nTipo := 1

    //Se for o código do produto
    If nTipo == 1
        cCodProd := Alltrim(&(ReadVar()))

        DbSelectArea('SB1')
        SB1->(DbSetOrder(1)) // B1_FILIAL + B1_COD

        //Valida se o produto existe
        If SB1->(DbSeek(FWxFilial('SB1') + cCodProd))
            DbSelectArea('AIB')
            AIB->(DbSetOrder(2)) // AIB_FILIAL + AIB_CODFOR + AIB_LOJFOR + AIB_CODTAB + AIB_CODPRO

            //Se existir na tabela do fornecedor
            If AIB->(DbSeek(FWxFilial('AIB') + cFornPad + cLojaPad + cTabePad + SB1->B1_COD))
                aColsAux[nLinha][nPosProd] := SB1->B1_COD
                aColsAux[nLinha][nPosDesc] := SubStr(SB1->B1_DESC, 1, 30)

            Else
                lRet := .F.
                MsgStop("Produto não encontrado na tabela de preço - " + cFornPad + "!", "Atenção")
            EndIf

        Else
            lRet := .F.
            MsgStop("Produto não encontrado!", "Atenção")
        EndIf
    EndIf

    RestArea(aArea)
Return lRet

Static Function fGravaTemp()
    Local cTexto := ""
    Local nAtual := 0
    Local aColsAux := oMsGetCom:aCols

    //Percorre as linhas, e se não tiver excluida, grava na variável
    For nAtual := 1 To Len(aColsAux)
        If ! aColsAux[nAtual][nPosDele]
            cTexto += aColsAux[nAtual][nPosProd]+";"
            cTexto += aColsAux[nAtual][nPosDesc]+";"
            cTexto += cValToChar(aColsAux[nAtual][nPosQtde])+";"
            cTexto += aColsAux[nAtual][nPosObse]+";"
            cTexto += CRLF
        EndIf
    Next

    //Gera o arquivo texto
    MemoWrite(cPastaTmp + cArquiTmp, cTexto)
Return

Static Function fBuscaDad()
    Local nAtual := 0
    Local cArquivo := cPastaTmp + cArquiTmp

    oFile := FWFileReader():New(cArquivo)

	//Se o arquivo pode ser aberto
	If (oFile:Open())

		//Se não for fim do arquivo
		If ! (oFile:EoF())
			//Definindo o tamanho da régua
			aLinhas := oFile:GetAllLines()
			ProcRegua(Len(aLinhas))

			//Método GoTop não funciona, deve fechar e abrir novamente o arquivo
			oFile:Close()
			oFile := FWFileReader():New(cArquivo)
			oFile:Open()

			While (oFile:HasLine())
			
				//Incrementando a régua
				nAtual++
				IncProc("Analisando linha " + cValToChar(nAtual) + " de " + cValToChar(Len(aLinhas)) + "...")
				
				//Buscando o texto da linha atual
				cLinAtu := oFile:GetLine()

                //Se tiver conteúdo na linha atual
                If ! Empty(cLinAtu)
                    aDadosAux := StrTokArr(cLinAtu, ";")

                    If ! Empty(aDadosAux[nPosProd])
                        aAdd(aColsCom, {;
                            aDadosAux[nPosProd],;
                            aDadosAux[nPosDesc],;
                            Val(aDadosAux[nPosQtde]),;
                            aDadosAux[nPosObse],;
                            "",;
                            .F.;
                        })
                    EndIf
                EndIf
            EndDo
        EndIf

		//Fecha o arquivo e finaliza o processamento
		oFile:Close()
    EndIf
Return

Static Function fLimpar()
    //Zera o array e apaga o arquivo temporário
    If MsgYesNo("Tem certeza que deseja limpar os itens?", "Atenção")
        aColsCom := {}
        aAdd(aColsCom, {;
            Space(TamSX3('C7_PRODUTO')[01]),;
            Space(30),;
            0,;
            Space(TamSX3('C7_OBS')[01]),;
            "",;
            .F.;
        })
        oMsGetCom:SetArray(aColsCom)

        FErase(cPastaTmp + cArquiTmp)
    EndIf
Return

Static Function fConfirmar()
    Local aColsAux := oMsGetCom:aCols
    Local nTotalItens := Len(aColsAux)
    Local nMinutos := Round(nTotalItens/15, 0) //média de 15 itens por minuto

    If MsgYesNo("Esse procedimento, levará em média " + cValToChar(nMinutos) + " minutos. Deseja continuar?", "Atenção")
        Processa( {|| fInclui()}, "Incluindo pedido...")
    EndIf
Return

Static Function fInclui()
    Local aCabC7 := {}
    Local aItensC7 := {}
    Local aColsAux := oMsGetCom:aCols
    Local nAtual
    Local aLinAux
    Local lAborta := .F.
    Local cProdutos := ""
    Private lMSErroAuto := .F.

    ProcRegua(0)
    IncProc("Adicionando o cabeçalho")

    //Monta o cabeçalho
    aCabC7 := {;
        {'C7_FILIAL',	cFilAnt,	Nil},;
        {'C7_FORNECE',	cFornPad,   Nil},;
        {'C7_LOJA',	    cLojaPad,	Nil},;
        {'C7_COND',	    "026",	    Nil},;
        {'C7_EMISSAO',	Date(),     Nil},;
        {'C7_MOEDA',	1,	        Nil},;
        {'C7_CONTATO',	"Teste",    Nil},;
        {'C7_FILENT',	cFilAnt,	Nil},;
        {'C7_TXMOEDA',	1,          Nil};
    }

    //Insere os itens
    ProcRegua(Len(aColsAux))
    For nAtual := 1 To Len(aColsAux)
        IncProc("Adicionando produto " + cValToChar(nAtual) + " de " + cValToChar(Len(aColsAux)) + "...")
        aLinAux := {}

        //Se a linha não estiver excluída
        If ! aColsAux[nAtual][nPosDele]

            //Faz a validação para ver se o produto tem preço
            If fVldPreco(aColsAux[nAtual][nPosProd], nAtual)
                aAdd(aLinAux, {"C7_ITEM",       StrZero(nAtual, 4),         Nil} )
                aAdd(aLinAux, {"C7_PRODUTO",    aColsAux[nAtual][nPosProd], Nil} )
                aAdd(aLinAux, {"C7_QUANT",      aColsAux[nAtual][nPosQtde], Nil} )
                aAdd(aLinAux, {"C7_CODTAB",     cTabePad,                   Nil} )
                aAdd(aLinAux, {"C7_OBS",        aColsAux[nAtual][nPosObse], Nil} )
                
                aAdd(aItensC7, aClone(aLinAux))
            Else
                cProdutos += "<li>" + Alltrim(aColsAux[nAtual][nPosProd]) + "</li>"
                lAborta := .T.
            EndIf
        EndIf
    Next

    //Se for abortar, irá mostrar a mensagem
    If lAborta
        MsgStop("Os seguintes produtos estão com o preço zerado na tabela de preço '" + cTabePad + "' do fornecedor '" + cFornPad + "': <br><ul>" + cProdutos + "</ul>", "Atenção")

    //Se não tiver sido abortado
    Else
        //Inicia a transação e chama a inclusão do pedido
        Begin Transaction
            ProcRegua(2)
            IncProc("Efetivando a gravação...")
            MSExecAuto({|v, x, y, z, w| MATA120(v, x, y, z, w) }, 1, aCabC7, aItensC7, 3, .F.)

            If lMsErroAuto
                MostraErro()
            Else
                MsgInfo("Pedido de compras gerado, código: " + SC7->C7_NUM, "Atenção")
            EndIf

            //DisarmTransaction()
        End Transaction
    EndIf
Return

Static Function fVldPreco(cCodProd, nLinAtu)
    Local aArea := GetArea()
    Local lRet := .F.
    Local cQuery := ""

    //Monta a consulta buscando o preço na tabela de preço do fornecedor
    cQuery += " SELECT " + CRLF
    cQuery += "     AIB_PRCCOM " + CRLF
    cQuery += " FROM " + CRLF
    cQuery += "     " + RetSQLName("AIB") + " AIB " + CRLF
    cQuery += " WHERE " + CRLF
    cQuery += "     AIB_CODFOR = '" + cFornPad + "' " + CRLF
    cQuery += "     AND AIB_LOJFOR = '" + cLojaPad + "' " + CRLF
    cQuery += "     AND AIB_CODTAB = '" + cTabePad + "' " + CRLF
    cQuery += "     AND AIB_CODPRO = '" + cCodProd + "' " + CRLF
    cQuery += "     AND AIB.D_E_L_E_T_ = ' ' " + CRLF
    TCQuery cQuery New Alias "QRY_AIB"

    //Se não tiver no fim do arquivo
    If ! QRY_AIB->(EoF())
        //Se tiver preço
        If QRY_AIB->AIB_PRCCOM > 0
            lRet := .T.
        Else
            lRet := .F.
            //MsgStop("Produto '" + Alltrim(cCodProd) + "' na linha '" + cValToChar(nLinAtu) + "' está com o preço zerado na tabela de preço '" + cTabePad + "' do fornecedor '" + cFornPad + "'!", "Atenção")
        EndIf

    //Senão, não foi encontrado registro
    Else
        lRet := .F.
        //MsgStop("Produto '" + Alltrim(cCodProd) + "' na linha '" + cValToChar(nLinAtu) + "' não encontrado na tabela de preço '" + cTabePad + "' do fornecedor '" + cFornPad + "'!", "Atenção")
    EndIf
    QRY_AIB->(DbCloseArea())

    RestArea(aArea)
Return lRet

Obs.: A classe MsNewGetDados foi descontinuada, não recomendo criar rotinas do zero com ela, para isso tente usar por exemplo a FwBrowse e/ou MVC, nesse link tem exemplos – Migrando do MSNewGetDados para FWBrowse e MVC.

Bom pessoal, por hoje é só.

Abraços e até a próxima.

Dan Atilio (Daniel Atilio)
Especialista em Engenharia de Software pela FIB. Entusiasta de soluções Open Source. E blogueiro nas horas vagas.

Deixe uma resposta