SPED: Um ponto de partida, basta criatividade

Fórum sobre desenvolvimento de software para atender as exigências da legislação fiscal e tributária (NFe, NFCe, NFSe, SPEED, Projeto ACBr, TEF, ECD, EFD, etc.)

Moderador: Moderadores

Responder
Avatar do usuário
rochinha
Administrador
Administrador
Mensagens: 4671
Registrado em: 18 Ago 2003 20:43
Localização: São Paulo - Brasil
Curtiu: 3 vezes
Contato:
Contato rochinha

SPED: Um ponto de partida, basta criatividade

Mensagem por rochinha »

Amiguinhos,

Já faz um tempo que não mexo neste código e nem sei em que pé está o layout, mas as dicas a seguir servirão como ponta-pé para aqueles que ainda não iniciaram suas implementações.

O projeto SPED é algo muito grande e não daria para ajudar em todos os âmbitos, mas eis minha contribuição.

Adepto da facilitação de codificação para evitar retrabalho ao dar de cara com o layout do SPED Pis Cofins e sabendo que tudo que vem do governo muda a cada segundo transportei o layout para uma tabela DBF a qual fica mais fácil incluir ou eliminar campos e depois gerar minhas funções.
piscodbf.txt
renomear para pisco.dbf
(363.96 KiB) Baixado 238 vezes
O código a seguir vai abrir esta tabela e gerar 7 arquivos com funções baseadas no layout:

Código: Selecionar todos

/*
 *
 * SPED PIS COFINS
 *
 */
#include "fivewin.ch" 
#define cHarbour "Harbour.dll"

function main
  //
  Request DBFCDX
  RddRegister('DBFCDX',1)
  RddSetDefault('DBFCDX')
  Request OrdKeyNo
  Request OrdKeyCount
  Set Delete On
  public hDLL := LoadLibrary( cHarbour )
  //
  if ! MsgYesNo('ATENCAO.'+CRLF+CRLF+'Esta operacao ira zerar todas as tabelas existentes. Continua?'+CRLF+CRLF+;
                'Ajustar ordem de escrita dos registros em PISCORG.PRG'+CRLF+;
                'Desabilitar linhas na funcao PISCOSalvaRA001()'+CRLF+;
                'Ajustar ordem de escrita dos registros em PISCOSR.PRG')
     return .t.
  endif
  dbCloseAll()
  PassoZero()
  PassoUm()
  PassoDois()
  PassoTres()
  dbCloseAll()
  return .t.

function PassoUm()
  LOCAL cCRLF := chr(13)+chr(10)
  //IF .NOT. FILE("PISCO.CDX")
     USE PISCO
     INDEX ON REGISTRO+STR(NUMERO) TO PISCO FOR NUMERO > 0
     USE
  //ENDIF
  USE PISCO INDEX PISCO NEW
  GOTO TOP
  M->QUEBRA_1 := PISCO->REGISTRO
  errhandle := FCREATE( "PISCOT.TXT" )
  errhandleN:= FCREATE( "PISCOTC.TXT" )
  cPISCONtxt := "FUNCTION GeraPISCOTabelas()" + cCRLF
  FWRITE( errhandleN, cPISCONtxt, len(cPISCONtxt) )
  DO WHILE .NOT. EOF()
     M->PISCO_REGISTRO  := PISCO->REGISTRO
     M->PISCO_NUMERO    := PISCO->NUMERO
     M->PISCO_CAMPO     := PISCO->CAMPO
     M->PISCO_DESCRICAO := PISCO->DESCRICAO
     M->PISCO_TIPO      := PISCO->TIPO
     M->PISCO_TAM       := PISCO->TAM
     M->PISCO_DEC       := PISCO->DEC
     //
     // Cria estruturas dos registros
     //
     IF M->PISCO_NUMERO = 1
        cPISCONtxt:= "   PISCOTabela"+alltrim(M->PISCO_REGISTRO) + "()" + cCRLF
        cPISCOtxt := "FUNCTION PISCOTabela"+alltrim(M->PISCO_REGISTRO) + "()" + cCRLF + ;
                     "   // *** Estrutura do Registro "+alltrim(M->PISCO_REGISTRO)+" ***" + cCRLF + ;
                     "   LOCAL Estru := {}" + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
        FWRITE( errhandleN, cPISCONtxt, len(cPISCONtxt) )
     ENDIF
     //
     //cPISCOtxt :=    "   AADD( Estru, { { '"+alltrim(M->PISCO_CAMPO)+"'"+space(20-len(alltrim(M->PISCO_CAMPO)))+", '"+alltrim(M->PISCO_TIPO)+"', "+strZero(M->PISCO_TAM,4)+", "+strZero(M->PISCO_DEC,2)+" } } ) // " + strzero(M->PISCO_NUMERO,2) + " - " + alltrim(OemToAnsi(M->PISCO_DESCRICAO)) + cCRLF
     cPISCOtxt :=    "   AADD( Estru, { 'CAMPO"+strZero(PISCO->NUMERO,2)+"'"+space(5)+", 'C', "+strZero(M->PISCO_TAM,4)+", "+strZero(M->PISCO_DEC,2)+" } ) // " + strzero(M->PISCO_NUMERO,2) + " - " + alltrim(OemToAnsi(M->PISCO_DESCRICAO)) + cCRLF
     FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
     //
     SKIP
     IF M->QUEBRA_1<>PISCO->REGISTRO
        /* EXECUTE ALGUMA ROTINA */
        cPISCOtxt := "   dbCreate( '"+alltrim(M->PISCO_REGISTRO)+".DBF', Estru )" + cCRLF + ;
                     "   RETURN NIL" + cCRLF + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
        M->QUEBRA_1 := PISCO->REGISTRO
     ENDIF
  ENDDO
  FCLOSE( errhandle )
  cPISCONtxt := "   RETURN NIL" + cCRLF
  FWRITE( errhandleN, cPISCONtxt, len(cPISCONtxt) )
  FCLOSE( errhandleN )
  return .t.
  
