Vấn đề HttpRequest "Get" trả về Response khác với Reponse thao tác trên trình duyệt

Liên hệ QC
ongke0711

ongke0711

Thành viên gắn bó
Tham gia
7/9/06
Bài viết
2,106
Được thích
2,750
Giới tính
Nam
Chào các bạn,
Tôi gặp một vấn đề là khi dùng Http request - GET thì nó trả về cái Response nhưng kiểm tra lại thì khác với Response tôi thao tác trực tiếp trên trang web.
- Tìm theo MST, CCCD dùng "https://masothue.com/Ajax/Search/" thì chạy rất nhanh nhưng khi tìm bằng tên thì không chạy.
- Tôi dùng "https://masothue.com/Search/?q" & chuỗi tên thì lại trả về Response sai. Đã thử khai báo các header đúng như trên trình duyệt cũng không sửa được lỗi.

File đính kèm bên dưới. Nhờ các bạn hướng dẫn tìm ra nguyên nhân của vấn đề trên.
Cảm ơn.


Mã: 
Dim js As Object
    Set js = CreateObject("Scripting.Dictionary")

    Dim formData As String, sTenCty As String, res As String
    Const url As String = "https://masothue.com/Search/"

    res = httpPost("https://masothue.com/Ajax/Token", "")
    Set js = JsonConverter.ParseJSON(res)

    sTenCty = UCase(Sheet1.Range("A1"))
    formData = "?q=" & URLEncode(CStr(sTenCty), True) & "&type=enterpriseName&token=" & js("token") & "&force-search=1"
    Debug.Print url & formData

    res = httpGet(url & formData)
    Debug.Print res

Mã: 
Function httpGet$(url$)
    'With CreateObject("WinHttp.WinHttpRequest.5.1")
    With CreateObject("MSXML2.serverXMLHTTP.6.0")
        .Open "GET", url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/90.0.4430.93 Safari/537.36 Edg/90.0.818.51"
        .setRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9"
        .send
        httpGet = .responseText

        Dim getStatus As String
        If Err.Number <> 0 Then
            'khong co phan hoi tu server
        Else
            getStatus = .Status
            If getStatus <> "300" And getStatus <> "200" Then
                Debug.Print "Some problems raised."
            Else
                Debug.Print "Connected."
            End If
        End If

        On Error GoTo 0
    End With
End Function
 

File đính kèm

  • getWebData.xlsm
    84.5 KB · Đọc: 29
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bên nguồn họ đã trả về URL thông tin vào trong Response Header. Chắc là do số người sử dụng trình tải quá lớn, nên họ cần giảm tải cho server của họ.
 
Upvote 0
Khi search Anh chỉ cần đổi phương thức GET thay cho POST, post data chuyển lên query parameters của url. Thêm option không cho chuyển trang tự động là http.options(6) = Fasle, trong response header tại Location là đường dẫn.
 
Upvote 0
HeSanbi đã viết:
Khi search Anh chỉ cần đổi phương thức GET thay cho POST, post data chuyển lên query parameters của url. Thêm option không cho chuyển trang tự động là http.options(6) = Fasle, trong response header tại Location là đường dẫn.
Nhấp chuột vào đây để mở rộng...
Anh làm thử mà nó báo Status=403, không biết bị sai ở phần nào. Em rảnh thì kiểm tra giùm anh nhe.

Screen Shot 2024-08-06 at 21.13.47.png

JavaScript: 
Option Explicit

Dim res$, url$

