Função para testar CGC

Attribute VB_Name = "CGC" Option Explicit Public Function TestaCGC(ByVal pvntCGC As Variant) As Boolean     '''''''''''''''''''''''''''''''''''''''''''''''''''''''     ' Funcao TestaCGC: Verifica se o CGC é válido     '     ' Entrada:  pvntCGC (String ou Long com o CGC com DV)     ' Retorno:  Boolean     ' Exemplo:  ? TestaCGC("50268838000139")     '           True     '           ? TestaCGC("50.268.838/0001-39")     '           True     '           ? TestaCGC(50268838000139)     '           True     '           ? TestaCGC("99999999999999")     '           False     '''''''''''''''''''''''''''''''''''''''''''''''''''''''     Dim strCGC As String     Dim strCGC1 As String     Dim strCGC2 As String     Dim intSoma As Integer, intDigito As Integer     Dim intI As Integer, intJ As Integer     Dim strDV As String, strMult As String          ' Prepara a string CGC para verificação     strCGC = CStr(pvntCGC)     strCGC = Replace(strCGC, ".", "")     strCGC = Replace(strCGC, "/", "")     strCGC = Replace(strCGC, "-", "")     strCGC = Format(strCGC, String(14, "0"))     strCGC1 = Left(strCGC, 12) ' CGC sem DV     strCGC2 = Right(strCGC, 2) ' Dígito verificador (DV)          strMult = "543298765432"     For intJ = 1 To 2         intSoma = 0         For intI = 1 To 12             intSoma = intSoma + (Val(Mid(strCGC1, intI, 1)) * Val(Mid(strMult, intI, 1)))         Next         If intJ = 2 Then intSoma = intSoma + (2 * intDigito)         intDigito = (intSoma * 10) Mod 11         If intDigito = 10 Then intDigito = 0         strDV = strDV + Trim(CStr(intDigito))         strMult = "654329876543"     Next     TestaCGC = IIf(strDV <> strCGC2, False, True) End Function

Quebra-Linha

Colaborador..: Alexandre Neves
Categoria(s).: ASP;
Versão.......: 1.0
Data.........: 11/04/2002 15:45:20
Visualizado..: 4095 vezes
Fonte........: Sharepedia