function PassoDois()
  LOCAL cCRLF := chr(13)+chr(10)
  //IF .NOT. FILE("PISCO.CDX")
     USE PISCO
     INDEX ON REGISTRO+STR(NUMERO) TO PISCO FOR NUMERO > 0
     USE
  //ENDIF
  USE PISCO INDEX PISCO NEW
  GOTO TOP
  M->QUEBRA_1 := PISCO->REGISTRO
  errhandle := FCREATE( "PISCOR.TXT" )
  errhandleN:= FCREATE( "PISCORG.TXT" )
  cPISCONtxt := "FUNCTION GeraPISCORegistros(SPEDhandle)" + cCRLF
  FWRITE( errhandleN, cPISCONtxt, len(cPISCONtxt) )
  DO WHILE .NOT. EOF()
     M->PISCO_REGISTRO  := PISCO->REGISTRO
     M->PISCO_NUMERO    := PISCO->NUMERO
     M->PISCO_CAMPO     := PISCO->CAMPO
     M->PISCO_DESCRICAO := PISCO->DESCRICAO
     M->PISCO_TIPO      := PISCO->TIPO
     M->PISCO_TAM       := PISCO->TAM
     M->PISCO_DEC       := PISCO->DEC
     //
     // Cria linhas formatadas dos registros
     //
     IF M->PISCO_NUMERO = 1
        //cPISCONtxt:= "   PISCORegistro"+alltrim(M->PISCO_REGISTRO) + "()" + cCRLF
        cPISCONtxt:= "   dbSelectArea('"+alltrim(M->PISCO_REGISTRO) + "'); dbGotop(); do while .not. eof(); cPISCORegistro := alltrim( PISCORegistro"+alltrim(M->PISCO_REGISTRO) + "() ); fWrite( SPEDhandle, cPISCORegistro, len( cPISCORegistro ) ); dbSkip(); enddo" + cCRLF
        cPISCOtxt := "FUNCTION PISCORegistro"+alltrim(M->PISCO_REGISTRO) + "()" + cCRLF + ;
                     "   // *** Estrutura do Registro "+alltrim(M->PISCO_REGISTRO)+" ***" + cCRLF + ;
                     "   LOCAL cCRLF := chr(13)+chr(10), cSeparator := '|'" + cCRLF + ;
                     "   cTrailler := cSeparator" + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
        FWRITE( errhandleN, cPISCONtxt, len(cPISCONtxt) )
     ENDIF
     //
     //cPISCOtxt :=    "   cTrailler := cTrailler + StrFill( PISCO->"+alltrim(M->PISCO_CAMPO)+space(20-len(alltrim(M->PISCO_CAMPO)))+", '"+strZero(M->PISCO_TAM,4)+"', '"+iif(M->PISCO_TIPO="C"," ","0")+"', '"+iif(M->PISCO_TIPO="C","R","L")+"' ) + cSeparator // " + strzero(M->PISCO_NUMERO,2) + " - " + alltrim(OemToAnsi(M->PISCO_DESCRICAO)) + cCRLF
     cPISCOtxt :=    "   cTrailler := cTrailler + StrFill( "+alltrim(M->PISCO_REGISTRO) + "->CAMPO"+strZero(PISCO->NUMERO,2)+space(5)+", "+strZero(M->PISCO_TAM,4)+", '"+iif(M->PISCO_TIPO="C"," ","0")+"', '"+iif(M->PISCO_TIPO="C","R","L")+"' ) + cSeparator // " + strzero(M->PISCO_NUMERO,2) + " - " + alltrim(OemToAnsi(M->PISCO_DESCRICAO)) + cCRLF
     FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
     //
     SKIP
     IF M->QUEBRA_1<>PISCO->REGISTRO
        /* EXECUTE ALGUMA ROTINA */
        cPISCOtxt := "   cTrailler := cTrailler + cCRLF" + cCRLF + ;
                     "   RETURN cTrailler" + cCRLF + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
        M->QUEBRA_1 := PISCO->REGISTRO
     ENDIF
  ENDDO
  /* EXECUTE ALGUMA ROTINA
  cPISCOtxt := "Function StrFill( _string_, _tamanho_, _fill_, _direction_ )" + cCRLF + ;
               "   default _fill_ := ' ', _direction_ := 'R'" + cCRLF + ;
               "   cStrFill := alltrim( CharRem( '[<(/-.,)>]*@&', _string_ ) )" + cCRLF + ;
               "   if _direction_ = 'R'" + cCRLF + ;
               "      cStrFill := PadR(SubStr(cStrFill,1,_tamanho_),_tamanho_,_fill_)" + cCRLF + ;
               "   else	  " + cCRLF + ;
               "      cStrFill := PadL(SubStr(cStrFill,1,_tamanho_),_tamanho_,_fill_)" + cCRLF + ;
               "   endif" + cCRLF + ;
               "   return cStrFill" + cCRLF
               */
  FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
  FCLOSE( errhandle )
  cPISCONtxt := "   RETURN NIL" + cCRLF
  FWRITE( errhandleN, cPISCONtxt, len(cPISCONtxt) )
  FCLOSE( errhandleN )
  return .t.

