关于身份证号码

*!* 以下为我收集的关于身份证号码的自定义函数

*!* 关于身份证号码最后一位的校验码的算法如下：
*!* 我国现行使用公民身份证号码有两种尊循两个国家标准，〖GB 11643-1989〗和〖GB 11643-1999〗。
*!* 〖GB 11643-1989〗中规定的是15位身份证号码：排列顺序从左至右依次为：六位数字地址码，
*!* 六位数字出生日期码，三位数字顺序码，其中出生日期码不包含世纪数。
*!* 〖GB 11643-1999〗中规定的是18位身份证号码：公民身份号码是特征组合码，由十七位数字本体码和一位数字校验码组成。
*!* 排列顺序从左至右依次为：六位数字地址码，八位数字出生日期码，三位数字顺序码和一位数字校验码。
*!* 地址码表示编码对象常住户口所在县(市、旗、区)的行政区划代码。
*!* 生日期码表示编码对象出生的年、月、日，其中年份用四位数字表示，年、月、日之间不用分隔符。
*!* 顺序码表示同一地址码所标识的区域范围内，对同年、月、日出生的人员编定的顺序号。顺序码的奇数分给男性，偶数分给女性。
*!* 校验码是根据前面十七位数字码，按照ISO 7064:1983.Mod 11-2校验码计算出来的检验码。
*!* 公式如下：
*!* 　　∑(a[i]*W[i]) Mod 11 ( i = 2, 3, ..., 18 ) (1)
*!* 　　"*" 表示乘号
*!* 　　i--------表示身份证号码每一位的序号，从右至左，最左侧为18，最右侧为1。
*!* 　　a[i]-----表示身份证号码第 i 位上的号码
*!* 　　W[i]-----表示第 i 位上的权值 W[i] = 2^(i-1) Mod 11
*!* 　　计算公式 (1) 令结果为 R
*!* 根据下表找出 R 对应的校验码即为要求身份证号码的校验码C。
*!* 　　R 0 1 2 3 4 5 6 7 8 9 10
*!* 　　C 1 0 X 9 8 7 6 5 4 3 2
*!* 由此看出 X 就是 10，罗马数字中的 10 就是X，所以在新标准的身份证号码中可能含有非数字的字母X。
*!* *********************************************************************************
*!* 感谢yesyesyes提供的信息：
*!* 15位身份证那时是我国第一次发身份证
*!* 发证当时已满100岁的人,就给他们那些号(因为年份只有2位)
*!* 十五位身份证第十三至十五位为分配顺序代码
*!* 分配顺序码中“999、998、997、996”四个顺序号分别为男女性百岁以上老人专用的特定编号。
*!* *********************************************************************************
*!* 感谢清风提供的信息：
*!* 这里所说的“百岁”应该是指19世纪也就是18XX年出生的人，而不是指办身份证时此人已有100岁。这种特例不多，所以男女各设了两个序号
*!* 还得提醒一下，1901年与2001年不会发生冲突，因为2000后就直接使用18位号码了，如果是15位的，那肯定是2000年以前的。
*!* *****************************************************************************

