'====================================================================
' AJPapps - Always on Their World
' Линда Кайе 2009. Посвящается Ариэль
' 
' Этот скрипт ни чего особенно полезного не делает. Он просто создаёт 
' видимость вашего присутствия на сайте. То есть это противоположность 
' невидимке - даже если вы далеко за городом на шашлыках в глухомани, 
' посетители будут думать, что вы в этот момент сидите за 
' компьютером и гуляете по Мирам.
' 
' Для работы скрипта нужна библиотека CommonFunctions0300.DLL.
' Её можно установить с любой моей программой.
' 
' Лучше всего запланировать запуск скрипта в любом планировщике (даже 
' во встроенном). При этом для начала стоит проверить параметры, 
' которые вы передаёте скрипту, а после того как всё пройдёт успешно, 
' передать WScript.EXE параметр //b, который будет блокировать 
' появление любых сообщений. Выглядеть это будет так:
' 
' WScript.EXE //b "H:\Always On Their World.VBS" abc mail.ru 123
' 
' • 23.08.2009
'   Первая версия ^^
' 
' • 24.08.2009
'   [-] Теперь в batch mode сообщения об ошибке WinInet не выдаются.
' 
'====================================================================
' Маленький копирайт
' 
' 1. Программа и исходный код распространяются бесплатно.
' 2. Вы имеете право распространять их на тех же условиях.
' 3. Вы не имеете права использовать имя автора после модификации 
'    исходного кода.
' 4. При этом желательно указывать ссылку на автора оригинальной 
'    версии исходного кода.
' 5. Вы не имеете права на платное распространение исходного кода, 
'    а также программных модулей, содержащих данный исходнй код.
' 6. Программа и исходный код распространяются как есть. Автор не 
'    несёт ответственности за любые трагедии или несчастные случаи, 
'    вызванные использованием программы и исходного кода.
' 7. Для любого пункта данного соглашения может быть сделано 
'    исключение с разрешения автора программы.
' 8. По любым вопросам, связанным с данной программой, обращайтесь 
'    по адресу lindaoneesama@gmail.com
' 
' Загружено с http://purl.oclc.org/Linda_Kaioh/Homepage/
'====================================================================
Option Explicit

Const AppTitle = "AJPapps - Always on Their World"
Const USER_AGENT = "AJPapps - Always on Their World"

Dim ajpMain
Set ajpMain = CreateObject("CmnFuncs0300.ajpMain")

Dim AllCookie
Dim Login
Dim Domain
Dim Password

If WScript.Arguments.Count <> 3 Then
  ShowUsage
  WScript.Quit
End If

Login = WScript.Arguments(0)
Domain = WScript.Arguments(1)
Password = WScript.Arguments(2)

LogonToBlogs