function PassoTres()
  LOCAL cCRLF := chr(13)+chr(10)
  //IF .NOT. FILE("PISCO.CDX")
     USE PISCO
     INDEX ON REGISTRO+STR(NUMERO) TO PISCO FOR NUMERO > 0
     USE
  //ENDIF
  USE PISCO INDEX PISCO NEW
  //GOTO TOP
  //BROWSE()
  GOTO TOP
  M->QUEBRA_1 := PISCO->REGISTRO
  errhandle := FCREATE( "PISCOS.TXT" )
  errhandleN:= FCREATE( "PISCOSR.TXT" )
  cPISCONtxt := "FUNCTION GeraPISCOSalva()" + cCRLF
  FWRITE( errhandleN, cPISCONtxt, len(cPISCONtxt) )
  DO WHILE .NOT. EOF()
     M->PISCO_REGISTRO  := PISCO->REGISTRO
     M->PISCO_NUMERO    := PISCO->NUMERO
     M->PISCO_CAMPO     := PISCO->CAMPO
     M->PISCO_DESCRICAO := PISCO->DESCRICAO
     M->PISCO_TIPO      := PISCO->TIPO
     M->PISCO_TAM       := PISCO->TAM
     M->PISCO_DEC       := PISCO->DEC
     if subStr(alltrim(M->PISCO_REGISTRO),2,1) = "9" .or. subStr(alltrim(M->PISCO_REGISTRO),2,4) = "9001"
        skip
        loop
     endif
     //
     // Salva cada campo dos registros
     //
     IF M->PISCO_NUMERO = 1
        cPISCONtxt:= "   PISCOSalva"+alltrim(M->PISCO_REGISTRO) + "()" + cCRLF
        cPISCOtxt := "FUNCTION PISCOSalva"+alltrim(M->PISCO_REGISTRO) + "()" + cCRLF + ;
                     "   // *** Estrutura do Registro "+alltrim(M->PISCO_REGISTRO)+" ***" + cCRLF
                     if (subStr(alltrim(M->PISCO_REGISTRO),2,4) = subStr(alltrim(M->PISCO_REGISTRO),2,1)+"990")
                        cPISCOtxt := cPISCOtxt + ;
                                     "   if recco() = 0" + cCRLF + ;
                                     "      M->QTD_LIN_"+subStr(alltrim(M->PISCO_REGISTRO),2,1)+" := '1'" + cCRLF + ;
                                     "      R"+subStr(alltrim(M->PISCO_REGISTRO),2,1)+"990->( dbAppend() )" + cCRLF + ;
                                     "   else" + cCRLF + ;
                                     "      M->QTD_LIN_"+subStr(alltrim(M->PISCO_REGISTRO),2,1)+" := alltrim(str(val(R"+subStr(alltrim(M->PISCO_REGISTRO),2,1)+"990->CAMPO02) + 1,6))" + cCRLF + ;
                                     "      R"+subStr(alltrim(M->PISCO_REGISTRO),2,1)+"990->( dbRLock() )" + cCRLF + ;
                                     "   endif" + cCRLF
                     else
                        cPISCOtxt := cPISCOtxt + ;
                        "   "+alltrim(M->PISCO_REGISTRO) + "->( dbAppend() )" + cCRLF
                     endif
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
        cPISCOtxt := "   "+alltrim(M->PISCO_REGISTRO)+"->CAMPO"+strZero(PISCO->NUMERO,2)+space(5)+" := '"+subStr(alltrim(M->PISCO_REGISTRO),2,4)+"' // " + strzero(M->PISCO_NUMERO,2) + " - " + alltrim(OemToAnsi(M->PISCO_DESCRICAO)) + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
        FWRITE( errhandleN, cPISCONtxt, len(cPISCONtxt) )
     ELSE
        cPISCOtxt := "   "+alltrim(M->PISCO_REGISTRO)+"->CAMPO"+strZero(PISCO->NUMERO,2)+space(5)+" := M->"+alltrim(M->PISCO_CAMPO)+space(20-len(alltrim(M->PISCO_CAMPO)))+" // " + strzero(M->PISCO_NUMERO,2) + " - " + alltrim(OemToAnsi(M->PISCO_DESCRICAO)) + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
     ENDIF
     //
     SKIP
     IF M->QUEBRA_1<>PISCO->REGISTRO
        /* EXECUTE ALGUMA ROTINA */
        cPISCOtxt := "   "+alltrim(M->PISCO_REGISTRO) + "->( dbCommit() )" + cCRLF 
                     if subStr(alltrim(M->PISCO_REGISTRO),2,1) = "9"
                        cPISCOtxt := cPISCOtxt + ;
                                     "   //" + cCRLF + ;
                                     "   M->AREA"+subStr(alltrim(M->PISCO_REGISTRO),2,4)+" := Select()" + cCRLF + ;
                                     "   M->REG_BLC := '"+subStr(alltrim(M->PISCO_REGISTRO),2,4)+"'" + cCRLF + ;
                                     "   M->QTD_LIN_9 := '1'" + cCRLF + ;
                                     "   M->QTD_REG_BLC := ''" + cCRLF + ;
                                     "   dbSelectArea('R9990')" + cCRLF + ;
                                     "   PISCOSalvaR9990()" + cCRLF + ;
                                     "   dbSelectArea(M->AREA"+subStr(alltrim(M->PISCO_REGISTRO),2,4)+")" + cCRLF
                     else
                        cPISCOtxt := cPISCOtxt + ;
                                     "   //" + cCRLF + ;
                                     "   M->AREA"+subStr(alltrim(M->PISCO_REGISTRO),2,4)+" := Select()" + cCRLF + ;
                                     "   M->QTD_LIN_"+subStr(alltrim(M->PISCO_REGISTRO),2,1)+" := '1'" + cCRLF + ;
                                     "   M->QTD_LIN_9 := '1'" + cCRLF + ;
                                     "   M->QTD_REG_BLC := '1'" + cCRLF
                        if !(subStr(alltrim(M->PISCO_REGISTRO),2,4) = subStr(alltrim(M->PISCO_REGISTRO),2,1)+"990")
                           cPISCOtxt := cPISCOtxt + ;
                                     "   dbSelectArea('R"+subStr(alltrim(M->PISCO_REGISTRO),2,1)+"990')" + cCRLF + ;
                                     "   PISCOSalvaR"+subStr(alltrim(M->PISCO_REGISTRO),2,1)+"990()" + cCRLF
                        endif
                        cPISCOtxt := cPISCOtxt + ;
                                     "   M->REG_BLC := '"+subStr(alltrim(M->PISCO_REGISTRO),2,4)+"'" + cCRLF + ;
                                     "   dbSelectArea('R9900')" + cCRLF + ;
                                     "   PISCOSalvaR9900()" + cCRLF + ;
                                     "   dbSelectArea(M->AREA"+subStr(alltrim(M->PISCO_REGISTRO),2,4)+")" + cCRLF
                     endif
                     cPISCOtxt := cPISCOtxt + ;
                                  "   RETURN nil" + cCRLF + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
        M->QUEBRA_1 := PISCO->REGISTRO
     ENDIF
  ENDDO
  /* EXECUTE ALGUMA ROTINA */
  //cPISCOtxt := "Function StrFill( _string_, _tamanho_, _fill_, _direction_ )" + cCRLF + ;
  //             "   default _fill_ := ' ', _direction_ := 'R'" + cCRLF + ;
  //             "   cStrFill := alltrim( CharRem( '[<(/-.,)>]*@&', _string_ ) )" + cCRLF + ;
  //             "   if _direction_ = 'R'" + cCRLF + ;
  //             "      cStrFill := PadR(SubStr(cStrFill,1,_tamanho_),_tamanho_,_fill_)" + cCRLF + ;
  //             "   else	  " + cCRLF + ;
  //             "      cStrFill := PadL(SubStr(cStrFill,1,_tamanho_),_tamanho_,_fill_)" + cCRLF + ;
  //             "   endif" + cCRLF + ;
  //             "   return cStrFill" + cCRLF
  //FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
  FCLOSE( errhandle )
  cPISCONtxt := "   RETURN NIL" + cCRLF
  FWRITE( errhandleN, cPISCONtxt, len(cPISCONtxt) )
  FCLOSE( errhandleN )
  return .t.
  
