'====================================================================
' AJPapps - Get Synthetic Garden picture
' Линда Кайе 2010. Посвящается Ариэль
' 
' Сей скрипт проверяет наличие новых картинок на сайте Synthetic 
' Garden и при необходимости качает их. Пока что там страница одна и 
' с картинками, поэтому скрипт работает. Будущее же у сайта весьма 
' туманно ^^
' 
' Каталог с картинками, имена файлов которых используются для 
' принятия решения о скачивании картинки с сайта, передаётся через 
' командную строку. Он должен быть заключён в кавычки (если содержит 
' пробелы) и должен существовать. Предыдущая версия скрипта 
' использовала для этого константу. Я решила сделать скрипт более 
' гибким и упразднила эту константу, но не что не мешает вам вернуть 
' её самостоятельно.
' 
' Для работы скрипта нужна библиотека CommonFunctions0300.DLL.
' Её можно установить с любой моей программой.
' 
' Лучше всего запланировать запуск скрипта в любом планировщике (даже 
' во встроенном).
' 
' • 28.04.2009 
'   Первая версия ^^
' 
' • 14.08.2009
'   [+] На странице ищутся все картинки, которые там есть.
' 
' • 15.04.2010
'   [-] Не во всех сообщениях выводился заголовок.
'   [-] Улучшила распознавание картинок на странице.
'   [-] Усилила обработку ошибок в DownloadPicture().
'   [+] Теперь каталог картинок передаётся как параметр.
' 
'====================================================================
' Маленький копирайт
' 
' 1. Программа и исходный код распространяются бесплатно.
' 2. Вы имеете право распространять их на тех же условиях.
' 3. Вы не имеете права использовать имя автора после модификации 
'    исходного кода.
' 4. При этом желательно указывать ссылку на автора оригинальной 
'    версии исходного кода.
' 5. Вы не имеете права на платное распространение исходного кода, 
'    а также программных модулей, содержащих данный исходный код.
' 6. Программа и исходный код распространяются как есть. Автор не 
'    несёт ответственности за любые трагедии или несчастные случаи, 
'    вызванные использованием программы и исходного кода.
' 7. Для любого пункта данного соглашения может быть сделано 
'    исключение с разрешения автора программы.
' 8. По любым вопросам, связанным с данной программой, обращайтесь 
'    по адресу lindaoneesama@gmail.com
' 
' Загружено с http://purl.oclc.org/Linda_Kaioh/Homepage/
'====================================================================
Option Explicit

Const AppTitle = "AJPapps - Get Synthetic Garden picture"
Const URL_BASE = "http://www.syntheticgarden.com/"

Const psatDirect = 1

'====================================================================
Dim HTR
Dim ajpMain
Dim Proxy
Dim RE
Dim MC
Dim URL
Dim FSO
Dim TS
Dim RC
Dim WshShell
Dim TMP

On Error Resume Next

' Пробуем создать объекты...
Set ajpMain = CreateObject("CmnFuncs0300.ajpMain")
If Err.Number <> 0 Then ajpMain.ErrorDisplay Err, , AppTitle, "Не удалось создать объект CmnFuncs0300.ajpMain.": WScript.Quit

Set HTR = CreateObject("CmnFuncs0300.ajpHTTPRequest")
If Err.Number <> 0 Then ajpMain.ErrorDisplay Err, , AppTitle, "Не удалось создать объект CmnFuncs0300.ajpHTTPRequest.": WScript.Quit

Set Proxy = CreateObject("CmnFuncs0300.ProxySettings")
If Err.Number <> 0 Then ajpMain.ErrorDisplay Err, , AppTitle, "Не удалось создать объект CmnFuncs0300.ProxySettings.": WScript.Quit

Set RE = CreateObject("VBScript.RegExp")
If Err.Number <> 0 Then ajpMain.ErrorDisplay Err, , AppTitle, "Не удалось создать объект VBScript_RegExp_55.RegExp.": WScript.Quit

Set FSO = CreateObject("Scripting.FileSystemObject")
If Err.Number <> 0 Then ajpMain.ErrorDisplay Err, , AppTitle, "Не удалось создать объект Scripting.FileSystemObject.": WScript.Quit

