<%

Class IDCardInfo
Private strAuthor ,strVersion ,StrMessage,StrIDCard

Public Property Let IDCard(ByVal strVar)
StrIDCard =strVar
End Property

Public Property Get Version
Version = strVersion
End Property

Public Property Get Author
Author = strAuthor
End Property

Public Property Get DataList
DataList = strDataList
End Property

Private Sub Class_Initialize()
strAuthor = "林其浓–http://www.youthbar.com"
strVersion = "1.0"
strMessage="该类功能：从省份证号码中获得生日，性别，籍贯等信息,欢迎测试使用!<br>联系制作者：<a href='mailto:[email protected]'>林其浓</a> @ <a href='http://www.youthbar.com'>www.youthbar.com</a>.<br>"
End Sub

Private Sub Class_Terminate()
'Response.Write "<br>myClass结束了<br>"
End Sub

Public Property Get Message
Message=StrMessage
End Property

Public Property Get Error
Error=CardErr()
End Property

Function IDCheck(e)
IDCheck = ""
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", ",")
Checker = Split("1,9,8,7,6,5,4,3,2,1,1", ",")
If Len(e) < 15 Or Len(e) = 16 Or Len(e) = 17 Or Len(e) > 18 Then
IDCheck= "身份证号共有 15 码或18位"
Exit Function
End If
Dim Ai
If Len(e) = 18 Then
Ai = Mid(e, 1, 17)
ElseIf Len(e) = 15 Then
Ai = e
Ai = Left(Ai, 6) & "19" & Mid(Ai, 7, 9)
End If
If Not IsNumeric(Ai) Then
IDCheck= "身份证除最后一位外，必须为数字！"
IDCheck = False
Exit Function
End If
Dim strYear, strMonth, strDaym,BirthDay
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
IDCheck= "身份证输入错误！"
IDCheck = False
Exit Function
End If
If strMonth > 12 Or strDay > 31 Then
IDCheck = False
IDCheck= "身份证输入错误！"
Exit Function
End If
Else
IDCheck= "身份证输入错误！"
Exit Function
End If
Dim i, TotalmulAiWi
For i = 0 To 16
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)
Next
Dim modValue
modValue = TotalmulAiWi Mod 11
Dim strVerifyCode
strVerifyCode = arrVerifyCode(modValue)
Ai = Ai & strVerifyCode
IDCheck =True' Ai
If Len(e) = 18 And e <> Ai Then
IDCheck= "身份证号码输入错误！"
Exit Function
End If
End Function

Function IDCheckedStr(e)
IDCheckedStr= ""
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", ",")
Checker = Split("1,9,8,7,6,5,4,3,2,1,1", ",")
If Len(e) < 15 Or Len(e) = 16 Or Len(e) = 17 Or Len(e) > 18 Then
IDCheckedStr= "身份证号共有 15 码或18位"
Exit Function
End If
Dim Ai
If Len(e) = 18 Then
Ai = Mid(e, 1, 17)
ElseIf Len(e) = 15 Then
Ai = e
Ai = Left(Ai, 6) & "19" & Mid(Ai, 7, 9)
End If
If Not IsNumeric(Ai) Then
IDCheckedStr= "身份证除最后一位外，必须为数字！"
IDCheckedStr = False
Exit Function
End If
Dim strYear, strMonth, strDay,BirthDay
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
IDCheckedStr= "身份证输入错误！"
IDCheckedStr = False
Exit Function
End If
If strMonth > 12 Or strDay > 31 Then
IDCheckedStr = False
IDCheckedStr= "身份证输入错误！"
Exit Function
End If
Else
IDCheckedStr= "身份证输入错误！"
Exit Function
End If
Dim i, TotalmulAiWi
For i = 0 To 16
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)
Next
Dim modValue
modValue = TotalmulAiWi Mod 11
Dim strVerifyCode
strVerifyCode = arrVerifyCode(modValue)
Ai = Ai & strVerifyCode
IDCheckedStr = Ai
If Len(e) = 18 And e <> Ai Then
IDCheckedStr= "身份证号码输入错误！"
Exit Function
End If
End Function

Private Function CardErr()
CardErr=IDCheck(StrIDCard)
End Function
Public Function CardLen()
if CardErr()=True then
CardLen=len(IDCheckedStr(StrIDCard))
end if
End Function

Public Function BirthDay()
Dim strYear, strMonth, strDay,Ai
Ai=IDCheckedStr(StrIDCard)
if CardErr()=true then
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)
else
BirthDay=""
end if
End Function

Public Function Sex()
if CardErr()=true then
sex=MID(IDCheckedStr(StrIDCard),17,1)
End if
End Function
End Class
dim NewClass
Set NewClass = New IDCardInfo
NewClass.IDCard="330325821217511"
%>
<pre>
作者： <%= NewClass.Author %>
版本： <%= NewClass.Version %>
类说明：<%= NewClass.Message %>
数据列表： <%' NewClass.DataList %>
错误： <%= NewClass.error %>
长度： <% = NewClass.CardLen%>
生日：<%= NewClass.BirthDay() %>
性别：<%= NewClass.Sex() %>
</pre>
<pre>
新身份证号：
XX|XX|XX|XXXX|XX|XX|XXX|X
省|市|区|出生年|月|日|编号|效验码

老身份证号：
XX|XX|XX|XX|XX|XX|XXX
省|市|区|出生年月|日|编号

收集省市区的编码建立一张基础数据表，通过该表查询。
北京 11
天津 12
河北 13
山西 14
内蒙古 15
辽宁 21
吉林 22
黑龙江 23
上海 31
江苏 32
浙江 33
安徽 34
福建 35
江西 36
山东 37
河南 41
湖北 42
湖南 43
广东 44
广西 45
海南 46
重庆 50
四川 51
贵州 52
云南 53
西藏 54
陕西 61
甘肃 62
青海 63
宁夏 64
新疆 65
台湾 71
香港 81
澳门 82
国外 91