function PassoZero()
  LOCAL cCRLF := chr(13)+chr(10)
  //IF .NOT. FILE("PISCO.CDX")
     USE PISCO
     INDEX ON REGISTRO+STR(NUMERO) TO PISCO FOR NUMERO > 0
     USE
  //ENDIF
  USE PISCO INDEX PISCO NEW
  GOTO TOP
  M->QUEBRA_1 := PISCO->REGISTRO
  errhandle := FCREATE( "PISCOV.TXT" )
  DO WHILE .NOT. EOF()
     M->PISCO_REGISTRO  := PISCO->REGISTRO
     M->PISCO_NUMERO    := PISCO->NUMERO
     M->PISCO_CAMPO     := PISCO->CAMPO
     M->PISCO_DESCRICAO := PISCO->DESCRICAO
     M->PISCO_TIPO      := PISCO->TIPO
     M->PISCO_TAM       := PISCO->TAM
     M->PISCO_DEC       := PISCO->DEC
     IF M->PISCO_NUMERO = 1
        cPISCOtxt := "FUNCTION PISCOVariavel"+alltrim(M->PISCO_REGISTRO) + "()" + cCRLF + ;
                     "   // *** Estrutura do Registro "+alltrim(M->PISCO_REGISTRO)+" ***" + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
        cPISCOtxt := "   M->REG := '"+subStr(alltrim(M->PISCO_REGISTRO),2,4)+"' // " + strzero(M->PISCO_NUMERO,2) + " - " + alltrim(OemToAnsi(M->PISCO_DESCRICAO)) + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
     ELSE
        cPISCOtxt := "   M->"+alltrim(M->PISCO_CAMPO)+space(20-len(alltrim(M->PISCO_CAMPO)))+" := iif(M->PISCO_TIPO='N'.and.M->PISCO_DEC>0,'0,'+repl('0',M->PISCO_DEC),iif(M->PISCO_TIPO='N'.and.M->PISCO_DEC=0,'0','')) // " + strzero(M->PISCO_NUMERO,2) + " - " + alltrim(OemToAnsi(M->PISCO_DESCRICAO)) + cCRLF
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
     ENDIF
     //
     SKIP
     IF M->QUEBRA_1<>PISCO->REGISTRO
        /* EXECUTE ALGUMA ROTINA */
        cPISCOtxt := "   RETURN nil" + cCRLF + cCRLF
                     
        FWRITE( errhandle, cPISCOtxt, len(cPISCOtxt) )
        M->QUEBRA_1 := PISCO->REGISTRO
     ENDIF
  ENDDO
  FCLOSE( errhandle )
  cPISCONtxt := "   RETURN NIL" + cCRLF
  return .t.