Set WshShell = CreateObject("WScript.Shell")
If Err.Number <> 0 Then ajpMain.ErrorDisplay Err, , AppTitle, "Не удалось создать объект WScript.Shell.": WScript.Quit

'====================================================================
Dim PicturesRoot

If WScript.Arguments.Count = 1 Then
  PicturesRoot = WScript.Arguments(0)
  
  If Not FSO.FolderExists(PicturesRoot) Then 
    MsgBox """" & PicturesRoot & """" & vbCrLf & vbCrLf & _
           "Каталог не существует.", vbCritical, AppTitle
    WScript.Quit
  End If
Else
  ShowUsage
End If

'====================================================================
' Минуем прокси, чтобы не нарваться на кэш.
Proxy.HTTP_AccessType = psatDirect
Set HTR.ProxySettings = Proxy

' Делаем запрос главной страницы, где будем искать картинку.
HTR.Execute "www.syntheticgarden.com", , , , , , , , , _
            AppTitle, , , True, True, True
If HTR.IsError Then
  ajpMain.ErrorDisplayHTTPRequest HTR, , AppTitle, "Не удалось загрузить стартовую страницу."
  WScript.Quit
End If

' Ищем картинку по регулярному выражению.
RE.Multiline = False
RE.Global = True
RE.Pattern = "src=""(http://www.syntheticgarden.com/)?(.*?)"""
Set MC = RE.Execute(HTR.ReceivedData)

' Вытаскиваем найденное. Если ни чего не нашлось, произойдёт
' ошибка, и переменная останется пустой....
For TMP = 0 To MC.Count - 1
  URL = MC(TMP).SubMatches(1)
  If URL = "" Then
    MsgBox "URL картинки #" & TMP & " не найден.", vbCritical, AppTitle
  Else
    If Left(URL, Len(URL_BASE)) = URL_BASE Then URL = Mid(URL, Len(URL_BASE))
    DownloadPicture URL, TMP, MC.Count
  End If
Next

'====================================================================
Sub DownloadPicture(ByVal URL, ByVal Index, ByVal Count)
  Dim FileName
  
  On Error Resume Next
  
  FileName = FSO.BuildPath(PicturesRoot, URL)
  
  ' По-тихому сворачиваемся, если файл уже есть...
  If FSO.FileExists(FileName) Then Exit Sub
  
  ' Качаем файл...
  HTR.Execute "www.syntheticgarden.com", , , "/" & URL, , , , , , _
              AppTitle, , , True, True, True
  If HTR.IsError Then
    ajpMain.ErrorDisplayHTTPRequest HTR, , AppTitle, "Не удалось загрузить картинку."
    Exit Sub
  End If
  
  ' Теперь сохраняем всё
  Set TS = FSO.CreateTextFile(FileName, True, False)
  TS.Write HTR.ReceivedData
  Set TS = Nothing
  
  If Err.Number <> 0 Then 
    ajpMain.ErrorDisplay Err, , AppTitle, _
                         FileName & vbCrLf & vbCrLf & _
                         "Не удалось сохранить файл."
    Exit Sub
  End If
  
  ' А теперь спрашиваем, нужно ли это показывать...
  RC = MsgBox("На сайте Synthetic Garden найдена новая картинка " & _
              "(" & URL & " :: " & CStr(Index + 1) & "/" & Count & "). " & _
              "Показать её?", vbQuestion + vbOKCancel, AppTitle)
  If RC = vbOK Then
    WshShell.Run """" & PictuturesRoot & URL & """"
    If Err.Number <> 0 Then 
      ajpMain.ErrorDisplay Err, , AppTitle, _
                           FileName & vbCrLf & vbCrLf & _
                           "Не удалось показать картинку."
    End If
  End If
End Sub

'====================================================================
Private Sub ShowUsage()
  MsgBox "Использование:" & vbCrLf & vbCrLf & _
         """Get Synthetic Garden Picture.VBS"" ""FolderForPictures""" & _
         vbCrLf & vbCrLf & _
         "Проверить наличие новых картинок на сайте Synthetic " & _
         "Garden. При этом имена картинок на сайте сравниваются с " & _
         "именами файлов в папке FolderForPictures. Имя папки " & _
         "FolderForPictures должно быть заключено в кавычки. " & _
         "Каталог должен существовать.", _
         vbInformation, AppTitle
  WScript.Quit
End Sub