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
1,955
Được thích
2,537
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: 24
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
AutoReply đã viết:
Mình không biết xài cookie lấy đoạn code trên mạng về chạy thử tự nhiên ra kết quả, hay máy mình bị virus nhỉ

Mã: 
Sub hello()
Dim sResponse As String, Url As String, objHTTP

Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
Url = "https://masothue.com/Ajax/Search"
objHTTP.Open "POST", Url, False
objHTTP.setRequestHeader "User-Agent", "ahihi"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.send ("q=0304408986&type=auto&force-search=1")
sResponse = objHTTP.responseText
MsgBox sResponse
End Sub
Nhấp chuột vào đây để mở rộng...

Trường hợp này nếu tìm chính xác theo mã số thuế (0304408986) thì làm sao để chỉ lấy được link sau khi như mình Search trên web vậy 2 anh @AutoReply @ongke0711 .

Ra link này: https://masothue.com/0304408986-cong-ty-tnhh-thuong-mai-dich-vu-viet-ha

Xin cảm ơn!
 
Upvote 0
excel_lv1.5 đã viết:
nếu get vài lần thì thêm bước get token nữa là giống y cũ thôi bạn
View attachment 265002
Nhấp chuột vào đây để mở rộng...

Cảm ơn bạn.
Tôi cũng đã sửa lại nhưng không biết còn sai chỗ khai báo nào mà chuỗi Json trả về cũng chưa đúng như của bạn. Bạn kiểm tra giùm tôi nhé.

Mã: 
res = httpPost("https://masothue.com/Ajax/Token", "")
    'Debug.Print res
    Set js = JsonConverter.ParseJSON(res)
    
    sMST = "0304440926"
    formData = "?q=" & sMST & "&type=auto&token=" & js("token") & "&force-search=1"
    'Debug.Print formData
    
    res = httpPost("https://masothue.com/Ajax/Search", formData)
    
    
    Debug.Print "----------------------------------------" & vbCrLf
    Debug.Print res

Screen Shot 2021-08-29 at 14.22.31.png
 

File đính kèm

  • LẤY THÔNG TIN DOANH NGHIỆP - test.xlsm
    95.5 KB · Đọc: 13
Lần chỉnh sửa cuối:
Upvote 0
Kiều Mạnh đã viết:
Thử nhập dòng sau xem ... nó ra 2 Cty ... đang rảnh bà tám 1 tí
Công Ty TNHH Dịch Vụ Viễn Thông Phương Nam Telecom
Nhấp chuột vào đây để mở rộng...

Đúng rồi bạn. Tìm theo tên nó sẽ trả về một danh sách tất cả các tên có chứa các từ đã gõ.
Chỉ tìm theo MST mới trả về 1 tên Doanh nghiêp.
 
Upvote 0
ongke0711 đã viết:
Cảm ơn bạn.
Tôi cũng đã sửa lại nhưng không biết còn sai chỗ khai báo nào mà chuỗi Json trả về cũng chưa đúng như của bạn. Bạn kiểm tra giùm tôi nhé.

Mã: 
res = httpPost("https://masothue.com/Ajax/Token", "")
    'Debug.Print res
    Set js = JsonConverter.ParseJSON(res)
  
    sMST = "0304440926"
    formData = "?q=" & sMST & "&type=auto&token=" & js("token") & "&force-search=1"
    'Debug.Print formData
  
    res = httpPost("https://masothue.com/Ajax/Search", formData)
  
  
    Debug.Print "----------------------------------------" & vbCrLf
    Debug.Print res

View attachment 265007
Nhấp chuột vào đây để mở rộng...
Nên viết trong một object request để cùng phiên bạn, code bạn gọi hàm httpPost 2 lần tức là đang tạo 2 phiên khác nhau rồi, đồng thời sửa formData = "?q=" thành formData = "q="
1630224781882.png
 
