Attribute VB_Name = "basAutoRemove"
Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private sTwitterId   As String
Private sPassword  As String

Sub Main()

    On Error Resume Next

    Dim objHttp  As New MSXML2.XMLHTTP
    Dim objXML As New MSXML2.DOMDocument
    Dim objIDs  As New MSXML2.DOMDocument
    Dim cXmlRoot    As Collection
    Dim cIds        As Collection
    Dim vLoop       As Variant
    Dim sKey        As String
    
    Dim vFrendIds       As Variant
    Dim vFollowersIds   As Variant
    Dim fp          As Integer
    Dim fp2         As Integer
    
    Dim sReadBuf    As String
    Dim cSkipIds    As New Collection
    
    Dim cId As New Collection
    Dim sSkipFile   As String
    Dim vCommand    As Variant
    Dim yn  As Integer
    
    vCommand = GetCommandLine
    If UBound(vCommand) <> 2 Then
        sTwitterId = Trim$(InputBox("Twitterユーザー名を入力してください。", "ユーザ名の入力"))
        If sTwitterId = "" Then End
        
        sPassword = Trim$(InputBox("パスワードを入力してください。", "パスワードの入力"))
        If sPassword = "" Then End
    Else
        sTwitterId = vCommand(1)
        sPassword = vCommand(2)
    
    End If
    
    
    objHttp.open "GET", "http://twitter.com/friends/ids/" & sTwitterId & ".xml", False, sTwitterId, sPassword
    objHttp.send
    
    If objHttp.Status = 200 Then
        objXML.async = False
        objXML.loadXML objHttp.responseText
        Set cXmlRoot = ExpandXML(objXML)
        
        objIDs.async = False
        objIDs.loadXML cXmlRoot("ids")(1).xml
        vFrendIds = Split(objIDs.childNodes(0).Text, " ")
        
        objHttp.open "GET", "http://twitter.com/followers/ids/" & sTwitterId & ".xml", False, sTwitterId, sPassword
        objHttp.send
        If objHttp.Status = 200 Then
            objXML.async = False
            objXML.loadXML objHttp.responseText
            Set cXmlRoot = ExpandXML(objXML)
            objIDs.async = False
            objIDs.loadXML cXmlRoot("ids")(1).xml
            vFollowersIds = Split(objIDs.childNodes(0).Text, " ")
        Else
            End
        End If
    Else
        End
    End If
    
    On Error Resume Next
    sSkipFile = App.Path & "\SkipIds_" & sTwitterId & ".txt"
    fp = FreeFile
    If Dir(sSkipFile) <> "" Then
        Open sSkipFile For Input As #fp
        Do While Not EOF(fp)
            Line Input #fp, sReadBuf
            cSkipIds.Add sReadBuf
        Loop
        Close #fp
    End If
    For Each vLoop In vFrendIds
        cId.Add Key:="KEY:" & (vLoop), Item:=(vLoop)
    Next
    
    For Each vLoop In vFollowersIds
        cId.Remove "KEY:" & (vLoop)
    Next
    
    For Each vLoop In cSkipIds
        cId.Remove "KEY:" & (vLoop)
    Next
    
    
    fp = FreeFile
    Open App.Path & "\RemoveIds_" & sTwitterId & ".txt" For Append As #fp
    
    Print #fp, Now, "RemoveCount = " & cId.Count
    If cId.Count > 3 Then
        yn = MsgBox("リムーブしようとするidの数が" & cId.Count & "個あります。" & vbCrLf & "本当にリムーブしてもよろしいですか？", vbYesNo + vbDefaultButton2 + vbQuestion, "確認")
        If yn <> vbYes Then
            Close #fp
            End
        End If
    End If
    
    For Each vLoop In cId
    '
        objHttp.open "POST", "http://twitter.com/friendships/destroy/" & vLoop & ".xml", False, sTwitterId, sPassword
        objHttp.send

        
        Print #fp, Now, "(" & objHttp.Status & ")Remove", "http://twitter.com/statuses/user_timeline/" & vLoop & ".rss"
        If objHttp.Status = 404 Then
            fp2 = FreeFile
            Open sSkipFile For Append As #fp2
            Print #fp2, (vLoop)
            Close #fp2
        End If
    Next
    
    Close #fp
    If UBound(vCommand) <> 2 Then
        Shell "cmd /c start " & App.Path & "\RemoveIds_" & sTwitterId & ".txt"
    End If
    
   
    End
    
End Sub

'childNodes展開
Private Function ExpandXML(ByRef objData As Variant) As Collection
    Dim vLoop   As Variant
    Dim cRet    As New Collection
    For Each vLoop In objData.childNodes
        cRet.Add Key:=vLoop.baseName, Item:=Array(vLoop.baseName, vLoop)
    Next
    Set ExpandXML = cRet
End Function


Function GetCommandLine(Optional MaxArgs)
   ' 変数を宣言します。
   Dim C, CmdLine, CmdLnLen, InArg, i, NumArgs
   ' MaxArgs が提供されるかどうかを調べます。
   If IsMissing(MaxArgs) Then MaxArgs = 10
   ' 現在のサイズの配列にします。
   ReDim ArgArray(MaxArgs)
   NumArgs = 0: InArg = False
   ' コマンド ラインの引数を取得します。
   CmdLine = Command()
   CmdLnLen = Len(CmdLine)
   ' 同時にコマンド ラインの引数を取得します。
   For i = 1 To CmdLnLen
      C = Mid(CmdLine, i, 1)
      ' スペースまたはタブを調べます。
      If (C <> " " And C <> vbTab) Then
         ' スペースまたはタブのいずれでもありません。
         ' 既に引数の中ではないかどうかを調べます。
         If Not InArg Then
         ' 新しい引数が始まります。
         ' 引数が多すぎないかを調べます。
            If NumArgs = MaxArgs Then Exit For
               NumArgs = NumArgs + 1
               InArg = True
            End If
         ' 現在の引数に文字を追加します。
         ArgArray(NumArgs) = ArgArray(NumArgs) & C
      Else
         ' スペースまたはタブを見つけました。
         ' InArg フラグに False を設定します。
         InArg = False
      End If
   Next i
   ' 引数がすべて格納できるように配列のサイズを変更します。
   ReDim Preserve ArgArray(NumArgs)
   ' 関数名に配列を返します。
   GetCommandLine = ArgArray()
End Function

Private Sub Wait(iTime As Integer)
    Dim sNow As String
    sNow = Now
    Do While DateDiff("s", sNow, Now) < iTime
        Sleep 1
        DoEvents
    Loop
    

End Sub