Vấn đề HttpRequest "Get" trả về Response khác với Reponse thao tác trên trình duyệt (3 người xem)

ongke0711 · 12/5/21

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

linhcute2000 · 29/8/21

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

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!

ongke0711 · 29/8/21

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

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

ongke0711 · 29/8/21

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

Đú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.

excel_lv1.5 · 29/8/21

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

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="

ongke0711 · 29/8/21

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="

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é.

Nguyễn Duy Tuân · 29/8/21

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.

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

HeSanbi · 29/8/21

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ử

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

quocphuoc88 · 29/8/21

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ử

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

hết chạy được rồi bạn, do trang masothue nó thay đổi rồi bạn !

quocphuoc88 · 30/8/21

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 !

quocphuoc88 · 30/8/21

emcute đã viết:
Nó Lock IP của mình đó bạn. Do tạo Request liên tục............Chắc bị lock mãi mãi... Như hình ở #27

hình như nó thay đổi gì á, mình thử fake IP nó vẫn không request được !

befaint · 30/8/21

Sao file mình làm từ năm 2019 giờ vẫn chạy được nhỉ. @@ .

quocphuoc88 · 30/8/21

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

ongke0711 · 30/8/21

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 !

Tắt modem router, khởi động lại là được.

quocphuoc88 · 30/8/21

ongke0711 đã viết:
Tắt modem router, khởi động lại là được.

hôm nay bạn còn tra cứu được không ? Chiều nay mình thử 3 máy 3 nơi IP khác nhau đều lỗi hết !

quocphuoc88 · 30/8/21

sáng còn Fake IP được, chiều nó khóa luôn rồi !

ongke0711 · 6/9/21

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.

Kiều Mạnh · 6/9/21

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á

truongvu317 · 6/9/21

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: 6/9/21

quocphuoc88 đã viết:
sáng còn Fake IP được, chiều nó khóa luôn rồi !

Họ dùng công nghệ gì không biết mà có thể khóa được nhỉ?

ongke0711 · 6/9/21

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: 6/9/21

Họ dùng công nghệ gì không biết mà có thể khóa được nhỉ?

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.

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:

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ì đó.

excel_lv1.5 · 6/9/21

ongke0711 đã viết:
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.

View attachment 265556

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:

View attachment 265557

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ì đó.

Tôi nghĩ bạn viết đoạn code fake cái proxy của nó để hoàn chỉnh, proxy thì lấy mấy cái proxy free ở web nó làm mới thường xuyên nên có chết hay bị chặn cũng chẳng sao, lấy trong web này https://www.sslproxies.org/ lấy mấy thằng port 8080 thôi để hạn chế mấy cái proxy không hoạt động

Vấn đề HttpRequest "Get" trả về Response khác với Reponse thao tác trên trình duyệt (3 người xem)

Người dùng đang xem chủ đề này

Thành viên gắn bó

File đính kèm

Thành viên mới

Thành viên gắn bó

File đính kèm

Thành viên gắn bó

Thành viên tích cực

Thành viên gắn bó

Nghị Hách

File đính kèm

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Thành viên thường trực

Thành viên thường trực

Thành viên thường trực

|||||||||||||

Thành viên thường trực

Thành viên gắn bó

Thành viên thường trực

Thành viên thường trực

Thành viên gắn bó

File đính kèm

I don't program, I beat code into submission!!!

Thành viên tích cực

Thành viên gắn bó

File đính kèm

Thành viên tích cực

Sinh nhật lần 19 GPE