Validar CPF e CNPJ

Zima · Mensagem por **Zima** » 16 Nov 2004 14:43

Boa Tarde,

Algum colega me indicaria onde conseguir tais rotinas ? Ou poderia me fazer a gentileza de enviar por e-mail ?

Grato !
Zima
zima@uol.com.br

Augusto · Mensagem por **Augusto** » 16 Nov 2004 20:56

Vamos lá...

Código: Selecionar todos

Procedure TESTA_CGC
c=1
do while c <= 12
   d=iif(c<10,'0'+str(c,1),str(c,2))
   d1&d=val(subs(mcgc,c,1))
   c=c+1
enddo
df1=5*d101+4*d102+3*d103+2*d104+9*d105+8*d106+7*d107+6*d108+5*d109;
    +4*d110+3*d111+2*d112
df2=df1/11
df3=int(df2)*11
r1=df1-df3
if r1=0 .or. r1=1
   pd=0
else
   pd=11-r1
endif

c=1
do while c <= 12
   d=iif(c<10,'0'+str(c,1),str(c,2))
   d2&d=val(subs(mcgc,c,1))
   c=c+1
enddo
df4=6*d101+5*d102+4*d103+3*d104+2*d105+9*d106+8*d107+7*d108+6*d109;
    +5*d110+4*d111+3*d112+2*pd
df5=df4/11
df6=int(df5)*11
r2=df4-df6
if r2=0 .or. r2=1
   sd=0
else
   sd=11-r2
endif
if pd#val(subs(mcgc,13,1)).or.sd#val(subs(mcgc,14,1))
   ok=.f.
else
   ok=.t.
endif
return

Procedure TESTA_CPF
c=1
do while c <= 9
   d='0'+str(c,1)
   d2&d=val(subs(mcpf,c,1))
   c=c+1
enddo
df4=10*d201+9*d202+8*d203+7*d204+6*d205+5*d206+4*d207+3*d208+2*d209
df5=df4/11
df6=int(df5)*11
r1=df4-df6
if r1=0 .or. r1=1
   pd=0
else
   pd=11-r1
endif

c=1
do while c <= 9
   d='0'+str(c,1)
   d2&d=val(subs(mcpf,c,1))
   c=c+1
enddo
df4=11*d201+10*d202+9*d203+8*d204+7*d205+6*d206+5*d207+4*d208+3*d209+2*pd
df5=df4/11
df6=int(df5)*11
r1=df4-df6
if r1=0 .or. r1=1
   sd=0
else
   sd=11-r1
endif
pd=str(pd,1)
sd=str(sd,1)
if pd#subs(mcpf,10,1).or.sd#subs(mcpf,11,1)
   ok=.f.
else
   ok=.t.
endif
return

Espero que ajude...

Zima · Mensagem por **Zima** » 19 Nov 2004 13:30

Obrigado Augusto !

Ajudou bastante !

Sds,
Zima

JuniorVaz · Mensagem por **JuniorVaz** » 04 Jan 2005 10:34

Ola, estou fazendo um programa de controle de produção de calçados, e estou precisando de uma ideia para um verificador:
Se resume em que eu preciso, no cadastro de clientes, que quandu eu preench os campos, e confirme a gravação dos dados do cliente, ele verifique se o cnpj ja não esteja gravado em algum outro cliente, isso para não gravar dados duplicados, mesmos clientes com codigos diferentes.... uso um banco de dados com nome CADCLI.DBF e o campo a ser verificado eh o CNPJ, no formulario de cadastro o campo cnpj é a variavel XCNPJ. Precisaria então, que ele verificasse se o XCNPJ, naum existe no campo CNPJ de algum outro cliente, e se encontrado, apareça uma mensagem dizendo que o cnpj cadastrado ja existe, e retorne para o cadastro sem salvar os dados. Obrigado...

Mensagem por **Clipper** » 04 Jan 2005 21:25

Prezado Junior

Primeiro você deve criar um indice com a chave CNPJ
Exemplo :
USE CADCLI
INDEX ON CNPJ TO CLICNPJ

No programa você deverá abrir o arquivo com todos os seus indices usando o comando SET INDEX
USE CADCLI
SET INDEX TO CLICOD,CLINOME,CLICNPJ

E para verificar a existencia de um CNPJ poderia ser assim :

