2013. 05. 04 네이버 금칙어 관리기

2년도 더 지난 프로젝트입니다. 참고하실 분 혹시나 있을까봐 이렇게 올려봅니다.

Private WinHttp As New WinHttpRequest
Private Login As Boolean
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()

Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Sub Form_Load()
FadeIN Me
Login = False
Option1.Enabled = False
Option2.Enabled = False
Option3.Enabled = False
End Sub
Private Sub Label1_Click()
If Login = False Then
If Text1.Text = "" Then MsgBox "아이디를 입력해주세요.", vbCritical, "로그인": Exit Sub
If Text2.Text = "" Then MsgBox "비밀번호를 입력해주세요.", vbCritical, "로그인": Exit Sub
If Text3.Text = "" Then MsgBox "카페주소를 입력해주세요.", vbCritical, "로그인": Exit Sub
WinHttp.Open "POST", "http://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 "id=" & Text1 & "&pw=" & Text2 & "&enctp=2&smart_level=-1"
If InStr(WinHttp.ResponseText, "sso/cross-domain.nhn") Then
WinHttp.Open "GET", "http://cafe.naver.com/" & Text3
WinHttp.Send

If InStr(StrConv(WinHttp.ResponseBody, vbUnicode), "카페 멤버만 보실 수") Or InStr(StrConv(WinHttp.ResponseBody, vbUnicode), "등록된 네이버 카페가 아닙니다") Then
MsgBox "카페에 가입되어 있지 않거나 존재하지 않습니다.", vbExclamation, "에러!"
Else
Label9.Caption = Split(Split(StrConv(WinHttp.ResponseBody, vbUnicode), "g_sClubId = """)(1), """;")(0)

WinHttp.Open "GET", "http://cafe.naver.com/MyCafeMyActivityAjax.nhn?clubid=" & Label9.Caption
WinHttp.Send

If InStr(WinHttp.ResponseText, "매니저") Or InStr(WinHttp.ResponseText, "스탭") Then
MsgBox "로그인에 성공하였습니다.", vbInformation, "로그인"
Text1.Enabled = False
Text2.Enabled = False
Text3.Enabled = False
Option1.Enabled = True
Option2.Enabled = True
Option3.Enabled = True
Label1.Enabled = False
Login = True
Else
MsgBox Text3.Text & " 카페에 관리 권한이 없습니다.", vbCritical, "관리 권한 없음"
End If
End If
Else
MsgBox "아이디 또는 비밀번호가 틀렸습니다.", vbExclamation, "에러!"
End If
Else
MsgBox "이미 로그인 중입니다.", vbCritical, "로그인"
End If
End Sub

Private Sub Command2_Click()
On Error Resume Next
If Text4.Text = "" Then MsgBox "금칙어를 입력해주세요.", vbCritical, "에러": Exit Sub
For i = 0 To List1.ListCount
If List1.List(i) = Text4.Text Then
List1.RemoveItem i
End If
Next i
List1.AddItem Text4.Text
Text4.Text = ""
Text4.SetFocus
End Sub
Private Sub Command3_Click()
If List1.ListIndex = -1 Then MsgBox "금칙어를 선택한 후에 제거해주세요.", vbCritical, "에러": Exit Sub
List1.RemoveItem List1.ListIndex
End Sub

Private Sub Command5_Click()
If Login = False Then MsgBox "로그인 중이 아닙니다. 로그인 먼저 해주세요.", vbInformation, "알림": Exit Sub

If Timer1.Enabled = False Then
If Text5.Text = "" Then
    MsgBox "카페 금칙어 관리가 시작되었습니다." & vbCrLf & vbCrLf & "삭제 주기가 입력되지 않으면 자동으로 5분으로 설정됩니다.", vbInformation, "알림"
    Text5.Text = 5
Else
    MsgBox "카페 금칙어 관리가 시작되었습니다.", vbInformation, "알림"
End If
Label10.Caption = 0
Timer1.Enabled = True
Else
    MsgBox "금칙어 관리가 중단되었습니다.", vbInformation, "중단"
    Timer1.Enabled = False
End If
End Sub

Private Sub Label2_Click()
FadeOUT Me
Unload Me
End Sub

Private Sub Label3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Dim lngReturnValue As Long

 If Button = 1 Then
  Call ReleaseCapture
  lngReturnValue = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
 End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
    Command2_Click
End If
End Sub

Function Jnumber(txtText As TextBox, KeyAscii As Integer)
Select Case KeyAscii
Case vbKey0 To vbKey9
Case vbKeyBack
If InStr(txtText, ".") Then KeyAscii = 0
Case Else
KeyAscii = 0
End Select
End Function

Private Sub Text5_KeyPress(KeyAscii As Integer)
Call Jnumber(Text5, KeyAscii)
End Sub

Private Sub Timer1_Timer()
If Label10.Caption <> 0 Then
Label10.Caption = Label10.Caption - 1
Else
Label10.Caption = Int(Text5.Text) * 60
pages = 1
ListView1.ListItems.Clear

WinHttp.Open "GET", "http://cafe.naver.com/ArticleList.nhn?search.clubid=" & Label9.Caption & "&search.questionTab=A&search.specialmenutype=&userDisplay=20&search.page=" & pages
WinHttp.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows; U; Windows NT 6.1; ko; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13"
WinHttp.Send

nick = Split(StrConv(WinHttp.ResponseBody, vbUnicode), "<div class=""article-board m-tcol-c"">")(1)
winrt = StrConv(WinHttp.ResponseBody, vbUnicode)

tmp = Split(winrt, "<a href=""/ArticleRead.nhn?clubid=")

For imea = 1 To UBound(tmp)
tmp2 = Split(tmp(imea), "")(0)
tmp2 = "A" & tmp2
L2 = Split(Split(tmp2, "articleid=")(1), "&")(0)

If InStr(tmp2, "onmouseover=""""") Then
L1 = Split(Split(tmp2, "class=""m-tcol-c"">")(1), "</a>")(0)
ListView1.ListItems.Add , , L2
ListView1.ListItems(ListView1.ListItems.Count).SubItems(1) = L1
Else
End If

