|
|
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
|
|
|
|
|
|
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
|
|
|
|
|