2013. 06. 08 네이버 관련 모듈

'-------------------------------------------------------------------------------------------------------------
'   이름: 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