*---------------------------------------------------------------
*此函数功能：输入的15位或18位身份证号，返回正确的18位的身份证号。
*---------------------------------------------------------------
Function IDCardTF
    Parameters cNumber
    #Define InvalidSize "身份证号码长度不正确！"
    #Define InvalidChar "身份证号码包括非法字符！"
    #Define InvalidDate "出生日期无效！"
    #Define InvalidReturnValue ".F."
    Private cString
    Do Case
        Case Len(cNumber) = 15
            cString = Stuff(cNumber,7,0,"19")
        Case Len(cNumber) = 18
            cString =Left(Alltrim(cNumber),17)
        Otherwise
            Messagebox(InvalidSize,48,"信息提示")
            Return InvalidReturnValue
    Endcase
    Private i,N,iRet
    Store 0 To iRet
    For i = 1 To 17
        N = Substr(cString,i,1)
        If Not Isdigit(N)
            Messagebox(invalidChar,48,"信息提示")
            Return invalidReturnValue
        Endif
        N = 2 ^ (18 - i) % 11 * Val(N)
        iRet = iRet + N
    Endfor
    iRet = iRet % 11 + 1
    Private oldDateSet, oldCentury
    Private oldStrictDate, BirthDay
    oldDateSet = Set("DATE")
    oldCentury = Set("CENTURY")
    oldStrictDate = Set("STRICTDATE")
    Set Date Ansi
    Set Century On
    Set StrictDate To 0
    BirthDay = Ctod(Substr(cString,7,4)+"-"+Substr(cString,11,2)+"-"+Substr(cString,13,2))
    Set StrictDate To &oldStrictDate
    Set Century &oldCentury
    Set Date &oldDateSet
    If Empty(BirthDay)
        Messagebox(InvalidDate,48,"信息提示")
        Return InvalidReturnValue
    Endif
    Return cString+Substr("10x98765432",iRet,1)
Endfunc

*----------------------------------------------------
*此函数功能：检验输入的15位或18位身份证号码是否为合法
*----------------------------------------------------
Function MyIdentityCardVerify &&校验身份证号是否合法
    Lparameters lstr &&参数:lstr 传入的号码
    Private lstr,relyn,tsfz,m1,m2,m3,m4,m,I,r,c,ai,wi
    relyn=.F. &&返回值
    tsfz=Alltrim(lstr)
    *分别用m1,m2,m3,m4表示四个条件是否成立
    Stor .T. To m1,m2,m3,m4
    *条件1：只能是15或18位
    m1=Iif(Len(tsfz)=15 Or Len(tsfz)=18,.T.,.F.)
    If Len(tsfz)=15 && 15位的号码
        For I=1 To 15 &&检查每一位是否为数字
            m=Asc(Substr(tsfz,I,1))
            If m<48 Or m>57 &&数字
                m2=.F. &&若有一位不是就不再查
                Exit
            Endif
        Endfor
        m="19" +Substr(tsfz, 7,2) &&早期的号都是上个世纪的
        m=m+"."+Substr(tsfz, 9,2)
        m=m+"."+Substr(tsfz,11,2)
        m=Ctod(m)
        If Isnull(m) Or Isblank(m)
            m3=.F. &&生日不正确
        Endif
    Endif
    If Len(tsfz)=18 && 18位的号码
        For I=1 To 17
            m=Asc(Substr(tsfz,I,1))
            If m<48 Or m>57
                m2=.F.
                Exit
            Endif
        Endfor
        m=Substr(tsfz,7,4)
        m=m+"."+Substr(tsfz,11,2)
        m=m+"."+Substr(tsfz,13,2)
        m=Ctod(m)
        If Isnull(m) Or Isblank(m)
            m3=.F.
        Endif
        r=0 &&计算校验位
        For I=18 To 2 Step -1
            ai=Val(Substr(tsfz,19-i,1))
            wi=Mod(2^(i-1),11)
            r=r+ai*wi
        Next
        r=Mod(r,11)
        Do Case
            Case r=0
                c="1"
            Case r=1
                c="0"
            Case r=2
                c="X"
            Otherwise
                c=Alltrim(Str(12-r))
        Endcase
        If Upper(Substr(tsfz,18,1))<>c
            m4=.F. &&校验位与原码最末位不同
        Endif
    Endif
    *四个条件全成立，则返回.t.
    relyn=Iif(m1 And m2 And m3 And m4,.T.,.F.)
    Return relyn
Endfunc

