[C#/VB.net]네이버 블로그 공감하기

Sub program1472()

    Dim URL As String, Cookie As String

    Dim T As String

    Dim blogId As String, logNo As String

    

    blogId = "블로그 아이디"

    logNo = "게시글 주소"

    

    Cookie = "NID_AUT=쿠키값; "

    Cookie = Cookie & "NID_SES=쿠키값; "

 

    URL = "https://blog.like.naver.com/v1/search/contents?suppress_response_codes=true"

    URL = URL & "&callback=jQuery32108679104131702924_" & UNIX_TIME

    URL = URL & "&q=BLOG%5B" & blogId & "_" & logNo & "%5D"

    URL = URL & "&isDuplication=true"

    URL = URL & "&_=" & UNIX_TIME

    

    With CreateObject("WinHttp.WinHttpRequest.5.1")

        .Open "GET", URL

        .SetRequestHeader "Accept", "application/javascript, */*;q=0.8"

        .SetRequestHeader "Referer", "https://section.blog.naver.com/BlogHome.nhn?directoryNo=0&currentPage=1&groupId=0"

        .SetRequestHeader "Accept-Language", "ko-KR"

        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"

        .SetRequestHeader "Host", "blog.like.naver.com"

        .SetRequestHeader "Connection", "Keep-Alive"

        If Len(Cookie) Then .SetRequestHeader "Cookie", Cookie

        .Send

        .WaitForResponse: DoEvents

        T = .ResponseText

        'T = StrConv(.ResponseBody, vbUnicode)

    End With

    

    T = Replace(T, ":", ":""")

    T = Replace(T, ",", """,")

    Do While InStr(T, """""") > 0

        T = Replace(T, """""", """")

    Loop

    

    Dim guestToken As String, timestamp As String

    

    guestToken = Split(Split(T, """guestToken""")(1), """")(1)

    timestamp = Split(Split(T, """timestamp""")(1), """")(1)

 

    URL = "https://blog.like.naver.com/v1/services/BLOG/contents/" & blogId & "_" & logNo & "?suppress_response_codes=true&"

    URL = URL & "_method=POST&" '// DELETE/POST

    URL = URL & "callback=jQuery32105048810427538088_" & timestamp & "&"

    URL = URL & "displayId=BLOG&"

    URL = URL & "reactionType=like&"

    URL = URL & "categoryId=post&"

    URL = URL & "guestToken=" & guestToken & "&"

    URL = URL & "timestamp=" & timestamp & "&"

    URL = URL & "_ch=pcw&"

    URL = URL & "isDuplication=true&"

    URL = URL & "lang=ko&"

    URL = URL & "countType=default&"

    URL = URL & "count=1&"

    URL = URL & "history=&"

    URL = URL & "runtimeStatus=&"

    URL = URL & "isPostTimeline=false&"

    URL = URL & "_=" & UNIX_TIME

 

    With CreateObject("WinHttp.WinHttpRequest.5.1")

        .Open "GET", URL

        .SetRequestHeader "Accept", "application/javascript, */*;q=0.8"

        .SetRequestHeader "Referer", "https://section.blog.naver.com/BlogHome.nhn?directoryNo=0&currentPage=1&groupId=0"

        .SetRequestHeader "Accept-Language", "ko-KR"

        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"

        .SetRequestHeader "Host", "blog.like.naver.com"

        .SetRequestHeader "Connection", "Keep-Alive"

        If Len(Cookie) Then .SetRequestHeader "Cookie", Cookie

        .Send

        .WaitForResponse: DoEvents

        'T = .ResponseText

        'T = StrConv(.ResponseBody, vbUnicode)

        Dim B() As Byte

        B = .ResponseBody

        T = UTF82(B, "utf-8")

    End With

    Debug.Print T

    

    '/**/jQuery32105048810427538088_1595228911077({"statusCode":403,"errorCode":4039,"message":"현재 서비스에서 더 이상 클릭할 수 없습니다.","moreInfos":["7","일","3"]});

    '/**/jQuery32105048810427538088_1595228917218({"statusCode":401,"errorCode":4010,"message":"로그인 하신 후 이용해 주시기 바랍니다.","moreInfos":null});

 

 End Sub

 

Public Function UNIX_TIME() As String

    Dim objSC As Object

    Set objSC = CreateObject("ScriptControl")

    objSC.Language = "Jscript"

    UNIX_TIME = objSC.Eval("new Date().getTime() + 60 * 60 * 24 * 30")

    Set objSC = Nothing

End Function

 

Public Function UTF82(ByRef data() As Byte, ByVal Charset As Variant) As String

    On Error GoTo ErrPass

    With CreateObject("ADODB.Stream")

        .Charset = Charset

        .Mode = 3

        .Type = 1

        .Open

        .Write data

        .Flush

        .Position = 0

        .Type = 2

        UTF82 = .ReadText

        .Close

    End With

    Exit Function

ErrPass:

    UTF82 = ""

End Function
[출처] [vb6.0/vba] vba를 이용한 네이버 블로그 공감하기|작성자 하나를하더라도최선을