'-------------------------------------------------------------------------------------------------------------
' 이름: modNaver.bas
' 날짜: 2013/02/13
'
' 내용: 네이버 공감, 덧글, 스크랩, 카페 가입 등에 관한 모듈
' 목록: Sub Initialization()
' Function Login(ID As String, PW As String) As Boolean
' Sub BlogComment(BlogID As String, logNo As String, Comment As String)
' Function GetBlogMenu(BlogID As String, logNo As String) As String
' Sub CafeComment(clubid As String, articleid As String, Comment As String, Optional emoticon As String = "11")
' Sub PostScrap(BlogID As String, logNo As String)
' Function PostSympathy(BlogID As String, logNo As String) As Boolean
' Function CafeInvite(clubid As String, ID As String, Title As String, Content As String) As Boolean
' Function GetCafeID(cluburl As String) As String
' Function CafeAutoRegister(Nickname As String, clubid As String, cluburl As String) As Boolean
' Function ReplaceW(Str) As String
' Function MessageSend(toID As String, fromID As String, Content As String) As Boolean
' Function MailSend(senderName As String, toID As String, ID As String, subject As String, body As String) As Boolean
' Function GetPersonacon() As String
' Function Change(Str As String) As String
' Function voteComment(titleID As String, no As String, commentNo As String, isRecommend As Boolean) As Boolean
'-------------------------------------------------------------------------------------------------------------
Dim WinHttp As Object
Dim key As String
' WinHttp 객체 할당 관련 함수
Public Sub Initialization()
Set WinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
End Sub
' 네이버 로그인 관련 함수
Public Function Login(ID As String, PW As String) As Boolean
WinHttp.Open "POST", "https://nid.naver.com/nidlogin.login"
WinHttp.SetRequestHeader "Referer", "https://nid.naver.com/nidlogin.login"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.Send "enctp=2&svctype=0&id=" & ID & "&pw=" & PW
If InStr(WinHttp.ResponseText, "http://static.nid.naver.com/sso/cross-domain.nhn?sid=") Then: Login = True: Else: Login = False
End Function
' 네이버 블로그 덧글 작성 관련 함수
Public Sub BlogComment(BlogID As String, logNo As String, Comment As String, Optional isSecret As Boolean = False)
WinHttp.Open "POST", "http://blog.naver.com/CommentWrite.nhn"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.SetRequestHeader "Referer", "http://blog.naver.com/CommentList.nhn?blogId=" & BlogID & "&logNo=" & logNo & "¤tPage=&isMemolog=false&focusingCommentNo=&showLastPage=true&shortestContentAreaWidth=false"
WinHttp.Send "blogId=" & BlogID & "&logNo=" & logNo & "&comment.emoticon=1112571&isMemolog=false¤tPage=&commentProfileImageType=3&comment.imageType=1&shortestContentAreaWidth=false&comment.contents=" & Change(Comment) & "&comment.secretYn=" & LCase(isSecret)
End Sub
' 네이버 카페 덧글 작성 관련 함수
Public Sub CafeComment(clubid As String, articleid As String, Comment As String, Optional emoticon As String = "11")
WinHttp.Open "POST", "http://cafe.naver.com/CommentPost.nhn"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.SetRequestHeader "Referer", "http://cafe.naver.com/ArticleRead.nhn?clubid=" & clubid & "&articleid=" & articleid & "&referrerAllArticles=true"
WinHttp.Send "content=" & Change(Comment) & "&clubid=" & clubid & "&articleid=" & articleid & "&m=write&emotion=" & emoticon & "&orderby=asc"
End Sub
' 네이버 블로그 메뉴 얻어오는 함수
Private Function GetBlogMenu(BlogID As String, logNo As String) As String
WinHttp.Open "POST", "http://blog.naver.com/ScrapForm.nhn"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.Send "blogId=" & BlogID & "&source_type=1&source_type_real=1&source_form=2&valid=0&logNo=" & logNo & "&source_no=" & logNo & _
"&source_blogId=" & BlogID & "&source_nickname=%BD%BA%C5%A9%B7%A6&source_paperno=56780534&source_openYn=2&source_url=" & BlogID & _
"&sourceSmartEditorVersion=2&no=1&attach=&source_title=%BD%BA%C5%A9%B7%&title=__WINHTTP&source_contents="
GetBlogMenu = Split(Split(WinHttp.ResponseText, ":0,""data"":[[""")(1), """")(0)
End Function
' 네이버 블로그 포스트 스크랩 관련 함수
Public Sub PostScrap(BlogID As String, logNo As String)
Dim arr() As String: arr = Split(GetBlogMenu(BlogID, logNo), "#")
WinHttp.Open "POST", "http://blog.naver.com/PostScrap.nhn"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.SetRequestHeader "Referer", "http://blog.naver.com/ScrapForm.nhn"
WinHttp.Send "logType=1&category=" & arr(0) & Change("#nhn#" & arr(2) & "#nhn#") & "true&scrapCommentView=%B0%D4%BD%C3%B1%DB%C0%CC+%BD%BA%C5%A9%B7%A6+%B5%C7%BE%FA%BD%C0%B4%CF%B4%D9" & _
"&tag=&openyn=2&commentYn=true&blogId=" & BlogID & "&source_type=1&source_type_real=1&source_no=" & logNo & "&source_sumyn=&source_sumtext=&source_paperno=56780534" & _
"&source_paperid=" & BlogID & "&source_nickname=%BD%BA%C5%A9%B7%A6&source_url=" & BlogID & "&source_form=2&cclType=&sourceSmartEditorVersion=2&greenReviewBannerYn=NO_USE" & _
"source_title=%BF%A2%BD%C3%B3%EB%BE%C6%B4%D4%C0%C7+%BA%ED%B7%CE%B1%D7&title=%5B%B8%B5%C5%A9%BD%BA%C5%A9%B7%A6%5D+__WINHTTP&contents=%253F%253F%253F" & _
"&scrapComment=%B0%D4%BD%C3%B1%DB%C0%CC+%BD%BA%C5%A9%B7%A6+%B5%C7%BE%FA%BD%C0%B4%CF%B4%D9&attach=&logNo=" & logNo & "&source_categoryNo=1&flv_include_yn=N" & _
"&themeCode=&imageUrl=&eventCode=&callbackUrl=&callbackEncoding=false&callbackType=server&no=1&isMemolog=false&sourceAttachedVideoScrapYn=false&scrap_hintyn=Y"
End Sub
' 네이버 블로그 게시글 공감 함수
Public Function PostSympathy(BlogID As String, logNo As String) As Boolean
WinHttp.Open "POST", "http://blog.naver.com/PostSympathyAddAndCountAsync.nhn"
WinHttp.SetRequestHeader "Referer", "http://blog.naver.com/PostList.nhn?blogId=" & BlogID & "&widgetTypeCall=true"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
WinHttp.Send "blogId=" & BlogID & "&logNo=" & logNo
If InStr(WinHttp.ResponseText, "공감하였") Then: PostSympathy = True: Else: PostSympathy = False
End Function
' 카페 초대 관련 함수
Public Function CafeInvite(clubid As String, ID As String, Title As String, Content As String) As Boolean
WinHttp.Open "GET", "http://cafe.naver.com/CafeInviteView.nhn?m=view&inviteid=" & ID
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.Send
Temp = Mid(StrConv(WinHttp.responsebody, vbUnicode), InStr(StrConv(WinHttp.responsebody, vbUnicode), "name=""cafeCookieToken"" value=""") + Len("name=""cafeCookieToken"" value="""))
CafeCookieToken = Left(Temp, InStr(Temp, """>") - 1)
WinHttp.Open "POST", "http://cafe.naver.com/CafeInviteViewResult.nhn"
WinHttp.SetRequestHeader "Referer", "http://cafe.naver.com/CafeInviteView.nhn?m=view&inviteid=" & ID
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.Send "webworkCookieTokenName=cafeCookieToken&cafeCookieToken=" & CafeCookieToken & "&inviteid=" & ID & "&invitecafe=" & clubid & "&title=" & Change(Title) & "&content=" & Change(Replace(Content, vbCrLf, " "))
If InStr(StrConv(WinHttp.responsebody, vbUnicode), "성공") Then: CafeInvite = True: Else: CafeInvite = False
End Function
' 카페 고유번호 추출 관련 함수
Public Function GetCafeID(cluburl As String) As String
WinHttp.Open "GET", "http://cafe.naver.com/" & cluburl
WinHttp.Send
GetCafeID = Split(Split(StrConv(WinHttp.responsebody, vbUnicode), "ClubId = """)(1), """")(0)
End Function
' 카페 자동가입 관련 함수
Public Function CafeAutoRegister(Nickname As String, clubid As String, cluburl As String) As Boolean
WinHttp.Open "POST", "http://m.cafe.naver.com/CafeApplyView.nhn?id=" & cluburl
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.Send "clubid=" & clubid & "&email="
CafeCookieToken = ReplaceW(Split(Split(WinHttp.ResponseText, "")(0))
clubTempld = ReplaceW(Split(Split(WinHttp.ResponseText, "clubTempId"" value=""")(1), """")(0))
alimCode = ReplaceW(Split(Split(WinHttp.ResponseText, "")(0))
questionNo = Split(Split(WinHttp.ResponseText, "applyQuestionSetno"" value=""")(1), """")(0)
questionNum = UBound(Split(WinHttp.ResponseText, "id=""applyanswer"))
For i = 1 To questionNum: Temp = Temp & "temp" & IIf(i = questionNum, "", "%23NHNC%23"): Next
WinHttp.Open "POST", "http://m.cafe.naver.com/CafeApplyViewResult.nhn"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.SetRequestHeader "Referer", "http://m.cafe.naver.com/CafeApplyView.nhn"
WinHttp.Send "webworkCookieTokenName=cafeCookieToken&cafeCookieToken=" & CafeCookieToken & "&clubTempId=" & clubTempld & "&alimCode=" & alimCode & "&clubid=" & clubid & "&cluburl=" & cluburl & "&boardFeedId=&cafeApplyTempSave.applyanswerstring=" & Temp & "&cafeApplyTempSave.applyQuestionSetno=" & questionNo & "&rewrite=&cafeApplyTempSave.nickname=" & Nickname
If InStr(WinHttp.ResponseText, "완료되었") Then: CafeAutoRegister = True: Else: CafeAutoRegister = False
End Function
' =와 /와 +기호만을 URL 인코딩 하는 함수
Private Function ReplaceW(Str) As String
ReplaceW = Replace(Replace(Replace(Str, "+", "%2B"), "/", "%2F"), "=", "%3D")
End Function
' 네이버 쪽지 관련 함수
Public Function MessageSend(toID As String, fromID As String, Content As String) As Boolean
WinHttp.Open "POST", "http://note.naver.com/json/write/send/"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=utf-8"
WinHttp.Send "svcType=undefined&isReplyNote=0&targetUserId=" & toID & "&content=" & Content & "&isBackup=1&u=" & fromID
If InStr(WinHttp.ResponseText, "성공") Then: MessageSend = True: Else: MessageSend = False
End Function
' 네이버 메일 관련 함수
Public Function MailSend(senderName As String, toID As String, ID As String, subject As String, body As String) As Boolean
WinHttp.Open "POST", "http://mail.naver.com/json/write/send/"
WinHttp.SetRequestHeader "Referer", "http://mail.naver.com/"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.Send "senderName=" & senderName & "&to=" & toID & "&subject=" & subject & "&body=" & body & "&contentType=html&charset=AUTO&sendSeparately=false&saveSentBox=true&type=new&fromMe=0&attachID=tseCWrwm_LYmKoumKSevFou97qUm7riGWzwCMBKTM40nWzJCbqMZKAEwKou.&addReceiverAddress=false&attachCount=0&attachSize=0&priority=0&u=" & ID
If InStr(WinHttp.ResponseText, "성공") Then: MailSend = True: Else: MailSend = False
End Function
'웹툰 댓글 추천/비추천
Public Function voteComment(titleID As String, no As String, commentNo As String, isRecommend As Boolean) As Boolean
WinHttp.Open "POST", "http://comic.naver.com/comments/vote_comment.nhn"
WinHttp.SetRequestHeader "Referer", "http://comic.naver.com/ncomment/ncomment.nhn?titleId=" + titleID + "&no=" + no + "&levelName=WEBTOON"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.Send "ticket=comic1&object_id=" + titleID + "_" + no + "&comment_no=" + commentNo + "&recommend_up_yn=" + IIf(isRecommend, "Y", "N")
If InStr(WinHttp.ResponseText, "No Error") Then: voteComment = True: Else: voteComment = False
End Function
' 자신의 퍼스나콘을 가져오는 함수
Public Function GetPersonacon() As String
WinHttp.Open "GET", "http://item.naver.com/personacon/PersonaconShop.nhn"
WinHttp.Send
GetPersonacon = Split(Split(Split(StrConv(WinHttp.responsebody, vbUnicode), "/personacon/")(3), ".")(0), "/")(2)
End Function
' 한글 -> EUC-KR, URL 인코딩 관련 함수
Public Function Change(Str As String) As String
On Error GoTo ErrLbl
For i = 1 To Len(Str)
If Len(Hex(Asc(Mid$(Str, i, 1)))) = 4 Then
Change = Change & "%" & Mid$(Hex(Asc(Mid$(Str, i, 1))), 1, 2) & "%" & Mid$(Hex(Asc(Mid$(Str, i, 1))), 3, 2)
Else
Change = Change & "%" & Hex(Asc(Mid$(Str, i, 1)))
End If
Next
ErrLbl:
End Function