Tema: Re: asmens kodas
Autorius: Raimis
Data: 2010-01-13 10:51:37
Radau cia  toki pvz savajam archyve:
Public Function isValidKodas(akodas As String, arpoz As String) As Boolean
    Dim sumx, sumx2, i As Long
    If arpoz = "1" And Len(akodas) <> 11 Then
        isValidKodas = False
        'MsgBox "Neteisingas asmens kodo simbolių skaičius." + Chr(13) +
Chr(10) + "Turi būti 11 simbolių.", vbOKOnly + vbExclamation, "Taisykite"
        Exit Function
    End If
    If Not (IsNumeric(Mid(akodas, 1, 1)) And IsNumeric(Mid(akodas, 2, 1)))
Then
        isValidKodas = False
        'MsgBox "Neteisingas asmens/rejestro kodas.", vbOKOnly +
vbExclamation, "Taisykite"
        Exit Function
    End If
    If arpoz = "1" Then
        Dim strstr, Metai, menuo, diena As String
        Select Case Left(akodas, 1)
            Case "1"
                Metai = "18"
            Case "2"
                Metai = "18"
            Case "3"
                Metai = "19"
            Case "4"
                Metai = "19"
            Case "5"
                Metai = "20"
            Case "6"
                Metai = "20"
            Case Else
                isValidKodas = False
                'MsgBox "Neteisingas a/k pirmas skaitmuo." + Chr(13) +
Chr(10) + "Turi būti tarp 1 ir 6", vbOKOnly + vbExclamation, "Taisykite"
                Exit Function
        End Select
        Metai = Metai + Mid(akodas, 2, 2)
        menuo = Mid(akodas, 4, 2)
        diena = Mid(akodas, 6, 2)
        If menuo <> "00" And diena <> "00" Then
            On Error GoTo ErrorHandler
            DateValue (Metai + "." + menuo + "." + diena)
            On Error GoTo 0
        End If
        Const strg1 = "1234567891"
        Const strg2 = "3456789123"
        sumx = 0
        For i = 1 To 10
            sumx = sumx + Val(Mid(akodas, i, 1)) * Val(Mid(strg1, i, 1))
        Next i
        sumx = sumx Mod 11
        If sumx = 10 Then
            sumx = 0
            For i = 1 To 10
                sumx = sumx + Val(Mid(akodas, i, 1)) * Val(Mid(strg2, i, 1))
            Next i
            sumx = sumx Mod 11
            sumx = IIf(sumx = 10, 0, sumx)
        End If
        If sumx <> Val(Mid(akodas, 11, 1)) Then
            isValidKodas = False
            'MsgBox "Neteisingas a/k apsauginis skaitmuo.", vbOKOnly +
vbExclamation, "Taisykite"
            Exit Function
        End If
    End If
    If arpoz = "2" Then
        If Len(akodas) <> 7 Then
            isValidKodas = True
            Exit Function
        End If
        sumx = 0
        For i = 1 To 6
            sumx = sumx + Val(Mid(akodas, i, 1)) * i
        Next i
        sumx = sumx Mod 11
        sumx2 = 11 - sumx
        If (sumx2 < 1 Or sumx2 > 9) Or Val(Mid(akodas, 7, 1)) <> sumx2 Then
            'MsgBox "Neteisingas r/k paskutinis skaitmuo: " + Mid(KODAS,
7,1) + Chr(13) + Chr(10) + "Turi b?ti: " + str(sumx2), vbOKOnly
+vbExclamation , "Taisykite"
            isValidKodas = False
            'MsgBox "Neteisingas r/k apsauginis skaitmuo.", vbOKOnly +
vbExclamation, "Taisykite"
            Exit Function
        End If
    End If
    isValidKodas = True
    Exit Function
ErrorHandler:
    'MsgBox "Neteisinga data ", vbOKOnly + vbExclamation, "Taisykite"
    isValidKodas = False
    Exit Function
End Function

"Joint_as" <a@a.com> wrote in message 
news:hi1pkb$6o0$1@trimpas.omnitel.net...
> Asmens kodo validation rule MS Access'e ??
>