Sub TraCuu()
    'On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
   
    Const WinHttpRequestOption_EnableRedirects = 6
   
    Dim formData As String, sMST As String, newURL As String
    Const Url1 As String = "https://masothue.com/Ajax/Token"
    Const Url2 As String = "https://masothue.com/Ajax/Search/"
    sMST = "2700118201" 'Sheets("TraCuu").Range("B4").Value
   
    Dim js As Object
    Set js = CreateObject("Scripting.Dictionary")
   
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", Url1, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/126.0.0.0 Safari/537.36 Edg/126.0.0.0"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send ("")
        res = .responseText
        Set js = JsonConverter.ParseJSON(res)
        Debug.Print res
       
        url = Url2 & "?q=" & sMST & "&type=enterpriseTax&token=" & js("token") & "&force-search=1"
        .Option(WinHttpRequestOption_EnableRedirects) = False
        .Open "GET", url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/127.0.0.0 Safari/537.36 Edg/127.0.0.0"
        .setRequestHeader "Content-type", "text/html; charset=UTF-8"
        .send
        Debug.Print .Status
        res = .responseText
    End With
   
    Debug.Print "--> " & res
End Sub
 

File đính kèm

  • TestMaSoThueVN.xlsm
    79.2 KB · Đọc: 7
Upvote 0
PHP: 
Option Explicit

Dim res$, url$
Dim datasend, token As String

Sub TraCuu()
    'On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
 
    Const WinHttpRequestOption_EnableRedirects = 6
 
    Dim formData As String, sMST As String, newURL As String
    Const Url1 As String = "https://masothue.com/Ajax/Token"
    Const Url2 As String = "https://masothue.com/Ajax/Search"
    sMST = "2700118201" 'Sheets("TraCuu").Range("B4").Value
 
    Dim js As Object
    Set js = CreateObject("Scripting.Dictionary")
 
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", Url1, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/126.0.0.0 Safari/537.36 Edg/126.0.0.0"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send ("")
        res = .responseText
        Set js = JsonConverter.ParseJSON(res)
        token = js("token")
        Debug.Print res
   
        datasend = "q=" & sMST & "&type=auto&token=" & token & "&force-search=0"
        ' "q=" & sMST & "&type=enterpriseTax&token=" & js("token") & "&force-search=1"

        .Option(WinHttpRequestOption_EnableRedirects) = False
        .Open "POST", Url2, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/127.0.0.0 Safari/537.36 Edg/127.0.0.0"
        .setRequestHeader "Content-type", "text/html; charset=UTF-8"
        .send datasend
        Debug.Print .Status
        res = .responseText
    End With
 
    Debug.Print "--> " & res
End Sub
Em sửa lại chút, chủ yếu là thành POST
PHP: 
.Open "POST", Url2, False
1722954982935.png
 
Lần chỉnh sửa cuối:
Upvote 0
Bài trên em nhầm "GET", phải là "HEAD"

Không phải responseText, phải là:
Debug.Print .GetResponseHeader("Location")
Nhấp chuột vào đây để mở rộng...
Sau khi có được đường dẫn này, nối với mainUrl, thực hiện request, mới có được thông tin.


Không cần đến JsonConverter cho nó tốn tài nguyên. Chỉ cần dùng Split hoặc RegExp là được nha anh, dùng hàm Unescape để giải mã Json.
 
Upvote 0
HeSanbi đã viết:
Bài trên em nhầm "GET", phải là "HEAD"

Không phải responseText, phải là:

Sau khi có được đường dẫn này, nối với mainUrl, thực hiện request, mới có được thông tin.


Không cần đến JsonConverter cho nó tốn tài nguyên. Chỉ cần dùng Split hoặc RegExp là được nha anh, dùng hàm Unescape để giải mã Json.
Nhấp chuột vào đây để mở rộng...
À làm được rồi. Cảm ơn em nhé.
 
Upvote 0
ongke0711 đã viết:
À làm được rồi. Cảm ơn em nhé.
Nhấp chuột vào đây để mở rộng...
Vậy theo em hiểu với gợi ý của bác Sanbi thì cần sửa lại như sau có đúng không ạ:
- Sử dụng phương thức HEAD thay vì POST để lấy thông tin trong phần header của response.
- Đặt WinHttpRequestOption_EnableRedirects thành False để không cho chuyển trang tự động.
- Sử dụng .GetResponseHeader("Location") để lấy URL từ phần header của response.
 
Upvote 0
ongke0711 đã viết:
À làm được rồi. Cảm ơn em nhé.
Nhấp chuột vào đây để mở rộng...
em có thêm mà loay hoay vẫn lỗi, không biết em đã sai ở bước nào ạ!
Mã: 
Option Explicit

Dim res$, url$
Dim datasend, token As String
Sub TraCuu()
    'On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
   
    Const WinHttpRequestOption_EnableRedirects = 6
   
    Dim formData As String, sMST As String, newURL As String
    Const Url1 As String = "https://masothue.com/Ajax/Token"
    Const Url2 As String = "https://masothue.com/Ajax/Search/"
    sMST = "2700118201" 'Sheets("TraCuu").Range("B4").Value
   
    Dim js As Object
    Set js = CreateObject("Scripting.Dictionary")
   
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", Url1, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/126.0.0.0 Safari/537.36 Edg/126.0.0.0"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .Option(WinHttpRequestOption_EnableRedirects) = False 'MOI THEM
        .send ("")
        res = .responseText
        Set js = JsonConverter.ParseJSON(res)
        Debug.Print res
       
        url = Url2 & "?q=" & sMST & "&type=enterpriseTax&token=" & js("token") & "&force-search=1"
        .Option(WinHttpRequestOption_EnableRedirects) = False
        .Open "HEAD", url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/127.0.0.0 Safari/537.36 Edg/127.0.0.0"
        .setRequestHeader "Content-type", "text/html; charset=UTF-8"
        .Option(WinHttpRequestOption_EnableRedirects) = False 'MOI THEM
        .send
        Debug.Print .Status
        res = .getResponseHeader("Location") 'MOI THEM
        'res = .responseText
    End With
   
    Debug.Print "--> " & res
End Sub
1722988180332.png
1722988463021.png
 
Upvote 0
hoangtuan.net đã viết:
em có thêm mà loay hoay vẫn lỗi, không biết em đã sai ở bước nào ạ!
Mã: 
Option Explicit

Dim res$, url$
Dim datasend, token As String
Sub TraCuu()
    'On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
 
    Const WinHttpRequestOption_EnableRedirects = 6
 
    Dim formData As String, sMST As String, newURL As String
    Const Url1 As String = "https://masothue.com/Ajax/Token"
    Const Url2 As String = "https://masothue.com/Ajax/Search/"
   ...
Nhấp chuột vào đây để mở rộng...

Bạn đổi cái Url2 nhé.
JavaScript: 
Const Url2 As String = "https://masothue.com/Search/"

(Bạn khai báo cái datasend kiểu đó, nó thành kiểu Variant chứ không phải String nhé.)
 
Upvote 0
ongke0711 đã viết:
Bạn đổi cái Url2 nhé.
JavaScript: 
Const Url2 As String = "https://masothue.com/Search/"

(Bạn khai báo cái datasend kiểu đó, nó thành kiểu Variant chứ không phải String nhé.)
Nhấp chuột vào đây để mở rộng...
dạ, em đã đổi Url2 nhưng vẫn bị lỗi lại res = .getResponseHeader("Location")1722992010867.png
 
Upvote 0
hoangtuan.net đã viết:
dạ, em đã đổi Url2 nhưng vẫn bị lỗi lại res = .getResponseHeader("Location")
Nhấp chuột vào đây để mở rộng...

Code này trên máy tôi chạy ra kết quả nhé. Một lưu ý là nếu bấm liên tục thì trang nó sẽ khóa IP của bạn đó. Khởi động lại modem để lấy IP mới.

JavaScript: 
Option Explicit

Dim res$, url$

