将身份证从15位升级为18位的函数

发表于:2007-06-30来源:作者:点击数: 标签:

  @#将身份证从15位升级为18位的函数

  Function GetNewIDCard(ByVal IDCard As String) As String
    Dim i, S As Integer
    Dim Wi() As String = Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2,1", ",")
    Dim Wf() As String = Split("1,0,X,9,8,7,6,5,4,3,2", ",")
    If Mid(IDCard, 7, 2) >= Mid(Now.AddYears(-14).Year, 3, 2) Then
      IDCard = Mid(IDCard, 1, 6) & "18" & Mid(IDCard, 7, 9)
    Else
      IDCard = Mid(IDCard, 1, 6) & "19" & Mid(IDCard, 7, 9)
    End If
    For i = 0 To 16
      S += Wi(i) * Mid(IDCard, i + 1, 1)
    Next
    Return IDCard & Wf(S Mod 11)
  End Function

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