'====================================================================
Sub ShowUsage()
  MsgBox "Использование:" & vbCrLf & vbCrLf & _
         """Allways On Their World.VBS"" Login Domain Password" & vbCrLf & vbCrLf & _
         "Login - логин пользователя." & vbCrLf & _
         "Domain - домен пользователя (mail.ru, list.ru etc)" & vbCrLf & _
         "Password - пароль пользователя.", _
         vbInformation, AppTitle
End Sub

'====================================================================
Private Sub LogonToBlogs()
  Dim HTR 'As New ajpHTTPRequest
  Dim FB 'As New HTTPFormBuilder
  
  Set HTR = CreateObject("CmnFuncs0300.ajpHTTPRequest")
  Set FB = CreateObject("CmnFuncs0300.HTTPFormBuilder")
  
  AllCookie = ""
  
  FB.AddElement "page", "http://wap.my.mail.ru/mail/lindakaioh"
  FB.AddElement "Login", "usura-node-3369"
  FB.AddElement "Domain", "mail.ru"
  FB.AddElement "Password", "ZetarXawon4304"
  
  HTR.Execute "my.mail.ru", , "POST", "/cgi-bin/auth", , , _
              FB.Header, FB.FormData, , USER_AGENT, , _
              True, True, True, True
  If HTR.IsError And HTR.ResponseCode <> 302 Then
    If WScript.Interactive Then ajpMain.ErrorDisplayHTTPRequest HTR, , AppTitle
    Exit Sub
  ElseIf HTR.ResponseCode = 302 Then
    Dim Cookies 'As BStr
    Dim Location 'As BStr
    
    Cookies = GetCookies(HTR.CookiesOut)
    If Cookies = "" Then
      MsgBox "Cookie не получены. Продолжение не возможно.", vbCritical, AppTitle
      Exit Sub
    End If
    
    Location = GetLocation(HTR.HTTPResponse)
    If Location = "" Then
      MsgBox "Адрес переадресации не получен. Продолжение не возможно.", vbCritical, AppTitle
      Exit Sub
    End If
    
    Proceed302 Location, Cookies
  End If
End Sub

Private Sub Proceed302(ByVal Location__, _
                       ByVal Cookies__)
  Dim HTR 'As New ajpHTTPRequest
  Dim Address 'As BStr
  Dim Port 'As Long
  Dim ObjectName 'As BStr
  
  Set HTR = CreateObject("CmnFuncs0300.ajpHTTPRequest")
  MyCrackURL Location__, , Address, Port, ObjectName
  
  AllCookie = AllCookie & Cookies__
  HTR.CookiesIn = AllCookie
  
  HTR.Execute Address, Port, , ObjectName, , , , , , _
              USER_AGENT, , True, True, True, True
  If HTR.IsError And HTR.ResponseCode <> 302 Then
    If WScript.Interactive Then ajpMain.ErrorDisplayHTTPRequest HTR, , AppTitle
    Exit Sub
  ElseIf HTR.ResponseCode = 302 Then
    Dim Cookies 'As BStr
    Dim Location 'As BStr
    
    Cookies = GetCookies(HTR.CookiesOut)
    
    Location = GetLocation(HTR.HTTPResponse)
    If Location = "" Then
      MsgBox "Адрес переадресации не получен. Продолжение не возможно.", vbCritical, AppTitle
      Exit Sub
    End If
    
    Proceed302 Location, Cookies
  End If
End Sub

'====================================================================
Private Function GetCookies(ByVal CookiesOut)
  Dim RE 'As New RegExp
  Dim MC 'As MatchCollection
  Dim TMP 'As Long
  
  Set RE = New RegExp
  
  RE.Global = True
  RE.IgnoreCase = True
  RE.MultiLine = True
  RE.Pattern = "^(.*?);"
  
  Set MC = RE.Execute(CookiesOut)
  
  For TMP = 0 To MC.Count - 1
    If Right(Trim(MC(TMP).SubMatches(0)), 1) <> "=" Then
      GetCookies = GetCookies & MC(TMP).SubMatches(0) & "; "
    End If
  Next 'TMP
End Function

Private Function GetLocation(ByVal Response)
  Dim RE 'As New RegExp
  Dim MC 'As MatchCollection
  
  Set RE = New RegExp
  
  RE.Global = True
  RE.IgnoreCase = True
  RE.MultiLine = True
  RE.Pattern = "^Location: (.*?)$"
  
  Set MC = RE.Execute(Response)
  
  GetLocation = Trim(MC(0).SubMatches(0))
End Function

'====================================================================
Sub MyCrackURL(ByVal URL, _
               ByRef Dummy, _
               ByRef Address, _
               ByRef Port, _
               ByRef ObjectName)
  Dim RE 'As New RegExp
  Dim MC 'As MatchCollection
  
  Set RE = New RegExp
  
  RE.Global = True
  RE.IgnoreCase = True
  RE.MultiLine = False
  RE.Pattern = "http://(.*?)/(.*)"
  
  Set MC = RE.Execute(URL)
  
  Address = Trim(MC(0).SubMatches(0))
  Port = 80
  ObjectName = "/" & Trim(MC(0).SubMatches(1))
End Sub