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

|