Olá pessoal

Hoje vou postar uma rotina que eu uso para documentar as minhas alterações no dicionario de dados em Excel, para ser entregue ao cliente no final de um projeto.

Abaixo o código fonte, a rotina é bem simples e tudo configurado em uma únida tela.

#INCLUDE "PROTHEUS.CH"    
#INCLUDE 'PARMTYPE.CH'
#INCLUDE "FWMVCDEF.CH"
#INCLUDE "TOPCONN.CH"
#include "TOTVS.CH"
#Include "RWMAKE.CH"

//define os campos que serão exportados
#DEFINE CSX2FIELD "X2_CHAVE|X2_NOMEENG     |X2_NOME         |X2_MODO|X2_MODOUN  |X2_MODOEMP|X2_UNICO |      |"
#DEFINE CSX2Label "Key     |Name in English|Nome em Portuges|Mode   |Unit. Mode |Corp. Mode|Uniqe Key|Action|"

#DEFINE CSIXFIELD "INDICE|ORDEM|CHAVE|DESCENG      |DESCRICAO          |      |"
#DEFINE CSIXLabel "Table |Order|Key  |Title English|Titulo em Portugues|Action|"

#DEFINE CSX1FIELD "X1_GRUPO|X1_ORDEM|X1_PERENG    |X1_PERGUNT         |X1_TIPO|X1_TAMANHO|X1_DECIMAL|X1_GSC      |X1_F3         |X1_GRPSXG    |X1_VALID  |X1_VAR01|X1_PRESEL|X1_DEFENG1      |X1_DEF01           |X1_DEFENG2      |X1_DEF02           |X1_DEFENG3      |X1_DEF03           |X1_DEFENG4      |X1_DEF04           |X1_DEFENG5      |X1_DEF05           |X1_PICTURE|      |"
#DEFINE CSX1Label "Group   |Order   |Title English|Titulo em Portugues|Type   |Size      |Decimal   |Group fields|Standard Query|Group Fields |Validation|Variable|Selected |Option 1 English|Option 1 Portugues |Option 2 English|Option 2 Portugues |Option 3 English|Option 3 Portugues |Option 4 English|Option 4 Portugues |Option 5 English|Option 5 Portugues |Picture   |Action|"

#DEFINE CSX6FIELD "X6_VAR  |X6_TIPO|X6_DSCENG          |X6_DESCRIC            |X6_DSCENG1           |X6_DESC1                |X6_DSCENG2           |X6_DESC2                |X6_CONTENG|X6_VALID  |      |"
#DEFINE CSX6Label "Variable|Type   |Description English|Descricao em Portugues|Description English 1|Descricao em Portugues 1|Description English 2|Descricao em Portugues 2|Value     |Validation|Action|"

#DEFINE CSX7FIELD "X7_CAMPO|X7_SEQUENC|X7_REGRA|X7_CDOMIN|X7_TIPO|X7_SEEK|X7_ALIAS|X7_ORDEM|X7_CHAVE|X7_CONDIC|      |"
#DEFINE CSX7Label "Field   |Sequence  |Rule    |C. Domain|Type   |Seek   | Alias  |Order   |key     |Condition|Action|"

#DEFINE CSXAFIELD "XA_ALIAS|XA_TIPO|XA_ORDEM|XA_AGRUP|XA_DESCENG         |XA_DESCRIC            |      |"
#DEFINE CSXALabel "Alias   |Type   |Order   |Group   |Description English|Descricao em Portugues|Action|"

#DEFINE CSXBFIELD "XB_ALIAS|XB_TIPO|XB_SEQ  |XB_COLUNA|XB_DESCENG         |XB_DESCRI             |XB_CONTEM|      |"
#DEFINE CSXBLabel "Alias   |Type   |Sequence|Column   |Description English|Descricao em Portugues|Conteud  |Action|"