O exemplo passado usa recursos do Fivewin, mas a intenção é que vocês possam vislumbrar o funcionamento.

Os arquivos gerados estão no compactado abaixo para entendimento:
spedforum.zip
(123.36 KiB) Baixado 166 vezes
Um executável de testes feito com o código passado anteriormente esta abaixo:
PISCO.ZIP
(65.78 KiB) Baixado 167 vezes
Segue um trecho, incompleto de código do gerador do arquivo SPED usando todas as funções criadas pelo gerador:

Código: Selecionar todos

/////////////////////////////////////////////////////////////////////////////
//
//     SPED - Funcoes Compativeis com ambiente PIS-COFINS
//
//         Autor: Jose Carlos da Rocha
//          Data: 19/02/2012
//         Email: irochinha@hotmail.com.br
//           MSN: fivolution@hotmail.com
//     Linguagem: xBase
//       Prefixo: PISCORegistro, PISCOTabela, PISCOSalva
//   Plataformas: DOS, Windows
// Requerimentos: Harbour/xHarbour
//
// Blocos:
// 0 Abertura, Identificação e Referências
// A Documentos Fiscais - Serviços (ISS)
// C Documentos Fiscais I – Mercadorias (ICMS/IPI)
// D Documentos Fiscais II – Serviços (ICMS)
// F Demais Documentos e Operações
// M Apuração da Contribuição e Crédito de PIS/PASEP e da COFINS
// 1 Complemento da Escrituração – Controle de Saldos de Créditos e de  Retenções, Operações Extemporâneas e Outras Informações
// 9 Controle e Encerramento do Arquivo Digital
//
/////////////////////////////////////////////////////////////////////////////
#include "FiveWin.ch"
#include "Selector.ch"
#include "dll.ch"
#command OPEN <(db)>                                                    ;
             [VIA <rdd>]                                                ;
             [ALIAS <a>]                                                ;
             [<new: NEW>]                                               ;
             [<ex: EXCLUSIVE>]                                          ;
             [<sh: SHARED>]                                             ;
             [<ro: READONLY>]                                           ;
             [INDEX <(index1)> [, <(indexn)>]]                          ;
       => iif( Select( <(db)> )==0, iif( !File( <(db)>+".CDX" ), ( MsgWait( "Arquivo "+<(db)>+" esta sem indices. Abrindo sem indices. Reorganiza primeiro" ), dbNetUseArea( <.new.>, <rdd>, <(db)>, <(a)>, if(<.sh.> .or. <.ex.>, !<.ex.>, NIL), <.ro.>, 0 ) ), ( dbNetUseArea( <.new.>, <rdd>, <(db)>, <(a)>, if(<.sh.> .or. <.ex.>, !<.ex.>, NIL), <.ro.>, 0 ), dbSetIndex( <(db)> ) ) ), ( dbSelectArea( <(db)> ) ) )

