C. G. C.

Novidades

Acima
C. G. C.
Dial Up pelo VB














































































 

A função abaixo informa se o número de CGC
fornecido é ou não válido:

Function FU_ValidaCGC (cgc As String) As Integer
        Dim retorno, a, j, i, d1, d2
        If Len(cgc) = 8 And Val(cgc) > 0 Then
            a = 0
            j = 0
            d1 = 0
            For i = 1 To 7
                    a = Val(Mid(cgc, i, 1))
                    If (i Mod 2) <> 0 Then
                        a = a * 2
                    End If
                    If a > 9 Then
                        j = j + Int(a / 10) + (a Mod 10)
                    Else
                        j = j + a
                    End If
            Next i
            d1 = IIf((j Mod 10) <> 0, 10 - (j Mod 10), 0)
            If d1 = Val(Mid(cgc, 8, 1)) Then
                    FU_ValidaCGC = True
            Else
                    FU_ValidaCGC = False
            End If
        Else
            If Len(cgc) = 14 And Val(cgc) > 0 Then
                a = 0
                i = 0
                d1 = 0
                d2 = 0
                j = 5
                For i = 1 To 12 Step 1
                        a = a + (Val(Mid(cgc, i, 1)) * j)
                        j = IIf(j > 2, j - 1, 9)
                Next i
                a = a Mod 11
                d1 = IIf(a > 1, 11 - a, 0)
                a = 0
                i = 0
                j = 6
                For i = 1 To 13 Step 1
                        a = a + (Val(Mid(cgc, i, 1)) * j)
                        j = IIf(j > 2, j - 1, 9)
                Next i
                a = a Mod 11
                d2 = IIf(a > 1, 11 - a, 0)
                If (d1 = Val(Mid(cgc, 13, 1)) And d2 = Val(Mid(cgc, 14, 1))) Then
                    FU_ValidaCGC = True
                Else
                    FU_ValidaCGC = False
                End If
            Else
                FU_ValidaCGC = False
            End If
        End If
End Function

 
AF Sistemas
(c) 1998 - 2005  Adriano Freitas
Dúvidas e sugestões sobre este site, escreva para:

suporte@afsistemas.cjb.net