#DEFINE CSX3FIELD "SX3->X3_ARQUIVO  |SX3->X3_CAMPO   |cTypefield(SX3->X3_TIPO)  |SX3->X3_TAMANHO    |SX3->X3_DECIMAL    |SX3->X3_ORDEM  |SX3->X3_PICTURE    |SX3->X3_TITENG     |SX3->X3_DESCENG        |Ap5GetHelp(SX3->X3_CAMPO)   |SX3->X3_TITULO       |SX3->X3_DESCRIC         |Ap5GetHelp(SX3->X3_CAMPO)  |X3Uso()    |X3Obrigat(SX3->X3_CAMPO)   |IIF(SX3->X3_BROWSE=='S','Yes',IIF(SX3->X3_BROWSE=='N','No',''))    |SX3->X3_CBOXENG         |SX3->X3_CBOX         |IIF(SX3->X3_CONTEXT=='R','Real',IIF(SX3->X3_CONTEXT=='V','Virtual',''))   |SX3->X3_F3              |SX3->X3_RELACAO     |Iif(empty(SX3->X3_VALID),SX3->X3_VLDUSER,SX3->X3_VALID)          |SX3->X3_WHEN  |SX3->X3_GRPSXG            |SX3->X3_TRIGGER    |SX3->X3_INIBRW |SX3->X3_FOLDER |SX3->X3_AGRUP  |IIf(SX3->X3_PROPRI == 'U','Creation','Update')     |"
#DEFINE CSX3Label "File	            |Field	         |Type	                    |Size               |Decimal            |Order		    |Picture    		|Title English		|Description English    |Help English                |Titulo em Portugues  |Descricao em Portugues	|Help Portugues		        |Used		|Mandatory		            |Browse		                                                        |Combox(English)         |Combox(Portugues)    |Context		                                                              |Standard Search         |Standard Init       |Validation                                                       |When		     |Group of Fields		    |Trigger		    |Init Browse    |Folder 		|Grouping		|Action		                                        |"


#Define ENTER	Chr(13)+Chr(10)

/*/{Protheus.doc} SPDOCAUT
Rotina responsavel por documentar dicionario de dados

@type function
@author Rafael Goncalves
@since Set|2020
/*/
User Function SPDOCAUT(cTGet1,cTGet2,cTGet3,cTGet4,cTGet5,cTGet6,cTGet7,cTGet8)

Default cTGet1 := space(250)
Default cTGet2 := space(250)
Default cTGet3 := space(250)
Default cTGet4 := space(250)
Default cTGet5 := space(250)
Default cTGet6 := space(250)
Default cTGet7 := space(250)
Default cTGet8 := space(250)

// Habilita interface com data mostrada com 4 digitos no ano
// e Habilita data em formato britânico ( Dia/Mes/Ano )
SET CENTURY ON
SET DATE BRITISH

cRmtBuild := GetBuild(.T.)
cRmtIp := GetclientIP()
cUsrName := LogUserName()
dRmtDate := GetRmtDate()
cRmtTime := GetRmtTime()
aRmtInfo := GetRmtInfo()
cRmtTmp := GetTempPath(.T.)
lActivex := IsPlugin()
lSSLConn := IsSecure()
cInfo := ''
cInfo += 'SmartClient Build ....... ' + cRmtBuild + ENTER
cInfo += 'SmartClient Activex ..... ' + IIF(lActivex,"SIM","NAO") + ENTER
cInfo += 'SmartClient Connection .. ' + IIF(lSSLConn ,"SSL","TCP") + ENTER
cInfo += 'SmartClient is 64 bits .. ' + IIF(IsRmt64() ,"SIM","NAO") + ENTER
cInfo += 'Remote IP ............... ' + cRmtIp + ENTER
cInfo += 'Remote User Name ........ ' + cUsrName + ENTER
cInfo += 'Remote DateTime ......... ' + dtoc(dRmtDate)+' '+cRmtTime + ENTER
cInfo += 'Remote Temp Path ........ ' + cRmtTmp + ENTER
cInfo += 'Remote Computer Name .... ' + aRmtInfo[1] + ENTER
cInfo += 'Remote O.S. ............. ' + aRmtInfo[2] + ENTER
cInfo += 'Remote O.S. Detais ...... ' + aRmtInfo[3] + ENTER
cInfo += 'Remote Memory (MB) ...... ' + aRmtInfo[4] + ENTER
cInfo += 'Remote CPU Count ........ ' + aRmtInfo[5] + ENTER
cInfo += 'Remote CPU MHZ .......... ' + aRmtInfo[6] + ENTER
cInfo += 'Remote CPU String ....... ' + aRmtInfo[7] + ENTER
cInfo += 'Remote O.S. Language .... ' + aRmtInfo[8] + ENTER
cInfo += 'Remote Web Browser ...... ' + aRmtInfo[9] + ENTER
cInfo += 'Remote Version .......... ' + RemoteXVersion()+ ENTER
cInfo += 'Remote Ini Patch ........ ' + GetRemoteIniName()+ ENTER
conout(cInfo)

//TODO remover
cTGet1 := "SA1|SA2" + space(250)
cTGet2 := "A1_COD|A1_LOJA"
cTGet3 := "SA1|SA2_1" + space(250)
cTGet4 := "ACA890|ACA980" + space(250)
cTGet5 := "MV_330ATCM|MV_LOTE" + space(250)
cTGet6 := "A00_NIVAGR|A1_CGC_002" + space(250)
cTGet7 := "AA1|ABS|AD1_1" + space(250)
cTGet8 := "SA1|SA2|SA4" + space(250)