Sub TraCuu3()
    'On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
 
    Const WinHttpRequestOption_EnableRedirects = 6
 
    Dim formData As String, sMST As String, newURL As String
    Const Url1 As String = "https://masothue.com/Ajax/Token"
    Const Url2 As String = "https://masothue.com/Search/"
    sMST = "2700118201" 'Sheets("TraCuu").Range("B4").Value
 
    Dim js As Object
    Set js = CreateObject("Scripting.Dictionary")
 
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", Url1, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/126.0.0.0 Safari/537.36 Edg/126.0.0.0"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send ("")
        res = .responseText
        Set js = JsonConverter.ParseJSON(res)
        Debug.Print res
     
        url = Url2 & "?q=" & sMST & "&type=auto&token=" & js("token") & "&force-search=1"
        .Option(WinHttpRequestOption_EnableRedirects) = False
        .Open "HEAD", url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/127.0.0.0 Safari/537.36 Edg/127.0.0.0"
        .setRequestHeader "Content-type", "text/html; charset=UTF-8"
        .send
        Debug.Print .Status
        res = .getResponseHeader("Location") 'MOI THEM
    End With
 
    Debug.Print "--> " & res
End Sub
 
Upvote 0
ongke0711 đã viết:
Code này trên máy tôi chạy ra kết quả nhé.

JavaScript: 
Option Explicit

Dim res$, url$

Sub TraCuu3()
    'On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
 
    Const WinHttpRequestOption_EnableRedirects = 6
 
    Dim formData As String, sMST As String, newURL As String
    Const Url1 As String = "https://masothue.com/Ajax/Token"
    Const Url2 As String = "https://masothue.com/Search/"
    sMST = "2700118201" 'Sheets("TraCuu").Range("B4").Value
 
    Dim js As Object
    Set js = CreateObject("Scripting.Dictionary")
 
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", Url1, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/126.0.0.0 Safari/537.36 Edg/126.0.0.0"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send ("")
        res = .responseText
        Set js = JsonConverter.ParseJSON(res)
        Debug.Print res
     
        url = Url2 & "?q=" & sMST & "&type=auto&token=" & js("token") & "&force-search=1"
        .Option(WinHttpRequestOption_EnableRedirects) = False
        .Open "HEAD", url, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/127.0.0.0 Safari/537.36 Edg/127.0.0.0"
        .setRequestHeader "Content-type", "text/html; charset=UTF-8"
        .send
        Debug.Print .Status
        res = .getResponseHeader("Location") 'MOI THEM
    End With
 
    Debug.Print "--> " & res
End Sub
Nhấp chuột vào đây để mở rộng...
em cảm ơn bác nhiều ạ!
 
Upvote 0
Sẵn chủ đề này.
Nhờ các anh xem thử và giúp gợi ý hoặc code giúp để có thể lấy thông tin link download từ web timfshare, với key = avatar
Get từ responseText không nhận được thông tin đầy đủ như khi dùng web browser.
PHP: 
https://timfshare.com/search?key=avatar
 
Upvote 0
huhumalu đã viết:
Sẵn chủ đề này.
Nhờ các anh xem thử và giúp gợi ý hoặc code giúp để có thể lấy thông tin link download từ web timfshare, với key = avatar
Get từ responseText không nhận được thông tin đầy đủ như khi dùng web browser.
PHP: 
https://timfshare.com/search?key=avatar
Nhấp chuột vào đây để mở rộng...
Cái trang này tiện lợi dữ, tự động tổng hợp các đường link.
Mà bạn lấy những thông tin nào? Tên file, đường link fshare...
 
Upvote 0
huhumalu đã viết:
Em cần đường link fshare thôi anh.
Nhấp chuột vào đây để mở rộng...
Chạy code này nhé.

JavaScript: 
Option Explicit

Dim res$, Url$

