T.C. Kimlik no doğrulama algoritması

Katılım
13 Kasım 2008
Mesajlar
86
Excel Vers. ve Dili
2010 TR
bu algoritmayı bir internet sitesinden buldum ancak a1 hücresine kimlik numarası girildiği zaman doğrulayacak şekilde düzenleyemedim. yardımcı olabilirmisiniz

Kod:
Function TcDogrulaV2(ByVal tcKimlikNo As String) As Boolean
        Dim returnvalue As Boolean = False
        If (tcKimlikNo.Length < a1 > 11) Then
            tcCustom.ErrorMessage = "<br />TC Kimlik Numarası 11 Haneli Olmalıdır."
            Return returnvalue
        End If
        Dim TcNo As Long = Long.Parse(tcKimlikNo)
        Dim BTCNO As Long = Long.Parse(Left(tcKimlikNo, 9))
        
        Dim C1 As Long = Long.Parse(Mid(tcKimlikNo, 1, 1))
        Dim C2 As Long = Long.Parse(Mid(tcKimlikNo, 2, 1))
        Dim C3 As Long = Long.Parse(Mid(tcKimlikNo, 3, 1))
        Dim C4 As Long = Long.Parse(Mid(tcKimlikNo, 4, 1))
        Dim C5 As Long = Long.Parse(Mid(tcKimlikNo, 5, 1))
        Dim C6 As Long = Long.Parse(Mid(tcKimlikNo, 6, 1))
        Dim C7 As Long = Long.Parse(Mid(tcKimlikNo, 7, 1))
        Dim C8 As Long = Long.Parse(Mid(tcKimlikNo, 8, 1))
        Dim C9 As Long = Long.Parse(Mid(tcKimlikNo, 9, 1))
        
        Dim Q1 As Long = ((10 - (((((((C1 + C3) + C5) + C7) + C9) * 3) + (((C2 + C4) + C6) + C8)) Mod 10)) Mod 10)
        Dim Q2 As Long = ((10 - (((((((C2 + C4) + C6) + C8) + Q1) * 3) + ((((C1 + C3) + C5) + C7) + C9)) Mod 10)) Mod 10)
        'Response.Write((((BTCNO * 100) + (Q1 * 10)) + Q2) & " - ")
        'Response.Write(tcKimlikNo)
        If ((((BTCNO * 100) + (Q1 * 10)) + Q2) = TcNo) Then
            tcCustom.ErrorMessage = ""
        Else
            tcCustom.ErrorMessage = "<br />Hatalı TC Kimlik Numarası."
        End If
        
        Return ((((BTCNO * 100) + (Q1 * 10)) + Q2) = TcNo)
    End Function
 
Katılım
13 Kasım 2008
Mesajlar
86
Excel Vers. ve Dili
2010 TR
teşekkürler istediğim buydu :)
 
Üst