/*If GetRemoteType() == 1  //nao for executado do menu
    RpcSetType(3)
    RpcSetEnv('00','102030')
    FSGERFILES(,,cTGet1, cTGet2, cTGet3, cTGet4, cTGet5, cTGet6, cTGet7, cTGet8)
else
*/

    DEFINE MSDIALOG oDlg FROM 0,0 TO 700,500 TITLE "Fast Dictionary Production (F.D.P.) - V 1.0.0" OF oMainWnd PIXEL

        nLin := 40
        //SX2
        oTGet1 := TGet():New( nLin+10,01, bSetGet( cTGet1 ),oDlg, 250,009,"",/* [ bValid ]*/,/**nClrFore */,/**nClrBack */,/**oFont */,/**uParam12 */,/**uParam13 */, .t.,/**uParam15 */,/**uParam16 */, {|| .T.},/*uParam18*/ ,/**uParam19 */, /*bChange*/, /* lReadOnly */, /* lPassword */, /* uParam23 */, /* cReadVar */, /* uParam25 */, /* uParam26 */, /* uParam27 */, /* lHasButton */, /* lNoButton */, /* uParam30 */, "Information for SX2 - Table Key(X2_CHAVE) Ex. SA1|SA2|SF1|"/* cLabelText */, 1/* nLabelPos */, /* oLabelFont */, /* nLabelColor */, /* cPlaceHold */, /* lPicturePriority */, /* lFocSel */ )
        nLin += 30
        //SX3
        //oTGet2 := TGet():New( nLin+10,01, bSetGet( cTGet2 ),oDlg, 250,009,"",/* [ bValid ]*/,/**nClrFore */,/**nClrBack */,/**oFont */,/**uParam12 */,/**uParam13 */, .t.,/**uParam15 */,/**uParam16 */, {|| .T.},/*uParam18*/ ,/**uParam19 */, /*bChange*/, /* lReadOnly */, /* lPassword */, /* uParam23 */, /* cReadVar */, /* uParam25 */, /* uParam26 */, /* uParam27 */, /* lHasButton */, /* lNoButton */, /* uParam30 */, "Information for SX3 - Table File or specific field Ex. SA1|A1_COD"/* cLabelText */, 1/* nLabelPos */, /* oLabelFont */, /* nLabelColor */, /* cPlaceHold */, /* lPicturePriority */, /* lFocSel */ )
        @ nLin+10,01 SAY oSay PROMPT 'Information for SX3 - Table File or specific field Ex. SA1|A1_COD' SIZE 250,09 OF oDlg PIXEL
        @ nLin+20,01 GET oGet VAR cTGet2 SIZE 248,60 MULTILINE OF oDlg PIXEL
               
        nLin += 80
        //SIX
        oTGet3 := TGet():New( nLin+10,01, bSetGet( cTGet3 ),oDlg, 250,009,"",/* [ bValid ]*/,/**nClrFore */,/**nClrBack */,/**oFont */,/**uParam12 */,/**uParam13 */, .t.,/**uParam15 */,/**uParam16 */, {|| .T.},/*uParam18*/ ,/**uParam19 */, /*bChange*/, /* lReadOnly */, /* lPassword */, /* uParam23 */, /* cReadVar */, /* uParam25 */, /* uParam26 */, /* uParam27 */, /* lHasButton */, /* lNoButton */, /* uParam30 */, "Information for SIX - Index in total or Index+Order order Ex. SA1|SA1_1|SA1_5|"/* cLabelText */, 1/* nLabelPos */, /* oLabelFont */, /* nLabelColor */, /* cPlaceHold */, /* lPicturePriority */, /* lFocSel */ )
        nLin += 30
        //SX1
        oTGet4 := TGet():New( nLin+10,01, bSetGet( cTGet4 ),oDlg, 250,009,"",/* [ bValid ]*/,/**nClrFore */,/**nClrBack */,/**oFont */,/**uParam12 */,/**uParam13 */, .t.,/**uParam15 */,/**uParam16 */, {|| .T.},/*uParam18*/ ,/**uParam19 */, /*bChange*/, /* lReadOnly */, /* lPassword */, /* uParam23 */, /* cReadVar */, /* uParam25 */, /* uParam26 */, /* uParam27 */, /* lHasButton */, /* lNoButton */, /* uParam30 */, "Information for SX1 - Pergunte Group Ex. ACA180|ACA190|"/* cLabelText */, 1/* nLabelPos */, /* oLabelFont */, /* nLabelColor */, /* cPlaceHold */, /* lPicturePriority */, /* lFocSel */ )
        nLin += 30
        //SX6
        oTGet5 := TGet():New( nLin+10,01, bSetGet( cTGet5 ),oDlg, 250,009,"",/* [ bValid ]*/,/**nClrFore */,/**nClrBack */,/**oFont */,/**uParam12 */,/**uParam13 */, .t.,/**uParam15 */,/**uParam16 */, {|| .T.},/*uParam18*/ ,/**uParam19 */, /*bChange*/, /* lReadOnly */, /* lPassword */, /* uParam23 */, /* cReadVar */, /* uParam25 */, /* uParam26 */, /* uParam27 */, /* lHasButton */, /* lNoButton */, /* uParam30 */, "Information for SX6 - Parameter Code Ex. MV_330ATCM|MV_LOTE"/* cLabelText */, 1/* nLabelPos */, /* oLabelFont */, /* nLabelColor */, /* cPlaceHold */, /* lPicturePriority */, /* lFocSel */ )
        nLin += 30
        //SX7
        oTGet6 := TGet():New( nLin+10,01, bSetGet( cTGet6 ),oDlg, 250,009,"",/* [ bValid ]*/,/**nClrFore */,/**nClrBack */,/**oFont */,/**uParam12 */,/**uParam13 */, .t.,/**uParam15 */,/**uParam16 */, {|| .T.},/*uParam18*/ ,/**uParam19 */, /*bChange*/, /* lReadOnly */, /* lPassword */, /* uParam23 */, /* cReadVar */, /* uParam25 */, /* uParam26 */, /* uParam27 */, /* lHasButton */, /* lNoButton */, /* uParam30 */, "Information for SX7 - Trigger Field or Field+Sequenc Ex. A00_NIVAGR|A1_CGC_002"/* cLabelText */, 1/* nLabelPos */, /* oLabelFont */, /* nLabelColor */, /* cPlaceHold */, /* lPicturePriority */, /* lFocSel */ )
        nLin += 30
        //SXA
        oTGet7 := TGet():New( nLin+10,01, bSetGet( cTGet7 ),oDlg, 250,009,"",/* [ bValid ]*/,/**nClrFore */,/**nClrBack */,/**oFont */,/**uParam12 */,/**uParam13 */, .t.,/**uParam15 */,/**uParam16 */, {|| .T.},/*uParam18*/ ,/**uParam19 */, /*bChange*/, /* lReadOnly */, /* lPassword */, /* uParam23 */, /* cReadVar */, /* uParam25 */, /* uParam26 */, /* uParam27 */, /* lHasButton */, /* lNoButton */, /* uParam30 */, "Information for SXA - Folder Alias or Alias+Order Ex. AA1|ACA_1"/* cLabelText */, 1/* nLabelPos */, /* oLabelFont */, /* nLabelColor */, /* cPlaceHold */, /* lPicturePriority */, /* lFocSel */ )
        nLin += 30
        //SXB
        oTGet8 := TGet():New( nLin+10,01, bSetGet( cTGet8 ),oDlg, 250,009,"",/* [ bValid ]*/,/**nClrFore */,/**nClrBack */,/**oFont */,/**uParam12 */,/**uParam13 */, .t.,/**uParam15 */,/**uParam16 */, {|| .T.},/*uParam18*/ ,/**uParam19 */, /*bChange*/, /* lReadOnly */, /* lPassword */, /* uParam23 */, /* cReadVar */, /* uParam25 */, /* uParam26 */, /* uParam27 */, /* lHasButton */, /* lNoButton */, /* uParam30 */, "Information for SXB - Standard Query  Alias Ex. SA1|SA2|SB1"/* cLabelText */, 1/* nLabelPos */, /* oLabelFont */, /* nLabelColor */, /* cPlaceHold */, /* lPicturePriority */, /* lFocSel */ )

    ACTIVATE MSDIALOG oDlg CENTER ON INIT EnchoiceBar(oDlg,{|| nOpcA:= 1,;
        FWMsgRun(, {|oSay| FSGERFILES(oSay,oDlg,cTGet1, cTGet2, cTGet3, cTGet4, cTGet5, cTGet6, cTGet7, cTGet8) }, "Processando", "Aguarde Iniciando exportacao")},{|| oDlg:End() })
