Vbscript身份證驗證函式

Function CheckIDCard(StrNumber)
'判斷社會安全號碼碼格式函數'公民身份號碼是特徵組合碼，
'由十七位元字本體碼和一位元字校正碼組成。
'排列順序從左至右依次為：六位元字地址碼，八位元字出生日期碼，三位元字順序碼和一位元字校正碼

'社會安全號碼碼長度判斷
If Len(StrNumber) < 15 Or Len(StrNumber) = 16 Or Len(StrNumber) = 17 Or Len(StrNumber) > 18 Then
CheckIDCard= "社會安全號碼共有15位或18位"
CheckIDCard = False
Exit Function
End If
'社會安全號碼碼最後一位可能是超過100歲老年人的X
'所以排除掉最後一位元字進行數字格式測試
'全部換算成17位元字格式
Dim Ai
If Len(StrNumber) = 18 Then
Ai = Mid(StrNumber, 1, 17)
ElseIf Len(StrNumber) = 15 Then
Ai = StrNumber
Ai = Left(StrNumber, 6) & "19" & Mid(StrNumber, 7, 9)
End If
 
If Not IsNumeric(Ai) Then
CheckIDCard= "身份證除最後一位外，必須為數字格式！"
Exit Function
End If
'MID函數，從多少位元字開始的後面N個數字，起始值1
Dim strYear, strMonth, strDay
strYear = CInt(Mid(Ai, 7, 4))
strMonth = CInt(Mid(Ai, 11, 2))
strDay = CInt(Mid(Ai, 13, 2))
BirthDay = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay)

If IsDate(BirthDay) Then
 If DateDiff("yyyy",Now,BirthDay) <-140 or cdate(BirthDay)> date() Then
 CheckIDCard= "社會安全號碼碼錯誤！"
 Exit Function
 End If
 If strMonth > 12 Or strDay > 31 Then
 CheckIDCard= "社會安全號碼碼錯誤！"
 Exit Function
 End If
Else
 CheckIDCard= "社會安全號碼碼錯誤！"
 Exit Function
End If
 
'順序碼
'表示在同一地址碼所標識的地區範圍內，對同年、同月、同日出生的人編定的順序號，順序碼的奇數分配給男性，偶數分配給女性。

'校正碼
'十七位元字本體碼加權求和公式
'S = Sum(Ai * Wi), i = 0, ... , 16 ，先對前17位元字的權求和
'Ai:表示第i位置上的社會安全號碼碼數字值
'Wi:表示第i位置上的加權因子
'Wi: 7 9 10 5 8 4 2 1 6 3 7 9 10 5 8 4 2
arrVerifyCode = Split("1,0,x,9,8,7,6,5,4,3,2", ",")
Wi = Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2", ",")

Dim i, TotalmulAiWi
For i = 0 To 16
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)
Next

'計算模
'Y = mod(S, 11)
'通過模得到對應的校正碼
'Y: 0 1 2 3 4 5 6 7 8 9 10
'校正碼: 1 0 X 9 8 7 6 5 4 3 2
Dim modValue
modValue = TotalmulAiWi Mod 11
Dim strVerifyCode
strVerifyCode = arrVerifyCode(modValue)
Ai = Ai & strVerifyCode
CheckIDCard = Ai '最終擷取18位元字社會安全號碼碼

If Len(StrNumber) = 18 And StrNumber<> Ai Then
CheckIDCard= "社會安全號碼碼錯誤！"
Exit Function
End If

End Function