*--------------------------------------------------------------------------------------------
*此函数功能：输入15位或18位的身份证号，返回被校验后的18位的身份证号，若身份证号非法，则返回空
*--------------------------------------------------------------------------------------------
Function sfjy
    Parameters msfz
    On Error Return ''
    Dimension T(17)
    Private msfz,T,sn,i
    msfz=Alltrim(msfz)
    Do Case
        Case Len(msfz)=15
            msfz=Left(msfz,6)+'19'+Substr(msfz,7)
        Case Len(msfz)=18
            msfz=Left(msfz,17)
        Otherwise
            Return ''
    Endcase
    For i=1 To 17
        If !Isdigit(Substr(msfz,i,1))
            Return ''
        Endif
    Endfor
    If !Left(msfz,2)$'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'
        Return ''
    Endif
    If Empty(Date(Val(Substr(msfz,7,4)),Val(Substr(msfz,11,2)),Val(Substr(msfz,13,2))))
        Return ''
    Endif
    sn=0
    T(1)=7
    T(2)=9
    T(3)=10
    T(4)=5
    T(5)=8
    T(6)=4
    T(7)=2
    T(8)=1
    T(9)=6
    T(10)=3
    T(11)=7
    T(12)=9
    T(13)=10
    T(14)=5
    T(15)=8
    T(16)=4
    T(17)=2
    For i=1 To 17
        sn=sn+Val(Substr(msfz,i,1))*T(i)
    Endfor
    sn=Mod(sn,11)
    On Error
    Return msfz+Substr('10X98765432',sn+1,1)
Endfunc

*------------------------------------------------------------------
*此函数功能：输入的15位或17位或18位的身份证号，返回校验后的最后一位
*------------------------------------------------------------------
Function sfzjy
    Parameters cID
    Do Case
        Case Len(Alltrim(cID)) = 15
            cID = Stuff(Alltrim(cID),7,0,"19")
        Case Len(Alltrim(cID)) = 18 Or Len(Alltrim(cID)) = 17
            cID =Left(Alltrim(cID),17)
        Otherwise
            Return .F.
    Endcase
    If Len(Alltrim(cID))#17
        Return .F.
    Endif
    nSum= Val(Substr(cID,1,1)) * 7 ;
        + Val(Substr(cID,2,1)) * 9 ;
        + Val(Substr(cID,3,1)) * 10 ;
        + Val(Substr(cID,4,1)) * 5 ;
        + Val(Substr(cID,5,1)) * 8 ;
        + Val(Substr(cID,6,1)) * 4 ;
        + Val(Substr(cID,7,1)) * 2 ;
        + Val(Substr(cID,8,1)) * 1 ;
        + Val(Substr(cID,9,1)) * 6 ;
        + Val(Substr(cID,10,1)) * 3 ;
        + Val(Substr(cID,11,1)) * 7 ;
        + Val(Substr(cID,12,1)) * 9 ;
        + Val(Substr(cID,13,1)) * 10 ;
        + Val(Substr(cID,14,1)) * 5 ;
        + Val(Substr(cID,15,1)) * 8 ;
        + Val(Substr(cID,16,1)) * 4 ;
        + Val(Substr(cID,17,1)) * 2
    *计算校验位
    check_number=Int((12-nSum % 11)%11)
    If check_number=10
        check_number='X'
    Endif
    Return check_number
Endfunc

******************************************
*身份证号出错信息(对字段：sfzherrc的编码解释)
*1、"身份证号不满15位！"2、性别与身份证不符3、出生月份出错（不在1－12范围内）4、出生日期出错（不在1－31范围内）
*5、18位校验位出错（sfzherrc中紧跟括号内的内容为正确的第18位校验码）6、18位身份证出生年份出错（不是19）
*检查原则：不满15位只检查位数，15位检查出生年、月、日的超界关系、性别对应关系（男：身份证第15位为13579，女：身份证第15位为02468）
*检查原则：18位身份证除检查15位的检查原则外增加检查最后一位检验码的关系校验
*以下附身份证号的算法函数，可供大家参考！！
***********************************************************************
*身份号码第18位校验位的算法〖中华人民共和国国家标准 GB 11643-1999〗(依此算法写的函数存放在过*程文件myproc.prg中<附后>)
* 15位的身份证编码首先把出生年扩展为4位，简单的就是增加一个19，但对于1900前年出生的人不适用
* ∑(ai×Wi)(mod 11)……………………………………(1)
* 公式(1)中：
* i----表示号码字符从由至左包括校验码在内的位置序号；
* ai----表示第i位置上的号码字符值；
* Wi----示第i位置上的加权因子，其数值依据公式Wi=2^(n-1)(mod 11)计算得出（(n-1)为幂）。
* i 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
* ai 3 4 0 5 2 4 1 9 8 0 0 1 0 1 0 0 1 a1
* Wi 7 9 10 5 8 4 2 1 6 3 7 9 10 5 8 4 2 1
* ai×Wi 21 36 0 25 16 16 2 9 48 0 0 9 0 5 0 0 2 a1
* 根据公式(1)进行计算：
* ∑(ai×Wi) =（21+36+0+25+16+16+2+9+48++0+0+9+0+5+0+0+2) = 189
* 189 ÷ 11 = 17 + 2/11
* ∑(ai×Wi)(mod 11) = 2
* 然后根据计算的结果，从下面的表中查出相应的校验码，其中X表示计算结果为10：
* ∑(ai×WI)(mod 11) 0 1 2 3 4 5 6 7 8 9 10
* 校验码字符值ai 1 0 X 9 8 7 6 5 4 3 2