Código: Selecionar todos

@ 10,20 GET XCNPJ "@R 99.999.999/9999-99" VALID VERCNPJ(XCNPJ)
READ

---------------------------------------
FUNCTION VERCNPJ(XXCNPJ)
SET ORDER TO 3  //QUE É O CLICNPJ
DBSEEK(XXCNPJ)
IF .NOT. EOF()
   @ 24,00 SAY "Cnpj ja cadastrado para outro cliente"
   RETURN(.F.)
ENDIF
SET ORDER TO 1
RETURN(.T.)
--------------------------------------

Até logo.

Marcelo

JuniorVaz · Mensagem por **JuniorVaz** » 05 Jan 2005 12:22

Ola marcelo, tentei inserir o que voce sugeriu mas não consegui, ficou dando alguns erros, então resolvi posta o codigo do arquivo abaixo para vc dar uma olhadinha para mim.

O codigo ta um poquinho confuso, porque eu andei alterando, hehehe, mas ta funcionando assim como está, soh precisaria fazer essa verificação do cnpj. Otra coisa, é dificil, de quando ele verificar, ao invés de dizer, que este cnpj ja está cadastrado para outro cliente, de aparecer o codigo do cliente para qual eles ja está cadastrado?
EXEMPLO: Este CNPJ ja está cadastrado no sistema, para o cliente de N° xxxxx!!!

Código: Selecionar todos

clear
cbc()
SET EXCLUSIVE OFF
SET CURS ON
SETCOLOR(cor2)
cx(1,0,19,79,"CADASTRO DE CLIENTES",80)
do telacli
STOR CTOD('  /  /  ') TO XUCOMPRA,CXDATEMI
STOR 0.00 TO XTOTVALOR,XUVALOR
STOR 0 TO XTOTPARES,XTOTCOMPRAS,XUPARES
STOR ('N') TO XCREDAFET
STOR SPACE(63) TO XOBS,XLOCALPGTO,XLOCALENTR,xobsref
STOR SPACE(45) TO XMOTIVO
STOR SPACE(15) TO XCIDADE
STOR SPACE(15) TO XBAIRRO
stor space(26) to XFANTASIA
stor space(40) to Xendereco,XRAZAO
stor space(6) to xnum
STOR SPACE(20) TO XCARIMBO
stor space(02) to xuf
stor space(13) to xfone
stor space(13) to xfax
STOR space(15) TO XINSC
stor space(23) to xcomple
stor space(26) to xcompra
stor space(26) to xemail
stor space(8) to xcep
STOR 0 TO XCODREp,XCODTRASN,xgrade
stor space(15) to xcnpj
//STOR ('  .   -   ') TO XCEP
cxdatemi=date()
SETCOLOR(cor2) 
CLOSE data    
sele 0
use cadgra inde cadgra alias gra
set index to cadgra
sele 0
use cadtra inde cadtra alias tra
set index to cadtra
SELE 0
USE CADuf INDE CADuf ALIAS ff
SET INDEX TO CADuf
SELE 0
USE CADREp INDE CADREP ALIAS REP
SET INDEX TO CADREP
sele 0
use cadcli inde cadcli alias cli
set index to cadcli,razao

DO while .T.
  SELE cli
   GOTO BOTT
  XCODCLI=CODCLI+1
 
  @ 03,16 SAY XCODCLI PICT "999999"
  cc=savescreen(0,0,24,79)
  SELE cli
  READ
 


  IF LASTKEY()=27
     
     close all
     EXIT
  ENDIF
//  if xcodcli=0 .or. empty(xcodcli)
if lastkey()=28
restscreen(0,0,24,79,cc)
     setcolor(cor2)
     do selcli
restscreen(0,0,24,79,cc)
    set inde to cadcli,razao
     @ 03,16 say XCODCLI PICT "999999"
cs=savescreen(0,0,24,79)
     read
     setcolor(cor2)
     if lastkey()=27
                loop
     endif
     if empty(xcodcli) .or. xcodcli=0
restscreen(0,0,24,79,cc)
        close all
        exit
     endif
  endif
  SELE cli
  SEEK XCODCLI
  READ
