terça-feira, 5 de junho de 2001

Validação Titulo de Eleitor

obs: É necessário tambem a função removemascara() que está no final do artigo !


Function FF_TituloEleitor(Controle)
    Dim WL_DSTITELE
    Dim WL_NRSOMA
    Dim WL_NRRESTO
    Dim i
    Dim VL_Numero(10)
    Dim VL_Digito(2)
   
    FF_TituloEleitor = False


    WL_DSTITELE = RemoveMascara(Controle)


    if trim(WL_DSTITELE)="" then
       FF_TituloEleitor = True
       exit Function
    End if


    WL_DSTITELE = String(12 - Len(WL_DSTITELE), "0") + WL_DSTITELE
   
    'Preenche Vetor com Valores do Número do Título de Eleitor
    For i = 1 To 10
       VL_Numero(i) = Mid(WL_DSTITELE, i, 1)
    Next


    'Verifica Primeiro Dígito
    WL_NRSOMA = (VL_Numero(8) * 2) + (VL_Numero(7) * 3) + (VL_Numero(6) * 4) + (VL_Numero(5) * 5) + (VL_Numero(4) * 6) + (VL_Numero(3) * 7) + (VL_Numero(2) * 8) + (VL_Numero(1) * 9)
    WL_NRRESTO = WL_NRSOMA Mod 11
    'Atribui valor para o primerio dígito
    If WL_NRRESTO = 0 Or WL_NRRESTO = 1 Then
       VL_Digito(1) = 0
    Else
       VL_Digito(1) = 11 - WL_NRRESTO
    End If
   
    'Verifica Segundo Dígito.
    WL_NRSOMA = (VL_Digito(1) * 2) + (VL_Numero(10) * 3) + (VL_Numero(9) * 4)
    WL_NRRESTO = WL_NRSOMA Mod 11
    'Atribui Valor para o segundo dígito.
    If WL_NRRESTO = 0 Or WL_NRRESTO = 1 Then
       VL_Digito(2) = 0
    Else
       VL_Digito(2) = 11 - WL_NRRESTO
    End If
   
    'Retorna Valor do Dígito.
    If Right(WL_DSTITELE, 2) <> VL_Digito(1) & VL_Digito(2) Then
       Controle.focus
       MsgBox "Número do Título de Eleitor Inválido", vbOKOnly + vbInformation
       Exit Function
    End If
    FF_TituloEleitor = True


End Function


Function RemoveMascara(Controle)
Dim wl_string,i


    wl_string=""
    For i = 1 to Len(Controle.value)
        if mid(Controle.Mask,i,1)="9" or mid(Controle.Mask,i,1)="#" then
            wl_string = wl_string & mid(Controle.value,i,1)
        End If
    Next
    RemoveMascara = wl_string


End Function



Esta matéria foi postada originalmente no ASP4Developers por Thiago Machado Souza (site), que na época era "Programador Desbravador, buscando quebrar todas as fronteiras além do horizonte da arte de programar !
www.thiagomachado.com.br". Hoje, vai saber...

0 comentários: