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

　　

版本的源碼給大家，調用方法都有，直接用就可以了！