*********************************************************************************************************
*** TESTE
Function main()
   lEncripta := .T.
   cProduz   := "V"
   //
   Request DBFCDX
   RddRegister('DBFCDX',1)
   RddSetDefault('DBFCDX')
   Request OrdKeyNo
   Request OrdKeyCount
   //
   Set date to british
   Set delete on
   Set epoch to 1970
   Set exclusive off
   Set date format to "DD/MM/YYYY"
   //
   GeraSPEDPisCofins()
   return .t.

Function StrFill( _string_, _tamanho_, _fill_, _direction_ )
   default _fill_ := " ", _direction_ := "R"
   cStrFill := alltrim( CharRem( "[<(/-.,)>]*&@", _string_ ) )
   if _direction_ = "R"
      cStrFill := PadR(SubStr(cStrFill,1,_tamanho_),_tamanho_,_fill_)
   else	  
      cStrFill := PadL(SubStr(cStrFill,1,_tamanho_),_tamanho_,_fill_)
   endif
   return cStrFill
   ******************************************************************************************************

******************************************************************************************************
#include "scripts\PISCOR.prg"  // Funcoes para geracao das linhas formatadas
#include "scripts\PISCOS.prg"  // Funcoes para geracao do salvamento de dados de cada registro
#include "scripts\PISCOT.prg"  // Funcoes para geracao das tabelas/registro com campos
#include "scripts\PISCORG.prg" // Funcoes para geracao do conteudo do arquivo digital
#include "scripts\PISCOSR.prg" // --- nao sera usado em demanda ---
#include "scripts\PISCOTC.prg" // Funcoes para geracao de todas as tabelas em demanda
******************************************************************************************************
   
