你的位置: Kiyo'Space首页 ASP 阅读文章 欢迎留下您的足迹

身份证查询的ASP版Ajax服务器端,不需要数据库支持

[ ASP ] 分享
以下是引用片段:

<%
Select Case Request("action")
    Case "send"
        Call RePinYin()
    Case "card"
        Call GetCard()
    Case "cardarea"
        Call GetCardCara()
    Case else
        Call Showmsg()
End Select

Sub GetCardCara()
    Dim AreaArr1,AreaArr2,AreaArr3,Area1,Area2,Area3
    Dim  CiS,LastCode,perIDNew,perIDSrc,ReStr,ajax,i,CiY,TempStr
    perIDSrc = Trim(Request("card"))
    IF len(perIDSrc) <> 15 and len(perIDSrc) <> 18 then
        ReStr = "身份证号码必须为15位或18位数字$$$1$$$1$$$1"
        set ajax=new AjaxXml
        ajax.re(Split(ReStr,"$$$"))
        Exit Sub
    End If
    TempStr = perIDSrc
    For i = 1 to 10
        TempStr = Replace(TempStr,(i-1) & "","")
    Next
    TempStr = Replace(TempStr,"X","")
    TempStr = Replace(TempStr,"x","")
    If TempStr<>"" then
        ReStr = "身份证号码必须为15位或18位数字$$$1$$$1$$$1"
        set ajax=new AjaxXml
        ajax.re(Split(ReStr,"$$$"))
        Exit Sub
    End If
    ReStr = ""
    If Len(perIDSrc) = 15 Then
        If Right(perIDSrc,1) Mod 2 = 0 then
            ReStr = ReStr & "女" & "$$$"’ & Area3 & "$$$1"
        Else
            ReStr = ReStr & "男" & "$$$"
        End If
        ReStr = ReStr & "19" & Mid(perIDSrc,7,2) & "年" & Mid(perIDSrc,9,2) & "月" & Mid(perIDSrc,11,2) & "日" & "$$$"
    Else
        If Mid(perIDSrc,17,1) Mod 2 = 0 then
            ReStr = ReStr & "女" & "$$$"
        Else
            ReStr = ReStr & "男" & "$$$"
        End If
        ReStr = ReStr & Mid(perIDSrc,7,4) & "年" & Mid(perIDSrc,11,2) & "月" & Mid(perIDSrc,13,2) & "日" & "$$$"
    End If
    AreaArr1 = Split("北京市|110000,天津市|120000,河北省|130000,山西省|140000,内蒙古自治区|150000,辽宁省|210000,吉林省|220000,黑龙江省|230000,上海市|310000,江苏省|320000,浙江省|330000,安徽省|340000,福建省|350000,江西省|360000,山东省|370000,河南省|410000,湖北省|420000,湖南省|430000,广东省|440000,广西壮族自治区|450000,海南省|460000,重庆市|500000,四川省|510000,贵州省|520000,云南省|530000,西藏自治区|540000,陕西省|610000,甘肃省|620000,青海省|630000,宁夏回族自治区|640000,新疆维吾尔自治区|650000,台湾省(886)|710000,香港特别行政区(852)|810000,澳门特别行政区(853)|820000",",")
    TempStr = Left(perIDSrc,3)
    for i=0 to UBOUND(AreaArr1)
        If Instr(AreaArr1(i),"|" & TempStr)>0 then
                Area1 = Left(AreaArr1(i),Len(AreaArr1(i))-7)
                Exit For
        End If
    Next
    Set AreaArr1 = Nothing
    Select Case Left(perIDSrc,2)
        Case "11"
            AreaArr2 = Split("市辖区|110100,北京县|110200",",")
            Select Case Mid(perIDSrc,3,2)
                Case "01"
                    AreaArr3 = Split("东城区|110101,西城区|110102,崇文区|110103,宣武区|110104,朝阳区|110105,丰台区|110106,石景山区|110107,海淀区|110108,门头沟区|110109,房山区|110111,通州区|110112,顺义区|110113,昌平区|110114,大兴区|110115,平谷区|110117,怀柔区|110116",",")
                Case "02"
                    AreaArr3 = Split("昌平县|110221,大兴县|110224,平谷县|110226,怀柔县|110227,密云县|110228,延庆县|110229",",")
            End Select
          ……
          ……
          中间的省略了,自己下附件看吧。
          ……
          ……
    End Select
    TempStr = Left(perIDSrc,4)
    if not IsArray(AreaArr2) then AreaArr2 = Split(",",",")
    for i=0 to UBOUND(AreaArr2)
        If Instr(AreaArr2(i),"|" & TempStr)>0 then
                Area2 = Left(AreaArr2(i),Len(AreaArr2(i))-7)
                Exit For
        End If
    Next
    Set AreaArr2 = Nothing
    if not IsArray(AreaArr3) then AreaArr3 = Split(",",",")
    TempStr = Left(perIDSrc,6)
    for i=0 to UBOUND(AreaArr3)
        If Instr(AreaArr3(i),"|" & TempStr)>0 then
                Area3 = Left(AreaArr3(i),Len(AreaArr3(i))-7)
                Exit For
        End If
    Next
    Set AreaArr3 = Nothing
    ReStr = ReStr & Area1 & Area2 & Area3 & "$$$"
    set ajax=new AjaxXml
    ajax.re(Split(ReStr,"$$$"))