Lần chỉnh sửa cuối:
Upvote 0
excel_lv1.5 đã viết:
Nên viết trong một object request để cùng phiên bạn, code bạn gọi hàm httpPost 2 lần tức là đang tạo 2 phiên khác nhau rồi, đồng thời sửa formData = "?q=" thành formData = "q="
Nhấp chuột vào đây để mở rộng...

Cái mấu chốt nó nằm ở đây :thumbs:. Bữa giờ cứ loay hoay không biết nguyên nhân, không xử lý được đoạn này.
Cảm ơn bạn nhé.
 
Upvote 0
​
Tôi đã hoàn thiện thêm code của file gửi trên trang đầu như sau:
1. Thiết lập khai báo tìm tùy ý các thông tin
2. Cho phép tìm MST chính xác, web thấy sao Excel thấy vậy.

lay_thong_tin_doanh_nghiep.png

Mã nguồn (có một số đoạn code file cũ thừa tôi không xóa, để đó để các bạn ứng dụng cho vieeucj khác):
Rich (BB code): 
Sub LayTenDN()

'On Error GoTo ErrorHandler
    Dim js As Object, res As String, TypeValue As String
    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)
    
    TypeValue = Range("TypeValue").Value
    
    sTenCty = UCase(Sheet1.Range("B3"))
    formData = "?q=" & URLEncode(CStr(sTenCty), True) & _
                "&type=" & TypeValue & _
                "&force-search=1"
    
    res = httpGet(Url & formData)
    Call Write2Sheet(res, TypeValue)
  
ErrorHandler_Exit:
    Exit Sub

ErrorHandler:
    MsgBox "Có lõi phát sinh." & vbCrLf & "Mã loi: " & Err.Number & vbCrLf & "Noi dung loi: " & Err.Description, vbExclamation, "Thông báo"
    Resume ErrorHandler_Exit

End Sub

Sub Write2Sheet(ByVal sHTML As String, ByVal TypeValue As String)
    Dim oHtml As HTMLDocument
    Dim oElement As Object, prc As Object, prc2 As Object
    Dim i As Long, j As Long, k As Long
    
    On Error GoTo lbEndSub
    
    Set oHtml = New HTMLDocument
    oHtml.body.innerHTML = sHTML
    Sheet1.Range("A7:D1000").ClearContents
    Sheet1.Range("D3") = "Xin cho..."
    
    If TypeValue = "enterpriseTax" Then
        'table-taxinfo
        Dim tb As Object, row As Object, r As Long
        'Set tb = oHtml.getElementsByClassName("Table - taxinfo")
        Set tb = oHtml.getElementsByTagName("TABLE")(0)
        For r = 0 To tb.Rows.Length - 1
            Set row = tb.Rows(r)
            Cells(r + 7, 1).Value = row.Cells(0).innerText
            If row.Cells.Length > 1 Then
                Cells(r + 7, 2).Value = row.Cells(1).innerText
            End If
        Next
        GoTo lbEndSub
    End If
    
    Set prc = oHtml.getElementsByClassName("tax-listing")(0).getElementsByTagName("a")
    Set prc2 = oHtml.getElementsByClassName("tax-listing")(0).getElementsByTagName("address")
        
    i = 0: j = 0: k = 0
    For Each oElement In prc
        If k > 2 Then
            k = 0: j = j + 1
        End If
        Sheet1.Range("A7").Offset(j, k) = prc(i).innerText
        Sheet1.Range("D7").Offset(j, 0) = prc2(j).innerText
        i = i + 1: k = k + 1
    Next oElement
    
lbEndSub:
    If Err <> 0 Then
        Sheet1.Range("D3") = "Loi tim kiem? Hay kiem tr kieu tim kiem."
        Sheet1.Range("D3").Font.Color = vbRed
    Else
        Sheet1.Range("D3") = "Xong."
        Sheet1.Range("D3").Font.Color = vbGreen
    End If
    Set oHtml = Nothing
    Set oElement = Nothing

