JackLoh wrote:
但我還是很想了解為什麼
它可以讓 WinHttp 或者 IDHttp 抓不到資料
還是你有解決之道
...(恕刪)
因為 "CSRF" ，詳細請 google "csrf token"
需要在xmlhttp物件裡，send 2次
第一次要在 meta name 裡面，拆出 csrf-token 的值
第二次再把 csrf-token，給要查詢的網址
傳回值是 json 格式，中文是 unicode
'=============================
'因為用來篩選的變數實在太多，範例中網址只用到3個變數=>新北市、鄉鎮不限、1000萬以下
'有興趣請自行測試增加
Sub get591()
Dim Jsondata As Object, DecodeJson, url As String, url_a As String, getxml As Object, temp, temp1, Token As String
Set getxml = CreateObject("WinHttp.WinHttpRequest.5.1")
Set Jsondata = CreateObject("HtmlFile")
Jsondata.write ”＜script＞document.JsonParse＝function （s） ｛return eval（’（’ ＋ s ＋ ’）’）；｝＜／script＞”
'Jsondata.write 這行程式碼，符號是全形字，複製後，請改成半形，或直接看附加檔案
Cells.Clear
'On Error Resume Next
url = "https://sale.591.com.tw/?shType=list&price=0_1000Rionid=3"
With getxml
.Open "GET", url, False
.setrequestheader "Cache-Control", "no-cache"
.setrequestheader "Pragma", "no-cache"
.setrequestheader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.setrequestheader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.send
Token = Split(Split(.responsetext, "<meta name="" csrf-token""="" content="" ")(1),="" """="">")(0)
url = "https://sale.591.com.tw/home/search/list?type=2&&shType=list®ionid=3&price=0_1000%C2%AEionid,0_1000×tamp="
url_a = "https://sale.591.com.tw/?shType=list&price=0_1000Rionid=3"
.Open "GET", url & UNIXTime, False
.setrequestheader "Referer", url_a
.setrequestheader "Cache-Control", "no-cache"
.setrequestheader "Pragma", "no-cache"
.setrequestheader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.setrequestheader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
.setrequestheader "X-CSRF-TOKEN", Token
.send
Set DecodeJson = Jsondata.JsonParse(Unicode_to_Cht(.responsetext))
Set temp = CallByName(CallByName(DecodeJson, "data", VbGet), "house_list", VbGet)
Debug.Print "total=" & CallByName(CallByName(DecodeJson, "data", VbGet), "total", VbGet) + 1
Debug.Print "first page total=" & CallByName(temp, "length", VbGet)
For i = 0 To CallByName(temp, "length", VbGet) - 1
Set temp1 = CallByName(temp, i, VbGet)
'同上，因資料太多，只簡單列出=>標題、地區，其它請自行增加
Cells(i + 1, 1) = CallByName(temp1, "title", VbGet)
Cells(i + 1, 2) = temp1.region_name & temp1.section_name
Next i
End With
Set DecodeJson = Nothing
Set Jsondata = Nothing
Set getxml = Nothing
Set temp = Nothing
End Sub
Function UNIXTime()
UNIXTime = Round(((Date - #1/1/1970#) * 86400 + Timer) * 1000, 0)
End Function
Function Unicode_to_Cht(unicode As String)
With CreateObject("htmlfile")
.write "＜script＞＜／script＞"
'.write 這行程式碼，符號是全形字，複製後，請改成半形，或直接看附加檔案
Unicode_to_Cht = .parentwindow.unescape(Replace(unicode, "\u", "%u"))
End With
End Function
'=============================
附加壓縮檔: 201904/mobile01-15c87802fa168793935dd0762388a7ef.zip
(補充：新範例請參考645樓)