End Sub

Sub GetCard()
    Dim  CiS,LastCode,perIDNew,perIDSrc,ReStr,ajax,i,CiY,TempStr
    perIDSrc = Trim(Request("card"))
    IF len(perIDSrc) <> 15 then
        ReStr = "原身份证号码必须为15位数字$$$1"
        set ajax=new AjaxXml
        ajax.re(Split(ReStr,"$$$"))
        Exit Sub
    End If
    TempStr = perIDSrc
    For i = 1 to 10
        TempStr = Replace(TempStr,(i-1) & "","")
    Next
    If TempStr<>"" then
        ReStr = "原身份证号码必须为15位数字$$$1"
        set ajax=new AjaxXml
        ajax.re(Split(ReStr,"$$$"))
        Exit Sub
    End If
    IF len(perIDSrc) <> 15 then
        ReStr = "原身份证号码必须为15位$$$1"
        set ajax=new AjaxXml
        ajax.re(Split(ReStr,"$$$"))
        Exit Sub
    End If
    Dim CiW
    CiS = 0
    ‘//加权因子常数
    CiW=Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2",",")
    ‘//校验码常数
    LastCode="10X98765432"
    ‘//新身份证号
    perIDNew=Left(perIDSrc,6)
    ‘//填在第6位及第7位上填上‘1’,‘9’两个数字
    perIDNew = perIDNew & "19"
    perIDNew = perIDNew & mid(perIDSrc,7,10)
    ‘//进行加权求和
    for i=0 to UBOUND(CiW)
        CiS = CiS + Cint(mid(perIDNew,i+1,1)) * Cint(CiW(i))
    Next
    ‘//取模运算,得到模值
    CiY = CiS mod 11
    ‘//从LastCode中取得以模为索引号的值,加到身份证的最后一位,即为新身份证号。
    perIDNew = perIDNew & Mid(LastCode,CiY+1,1)
    ReStr = perIDNew & "$$$1"
    set ajax=new AjaxXml
    ajax.re(Split(ReStr,"$$$"))
End Sub

Sub Showmsg()
        set ajax=new AjaxXml
        Dim ReStr
        ReStr = "1$$$1"
        ajax.re(Split(ReStr,"$$$"))
End Sub

Class AjaxXml
        Private m_contentType,m_encoding,m_xml

        Private Sub Class_Initialize()
                m_contentType = "text/xml"
                m_encoding = "gb2312"
                m_xml=true
        End sub

        Public sub re(result)
                Response.contentType = m_contentType
                Response.Expires=0
                Response.Clear
                Response.Write serialize(result)
        End Sub

        Private function serialize(result)
                Dim restr,i
                if m_xml then
                        restr = "<?xml version=""1.0"" encoding="""&m_encoding&"""?>"
                        restr = restr+"<Response>"
                        if IsArray(result) then
                                For i=0 to UBound(result)
                                        restr = restr + "<item><![CDATA["&result(i)&"]]></item>"
                                next
                        else
                                restr = restr + result
                        end If
                        restr = restr + "</Response>"
                else
                        restr = result
                end if
                serialize = restr
        end function
End Class

%>

没有评论

  • (Required)
  • (Required, will not be published)