restscreen(0,0,24,79,cc)

  IF FOUN()
     XCODCLI      =  CODCLI
     XRAZAO       =  RAZAO
     XCODREp      =  CODREP
     XFANTASIA    =  FANTASIA
     XCARIMBO     =  CARIMBO
     XENDERECO    =  ENDERECO
     xnum         =  num
     XBAIRRO      =  BAIRRO
     XUF          =  UF
     XCEP         =  CEP
     XCIDADE      =  CIDADE
     XINSC        =  INSC
     XCNPJ        =  CNPJ
     xfone        =  fone
     xfax         =  fax
     XCODTRASN    =  CODTRASN
     XLOCALPGTO   =  LOCALPGTO
     XLOCALENTR   =  LOCALENTR
     XUCOMPRA     =  UCOMPRA
     XuPARES      =  uPARES
     XuVALOR      =  uVALOR
     XTOTCOMPRAS  =  TOTCOMPRAS
     XTOTPARES    =  TOTPARES
     XTOTVALOR    =  TOTVALOR
     XCREDAFET    =  CREDAFET
     XMOTIVO      =  MOTIVO
     XOBS         =  OBS
     XDATEMI      =  DATEMI
     xcompra      =  compra
     xemail       =  email
     xcomple      =  comple
     @ 03,47 SAY Xdatemi
     @ 04,16 SAY XRAZAO PICT "@k!"
     @ 05,16 SAY XFANTASIA PICT "@k!"
     @ 05,59 SAY XCARIMBO PICT "@k!"
     @ 06,16 say xcodrep pict "999999"
     @ 07,16 SAY XENDERECO PICT "@k!"
     @ 07,73 say xnum pict "@K!"
     @ 08,16 SAY XUF PICT "@k!"
     @ 08,28 SAY XCEP PICT "@R 99.999-999"
     @ 08,56 say xcomple pict "@k!"
     @ 09,16 SAY XCIDADE PICT "@K!"
     @ 09,56 SAY XBAIRRO PICT "@k!"
    
     @ 10,16 SAY XINSC PICT "@K!"
     @ 10,56 SAY XCNPJ PICT "@R 99.999.999/9999-99"
     @ 11,16 say xfone pict "(99)999-99999" 
     @ 11,56 say xfax pict "(99)999-99999"
     @ 12,16 say xcompra pict "@K!"
     @ 13,16 say xemail pict "@K!"
     @ 14,16 SAY XCODTRASN PICT "999999"
     @ 15,16 SAY XLOCALPGTO PICT "@k!"
     @ 16,16 SAY XLOCALENTR PICT "@K!"
     @ 17,16 SAY XOBS PICT "@k!"
     xconf="N"
     ss=savescreen(0,0,24,79)
     tone(800)
     @ 24,5 SAY "Deseja o Cadastro deste Cliente? <S/N>" get xconf pict "!" valid xconf $ "SN"
     read
     IF LASTKEY()=27
         DO LIMPAR
         LOOP
     ENDIF
     if xconf="S"
         rlock()
         delet
         commit
         unlock
         do limpar
         loop
      endif
      if xconf="N"
         restscreen(0,0,24,79,ss)
      endif
  endif
  @ 03,47 say cxdatemi 
  @ 04,16 get XRAZAO PICT "@k!" valid !empt(xrazao)
  @ 05,16 get XFANTASIA PICT "@k!"
  @ 05,59 get XCARIMBO PICT "@k!"
  @ 06,16 get XCODREp PICT "999999"
  READ
          if lastkey()=27
             do limpar
          loop
          endif
          if empty(xcodrep) .or. xcodrep=0
             ss=savescreen(00,00,24,79)
             do selrep
             sele rep
             set inde to cadrep
             restscreen(0,0,24,79,ss)
             set color to (cor2)
                          @ 06,16 get XCODrep PICT "999999"
             read
             if lastkey()=27 .or. empty(xcodrep) .or. xcodrep=0
                   do limpar
                   loop
             endif
          endif
          SELE rep
          SEEK xcodrep
  IF FOUNd()
SETCOLOR(cor2)




      @ 06,23 SAY SUBS(NOME,1,50)
  ELSE
    tone(800)
    @ 24,5 SAY "Este Representante NÆo est  Cadastrado !"
    inkey(0)
    do limpar
    loop
  endif
  sele cli
  @ 07,16 get XENDERECO PICT "@k!"
  @ 07,73 get xnum pict "@K!"
  @ 08,16 get XUF PICT "!!" valid !empt(xuf)