Next imea

Nick2 = Split(nick, "onclick=""ui(event, '")

Nick2(a) = Nick2(a) & "A"

For a = 1 To UBound(Nick2)
ListView1.ListItems(a).SubItems(2) = Split(Nick2(a), "',")(0)
Next a
GetAllPosts (Label9.Caption)
End If
End Sub

Public Function GetAllPosts(CafeNum As String)
    Dim temp As String, i As Long, j As Long, PostNum() As String
    
    WinHttp.Open "GET", "http://cafe.naver.com/ArticleList.nhn?search.clubid=" & CafeNum & "&search.boardtype=L"
    WinHttp.Send
    WinHttp.WaitForResponse

    temp = StrConv(WinHttp.ResponseBody, vbUnicode)
    
    PostNum = Split(temp, ";boardtype=L&articleid=")
        For i = 1 To UBound(PostNum) Step 2
            PostNum(i) = Split(PostNum(i), "&")(0)
            WinHttp.Open "GET", "http://cafe.naver.com/ArticleRead.nhn?clubid=" & CafeNum & "&page=1&boardtype=L&articleid=" & PostNum(i) & "&referrerAllArticles=true"
            WinHttp.Send
            WinHttp.WaitForResponse
            temp = Split(StrConv(WinHttp.ResponseBody, vbUnicode), "<td class=""per-info-id")(0)
                For j = 1 To List1.ListCount
                   If InStr(temp, List1.List(j - 1)) Then
                        Text6.Text = Text6.Text & Now & " 금칙어가 발견되었습니다. (" & List1.List(j - 1) & ", " & PostNum(i) & ")" & vbCrLf
                        Call DelArticle(CafeNum, PostNum(i))
                        Exit For
                    End If
               Next j
        Next i
End Function

Public Function DelArticle(ClubID As String, ArticleNum As String)
WinHttp.Open "POST", "http://cafe.naver.com/ArticleDelete.nhn"
WinHttp.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
WinHttp.SetRequestHeader "Referer", "http://cafe.naver.com/ArticleRead.nhn?clubid=" & ClubID & "&page=1&boardtype=L&articleid=" & ArticleNum & "&referrerAllArticles=true"
WinHttp.Send "articleid=" & ArticleNum & "&page=1&boardtype=L&clubid=" & ClubID & "&referrerAllArticles=true"
End Function