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,260
Được thích
3,001
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

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

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

T
Xin giúp em copy cột C ở tất cả các sheet vào file import_template. Em cảm ơn ạ.
Trả lời
1
Đọc
10
BuiQuangThuan
B
KTS NGUYEN DU
Các bác có biết chỉnh mục trống này về dạng word cơ bản không ạ.
Trả lời
5
Đọc
67
KTS NGUYEN DU
KTS NGUYEN DU
giaiphap
Chia sẻ cách tạo gợi ý cho hàm trong Excel bằng thư viện ExcelDna.
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
6
Đọc
2K
Phương Nguyễn 89
Phương Nguyễn 89
hahuykhuong
  • Question Question
link file pdf hóa đơn bằng vba
Trả lời
3
Đọc
126
hahuykhuong
hahuykhuong
Manhhung90
  • Question Question
Xin giúp chuyển dữ liệu từ cột dọc sang hàng ngang theo điều kiện
    • Buồn
Trả lời
10
Đọc
198
Manhhung90
Manhhung90
M
  • Question Question
Code VBA tìm mã kiện gỗ còn tồn kho
Trả lời
7
Đọc
254
BuiQuangThuan
B
HeSanbi
  • Đã giải quyết
ExplorerXL - Quản lý thư mục với Excel: tìm, đổi tên, sao chép, di chuyển và xóa
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
80
Đọc
16K
ngochienbmt
N
T
cách viết hàm if
Trả lời
4
Đọc
147
VetMini
V
X
Tự động giãn dòng và ẩn các dòng bị bỏ trống
Trả lời
4
Đọc
189
HeSanbi
HeSanbi
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
    • Yêu thích
Trả lời
2
Đọc
916
nguyentnct
N
N
  • Question Question
Cần giúp rút gọn code vba
Trả lời
8
Đọc
241
VetMini
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
13 14 15
Trả lời
299
Đọc
20K
trdethuong
T
D
Vẽ biểu đồ phân tích doanh thu và lợi nhuận theo mã đơn vị
Trả lời
5
Đọc
890
thuytrangbp28
T
HeSanbi
  • Đã giải quyết
VBA Nâng cao: Khi ô Excel ở chế độ đang nhập liệu thì VBA có thể chạy và lấy giá trị ô không?
    • Thích
    • Cảm ơn
Trả lời
9
Đọc
2K
A HOANG 620
A
P
Xin hỏi cách tăng tốc khi nhập liệu cho sheet NHAPXUAT
Trả lời
4
Đọc
214
yeudoi
yeudoi
S
Tính trung bình của tháng đầu tiên.
Trả lời
5
Đọc
298
SteveNguyen1991
S
A
  • Đã giải quyết
Xin giúp đỡ code VBA chép cột dữ liệu có điều kiện từ file này sang file khác
2 3
Trả lời
59
Đọc
3K
Hoàng Nhật Phương
Hoàng Nhật Phương
T
  • Question Question
Xin code VBA trả về tên tài khoản theo điều kiện
    • Chấp nhận
Trả lời
10
Đọc
239
DeTong
D
H
Nhờ các cao nhân chỉ giáo code file Form nhập liệu Google Sheet !!!
    • Thích
Trả lời
4
Đọc
114
befaint
befaint
hoamattroicoi
TỔNG HỢP TỜ KHAI THUẾ THEO THÔNG TƯ 80/2021 TỪ *.XML SANG EXCEL
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
7
Đọc
3K
Nguyễn Văn Thái 92
N
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới
Back
Top Bottom