READ
  SELE ff
  SEEK xuf
  IF !FOUN()
    tone(800)
    @ 24,5 SAY "AVISO:  UF Inv lida!!"
    inkey(0)
    do limpar
    loop
  ELSE
  endif
  sele cli
  @ 08,28 get XCEP PICT "@R 99.999-999"
  @ 08,56 get xcomple pict "@K!"
  @ 09,16 get XCIDADE PICT "@K!"
  @ 09,56 get XBAIRRO PICT "@k!"
  @ 10,16 get XINSC PICT "@K!" valid !empt(XINSC) .AND. ieok(xuf,xinsc)      
  @ 10,56 get XCNPJ PICT "@R 99.999.999/9999-99" valid !empt(xcnpj) .AND. vcgc(xcnpj)
  @ 11,16 get xfone pict "(99)999-99999"
  @ 11,56 get xfax pict "(99)999-99999"
  @ 12,16 get xcompra pict "@K!"
  @ 13,16 get xemail pict "@K!"
  @ 14,16 get XCODTRASN PICT "999999"
  
 READ
          if lastkey()=27
             do limpar
          loop
          endif
          if empty(xcodtrasn) .or. xcodtrasn=0
             ss=savescreen(00,00,24,79)
             do seltra
             sele tra
             set inde to cadtra
             restscreen(0,0,24,79,ss)
             set color to (cor2)
                          @ 14,16 get XCODtrasn PICT "999999"
             read
             if lastkey()=27 .or. empty(xcodtrasn) .or. xcodtrasn=0
                   do limpar
                   loop
             endif
          endif
          SELE tra
          SEEK xcodtrasn
  IF FOUNd()
SETCOLOR(cor2)




      @ 14,23 SAY SUBS(razao,1,50)
  ELSE
    tone(800)
    @ 24,5 SAY "Esta Transportadora Nao esta  Cadastrada !"
    inkey(0)
    do limpar
    loop
  endif
  sele cli




  @ 15,16 get XLOCALPGTO PICT "@k!"
  @ 16,16 get XLOCALENTR PICT "@K!"
  @ 17,16 get XOBS PICT "@k!"
  read
  if lastkey()=27
    do limpar
    loop
  endif
  conf=" "
  tone(880)
  @ 24,5 say "Deseja Gravar o Cadastro deste Cliente! <S/N> " get conf pict "!!" valid conf $ "SN"
  read
  if conf = "S"
     do gravar
     do limpar
     loop
  endif
  if lastkey()=27 .or. conf="N"
     do limpar
     loop
   endif
enddo
close all
return
         