******************************************************************************************************
// SPED FISCAL - INICIO
// Baseado em Frazato - 25 Fev 2011 14:12
******************************************************************************************************
FUNCTION GeraSPEDPisCofins(cFilial)

   LOCAL dDATAPROC := dDATAPROC := Date()

   LOCAL dDATAINI := BOM( dDATAPROC )
   LOCAL dDATAFIM := EOM( dDATAPROC )

   LOCAL cEmpresa := '00422' // PDV_CODIGO_DESTINO
   LOCAL nTMP     := fcreate( "c:\temp\SPED_" + strzero( year( dDATAPROC ), 4, 0 ) + "_" + strzero( month( dDATAPROC ), 2, 0 ) + ".TXT" )

   Set Default to c:\temp\

   dbCloseAll()
   GeraPISCOTabelas() // Gera todas as tabelas de registros
   dbCloseAll()

   // Abre tabelas necessarias
   // Preenche registros com dados necessarios

   // Monta blocos
   GeraPISCOBloco0()
   GeraPISCOBlocoA()
   GeraPISCOBlocoC()
   GeraPISCOBlocoD()
   GeraPISCOBlocoF()
   GeraPISCOBlocoM()
   GeraPISCOBloco1()
   GeraPISCOBloco9()

   errhandle := fCreate( "c:\temp\SPED_" + strzero( year( dDATAPROC ), 4, 0 ) + "_" + strzero( month( dDATAPROC ), 2, 0 ) + ".TXT" )
   
   GeraPISCORegistros()
   fClose( errhandle )
   return .t.
   ******************************************************************************************************

FUNCTION GeraPISCOBloco0(lGeraPISCOBloco0)
   ******************************************************************************************************
   ******************************************************************************************************
   // BLOCO 0: ABERTURA, IDENTIFICAÇÃO E REFERÊNCIAS.
   ******************************************************************************************************
   ******************************************************************************************************
   USE &(SPEDPath+"\R0000") SHARED NEW
   USE &(SPEDPath+"\R0001") SHARED NEW
   USE &(SPEDPath+"\R0100") SHARED NEW
   USE &(SPEDPath+"\R0110") SHARED NEW
   USE &(SPEDPath+"\R0111") SHARED NEW
   USE &(SPEDPath+"\R0120") SHARED NEW
   ...
   // Falta completar este código
   ...
   ******************************************************************************************************
   return .t.
   ******************************************************************************************************
Codigo completo, mas não sei se funcional para compilar e sair usando, pois esta estabelecido para usar minhas tabelas.
criasped.zip
(25.83 KiB) Baixado 161 vezes
Bom creio que vocês poderão tirar algum proveito.
OPS! LINK QUEBRADO? Infelizmente links para www.pctoledo.COM.BR irão quebrar pois o Forum se foi, assim como nosso célebre Irmão de Bits Toledo. Ainda assim me ENVIE seu email com link do tópico encontrado na Web para [url=mailto://fivolution@hotmail.com]fivolution@hotmail.com[/url] e tentarei lembrar do que se tratava. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Voltar ao topo
Responder

Voltar para “Legislação Fiscal e Tributária”