End Sub
​
 

File đính kèm

  • getWebData - Lấy thông tin doanh nghiệp - Tuân.xlsm
    85 KB · Đọc: 33
Upvote 0
Chủ đề mã số thuế bên này không biết còn chạy được không, mọi người chạy thử

www.giaiphapexcel.com

Tra cứu Mã Số Thuế và Kê Khai Hải Quan nhanh chóng với Excel

***Dự án sẽ sớmcập nhật trở lại*** https://github.com/SanbiVN/MaSoThueVN Liên hệ Messenger: https://m.me/he.sanbi hoặc tìm /he.sanbi Liên hệ Zalo: 0384170514 Hôm nay tôi sẽ chia sẻ với các bạn ứng dụng Excel dùng để tra mã số thuế của cá nhân nếu các bạn đã có Danh sách Chứng Minh Thư hoặc Số...
www.giaiphapexcel.com www.giaiphapexcel.com
 
Upvote 0
HeSanbi đã viết:
Chủ đề mã số thuế bên này không biết còn chạy được không, mọi người chạy thử

www.giaiphapexcel.com

Tra cứu Mã Số Thuế và Kê Khai Hải Quan nhanh chóng với Excel

***Dự án sẽ sớmcập nhật trở lại*** https://github.com/SanbiVN/MaSoThueVN Liên hệ Messenger: https://m.me/he.sanbi hoặc tìm /he.sanbi Liên hệ Zalo: 0384170514 Hôm nay tôi sẽ chia sẻ với các bạn ứng dụng Excel dùng để tra mã số thuế của cá nhân nếu các bạn đã có Danh sách Chứng Minh Thư hoặc Số...
www.giaiphapexcel.com www.giaiphapexcel.com
Nhấp chuột vào đây để mở rộng...
hết chạy được rồi bạn, do trang masothue nó thay đổi rồi bạn !
 
Upvote 0
rồi xong. Masothue.com lại thay đổi gì nữa rồi, tối qua request nhiều quá hay sao không biết !
 
Upvote 0
Sao file mình làm từ năm 2019 giờ vẫn chạy được nhỉ. @@ .

QOUC6S.gif
 
Upvote 0
Mình mới kiểm tra lại File lấy thông tin chỗ a Tuân ở máy nơi khác (khác IP máy mình) thì chạy bình thường. Tuy nhiên cái mình đang làm là tra cứu mã số thuế TNCN từ số CMND(hoặc căn cước)
Code mình như sau (hôm qua chạy ngon lành, sáng nay thì lỗi, không chạy được nữa )
Mình qua 2 lần Post và Get, nếu 1 lần Post và 1 lần Get thì nếu số CMND đó mình mới tra cứu thì nó ra kết quả còn nếu số CMND đó chưa tra cứu thì nó không ra kết quả, chả biết nguyên nhân tại sao !

Mã: 
Function LayTTMSTNCN(ByVal SoCMND As String)
Dim Msg As String, Url As String
Dim hreq As Object, html As Object, js As Object

    Set hreq = CreateObject("WinHttp.WinHttpRequest.5.1")
    Set html = CreateObject("htmlfile")
    Set js = CreateObject("Scripting.Dictionary")
   
    With hreq
        .Open "POST", "https://masothue.com/Ajax/Token", 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"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send (Msg)
        Set js = JsonConverter.ParseJSON(.responseText)
       
        Msg = "q=" & SoCMND & "&type=personalTax&token=" & js("token") & "&force-search=1"
        .Open "POST", "https://masothue.com/Ajax/Search", 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"
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send (Msg)
        .WaitForResponse
       
        Url = GetUrl(.responseText)
        If InStr(1, Url, "ch\u01b0a c\u00f3") > 0 Or Len(Url) = 0 Then
            LayTTMSTNCN = "Chua cap MST"
            Exit Function
        Else
            .Open "GET", "https://masothue.com" & Url, False
            .send
            html.body.innerHTML = .responseText
                   
            If Err.Number Then
                Err.Clear
            Else
                LayTTMSTNCN = html.getElementsByClassName("table-taxinfo")(0).innerText
            End If
            html.Close
        End If
    End With
   
    Set hreq = Nothing
    Set html = Nothing
    Set js = Nothing

