USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Validar CNPJ com Mask
Roberto
não registrado
Postada em 10/08/2005 09:01 hs   
Pessoal tenho o codigo abaixo como faço para validar em Mask
 
 
Public Function CheckCGC(cgc As String) As Boolean
   Dim VAR1, VAR2, VAR3, VAR4, VAR5
   If Len(cgc) = 8 And Val(cgc) > 0 Then
      VAR1 = 0
      VAR2 = 0
      VAR4 = 0
      For VAR3 = 1 To 7
         VAR1 = Val(Mid(cgc, VAR3, 1))
         If (VAR1 Mod 2) <> 0 Then
            VAR1 = VAR1 * 2
         End If
         If VAR1 > 9 Then
            VAR2 = VAR2 + Int(VAR1 / 10) + (VAR1 Mod 10)
         Else
            VAR2 = VAR2 + VAR1
         End If
      Next VAR3
      VAR4 = IIf((VAR2 Mod 10) <> 0, 10 - (VAR2 Mod 10), 0)
      If VAR4 = Val(Mid(cgc, 8, 1)) Then
         CheckCGC = True
      Else
         CheckCGC = False
      End If
   Else
      If Len(cgc) = 14 And Val(cgc) > 0 Then
         VAR1 = 0
         VAR3 = 0
         VAR4 = 0
         VAR5 = 0
         VAR2 = 5
         For VAR3 = 1 To 12
            VAR1 = VAR1 + (Val(Mid(cgc, VAR3, 1)) * VAR2)
            VAR2 = IIf(VAR2 > 2, VAR2 - 1, 9)
         Next VAR3
         VAR1 = VAR1 Mod 11
         VAR4 = IIf(VAR1 > 1, 11 - VAR1, 0)
         VAR1 = 0
         VAR3 = 0
         VAR2 = 6
         For VAR3 = 1 To 13
            VAR1 = VAR1 + (Val(Mid(cgc, VAR3, 1)) * VAR2)
            VAR2 = IIf(VAR2 > 2, VAR2 - 1, 9)
         Next VAR3
         VAR1 = VAR1 Mod 11
         VAR5 = IIf(VAR1 > 1, 11 - VAR1, 0)
         If (VAR4 = Val(Mid(cgc, 13, 1)) And VAR5 = Val(Mid(cgc, 14, 1))) Then
            CheckCGC = True
         Else
            CheckCGC = False
         End If
      Else
         CheckCGC = False
      End If
   End If
End Function
     
Erico
SALVADOR
BA - BRASIL
Postada em 11/08/2005 12:45 hs            
Roberto,
Não analisei o código mas imagino que esteja correto. Se vc está usando o controle msmaskedit utilize a picture "@R 99.999.999.9999-99". Ela fará com que os sinais sejam desprezados no valor.
Para usa o código vc deve chamar a função com o cgc, tente:
 
IF CheckCGC(NumCGC) then ' Retorna true se CGC ok
     msgbox("CGC Ok")
else
     msgbox("CGC Invalido")
endif

A.Erico S.Peixoto
--------------------
Analista de Sistemas
     
Martini
Pontos: 2843 Pontos: 2843
PAROBÉ
RS - BRASIL
Postada em 11/08/2005 13:18 hs         
retira a máscara antes:
 
'valida CGC
Public Function VCGC(St As String) As Integer
  Dim RetVal As Integer, x As String, Posi As Integer, _
        dv1c As Integer, dv2c As Integer, dv1f As Integer, dv2f As Integer, _
        Num As String, Mu As String, Resto As Integer, Dv As String
  x$ = RTrim$(Retira$(St$, "./-,:", UM_A_UM))
  If Len(x$) = 0 Then                             'se vazio...
    RetVal = True                                 'preparamos retorno true
  Else                                            'senão,
    RetVal = False                                'preparamos false
  End If
  If Len(x$) = 14 Then                            'se tem 14 caracteres = ok
    dv1f = Val(Mid$(x$, 13, 1))                   'salva os dígitos
    dv2f = Val(Right$(x$, 1))                     'fornecidos
    Num$ = Left$(x$, 12)                          'separa o número
    dv1c = 0                                      'inicializa dv1 a calcular
    Mu$ = "543298765432"                          'constante multiplicadora
    Posi = 12                                     'inicializa posição
    While Posi > 0                                'vamos correr de trás para a frente
      dv1c = dv1c + Val(Mid$(Num$, Posi, 1)) * Val(Mid$(Mu$, Posi, 1))
      Posi = Posi - 1                             'acumulando cada dígido X o seu multiplicador
    Wend                                          'decrementa contador de posição
    Resto = dv1c Mod 11                           'calcula o resto (módulo 11)
    If Resto < 2 Then                             'se menor do que 2
      dv1c = 0                                    'o dv é o resto
    Else                                          'senão,
      dv1c = 11 - Resto                           'este dv é a diferença 11 - resto
    End If
    Dv$ = Right$(Str$(dv1c), 1)                   'salva o dv calculado como string
    Num$ = Num$ + Dv$                             'incorpora dv1
    dv2c = 0                                      'inicializa dv2
    Mu$ = "6" + Mu$                               'poe mais um dígito nos multiplicadores
    Posi = 13                                     'posição agora inicia em 13
    While Posi > 0                                'vamos fazer a mesma coisa,
      dv2c = dv2c + Val(Mid$(Num$, Posi, 1)) * Val(Mid$(Mu$, Posi, 1))
      Posi = Posi - 1                             'que fizemos acima
    Wend
    Resto = dv2c Mod 11                           'pega o resto da divisão por 11
    If Resto < 2 Then                             'se menor do que 2
      dv2c = 0                                    'o dv é 0
    Else                                          'senão,
      dv2c = 11 - Resto                           'o dv é a diferença
    End If
    RetVal = (dv1c = dv1f And dv2c = dv2f)        'prepara retorno
  End If
  VCGC = RetVal                                   'true se DVs fornecidos iguais aos calculados
End Function

'remove caracteres de uma string
Public Function Retira(vgAlvo As String, vgOQue As String, Como As Integer) As String
  Dim x As String, k As String, i As Integer, _
      j As Integer, p As Integer                       'dimensiona
  If Como = UM_A_UM Then                               'se um a um
    x$ = ""                                            'vamos concatenar em x
    For i = 1 To Len(vgAlvo$)                          'cada caracter que
      k$ = Mid$(vgAlvo$, i, 1)                         'não estiver
      If InStr(vgOQue$, k$) = 0 Then x$ = x$ + k$      'contido na string a regirar
    Next
  Else                                                 'se não for um a um
    x$ = vgAlvo$                                       'vamos tirar
ProcuraOutro:
    p = InStr(x$, vgOQue$)                             'toda a string
    If p > 0 Then                                      'de uma só vez
      x$ = Left$(x$, p - 1) + Mid$(x$, p + Len(vgOQue$)) 'da string alvo
      GoTo ProcuraOutro
    End If
  End If
  Retira$ = x$                                           'retorna nova string
End Function
     
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2026   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página