这是我这几天，重新修订的身份证类。
主要功能是：
可以将以前旧的15位身份证转化为18位（考虑到15位身份证号存在时间较早，只在第6位后插入19，而不是插入20）。
可以验证身份证号码是否正确。
可以获得性别、年龄。
如果能够加载行政区划数据，则可以进行相应的验证。
考虑到现实中的实际运用，行政区划代码是否找到，不作为判断身份证是否正确的必要依据。因为行政区划代码经常有调整，很担心误判。可以按我程序的方法，结合行政区划代码的*号来判断身份证号是否正确。
现将全部代码分享于后。
Public Class BqSfz2
#Region "私有变量"
'在身份证验证过程中，获得以下变量变量的值
Private lsfzText As String = "" ' 格式化后的身份证号（统一大写，去除空格）
Private lRQbirth As String = "" ' 出生日期（格式：YYYY-MM-DD）
Private lSexText As String = "" ' 性别（"男"或"女"）
Private lsLevelC As String = "" ' 行政区划代码（带*表示未在行政区划表中找到）
'校验码计算相关常量 （GB 11643-1999标准）
'直接在这里定义，而不是在mGetCheck2中，以提高运行的速度
' 权重因子数组
Private lsWeightS() As Integer = {7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2}
'定义校验码映射表（余数0-10对应的校验码）
Private lsCheckDigitS() As String = {"1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2"}
'以下是解决可以判定行政区划的问题
'基本思路：
' 1、先加载行政区划的数据，如果加载成功，则进行行政区划的判断，如果没成功，则不判断
' 2、加载后，对行政区划编码进行搜索判断，如果找到，则正确，并获得行政区划代码；如果没有找到，则提示没找到，在区划代码前边加*号
' 3、行政区划是否找到，不作为判断身份证是否正确的必要依据。因为数据有调整，很担心误判。可以按我程序的方法，结合行政区划代码的*号来判断
' 4、这里只编写用数据表的方法。（也可以把行政区划及代码写入XML文件，读取后，进行查找验证。
Private lYnLoadArea As Boolean = False ' 是否已加载行政区划数据
Private loTabArea As DataTable = Nothing ' 行政区划数据表
Private ltv As DataView = Nothing ' 用于快速查找的数据视图
#End Region
#Region "公共属性"
'验证传入的身份证号码是否正确
Public ReadOnly Property BqPbIsRight(ByVal lstrSfz As String) As Boolean
Get
Return mGetRight(lstrSfz) ' 调用内部验证方法
End Get
End Property
' 属性：获取格式化后的身份证号（去除空格，统一大写）
Public ReadOnly Property BqPsTrim() As String
Get
Return lsfzText
End Get
End Property '格式化后的身份证号
' 属性：获取性别名称（"男"或"女"）
Public ReadOnly Property BqPsSex() As String
Get
Return lSexText
End Get
End Property '性别名称
' 属性：获取性别布尔值（False=女，True=男）
Public ReadOnly Property BqPbSex() As Boolean
Get
Return IIf(lSexText = "女", False, True)
End Get
End Property '性别 false 0 女生,ture 1 男生
' 属性：获取出生日期（格式：YYYY-MM-DD）
Public ReadOnly Property BqPsBirth() As String
Get
Return lRQbirth
End Get
End Property '出生日期
' 属性：将15位身份证转换为18位
Public ReadOnly Property BqPsTo18(ByVal lstrSfz As String) As String
Get
Dim m0 As String = ""
If mGetRight(lstrSfz) = True Then
If lsfzText.Length = 15 Then
' 15位转18位算法
Dim m1, m2 As String
m1 = lsfzText
m1 = Left(m1, 6) + "19" + Right(m1, 9) ' 在6位后插入19
m2 = mGetCheck1(m1) '计算校验位，旧方法
m0 = m1 + m2
Else ' 已经是18位的
m0 = lsfzText
End If
End If
Return m0
End Get
End Property '将15的升为18位
' 属性：计算到当前日期的年龄（基于身份证出生日期）
Public ReadOnly Property BqPsOld() As String
Get
Return mGetOld(lRQbirth, Now)
End Get
End Property '到 Now的年龄
' 属性：计算到指定日期的年龄（基于身份证出生日期）
Public ReadOnly Property BqPsOld(ByVal lBeginDate As DateTime) As String
Get
Return mGetOld(lRQbirth, lBeginDate)
End Get
End Property '到 Now的年龄
'以下是解决对身份证前6位，行政区划的验证的思路
'传入的是数据库
Public Property BqpTabArea(ByVal lTabArea As DataTable) As Boolean
Get
Return lYnLoadArea
End Get
Set(ByVal Value As Boolean)
lYnLoadArea = False
loTabArea = lTabArea
ltv = lTabArea.DefaultView
If IsNothing(loTabArea) = False AndAlso loTabArea.Rows.Count > 2000 Then
lYnLoadArea = True
End If
End Set
End Property
'读取行政区划，快速定位找到
Public ReadOnly Property BqpAreaLevel() As String
Get
Return mGetCheckLevel()
End Get
End Property
#End Region
#Region "内部方法 "
''' <summary>
''' 核心验证方法 - 验证身份证有效性并提取信息
''' </summary>
'验证身份证号码有效性
Private Function mGetRight(ByVal lstrSfz As String) As Boolean
Dim m0 As Boolean = False
' 清空前次验证结果
lsfzText = "" ' 整理后的身份证号（统一格式）
lRQbirth = "" ' 生日（格式：YYYY-MM-DD）
lSexText = "" ' 性别（"男"或"女"）
lsLevelC = ""
Dim s, ls1, ls2, ls3, ls4, ls5, ls6, ls7, ls9 As String
' 预处理身份证号码：去除空格、统一X的大小写、去除特殊字符
s = "" & lstrSfz.ToString
s = s.Replace(" ", "").Replace(" ", "").Replace("Ｘ", "X").Replace("ｘ", "X")
s = s.Replace("e", "").Replace("+", "")
' 只处理15位或18位身份证号
If s.Length = 15 Or s.Length = 18 Then
Try
If s.Length = 15 Then
ls1 = s ' 完整15位号码
ls2 = "" ' 15位无校验码
ls3 = "19" & s.Substring(6, 6) ' 生日部分（补19前缀）
ls4 = s.Substring(14, 1) ' 性别位（15位的最后一位）
ls5 = "" ' 无需计算校验码
ls6 = "" & IsNumeric(ls1) ' 检查是否全数字
ElseIf s.Length = 18 Then
ls1 = s.Substring(0, 17) ' 前17位
ls2 = s.Substring(17, 1).ToUpper ' 校验位（转为大写）
ls3 = s.Substring(6, 8) ' 生日部分（8位）
ls4 = s.Substring(16, 1) ' 性别位（第17位）
ls5 = "" ' 待计算的校验码
ls6 = "" & IsNumeric(ls1) ' 检查前17位是否全数字
If ls6 = "True" Then
ls5 = mGetCheck2(ls1) '计算校验位，这是新方法
ls9 = mGetCheck1(ls1) '这是旧方法
If ls5 <> ls9 Then '主要是验证两种方法的一致性，正式使用时，可以把旧方法备注掉
MessageBox.Show("两种验证方法获取的验证码出错")
End If
End If
End If
'格式化日期字符串
ls7 = ls3.Substring(0, 4) & "-" & ls3.Substring(4, 2) & "-" & ls3.Substring(6, 2)
' 验证条件：日期有效、校验码匹配、全数字（15位）或前17位全数字（18位）
m0 = IIf(IsDate(ls7) = False Or ls2 <> ls5 Or ls6 = "False", False, True)
Catch ex As Exception
'出现异常视为无效身份证号
End Try
End If
If m0 = True Then ' 验证通过，保存格式化后的信息
lsfzText = s.ToUpper '统一转为大写
lRQbirth = IIf(IsDate(ls7), ls7, "") '格式化后的日期
lSexText = IIf("24680".IndexOf(ls4) >= 0, "女", "男") '偶数为女，奇数为男
End If
Return m0
End Function
'年龄计算改进。（到指定的指定日期）
Private Function mGetOld(ByVal lBirth As String, ByVal m2 As DateTime) As String
Dim n As Integer = 0
Try
If IsDate(lBirth) Then
Dim m1 As Date = CDate(lBirth)
n = m2.Year - m1.Year
If m1.Month < m1.Month Or (m1.Month = m1.Month And m1.Day < m1.Day) Then
n -= 1
End If
End If
Catch ex As Exception
End Try
Return IIf(n = 0, "", "" & n)
End Function
'根据17位计算校验码。这是方法一 （保留的意义在于与方法二进行对比，可以在mGetRight中将其备注掉）
Private Function mGetCheck1(ByVal m17 As String) As String
'因为在内部用，m17肯定是17位的，所以就忽略是否是17位的验证
Dim m0 As String = ""
Dim i, n, m1 As Integer
n = 0 ' 计算校验位
For i = 18 To 2 Step -1
m1 = CInt(Mid(m17, 19 - i, 1))
n = n + (2 ^ (i - 1) Mod 11) * m1
Next i
n = n Mod 11
' 根据模11结果确定校验码
m0 = IIf(n = 0, "1", IIf(n = 1, "0", IIf(n = 2, "X", Trim(Str(12 - n)))))
Return m0
End Function
'根据17位计算校验码。这是方法二 更清晰,更符合新国标〖GB 11643-1999〗
Private Function mGetCheck2(ByVal m17 As String) As String
Dim m0 As String = ""
Dim i, n, m1 As Integer
n = 0 '加权和
For i = 1 To 17
m1 = CInt(Mid(m17, i, 1))
n = n + m1 * lsWeightS(i - 1) '与权重因子的积进行累加
Next
n = n Mod 11
m0 = lsCheckDigitS(n) '根据余数返回对应的校验码
Return m0
End Function
'验证行政区划
Private Function mGetCheckLevel() As String
'结果有两种情况：身份证前六位；没在行政区划表里找到，则加*；身份证有错就返回空值
Dim m0 As String = ""
Dim s As String = ""
If lsfzText.Length > 6 Then
s = Mid(lsfzText, 1, 6) '取前6位
Try
If IsNothing(ltv) = True Then
m0 = s & "*"
Else
ltv.Sort = "BhDq"
m0 = IIf(ltv.Find(s) > 0, s, s & "*")
End If
Catch ex As Exception
End Try
End If
Return m0
End Function
#End Region
End Class
如果再结合行政区划数据，可以将身份证类进一步扩充：
可以获得身份证号对应的省、市、县级行政区划代码或名称。
如果再结合农历数据，可以将身份证类进一步扩充：
获得农历生日、生肖、星座等。
身份证号码验证原理，可以参见我在2006年的写的文章：
身份证号码的秘密_没有0的身份证号码 上个世纪 11 12-CSDN博客
测试代码：
在新建窗口中，建立一个文本框TextBox1、一个列表ListBox1、一个命令按钮Button1。然后在命令按钮中，写入以下代码：
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Me.ListBox1.DataSource = Nothing
Dim k As Date = DateAdd(DateInterval.Day, -1000, Now)
Dim mm As String
mm = Me.TextBox1.Text
Dim m(9) As String
Dim lsfz As New BqSfz2
With lsfz
m(0) = "转18位：" & .BqPsTo18(mm)
m(1) = "正确否：" & .BqPbIsRight(mm)
m(2) = "性别：" & .BqPbSex()
m(3) = "性别：" & .BqPsSex()
m(4) = "生日：" & .BqPsBirth()
m(5) = "规范后：" & .BqPsTrim()
m(6) = "年龄：根据身份证号来计算：" & .BqPsOld()
m(7) = "年龄：根据生日来计算：" & .BqPsOld()
m(8) = "1000天前的年龄：" & .BqPsOld(k)
'If .BqpTabArea(ltb) = True Then
' '这一段移到学校管理系统中去测试
'End If
m(9) = "地区编码：" & .BqpAreaLevel
End With
Me.ListBox1.DataSource = m
End Sub