求vb6算法－－身份证15位升18位算法

Question

如题！
请帮忙！谢

Answer 1

function getnewsfzhm(osfzhm ) 
 if len(osfzhm)=18 then 
   getnewsfzhm=osfzhm
   exit function
 end if
 if len(osfzhm)<>15 then 
   getnewsfzhm=osfzhm
   exit function
 end if
 dim w(17) 
 w(0)=7
 w(1)=9
 w(2)=10
 w(3)=5
 w(4)=8
 w(5)=4
 w(6)=2
 w(7)=1
 w(8)=6
 w(9)=3
 w(10)=7
 w(11)=9
 w(12)=10
 w(13)=5
 w(14)=8
 w(15)=4
 w(16)=2
 dim y(10)
 y(0)="1"
 y(1)="0"
 y(2)="X"
 y(3)="9"
 y(4)="8"
 y(5)="7"
 y(6)="6"
 y(7)="5"
 y(8)="4"
 y(9)="3"
 y(10)="2"  xx=left(osfzhm,6) & "19" & right(osfzhm,15-6)
 olen=17
 nsfzhm=""
 for i=0 to olen-1
  ai=left(xx,1)
  xx=right(xx,len(xx)-1)
  nsfzhm=nsfzhm & ai
  fx=fx+ ai*w(i)
 next
 
 fx=fx mod 11
 getnewsfzhm=nsfzhm & y(fx)
  
end function 

Answer 2

Text1、Text2
Command1、Command2
在窗口上放置以上标准控件后
Private Sub Command1_Click()
Dim num As String
Dim num1 As Double
Dim num2 As Double
Dim num3 As String
Dim numadd As Doublenum = (Text1.Text)
  ln = Len(num)
     If ln = 15 Then
          Call num15
          Exit Sub
     Else
          Text2.Text = "错误：你一共输入了 " & ln & " 位数"
          Exit Sub
     End If
   End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
End Sub
Private Sub num15()  num = Val(Text1.Text)
         If Mid(num, 9, 2) > 12 Or Mid(num, 11, 2) > 31 Then
            ' MsgBox "你输入的身份证号信息有错误，错误原因：数据错误!", vbCritical, "错误"
             Text2.Text = "错误：数据中的 " & Mid(num, 9, 4) & " 校验错"
             Exit Sub
          Else
                 num7 = 1        '第七个值
                 num8 = 9         '第八个值
                 num1 = Left(num, 6)        '取前六个数字
                 num2 = Right(num, 9)        '取后九个数字
                 numadd = Left(num, 1) * 7 + Mid(num, 2, 1) * 9 + Mid(num, 3, 1) * 10 + Mid(num, 4, 1) * 5 + Mid(num, 5, 1) * 8 + Mid(num, 6, 1) * 4 + num7 * 2 + num8 * 1 + Mid(num, 7, 1) * 6 + Mid(num, 8, 1) * 3 + Mid(num, 9, 1) * 7 + Mid(num, 10, 1) * 9 + Mid(num, 11, 1) * 10 + Mid(num, 12, 1) * 5 + Mid(num, 13, 1) * 8 + Mid(num, 14, 1) * 4 + Right(num, 1) * 2
                 nummod = numadd Mod 11                 '和11求余数
                         If nummod = 0 Then num3 = 1
                         If nummod = 1 Then num3 = 0
                         If nummod = 2 Then num3 = "X"
                         If nummod = 3 Then num3 = 9
                         If nummod = 4 Then num3 = 8
                         If nummod = 5 Then num3 = 7
                         If nummod = 6 Then num3 = 6
                         If nummod = 7 Then num3 = 5
                         If nummod = 8 Then num3 = 4
                         If nummod = 9 Then num3 = 3
                         If nummod = 10 Then num3 = 2
                  Text2.Text = num1 & "19" & num2 & num3
          End If
End Sub

Answer 3

一个将15的身份证号升为18位的函数
在新旧身份证同时并存使用的情况下，最好将升位后的18位方式保存在数据库中，下面的函数能将用户输入的15位数据转化为18位。
Function IDCode15to18(sCode15 As String) As String
    '*  功能:将15的身份证号升为18位(根据GB 11643-1999)
    '*  参数:原来的号码
    '*  返回:升位后的18位号码
    Dim i As Integer
    Dim num As Integer
    Dim code As String
    num = 0
    IDCode15to18 = Left(sCode15, 6) + "19" + Right(sCode15, 9)
    '  计算校验位
    For i = 18 To 2 Step -1
      num = num + (2 ^ (i - 1) Mod 11) * (Mid(IDCode15to18, 19 - i, 1))
    Next i
    num = num Mod 11
    Select Case num
    Case 0
      code = "1"
    Case 1
      code = "0"
    Case 2
      code = "X"
    Case Else
      code = Trim(Str(12 - num))
    End Select
    IDCode15to18 = IDCode15to18 + code
End Function

Answer 4

Private Sub Command1_Click()
Dim num As String
Dim num1 As Double
Dim num2 As Double
Dim num3 As String
Dim numadd As Doublenum = (Text1.Text)
  ln = Len(num)
     If ln = 15 Then
          Call num15
          Exit Sub
     Else
          Text2.Text = 错误，你一共输入了" & ln & " 位数"
          Exit Sub
     End If
   End Sub
Private Sub Command2_Click()
Text1.Text = ""
Text2.Text = ""
End Sub
Private Sub num15()  num = Val(Text1.Text)
         If Mid(num, 9, 2) > 12 Or Mid(num, 11, 2) > 31 Then
               Text2.Text = 错误，数据中的 " & Mid(num, 9, 4) & " 校验错"
             Exit Sub
          Else
                 num7 = 1        '第七个值
                 num8 = 9         '第八个值
                 num1 = Left(num, 6)        '取前六个数字
                 num2 = Right(num, 9)        '取后九个数字
                 numadd = Left(num, 1) * 7 + Mid(num, 2, 1) * 9 + Mid(num, 3, 1) * 10 + Mid(num, 4, 1) * 5 + Mid(num, 5, 1) * 8 + Mid(num, 6, 1) * 4 + num7 * 2 + num8 * 1 + Mid(num, 7, 1) * 6 + Mid(num, 8, 1) * 3 + Mid(num, 9, 1) * 7 + Mid(num, 10, 1) * 9 + Mid(num, 11, 1) * 10 + Mid(num, 12, 1) * 5 + Mid(num, 13, 1) * 8 + Mid(num, 14, 1) * 4 + Right(num, 1) * 2
                 nummod = numadd Mod 11                 '和11求余数
                         If nummod = 0 Then num3 = 1
                         If nummod = 1 Then num3 = 0
                         If nummod = 2 Then num3 = "X"
                         If nummod = 3 Then num3 = 9
                         If nummod = 4 Then num3 = 8
                         If nummod = 5 Then num3 = 7
                         If nummod = 6 Then num3 = 6
                         If nummod = 7 Then num3 = 5
                         If nummod = 8 Then num3 = 4
                         If nummod = 9 Then num3 = 3
                         If nummod = 10 Then num3 = 2
                  Text2.Text = num1 & "19" & num2 & num3
          End If
End Sub