*-----------------------------
*身份证升位程序
*作者：窦学田
*功能：计算身份证的校验码
*入口参数：15位号码 或17位号码
*返回：18位身份证号码
*-----------------------------
Function NewIdCode()
    Parameters OldId
    Local id1,id2,i2,NewIdCode
    id1=Strtran(OldId,' ','')
    id2=0
    If Len(id1)=15
        id1=Left(OldId,6)+'19'+Right(OldId,9)
    Endif
    If Len(id1)=17
        For i2=1 To 17
            id2=id2+Val(Substr(id1,18-i2,1))*(Mod(2^i2,11))
        Endfor
        id1=id1+Iif(Mod(1-id2,11)=10,'X',Str(Mod(1-id2,11),1))
    Endif
    NewIdCode=id1
    Return NewIdCode
Endfunc

*-----------------------------
*测试18位的身份证是否正确
*作者：窦学田
*功能：测试18位身份证的校验码
*入口参数：18位号码
*返回：出错信息
*-----------------------------
Function GetOld()
    Parameters sID
    s1=' 7 910 5 8 4 2 1 6 3 7 910 5 8 4 2'
    s2='10X98765432'
    sID=Upper(Alltrim(sID))
    If Len(sID)=15
        sID=Stuff(sID,7,0,"19")
    Endif
    NewId=Left(sID,17)
    jym=0
    For i=1 To 17
        jym=jym+Val(Substr(s1,i*2-1,2))*Val(Substr(NewId,i,1))
    Endfor
    NewId= NewId+ Substr(s2,Mod(jym,11)+1,1)
    If Len(sID)=18
        If Right(sID,1)<>Right(NewId,1) &&正确
            Messagebox(sID+"为错误身份证号码！",48,"警告")
        Endif
    Endif
Endfunc