Sub TraCuu3()
    'On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
  
    Const WinHttpRequestOption_EnableRedirects = 6
  
    Dim query As String
    Const Url As String = "https://timfshare.com/api/v1/string-query-search?query="
    query = "avatar"
  
    Dim js As Object
    Set js = CreateObject("Scripting.Dictionary")
  
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        '.Option(WinHttpRequestOption_EnableRedirects) = False
        .Open "POST", Url & query, False
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/126.0.0.0 Safari/537.36 Edg/126.0.0.0"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send ("")
        Debug.Print .Status
        res = .responseText
        Set js = JsonConverter.ParseJSON(res)
        Debug.Print res
    End With
  
End Sub
 
Upvote 0
Ồ, ngon lành xịn quá.
Cho em hỏi sao anh biết được:
Mã: 
Const Url As String = "https://timfshare.com/api/v1/string-query-search?query="
Hay công cụ nào, anh chia sẻ thêm với ạ.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

B
  • Question
Chuyển dữ liệu từ cột sang dòng bằng vba excel
Trả lời
2
Đọc
36
VetMini
V
V
Tiếng Tây
Trả lời
2
Đọc
36
VetMini
V
NguyenTai1003
  • Question
Code lọc nội lực VBA
Trả lời
14
Đọc
3K
PhanTuHuong
PhanTuHuong
T
HỎI CÁCH LỌC DỮ LIỆU HIỆU QUẢ ĐẦY ĐỦ
Trả lời
4
Đọc
170
VetMini
V
N
  • Question
Com Add-Ins trong VBA
Trả lời
1
Đọc
134
Nguyễn Duy Tuân
Nguyễn Duy Tuân
vuha
Xử lý lỗi ứng dụng zalo PC dừng đột ngột (mã lỗi 0x42208) như thế nào?
Trả lời
9
Đọc
208
PhanTuHuong
PhanTuHuong
hoamattroicoi
Trích xuất file *.xml sang Excel cho hóa đơn điện tử áp dụng nghị định 123/2020
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
106
Đọc
26K
dinhduy
D
T
Công thức tính tổng số lượng giữa hai Sheel nhiều điều kiện
Trả lời
5
Đọc
129
VetMini
V
thonglongtong
Thắc mắc về khác biệt các hàm cơ sở dữ liệu
Trả lời
1
Đọc
52
VetMini
V
T
Lấy dữ liệu giá cổ phiếu từ website bằng Python hay code VBA
2
Trả lời
35
Đọc
1K
Kiều Mạnh
Kiều Mạnh
P
  • Question
Tự động tạo folder và xuất pdf theo tên ngày hiện tại
Trả lời
13
Đọc
313
phan van tai
P
GPE-Trợ Lý
HN - Đăng ký tham dự sinh nhật GIAIPHAPEXCEL lần thứ 18 ngày 29/09/2024
    • Thích
    • Ngạc nhiên
Trả lời
3
Đọc
145
PhanTuHuong
PhanTuHuong
LuuGiaPhúc
Code để lọc theo nhiều điều kiện
2
Trả lời
34
Đọc
821
cantl
C
N
Xin hỏi cách chia thời gian bằng Droplist
Trả lời
0
Đọc
40
namtn2562
N
Huế Vũ 1989
Cách chuyển công thức VBA từ 32 bit sang 64 bit ?
Trả lời
4
Đọc
599
Vinhwru1
Vinhwru1
T
  • Question
tự động chèn dòng trong vba
Trả lời
10
Đọc
152
VetMini
V
T
Chỉ tìm và cập nhật ô có chứa giá trị
Trả lời
3
Đọc
72
Tri1983
T
GPE-Trợ Lý
TP.HCM - Đăng ký tham dự sinh nhật GIAIPHAPEXCEL lần thứ 18 ngày 06/10/2024
    • Thích
Trả lời
3
Đọc
224
tungnguyen_kt
tungnguyen_kt
Q
Nhập dữ liệu nhanh
    • Cười
Trả lời
9
Đọc
222
VetMini
V
Q
lấy tháng trong chuỗi ký tự .
Trả lời
3
Đọc
57
quocnb
Q
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom