身份证号码验证函数

Function CheckIDCard(sStr, ByVal dDate, ByVal nSex)
?CheckIDCard = "False"
?If IsNull(sStr) Or sStr = "" Then Exit Function
?If Not IsDate(dDate) Or dDate = "" Then Exit Function
?If Not IsNumeric(nSex) Or nSex = "" Then Exit Function
?
?Dim oRE, sDate
?
?Set oRE??= New RegExp
?oRE.IgnoreCase?= True
?oRE.Global?= True
?
?nSex?= CInt(nSex Mod 2)
?sDate?= Year(dDate) & DblNum(Month(dDate)) & DblNum(Day(dDate))
?
?Select Case Len(sStr)
??Case 8
???If DateDiff("yyyy", dDate, Date()) < 19 Then Exit Function
???oRE.Pattern?= "^[d]{8}$"
???If Not oRE.Test(sStr) Then Exit Function
???If sStr <> sDate Then Exit Function
??Case 15
???oRE.Pattern?= "^[d]{15}$"
???If Not oRE.Test(sStr) Then Exit Function
???If Mid(sStr, 7, 6) <> Right(sDate, 6) Then Exit Function
???If CInt(Mid(sStr, 14, 1)) Mod 2 <> nSex Then Exit Function
??Case 18
???oRE.Pattern?= "^(?:[d]{18}|[d]{17}X)$"
???If Not oRE.Test(sStr) Then Exit Function
???If Mid(sStr, 7, 8) <> sDate Then Exit Function
???If CInt(Mid(sStr, 17, 1)) Mod 2 <> nSex Then Exit Function
???
???Dim nN, aW, aC, nL
???
???nN = 0
???aW = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)
???aC = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")
???
???For nL = 1 To 17
????nN = nN + CInt(Mid(sStr, nL, 1)) * aW(nL - 1)
???Next
???
???If UCase(Right(sStr, 1)) <> aC(nN Mod 11) Then Exit Function
??Case Else
???Exit Function
?End Select
?
?Set oRE??= Nothing
?
?CheckIDCard = "True"
End Function

Function DblNum(nNum)
?DblNum = nNum
?If DblNum <10 Then DblNum = "0" & DblNum
End Function

原文转自：http://www.ltesting.net