고구마와 놀기

WinHttp를 이용해요.

 

 

* 로그인

' // -- 네이버 로그인하는 함수 -- // '
Public Function Naver_Login(ByVal sID As String, ByVal sPW As String) As Boolean
     Dim strGet As String

     If sID = "" Or sPW = "" Then Exit Function

     WinHttps.Open "POST", "https://nid.naver.com/nidlogin.login"
     WinHttps.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
     WinHttps.Send "smart_level=1&id=" & sID & "&pw=" & sPW

     strGet = StrConv(WinHttps.ResponseBody, vbUnicode)

     If InStr(strGet, "//www") > 0 Then
          strID = sID
          strPW = sPW
          Naver_Login = True
     End If
End Function

사용법:

if Naver_Login("koki423", "nunbabo") then

  msgbox "로그인 성공!"

else

  msgbox "실패했음"

end if

 

 

 

* 카페 목록 추출

' // -- 카페 목록 추출하는 함수 -- // '
Public Function Cafe_List(ByRef Cmb As ComboBox, ByRef CmbHide As ComboBox) As Boolean
     On Error Goto Er
     Dim strGet As String
     Dim strName As String, strUrl As String
     Dim lPos As Long

     Cmb.Clear
     CmbHide.Clear

     WinHttps.Open "GET", "http://cafe.naver.com/MyCafeList.nhn"
     WinHttps.Send
     strGet = WinHttps.ResponseText

     lPos = InStr(strGet, "}")
     If lPos < 1 Then MsgBox "카페 목록 추출에 실패했습니다.", vbCritical, TITLE: Exit Function
     strGet = Mid$(strGet, lPos + 1)

     lPos = InStr(strGet, "t"":""")
     If lPos < 1 Then MsgBox "카페 목록 추출에 실패했습니다.", vbCritical, TITLE: Exit Function

     Do While (lPos > 0)
          strGet = Mid$(strGet, lPos + 4)

          lPos = InStr(strGet, """")
          strName = Mid$(strGet, 1, lPos - 1)

          lPos = InStr(strGet, "e"":""")
          strGet = Mid$(strGet, lPos + 4)

          lPos = InStr(strGet, """")
          strUrl = Mid$(strGet, 1, lPos - 1)

          If (Not strName = "") And (Not strUrl = "") Then
               Cmb.AddItem strName
               CmbHide.AddItem strUrl
          End If

          lPos = InStr(strGet, "t"":""")
     Loop

     Cmb.ListIndex = 0
     CmbHide.ListIndex = 0
     Cafe_List = True
     Exit Function
Er:
     MsgBox "오류가 발생했습니다." & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description, vbCritical, TITLE
End Function

사용법: Call(ComboBox1, ComboHide1)

ComboBox1에는 카페명들이 들어가고 ComboHide1에는 카페 주소(gogoomas)가 들어갑니다.

 

 

 

* 카페 번호 얻어오는 함수

' // -- 카페 번호 얻어오는 함수 -- // '
Public Function Cafe_GetNum(strUrl As String) As Long
     Dim strGet As String
     Dim lPos As Long

     WinHttps.Open "GET", "http://cafe.naver.com/" & strUrl
     WinHttps.Send
     strGet = StrConv(WinHttps.ResponseBody, vbUnicode)

     lPos = InStr(strGet, "<a href=""/MyCafeIntro.nhn?clubid=")
     If lPos < 1 Then MsgBox "카페 번호 추출에 실패했습니다.", vbCritical, TITLE: Exit Function
     strGet = Mid$(strGet, lPos + 33)
     strGet = Mid$(strGet, 1, InStr(strGet, """ target") - 1)
     Cafe_GetNum = Val(strGet)
End Function

사용법: Call Cafe_GetNum("gogoomas")

위와 같이 사용하면 14252258을 반환합니다.

 

 

 

* 카페 메뉴 추출하는 함수

' // -- 카페 메뉴 얻어오는 함수 -- // '
Public Function Cafe_Menu(strUrl As String, Cmb As ComboBox, CmbHide As ComboBox) As Boolean
     On Error Goto Er
     Dim strGet As String
     Dim strMenuNum As String, strMenuName As String
     Dim lPos As Long

     Cmb.Clear
     CmbHide.Clear

     If strUrl = "" Or strUrl = "-1" Then Exit Function

     WinHttps.Open "GET", "http://cafe.naver.com/" & strUrl
     WinHttps.Send

     strGet = WinHttps.ResponseText

     lPos = InStr(strGet, """cafe-menu-list""")
     If lPos < 1 Then MsgBox "카페 메뉴 추출에 실패했습니다.", vbCritical, TITLE: Exit Function

     strGet = Mid$(strGet, lPos + 16)

     lPos = InStr(strGet, "menuid=")
     If lPos < 1 Then MsgBox "카페 메뉴 추출에 실패했습니다.", vbCritical, TITLE: Exit Function

     Do While (lPos > 0)
          strGet = Mid$(strGet, lPos + 7)

          lPos = InStr(strGet, """")
          If lPos > 6 Then lPos = InStr(strGet, "&")
          strMenuNum = Int(Mid$(strGet, 1, lPos - 1))

          lPos = InStr(strGet, """>")
          strGet = Mid$(strGet, lPos + 2)

          lPos = InStr(strGet, "</a>")
          strMenuName = Mid$(strGet, 1, lPos - 1)

          Cmb.AddItem strMenuName
          CmbHide.AddItem strMenuNum

          lPos = InStr(strGet, "menuid=")
     Loop

     Cmb.ListIndex = 0
     CmbHide.ListIndex = 0
     Cafe_Menu = True
     Exit Function
Er:
     MsgBox "오류가 발생했습니다." & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description, vbCritical, TITLE
End Function

사용법: Call Cafe_Menu("gogoomas", ComboBox1, ComboHide1)

ComboBox1에는 메뉴명을, ComboHide1에는 메뉴 아이디를 넣어줍니다.


Posted by ko9ma Trackback 0 Comment 0


티스토리 툴바