****tela
procedure telacli()
SETCOLOR('N/W')
*/       0....x....1....x....2....x....3....x....4....x....5....x....6....x....7....x....8/*
@ 03,02 say "C¢d.Client..:            Data de Cadastro..:                               "
@ 04,02 say "RazÆo Social:                                                              "
@ 05,02 say "Nome Fantas.:                            Carimbo Espec.:                   "
@ 06,02 say "Cod.Repres..:                                                              "
@ 07,02 say "Endere‡o....:                                                      Nø:     "
@ 08,02 say "UF..........:     CEP...:                Complemento:                      "
@ 09,02 say "Cidade......:                            Bairro.....:                      "
@ 10,02 say "Insc.Estad..:                            CNPJ.......:                      "
@ 11,02 say "Fone........:                            FAX........:                      "
@ 12,02 say "Comprador...:                                                              "
@ 13,02 say "E-mail:.....:                                                              "
@ 14,02 say "C¢d.Transp..:                                                              "
@ 15,02 say "Local Pgto..:                                                              "
@ 16,02 say "Local Entre.:                                                              "
@ 17,02 say "Observ......:                                                              "
return
**************************************
*********limp cadastro
proc limpar()
STOR CTOD('  /  /  ') TO XUCOMPRA,CXDATEMI
STOR 0.00 TO XTOTVALOR,XUVALOR
STOR 0 TO XTOTPARES,XTOTCOMPRAS,XUPARES
STOR ('N') TO XCREDAFET
STOR SPACE(63) TO XOBS,XLOCALPGTO,XLOCALENTR,xobsref
STOR SPACE(45) TO XMOTIVO
STOR SPACE(15) TO XCIDADE,XBAIRRO
STOR SPACE(25) TO XFANTASIA
stor space(40) to xendereco,XRAZAO
stor space(6) to xnum
STOR SPACE(20) TO XCARIMBO
stor space(02) to xuf
stor space(13) to xfone
stor space(13) to xfax
STOR space(15) TO XINSC
stor space(23) to xcomple
stor space(26) to xcompra
stor space(26) to xemail
STOR 0 TO XCODREp,XCODTRASN,xgrade
stor space(14) to xcnpj
stor space(8) to xcep
cxdatemi=date()
restscreen(0,0,24,79,cc)
retu

**********gravar
proc gravar()
sele cli
seek xcodcli
if foun()
  rlock()
else
  appe blank
endif
   replace  CODCLI      with  XCODCLI,;
            RAZAO       with  XRAZAO,;
            FANTASIA    with  XFANTASIA,;
            CARIMBO     with  XCARIMBO,;
            ENDERECO    with  XENDERECO,;
            NUM         with  XNUM,;
            BAIRRO      with  XBAIRRO,;
            UF          with  XUF,;
            CEP         with  XCEP,;
            CIDADE      with  XCIDADE,;
            INSC        with  XINSC,;
            comple     with  xcomple,;
            CNPJ        with  XCNPJ,;
            LOCALPGTO   with  XLOCALPGTO,;
            localentr   with  Xlocalentr,;
            CREDAFET    with  XCREDAFET,;
            MOTIVO      with  XMOTIVO,;
            OBS         with  XOBS,;
            DATEMI      with  CXDATEMI,;
            CODTRASN    with  XCODTRASN,;
            CODREp      with  XCODREp,;
            fone        with  xfone,;
            compra      with  xcompra,;
            email       with  xemail,;
            fax         with  xfax
            commit

     unlock
return

Mensagem por **Clipper** » 05 Jan 2005 20:23

Prezado Junior

Primeira coisa
Crie um arquivo de indice com a chave CNPJ chamado cnpj

Modifique as linhas :
use cadcli inde cadcli alias cli
set index to cadcli,razao

por
use cadcli
set index to cadcli,razao,cnpj

Modifique a linha :

@ 10,56 get XCNPJ PICT "@R 99.999.999/9999-99" valid !empt(xcnpj) .AND. vcgc(xcnpj)

por

@ 10,56 get XCNPJ PICT "@R 99.999.999/9999-99" valid vercnpj(xcnpj)

e adicione essa função :

Código: Selecionar todos

FUNCTION VERCNPJ(XXCNPJ) 
IF XXCNPJ=SPACE(14)
   @ 24,00 SAY "O CNPJ não pode ser em branco !"
   INKEY(3)
   @ 24,00 CLEAR TO 24,79
   RETURN(.F.)
ENDIF

SET ORDER TO 3 
DBSEEK(XXCNPJ)
IF .NOT. EOF() 
   @ 24,00 SAY "Cnpj ja cadastrado para o cliente "STR(CODCLI,6)+" "+ALLTRIM(RAZAO) 
   inkey(3)
   @ 24,00 CLEAR TO 24,79
   RETURN(.F.) 
ENDIF 
SET ORDER TO 1 
RETURN(.T.)

Se você fizer o que eu escrevi e não funcionar eu mudo de nome.

Ps: Perde essa mania de usar o STORE aumenta o tamanho do PRG e dificulta a leitura do mesmo, aproveita e para de usar procedure e muda para function, apesar disso não ser obrigatório é uma boa prática, apenas algumas dicas para melhorar sua técnica de programação

Até logo.

Marcelo

JuniorVaz · Mensagem por **JuniorVaz** » 06 Jan 2005 00:56

É Marcelo, vou continuar chamando vc de marcelo entaum, pq funcionou... hehehe... soh teve um probleminha, mas axu q issu naum eh dificil. Primeiro que assim, as vezes quando eu vou cadastrar algum cliente que na hora eu não tenho cnpj e inscrição estadual, o programa é liberado pra preenxer com 000000 e passar reto, dai agora não da, pq quando coloko 00000, aparece q cnpj não por ser em branco, gostaria de liberar isso, e otra coisa. Dai quando eu vou cadastrar algum com 000, como existem alguns clientes cadastrados com cnpj = 0000, ele não dexa cadastrar porque tambem ja existe cadastrado, dai queria que quando for cnpj = 0000 pra ele não conferir.... Vlw ae pela ajuda... ta sendu de baxtante importancia pra mim aki...

JuniorVaz · Mensagem por **JuniorVaz** » 10 Jan 2005 21:29

Ola, coloquei no meu sistema aqui, uma função que o Marcelo Clipper me passou, para verificar o cnpj, ela funciona OK, acontece, que as vezes é necessario cadastrar algum cliente sem ter o cnpj, e então minha função de validar o cnpj, libera o cadastro de clientes com CNPJ = 00000000

Blz, o problema é que como podem existir mais de 1 cliente com o cnpj = 0000, queria saber como possso modificar esta função, pra quando o cnpj for = 0000 que ele ignore e deixe cadastrar assim mesmo:

FUNCTION VERCNPJ(XXCNPJ)
IF XXCNPJ=SPACE(14)
@ 24,00 SAY "O CNPJ não pode ser em branco !"
INKEY(3)
@ 24,00 CLEAR TO 24,79
RETURN(.F.)
ENDIF

SET ORDER TO 3
DBSEEK(XXCNPJ)
IF .NOT. EOF()
@ 24,00 SAY "Cnpj ja cadastrado para o cliente "STR(CODCLI,6)+" "+ALLTRIM(RAZAO)
inkey(3)
@ 24,00 CLEAR TO 24,79
RETURN(.F.)
ENDIF
SET ORDER TO 1
RETURN(.T.)

Trazom · Mensagem por **Trazom** » 10 Jan 2005 23:06

func testacnpj(cnpj)
if cnpj=000000
return(.t.)
endif

aqui continua a função normalmente

JuniorVaz · Mensagem por **JuniorVaz** » 11 Jan 2005 13:14

Vlw Trazom, deu +/- certo, so tive que muda rali, ao invés de if cnpj=0, tinha que ser if cnpj="00000000", mas obrigado pela ideia, não tinha conseguido aqui ainda...

Dionatan · Mensagem por **Dionatan** » 26 Jan 2005 19:20

Pra isso basta vc fz isso :

IF XXCNPJ="0000"
Return nil
ENDIF

IF XXCNPJ=SPACE(14)
.
.
.
.
.

.
.
.
.
E so por perg pra que serve esse store ??!?!?!?

ederxc · Mensagem por **ederxc** » 02 Out 2006 16:02

por gentileza alguem teria um função "simples de como validar cnpj" até achei umas fontes mas achei um pouco complexas ...

Mensagem por **sygecom** » 02 Out 2006 16:55

Código: Selecionar todos

FUNC CNPJ
aSal := savenv( 10, 02, 23, 79 ) //VL-Salva o ambiente
SET TALK OFF
SET STAT OFF
public vObsCGC:=SPACE(25)
********* CALCULO *********************
    T :=  TT :=  TTT :=  0
    CCNPJ = SPACE(18)

    PARTEA1 = SUBS(FCGC,1,2)  //   Divide a
    PARTEA2 = SUBS(FCGC,3,3)  //   variavel
    PARTEA3 = SUBS(FCGC,6,3)  //     em 5
    PARTEA4 = SUBS(FCGC,9,4) //    partes
    PARTEA5 = SUBS(FCGC,13,2) //    partes

    CCNPJ = PARTEa1+PARTEa2+PARTEa3+PARTEa4 // Junta as 4 partes

    FOR TT =  12 TO 5 STEP -1                         //
            T = T + VAL(SUBS(CCNPJ,TT,1)) * (14 - TT)  //
    NEXT TT                                           //
    FOR TT =  4 TO 1 STEP -1                          //
            T = T + VAL(SUBS(CCNPJ,TT,1)) * (6 - TT)   //   Processa
    NEXT TT                                           //  os calculos
    TT :=  T - (INT(T/11)*11)                         //     para
    IF TT < 2                                         //   verificar
            TT :=  0                                  //   o primeiro
    ELSE                                              //    digito
            TT :=  11 - TT                            //
    ENDIF                                             //
    CCNPJ =  CCNPJ + STR(TT,1) // Junta o primeiro digito com as 4 primeiras partes

    T= 0 // Zera a variavel para inicio do novo calculo
    FOR TT =  13 TO 6 STEP -1                         //
            T = T + VAL(SUBS(CCNPJ,TT,1)) * (15 - TT)  //
    NEXT TT                                           //
    FOR TT =  5 TO 1 STEP -1                          //
            T = T + VAL(SUBS(CCNPJ,TT,1)) * (7 - TT)   //    Processa
    NEXT TT                                           //    o calculo
    TT :=  T - (INT(T/11)*11)                         //  para verificar
    IF TT < 2                                         //    o segundo
            TT :=  0                                  //     digito
    ELSE                                              //
            TT :=  11 - TT                            //
    ENDIF                                             //
    CCNPJ =  CCNPJ + STR(TT,1) // Junta o segundo digito ao restante inicial

    PARTE1 = SUBS(CCNPJ,1,2)  //
    PARTE2 = SUBS(CCNPJ,3,3)  //  Divide novamente
    PARTE3 = SUBS(CCNPJ,6,3)  //     a variavel
    PARTE4 = SUBS(CCNPJ,9,4)  //  agora em 5 partes
    PARTE5 = SUBS(CCNPJ,13,2) //
    CCNPJ = PARTE1+PARTE2+PARTE3+PARTE4+PARTE5               // Monta a variavel conforme um CCNPJ verdadeiro

DO WHILE .T.
   IF CCNPJ != PARTEa1+PARTEa2+PARTEa3+PARTEa4+PARTEa5
      TONE(1000) ; TONE(1000) ; TONE(1000)
      alert("N§ do CNPJ informado esta errado!")
      vObsCGC="CNPJ Incorreto"
      FCGC=SPACE(18)
      CCNPJ=space(18)
   ELSE
      Return
      vObsCGC="CNPJ Correto"
   ENDIF
   FCGC=CCNPJ
   EXIT
ENDDO
RETURN .T.

Qualquer duvida posta ai........Abraços

Daniel · Mensagem por **Daniel** » 03 Out 2006 05:52

Mais um exemplo

Código: Selecionar todos

********************************
Function Cgc(xcgc)

   xcgc1:= ''
   For x:= 1 To Len(xcgc)  //para tirar a mascara
   	If SubStr(xcgc, x, 1) != "/"
   		If SubStr(xcgc, x, 1) != "."
   			If SubStr(xcgc, x, 1) != "-"
   				xcgc1+= SubStr(xcgc, x, 1)
   			EndIf
   		EndIf
   	EndIF
   Next

   xcgc:= xcgc1
   If Empty(xcgc)
	 Return .t.
   EndIf
   For x:= 1 To 12
      d:= 'd1' + StrZero(x, 2)
      &d:= Val(SubStr(xcgc, x, 1))
   Next x
   df1:= 5 * d101 + 4 * d102 + 3 * d103 + 2 * d104 + 9 * d105 + 8 * ;
      d106 + 7 * d107 + 6 * d108 + 5 * d109 + 4 * d110 + 3 * d111 + ;
      2 * d112
   df2:= df1 / 11
   df3:= Int(df2) * 11
   resto1:= df1 - df3
   If (resto1 = 0 .Or. resto1 = 1)
      pridig:= 0
   Else
      pridig:= 11 - resto1
   EndIf
   For x:= 1 To 12
      d:= 'd1' + StrZero(x, 2)
      &d:= Val(SubStr(xcgc, x, 1))
   Next x
   df4:= 6 * d101 + 5 * d102 + 4 * d103 + 3 * d104 + 2 * d105 + 9 * ;
      d106 + 8 * d107 + 7 * d108 + 6 * d109 + 5 * d110 + 4 * d111 + ;
      3 * d112 + 2 * pridig
   df5:= df4 / 11
   df6:= Int(df5) * 11
   resto2:= df4 - df6
   If (resto2 = 0 .OR. resto2 = 1)
      segdig:= 0
   Else
      segdig:= 11 - resto2
   EndIf
   If (pridig != Val(SubStr(xcgc, 13, 1)) .OR. segdig != ;
         Val(SubStr(xcgc, 14, 1)))
      Tone(1000, 3)
      Alert("CNPJ Incorreto.... Confira o Nº do CNPJ....")
      Return .F.
   EndIf