VB版本查询快递单号源码

能查询各大快递单号，包括申通快递，圆通快递，韵达快递等国内超过90家以上快递单号查询，

如果想快速搭建一个快递单号查询站我推荐这个，这是地址www.aikuaidi.cn，我分享一个VB

Function kdcx(kd, orderid)

Dim Err, url, kdtime, link, Errcode, Status



Select Case kd  '此处支持的快递公司很多的，我自己就常用这几个。

    Case "申通"

        kd = "shentong"

    Case "圆通"

        kd = "yuantong"

    Case "优速"

        kd = "yousu"

    Case "龙邦"

        kd = "longbang"

    Case "城市"

        kd = "cs"

    Case Else

        MsgBox "暂时不支持此快递，可以联系管理员添加！"

        kdcx = "暂时不支持此快递"

        Exit Function

End Select





Set http = CreateObject("Microsoft.XMLHTTP")

url = "http://www.aikuaidi.cn/rest/?key=29fe1030ceaa49ea8d0d7698efd1fd05&order=" & orderid & "&id=" & kd & "&ord=desc&show=xml"



http.Open "get", url, False

http.send

WebContent = http.responsetext

'MsgBox WebContent



Set objDom = CreateObject("Microsoft.XMLDom")

objDom.async = False

objDom.LoadXML (WebContent)

If objDom.ReadyState > 2 Then

    Set Item = objDom.getElementsByTagName("SyncResponseEntity") '读取页面上指定区域

    For i = 0 To (Item.Length - 1)

        Status = Item.Item(i).getElementsByTagName("status").Item(0).Text

        If Status = 1 Then

                kdcx = Status

            Exit For

        End If

        Errcode = Item.Item(i).getElementsByTagName("errcode").Item(0).Text

       ' kdtime = Item.Item(i).getElementsByTagName("time").Item(0).Text

        'link = Item.Item(i).getElementsByTagName("content").Item(0).Text

    Next

Else

    MsgBox "查询数据还未准备就绪。状态：" & objDom.ReadyState & "。"

End If

Set http = Nothing

Set objDom = Nothing





Select Case Errcode

    Case "0000"

        Err = "无错误"

    Case "0001"

        Err = "传输参数格式有误"

    Case "0002"

        Err = "用户编号(uid)无效"

    Case "0003"

        Err = "用户被禁用"

    Case "0004"

        Err = "授权key无效"

    Case "0005"

        Err = "快递代号(id)无效"

    Case "0006"

        Err = "访问次数达到最大额度"

    Case "0007"

        Err = "查询服务器返回错误"

    Case Else

        Err = "查询出现未知错误"

End Select





Select Case Status

    Case "-1"

        Status = "未更新的单号"

    Case "0"

        Status = "查询异常"

    Case "1"

        Status = "暂无记录"

    Case "2"

        Status = "在途中"

    Case "3"

        Status = "派送中"

    Case "4"

        Status = "已签收"

    Case "5"

        Status = "拒签收"

    Case "6"

        Status = "疑难件"

    Case "7"

        Status = "无效单"

    Case "8"

        Status = "超时单"

    Case "9"

        Status = "签收失败"

    Case Else

        Status = "快递状态未知情况"

End Select



kdcx = Status

End Function

　　

版本的源码给大家，调用方法都有，直接用就可以了！