فرمول تشخيص صحت كد ملي
سلام
با استفاده از برنامه زير مي توانيد تشخيص دهيد كاربر كد ملي صحيحي را وارد نموده يا خير
سازمان ثبت احوال کشور در راستای ارائه کارت ملی روشی را برای تولید کدهای ملی استفاده نموده است که با استفاده از آنها می توانیم کدهایی داشته باشیم که از امنیت بالایی برخوردار باشند و همچنین قابلیت تقلب نداشته باشند.
همه کدهای ملی ۱۰ رقمی هستند.
کدهای ملی که همه ارقام آنها مثل هم باشند معتبر نیستند مثل
۰۰۰۰۰۰۰۰۰۰
۱۱۱۱۱۱۱۱۱۱
۲۲۲۲۲۲۲۲۲۲
۳۳۳۳۳۳۳۳۳۳
۴۴۴۴۴۴۴۴۴۴
۵۵۵۵۵۵۵۵۵۵
۶۶۶۶۶۶۶۶۶۶
۷۷۷۷۷۷۷۷۷۷
۸۸۸۸۸۸۸۸۸۸
۹۹۹۹۹۹۹۹۹۹
روش اعتبار سنجی کد ملی :
دهمین رقم شماره ملی را ( از سمت چپ ) به عنوان A در نظر می گیریم.
یک مقدار B در نظر می گیریم و آن را برابر با =
(اولین رقم * ۱۰) + ( دومین رقم * ۹ ) + ( سومین رقم * ۸ ) + ( چهارمین رقم * ۷ ) + ( پنجمین رقم * ۶) + ( ششمین رقم * ۵ ) + ( هفتمین رقم * ۴ ) + ( هشتمین رقم * ۳ ) + ( نهمین رقم * ۲ )
قرار می دهیم.
مقدار C را برابر با = B – (B/11)*11 قرار می دهیم.
اگر مقدار C برابر با صفر باشد و مقدار A برابر C باشد کد ملی صحیح است.
اگر مقدار C برابر با ۱ باشد و مقدار A برابر با ۱ باشد کد ملی صحیح است.
اگر مقدار C بزرگتر از ۱ باشد و مقدار A برابر با ۱۱ – C باشد کد ملی صحیح است.
Function CheckMelliCode(Melli_Code As String) As Boolean
Dim c@, n@, r@
If Len(Melli_Code) < 10 Then Melli_Code = String(10 - Len(Melli_Code), "0") & Melli_Code
If Melli_Code = "0000000000" Or _
Melli_Code = "1111111111" Or _
Melli_Code = "2222222222" Or _
Melli_Code = "3333333333" Or _
Melli_Code = "4444444444" Or _
Melli_Code = "5555555555" Or _
Melli_Code = "6666666666" Or _
Melli_Code = "7777777777" Or _
Melli_Code = "8888888888" Or _
Melli_Code = "9999999999" Then
Else
c = Val(Mid$(Melli_Code, 10, 1))
n = Val(Mid$(Melli_Code, 1, 1)) * 10 + _
Val(Mid$(Melli_Code, 2, 1)) * 9 + _
Val(Mid$(Melli_Code, 3, 1)) * 8 + _
Val(Mid$(Melli_Code, 4, 1)) * 7 + _
Val(Mid$(Melli_Code, 5, 1)) * 6 + _
Val(Mid$(Melli_Code, 6, 1)) * 5 + _
Val(Mid$(Melli_Code, 7, 1)) * 4 + _
Val(Mid$(Melli_Code, 8, 1)) * 3 + _
Val(Mid$(Melli_Code, 9, 1)) * 2
r = n - Int(n / 11) * 11
If (r = 0 And r = c) Or (r = 1 And c = 1) Or (r > 1 And c = 11 - r) Then CheckMelliCode = True
End If
End Function
Private Sub Command1_Click()
MsgBox CheckMelliCode("4591246361")
End Sub
پاسخ با نقل قول