//Endif

Return .t.


/*/{Protheus.doc} FSGERFILES
Rotina gera arquivos
@type function
@author Rafael Goncalves
@since Set|2020
/*/
Static Function FSGERFILES(oSay,oDlg,cTGet1, cTGet2, cTGet3, cTGet4, cTGet5, cTGet6, cTGet7, cTGet8) as logical
Local _Ni as Numeric
Local _Nj as Numeric
Local lGerF as Logical
Local aGer as Array
Local aGer1 as Array
Local aFIELD as Array
Local aSX2 as Array
Local aSX3 as Array
Local aSIX as Array

Local aSX6 as Array
Local aSX7 as Array
Local aSXA as Array
Local aSXB as Array


//Excel Information
Local cArquivo    := GetTempPath()+'ExpDic_'+dtos(dDataBAse)+'_'+cvaltochar(hora())+'.xml'
Local oFWMSEx     := FWMsExcelEx():New()
Local oExcel

default oSay := nil
default oDlg := nil

lGerF := .F.
//Start SX2
If !Empty(alltrim(cTGet1))
    lGerF := .T.
    If (GetRemoteType() == 1)
        oSay:cCaption := "Gerando SX2"
        ProcessMessages()
    Endif
    aGer := {}
    aSX2 := {}
    aGer := StrTokArr(alltrim(cTGet1), '|' ) //default optional fields
    aFIELD := StrTokArr(alltrim(CSX2FIELD), '|' ) //Fields to export
    aLabel := StrTokArr(alltrim(CSX2Label), '|' ) //Labels to export
    For _Ni := 1 to len(aGer)
        //Found lines
        DbSelectArea("SX2")
        SX2->( dbSetOrder( 1 ) ) //ARQUIVO
        If SX2->( msSeek( aGer[_Ni], .F. ) )
            //Loop Fields
            aGer1 := {}
            For _Nj := 1 to len(aFIELD)
                If !Empty(aFIELD[_Nj])
                    aAdd(aGer1,alltrim(SX2->&(aFIELD[_Nj])))
                Elseif alltrim(aLabel[_Nj]) == "Action"
                    /*If empty(SX2->X2_LOCTYP)
                        aAdd(aGer1,"Creation")
                    Else
                        aAdd(aGer1,"Update")
                    Endif */ 
                    aAdd(aGer1," ")                    
                Else
                    aAdd(aGer1," ")
                EndIf
            Next
            //add to array
            aAdd(aSX2,aGer1)
        Endif
    Next
Endif

//Start SX3

If !Empty(alltrim(cTGet2))
    lGerF := .T.
    If (GetRemoteType() == 1)
        oSay:cCaption := "Gereando SX3"
        ProcessMessages()
    Endif
    aGer := {}
    aSX3 := {}
    aGer := StrTokArr(alltrim(cTGet2), '|' ) //default optional fields
    aFIELD := StrTokArr(alltrim(CSX3FIELD), '|' ) //Fields to export
    aLabel := StrTokArr(alltrim(CSX3Label), '|' ) //Labels to export
    For _Ni := 1 to len(aGer)
        //Checa se gera tabela toda ou um campo
        If len(aGer[_Ni]) < 4 //tabela toda
            SX3->(dbSetOrder(1))
            SX3->(msSeek(aGer[_Ni]))
            While SX3->(!EOF()) .And.  SX3->X3_ARQUIVO == aGer[_Ni]
                aGer1 := {}
                For _Nj := 1 to len(aFIELD)
                    If !Empty(aFIELD[_Nj])
                        xValue:=&(aFIELD[_Nj])
                        If ValType(xValue) == 'C' //Char
                            aAdd(aGer1,alltrim(&(aFIELD[_Nj])))
                        ElseIf ValType(xValue) == 'L' //Char
                            IF xValue
                                aAdd(aGer1,"Yes")
                            Else
                                aAdd(aGer1,"No")     
                            EndIf                       
                        else
                            aAdd(aGer1,&(aFIELD[_Nj]))
                        Endif                        
                        //aAdd(aGer1,alltrim(SX3->&(aFIELD[_Nj])))
                    Elseif aLabel[_Nj] == "Action"
                        /*If empty(SX3->X3_LOCTYP)
                            aAdd(aGer1,"Creation")
                        Else
                            aAdd(aGer1,"Update")
                        Endif */
                        aAdd(aGer1," ")                   
                    Else
                        aAdd(aGer1," ")
                    EndIf
                Next
                //add to array
                aAdd(aSX3,aGer1)
                SX3->(dbSkip())
            EndDo
        Else //campo especifico
            DbSelectArea("SX3")
            SX3->(DbSetOrder(2))
            If SX3->(msSeek(aGer[_Ni]))
                aGer1 := {}
                For _Nj := 1 to len(aFIELD)
                    If !Empty(aFIELD[_Nj])
                        aAdd(aGer1,alltrim(&(aFIELD[_Nj])))
                    Elseif alltrim(aLabel[_Nj]) == "Action"
                        /*If empty(SX3->X3_LOCTYP)
                            aAdd(aGer1,"Creation")
                        Else
                            aAdd(aGer1,"Update")
                        Endif */ 
                        aAdd(aGer1," ")                    
                    Else
                        aAdd(aGer1," ")
                    EndIf
                Next
                //add to array
                aAdd(aSX3,aGer1)
                //cTitulo := TRIM(X3Titulo())
            EndIf
        Endif
    Next
Endif

//Start SIX
If !Empty(alltrim(cTGet3))
    lGerF := .T.
    If (GetRemoteType() == 1)
        oSay:cCaption := "Gereando SIX"
        ProcessMessages()
    Endif
    aGer := {}
    aSIX := {}
    aGer := StrTokArr(alltrim(cTGet3), '|' ) //default optional fields
    aFIELD := StrTokArr(alltrim(CSIXFIELD), '|' ) //Fields to export
    aLabel := StrTokArr(alltrim(CSIXLabel), '|' ) //Labels to export
    For _Ni := 1 to len(aGer)
        //Information for SIX - Index in total or Index+Order order Ex. SA1|SA1_1|SA1_5|
        cKey := aGer[_Ni]
        If !len(aGer[_Ni])<4 //expecific
            cKey := substring(aGer[_Ni],1,3) + substring(aGer[_Ni],5,len(aGer[_Ni]))
        Endif

        //Found lines
        dbSelectArea("SIX")
        SIX->( dbSetOrder( 1 ) ) //ARQUIVO
        If SIX->( msSeek( cKey, .F. ) )
            While !eof() .and. (SIX->INDICE == cKey .or. SIX->INDICE+SIX->ORDEM == cKey)
                //Loop Fields
                aGer1 := {}
                For _Nj := 1 to len(aFIELD)
                    If !Empty(aFIELD[_Nj])
                        aAdd(aGer1,alltrim(SIX->&(aFIELD[_Nj])))
                    Elseif aLabel[_Nj] == "Action"
                        /*If empty(SIX->IX_LOCTYP)
                            aAdd(aGer1,"Creation")
                        Else
                            aAdd(aGer1,"Update")
                        Endif */
                        aAdd(aGer1," ")                     
                    Else
                        aAdd(aGer1," ")
                    EndIf
                Next

                //add to array
                aAdd(aSIX,aGer1)

                dbSelectArea("SIX")
                SIX->(DbSkip())
            EndDo

        Endif
    Next
Endif


/////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////// E X P O R T   S X 1 //////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////

If !Empty(alltrim(cTGet4))
    lGerF := .T.
    If (GetRemoteType() == 1)
        oSay:cCaption := "Gereando SX1"
        ProcessMessages()
    Endif
    aGer := {}
    aSX1 := {}
    aGer := StrTokArr(alltrim(cTGet4), '|' ) //default optional fields
    aFIELD := StrTokArr(alltrim(CSX1FIELD), '|' ) //Fields to export
    For _Ni := 1 to len(aGer)
        //Found lines
        dbSelectArea("SX1")
        SX1->( dbSetOrder( 1 ) )
        If SX1->( msSeek( aGer[_Ni], .F. ) )
            While !eof() .and. (alltrim(SX1->X1_GRUPO) == alltrim(aGer[_Ni]) )
                //Loop Fields
                aGer1 := {}
                For _Nj := 1 to len(aFIELD)
                    If !Empty(aFIELD[_Nj])
                        aAdd(aGer1,(SX1->&(aFIELD[_Nj])))
                    Else
                        aAdd(aGer1," ")
                    EndIf
                Next
                //add to array
                aAdd(aSX1,aGer1)
                dbSelectArea("SX1")
                SX1->(DbSkip())
            EndDo

        Endif
    Next
Endif


/////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////// E X P O R T   S X 6 //////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////

If !Empty(alltrim(cTGet5))
    lGerF := .T.
    If (GetRemoteType() == 1)
        oSay:cCaption := "Gereando SX6"
        ProcessMessages()
    Endif
    aGer := {}
    aSX6 := {}
    aGer := StrTokArr(alltrim(cTGet5), '|' ) //default optional fields
    aFIELD := StrTokArr(alltrim(CSX6FIELD), '|' ) //Fields to export
    aLabel := StrTokArr(alltrim(CSX6Label), '|' ) //Labels to export
    For _Ni := 1 to len(aGer)
        //Found lines
        dbSelectArea("SX6")
        SX6->( dbSetOrder( 1 ) )
        If SX6->( msSeek(xFilial('SX6') +  aGer[_Ni], .F. ) )
            aGer1 := {}
            For _Nj := 1 to len(aFIELD)
                If !Empty(aFIELD[_Nj])
                    aAdd(aGer1,alltrim(SX6->&(aFIELD[_Nj])))
                Elseif aLabel[_Nj] == "Action"
                    /*If empty(SIX->IX_LOCTYP)
                        aAdd(aGer1,"Creation")
                    Else
                        aAdd(aGer1,"Update")
                    Endif*/
                    aAdd(aGer1," ")                      
                Else
                    aAdd(aGer1," ")
                EndIf
            Next
            //add to array
            aAdd(aSX6,aGer1)
        Endif
    Next
Endif





/////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////// E X P O R T   S X 7 //////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////

If !Empty(alltrim(cTGet6))
    lGerF := .T.
    If (GetRemoteType() == 1)
        oSay:cCaption := "Gereando SX7"
        ProcessMessages()
    Endif
    aGer := {}
    aSX7 := {}
    aGer := StrTokArr(alltrim(cTGet6), '|' ) //default optional fields
    aFIELD := StrTokArr(alltrim(CSX7FIELD), '|' ) //Fields to export
    For _Ni := 1 to len(aGer)
        //Found lines
        dbSelectArea("SX7")
        SX7->( dbSetOrder( 1 ) )
        If SX7->( msSeek( aGer[_Ni], .F. ) )
            While SX7->X7_CAMPO == aGer[_Ni]
                aGer1 := {}                    
                For _Nj := 1 to len(aFIELD)
                    If !Empty(aFIELD[_Nj])
                    aAdd(aGer1,alltrim(SX7->&(aFIELD[_Nj])))
                    Else
                        aAdd(aGer1," ")
                    EndIf
                Next
                SX7->(DbSkip())
                //add to array
                aAdd(aSX7,aGer1)                
            EndDo
        Endif
    Next
Endif



/////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////// E X P O R T   S X A //////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////

If !Empty(alltrim(cTGet7))
    lGerF := .T.
    If (GetRemoteType() == 1)
        oSay:cCaption := "Gereando SXA"
        ProcessMessages()
    Endif
    aGer := {}
    aSXA := {}
    aGer := StrTokArr(alltrim(cTGet7), '|' ) //default optional fields
    aFIELD := StrTokArr(alltrim(CSXAFIELD), '|' ) //Fields to export
    For _Ni := 1 to len(aGer)
        //Found lines
        dbSelectArea("SXA")
//        SX7->( dbSetOrder( 1 ) )
        cIndex := CriaTrab(Nil, .F.)
        cChave := IndexKey()
        IndRegua("SXA", cIndex, "XA_ALIAS + XA_TIPO + XA_ORDEM", , , "Selecionando Registros...")
		nIndex := RetIndex("SXA") + 1        
        dbSelectArea("SXA")
		dbSetOrder(nIndex)

        If SXA->( msSeek( aGer[_Ni], .F. ) )
            While SXA->XA_ALIAS == aGer[_Ni]
                aGer1 := {}                    
                For _Nj := 1 to len(aFIELD)
                    If !Empty(aFIELD[_Nj])
                    aAdd(aGer1,alltrim(SXA->&(aFIELD[_Nj])))
                    Else
                        aAdd(aGer1," ")
                    EndIf
                Next
                SXA->(DbSkip())
                //add to array
                aAdd(aSXA,aGer1)                
            EndDo
        Endif
    Next
Endif




/////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////// E X P O R T   S X B //////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////

If !Empty(alltrim(cTGet8))
    lGerF := .T.
    If (GetRemoteType() == 1)
        oSay:cCaption := "Gereando SXB"
        ProcessMessages()
    Endif
    aGer := {}
    aSXB := {}
    aGer := StrTokArr(alltrim(cTGet8), '|' ) //default optional fields
    aFIELD := StrTokArr(alltrim(CSXBFIELD), '|' ) //Fields to export
    For _Ni := 1 to len(aGer)
        //Found lines
        dbSelectArea("SXB")
        SXB->( dbSetOrder( 1 ) )
        If SXB->( msSeek(aGer[_Ni], .F. ) )
            While alltrim(SXB->XB_ALIAS) == alltrim(aGer[_Ni])
                aGer1 := {}
                For _Nj := 1 to len(aFIELD)
                    If !Empty(aFIELD[_Nj])
                        aAdd(aGer1,alltrim(SXB->&(aFIELD[_Nj])))
                    Else
                        aAdd(aGer1," ")
                    EndIf
                Next
                //add to array
                aAdd(aSXB,aGer1)
                SXB->(DbSkip())
            EndDo
        Endif
    Next
Endif


//Create Excel with informations
If lGerF := .T.
    If (GetRemoteType() == 1)
        oSay:cCaption := "Gereando Excel"
        ProcessMessages()
    Endif

    //SX2 Folder
    If !Empty(alltrim(cTGet1))
        aLabel := StrTokArr(alltrim(CSX2Label), '|' ) //Labels to export
        FSTABLE(@oFWMSEx,"SX2","Table Information",aSX2,aLabel)
    EndIf

    //SX3 Folder
    If !Empty(alltrim(cTGet2))
        aLabel := StrTokArr(alltrim(CSX3Label), '|' ) //Labels to export
        FSTABLE(@oFWMSEx,"SX3","Fields Information",aSX3,aLabel)
    EndIf

    //SIX Folder
    If !Empty(alltrim(cTGet3))
        aLabel := StrTokArr(alltrim(CSIXLabel), '|' ) //Labels to export
        FSTABLE(@oFWMSEx,"SIX","Index Information",aSIX,aLabel)
    EndIf

    //SX1 Folder
    If !Empty(alltrim(cTGet4))
        aLabel := StrTokArr(alltrim(CSX1Label), '|' ) //Labels to export
        FSTABLE(@oFWMSEx,"SX1","Question Information",aSX1,aLabel)
    EndIf

    //SX6 Folder
    If !Empty(alltrim(cTGet5))
        aLabel := StrTokArr(alltrim(CSX6Label), '|' ) //Labels to export
        FSTABLE(@oFWMSEx,"SX6","Parameter Information",aSX6,aLabel)
    EndIf

    //SX7 Folder
    If !Empty(alltrim(cTGet6))
        aLabel := StrTokArr(alltrim(CSX7Label), '|' ) //Labels to export
        FSTABLE(@oFWMSEx,"SX7","Triguer Information",aSX7,aLabel)
    EndIf

    //SXA Folder
    If !Empty(alltrim(cTGet7))
        aLabel := StrTokArr(alltrim(CSXALabel), '|' ) //Labels to export
        FSTABLE(@oFWMSEx,"SXA","Grouping Information",aSXA,aLabel)
    EndIf

    //SXA Folder
    If !Empty(alltrim(cTGet8))
        aLabel := StrTokArr(alltrim(CSXBLabel ), '|' ) //Labels to export
        FSTABLE(@oFWMSEx,"SXB","Standard Query Information",aSXB,aLabel)
    EndIf

    //Criando o XML
    oFWMSEx:Activate()
    oFWMSEx:GetXMLFile(cArquivo)

    //Abrindo o excel e abrindo o arquivo xml
    oExcel := MsExcel():New()               //Abre uma nova conexão com Excel
    oExcel:WorkBooks:Open(cArquivo)         //Abre uma planilha
    oExcel:SetVisible(.T.)                  //Visualiza a planilha
    oExcel:Destroy()                        //Encerra o processo do gerenciador de tarefas
Endif

If !(GetRemoteType() == 1)
    msginfo("Gerados")
Else
    Conout("End table creation")
Endif



return .t.



//Gera a tabela
Static function FSTABLE(oFWMSEx,cTable,cDesc,aInfo,aLabel) as logical
Local _Ni as Numeric
Local _Nj as Numeric
 //Criando a Aba Teste 1
oFWMSEx:AddworkSheet(cTable)
    //Adicionando a tabela
    oFWMSEx:AddTable (cTable,cDesc)
        //Adicionando as colunas
        oFWMSEx:AddColumn(cTable,cDesc,"Atribute",1,1)
        oFWMSEx:AddColumn(cTable,cDesc,"Value"   ,1,1)

        //Adicionando Linhas
        //aLabel := StrTokArr(alltrim(CSX2Label), '|' ) //Labels to export
        For _Ni := 1 to len(aInfo) //Loop informations
            //Define colors
            oFWMSEx:SetCelFrColor("#FFFFFF")
            oFWMSEx:SetCelBgColor("#4682B4")
            //headers
            For _Nj := 1 to len(aLabel) //loop campos
                //aAdd(aGer1,alltrim(SX2->&(aFIELD[_Nj])))
                oFWMSEx:AddRow(cTable,cDesc,{alltrim(aLabel[_Nj]),(aInfo[_Ni,_Nj])},{1})
            Next

            //Pula uma linha
            oFWMSEx:SetCelFrColor("#FFFFFF")
            oFWMSEx:SetCelBgColor("#FFFFFF")
            oFWMSEx:AddRow(cTable,cDesc,{" "," "},{1,2})
        Next

return .t.



Static Function cTypefield(cChar)
    Local cRet as Character 
    cRet:=""
    If cChar == 'C'
        cRet:="Character"
    ElseIf cChar == 'D'
        cRet:="Date"
    ElseIf cChar == 'N'
        cRet:="Numeric"
    Else
        cRet:="Unknow"
    Endif     

return cRet

O código fonte desse e outros exemplos podem ser encontrados em nosso git.

Post interessantes:

Ponto de entrada ao acessar o sistema aqui.

Aprenda a instalar o Protheus aqui.

Retornar datas por extenso aqui.

Barras de progresso aqui.

Dúvidas e sugestões, entre em contato.

Obrigado e até a próxima!

Categorias: ADVPL - Dicas

0 comentário

Deixe um comentário