*---------------------------------------------------
*测试身份证的年月日的合法性YMDS(year,month,date,sex)
*作者：窦学田
*功能：测试18位身份证的年月日的合法性
*入口参数：原表中的性别代码,原身份证号码
*返回：综合出错信息
*---------------------------------------------------
Function CheckYMDS()
    Parameters F_xbdm,F_ID
    Local rtn_errcode
    rtn_errcode=''
    sfxb=Iif(F_xbdm='1','13579','02468')
    If Len(Alltrim(F_ID))=15
        sfsex=Substr(F_ID,15,1)
        If !sfsex$sfxb &&测试性别
            rtn_errcode=Iif(Empty(rtn_errcode),"2",Alltrim(rtn_errcode)+'+2')
        Endif
        sfy=Substr(F_ID,9,2) &&月
        sfr=Substr(F_ID,11,2) &&日
        If !(Val(sfy)<=12)
            rtn_errcode=Iif(Empty(rtn_errcode),"3",Alltrim(rtn_errcode)+'+3')
        Endif
        If !(Val(sfr)<=31)
            rtn_errcode=Iif(Empty(rtn_errcode),"4",Alltrim(rtn_errcode)+'+4')
        Endif
    Else
        sfsex=Substr(F_ID,17,1)
        If !sfsex$sfxb &&测试性别
            rtn_errcode=Iif(Empty(rtn_errcode),"2",Alltrim(rtn_errcode)+'+2')
        Endif
        sfy=Substr(F_ID,11,2) &&月
        sfr=Substr(F_ID,13,2) &&日
        If !(Val(sfy)<=12) &&月
            rtn_errcode=Iif(Empty(rtn_errcode),"3",Alltrim(rtn_errcode)+'+3')
        Endif
        If !(Val(sfr)<=31) &&日
            rtn_errcode=Iif(Empty(rtn_errcode),"4",Alltrim(rtn_errcode)+'+4')
        Endif
    Endif
    *以下测试第18位校验码的正确性
    s1=' 7 910 5 8 4 2 1 6 3 7 910 5 8 4 2'
    s2='10X98765432'
    F_ID=Upper(Alltrim(F_ID))
    If Len(F_ID)=15
        F_ID=Stuff(F_ID,7,0,"19")
    Endif
    NewId=Left(F_ID,17)
    jym=0
    For i=1 To 17
        jym=jym+Val(Substr(s1,i*2-1,2))*Val(Substr(NewId,i,1))
    Endfor
    NewId= NewId+ Substr(s2,Mod(jym,11)+1,1)
    If Len(F_ID)=18
        If Right(F_ID,1)<>Right(NewId,1) &&不正确
            &&返回出错信息及正确的第18位校验码
            rtn_errcode=Iif(Empty(rtn_errcode),"5"+'(应为'+Right(NewId,1)+')',Alltrim(rtn_errcode)+'+5'+'(应为'+Right(NewId,1)+')')
        Endif
    Endif
    If Substr(F_ID,7,2)<>'19' &&测试年（19）
        rtn_errcode=Iif(Empty(rtn_errcode),"6",Alltrim(rtn_errcode)+'+6')
    Endif
    Return rtn_errcode
Endfunc

*------------------------------------------------------
* 从身份证在返回相关资料
* 第一个参数为[字符型]:身份证号码
* 第二个参数为返回资料[数值型]:1.返回为行政区号[字符符]
* 2.返回为出生日期[日期型]
* 3.返回为性别男女[字符型]
* 没有第二参数时返回正确的18位身份证号码
* 梦幻幻影 2005-04-22 17:12:18 *
*------------------------------------------------------
Function IDCardCheck ( c_IDCard,nRetValue )
    If Vartype(m.c_IDCard) <> [C] Or Not Inlist(Len(Alltrim(m.c_IDCard)),15,18)
        Return .F.
    Endif
    If Len(Alltrim(m.c_IDCard)) = 15
        m.c_IDCard = Substr(m.c_IDCard,1,6)+[19]+Substr(m.c_IDCard,7) + [X]
    Endif
    m.nRetValue = Iif(Vartype(m.nRetValue) = [N],m.nRetValue,0)
    Local nEndCode,ReString
    m.nEndCode = 0
    For i=17 To 1 Step -1
        m.nEndCode = m.nEndCode +(2^i%11)*Val(Substr(c_idcard,18-i,1))
    Endfor
    Do Case
        Case m.nRetValue = 1 &&返回行政区号
            m.ReString = Substr(m.c_IDCard,1,6)
        Case m.nRetValue = 2 &&返回出生日期
            m.ReString = Substr(m.c_IDCard,7,8)
            Local nYear,nMonth,nDay
            m.nYear = Val(Substr(m.ReString,1,4))
            m.nMonth = Val(Substr(m.ReString,5,2))
            m.nDay = Val(Substr(m.ReString,7,2))
            If !Between(m.nMonth, 1, 12)
                Return .F.
            Endif
            Do Case
                Case Inlist(m.nMonth,4,6,9,11)
                    If !Between(m.nDay,1,30)
                        Return .F.
                    Endif
                Case m.nMonth = 2
                    If !Between(m.nDay,1,Iif(Int(m.nYear/4) = m.nYear/4,29,28))
                        Return .F.
                    Endif
                Otherwise
                    If !Between(m.nDay,1,31)
                        Return .F.
                    Endif
            Endcase
            Return Date(m.nYear,m.nMonth,m.nDay)
        Case m.nRetValue = 3 &&返回性别
            m.ReString = Substr(Right(m.c_IDCard,2),1,1)
            m.ReString = Iif(Mod(Val(m.ReString),2)=0,[女],[男])
        Otherwise
            m.ReString = Substr([10X98765432],Mod(m.nEndCode,11)+1,1)
            m.ReString = Substr(m.c_IDCard,1,17) + m.ReString
    Endcase
    Return m.ReString