End Function

Function GetUrl(ByVal str As String)
    Dim h As Long, i As Long, s As String
    h = InStr(1, str, "\/")
    If h > 0 Then
        For i = h + 2 To Len(str)
            If Mid(str, i, 1) = Chr(34) Then
                s = Mid(str, h + 1, i - h - 1)
                Exit For
            End If
        Next i
        GetUrl = s
    End If
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
quocphuoc88 đã viết:
Mình mới kiểm tra lại File lấy thông tin chỗ a Tuân ở máy nơi khác (khác IP máy mình) thì chạy bình thường. Tuy nhiên cái mình đang làm là tra cứu mã số thuế TNCN từ số CMND(hoặc căn cước)
Code mình như sau (hôm qua chạy ngon lành, sáng nay thì lỗi, không chạy được nữa )
Mình qua 2 lần Post và Get, nếu 1 lần Post và 1 lần Get thì nếu số CMND đó mình mới tra cứu thì nó ra kết quả còn nếu số CMND đó chưa tra cứu thì nó không ra kết quả, chả biết nguyên nhân tại sao !
Nhấp chuột vào đây để mở rộng...
Tắt modem router, khởi động lại là được.
 
Upvote 0
Mới sửa lại cái file tra cứu theo các kiểu: MST , CCCD (CMND), Tên DN và thêm cái tìm theo danh sách MST vì lúc trước có bạn hỏi.

Screen Shot 2021-09-06 at 19.18.40.png
 

File đính kèm

  • TRA CỨU THÔNG TIN DOANH NGHIỆP.xlsm
    110.2 KB · Đọc: 20
Lần chỉnh sửa cuối:
Upvote 0
ko biết sử dụng được lâu ko nữa xong nó lại khóa do sent với get nhiều quá
 
Upvote 0
truongvu317 đã viết:
View attachment 265554


Làm như nào bây giờ để nó có thể chạy mượt mà được bây giờ?
Bài đã được tự động gộp:


Họ dùng công nghệ gì không biết mà có thể khóa được nhỉ?
Nhấp chuột vào đây để mở rộng...

Một cách sửa lỗi trên là không dùng WinHTTP mà đổi sang MSXML2. Trong code tôi có viết sẳn rồi.

Screen Shot 2021-09-06 at 22.30.23.png


Nếu dùng WinHTTP thì bạn chạy file đính kèm xem sửa lỗi TLS của Windows xem còn lỗi không. Do máy tôi cài rồi nên chạy không lỗi.
Theo tôi biết thì nguyên nhân nó tương tự như nội dung bên dưới:

Screen Shot 2021-09-06 at 22.43.00.png

Và link down ở đây: https://docs.microsoft.com/en-us/an...-11-and-tls-12-easy-fix-download-missing.html

Còn về vụ khoá IP thì tôi không rành web nên nghĩ chắc họ dùng các tool để chống DDOS hoặc kỹ thuậnt anti-scraping gì đó.
 

File đính kèm

  • MicrosoftEasyFix51044.zip
    295.5 KB · Đọc: 8
Lần chỉnh sửa cuố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 đổi dữ liệu sạng dạng mảng
Trả lời
5
Đọc
69
ongke0711
ongke0711
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
Trả lời
11
Đọc
152
ho van luong
H
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
6
Đọc
135
Hoàng Tuấn 868
H
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
0
Đọc
57
shnhatha221108
S
T
Không hiện dữ liệu ở ô công thức
Trả lời
3
Đọc
71
thien-16
T
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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