vb6.0/vba [vb6.0/vba] vba를 이용한 네이버 블로그 공감하기
페이지 정보
본문
Option Explicit
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=쿠키(NID_AUT)값; "
Cookie = Cookie & "NID_SES=쿠키(NID_SES)값; "
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¤tPage=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¤tPage=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
- 이전글[vba] PowerPoint 슬라이드 복사후 복사한 슬라이드에 이미지 삽입하기 20.07.23
- 다음글[Excel vba] 프로시져 실행방법 6가지 정리 20.07.18
댓글목록
등록된 댓글이 없습니다.