Endfunc

*------------------------------------------------------
*感谢：dfwxj(清风)
*------------------------------------------------------
Function sfjy
    Parameters msfz
    On Error Return ''
    Private msfz,sn,i,dic
    dic='0709100508040201060307091005080402'
    msfz=Alltrim(msfz)
    *出生日期预处理，仅接受15或18位字符串
    Do Case
        Case Len(msfz)=15
            If Right(msfz,3)$'996,997,998,999'
                msfz=Left(msfz,6)+'18'+Substr(msfz,7)
            Else
                msfz=Left(msfz,6)+'19'+Substr(msfz,7)
            Endif
        Case Len(msfz)=18
            msfz=Left(msfz,17)
        Otherwise
            Return ''
    Endcase
    *检查身份证号字符的合法性
    For i=1 To 17
        If !Isdigit(Substr(msfz,i,1))
            Return ''
        Endif
    Endfor
    *检查行政区划合法性
    If !Left(msfz,2)$'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'
        Return ''
    Endif
    *检查出生日期合法性
    If Empty(Date(Val(Substr(msfz,7,4)),Val(Substr(msfz,11,2)),Val(Substr(msfz,13,2))))
        Return ''
    Endif
    *生成校检码
    sn=0
    For i=1 To 17
        sn=sn+Val(Substr(msfz,i,1))*Val(Substr(dic,i*2-1,2))
    Endfor
    sn=Mod(sn,11)
    On Error
    Return msfz+Substr('10X98765432',sn+1,1)
Endfunc

*------------------------------------------------------
*作者：Linzhiyang，发表于『动感游标』 http://www.vfp.cn
*若转载，请保留本注释部分
*功能：计算身份证的校验码
*入口参数：15位号码 或17位号码
*返回：18位身份证号码
*------------------------------------------------------
Function NewIdCode
    Parameters OldId
    Local id1,id2,i,NewId
    id1=Strtran(OldId," ","")
    id2=0
    Do Case
        Case Len(id1)=15
            id1=Left(OldId,6)+"19"+Right(OldId,9)
            For i=1 To 17
                id2=id2+Val(Substr(id1,18-i,1))*(Mod(2^i,11))
            Endfor
            id1=id1+Iif(Mod(1-id2,11)=10,"X",Str(Mod(1-id2,11),1))
        Case Len(id1)=17
            For i=1 To 17
                id2=id2+Val(Substr(id1,18-i,1))*(Mod(2^i,11))
            Endfor
            id1=id1+Iif(Mod(1-id2,11)=10,"X",Str(Mod(1-id2,11),1))
        Otherwise
            id1="Error"
    Endcase
    NewId=id1
    Return NewId
Endfunc

*----------------
*18位身份证校验码
*----------------
Function valid_Id_Card_Num
    Lparameters cIdCardNo18
    Local s,i,b,Y,LastChart, StrValid, Wi
    StrValid = '10X98765432'
    Wi = '7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2,1'
    S=0
    For i = 1 To 17
        b = Val(Substr(cIdCardNo18,i,1))
        S = S + b * Val(Getwordnum(wi,i,','))
    Endfor
    Y= Mod(s,11) + 1
    LastChart = Substr(StrValid,Y,1)
    Return LastChart
Endfunc