'====================================================================
' AJPapps - Max feeds tweak
' Линда Кайе 2011. Посвящается Ариэль
' 
' Сей скрипт поможет бороться со скупердяйством Internet Explorer и 
' Windows Live Mail. Он пробегает по всем лентам RSS, на которые 
' подписан текущий пользователь, и устанавливает для них хранение 
' максимального количества элементов. Для IE это 2500, а для WLM - 
' неограниченное количество. Отныне в активно обновляющихся лентах 
' не пропадёт ни чего!
' 
' • 8.05.2010
'   Первая версия ^^
' 
' • 31.05.2011
'   [+] Теперь можно задать не только максимальное значение, 
'       но и значение по умолчанию.
' 
'====================================================================
' Маленький копирайт
' 
' 1. Программа и исходный код распространяются бесплатно.
' 2. Вы имеете право распространять их на тех же условиях.
' 3. Вы не имеете права использовать имя автора после модификации 
'    исходного кода.
' 4. При этом желательно указывать ссылку на автора оригинальной 
'    версии исходного кода.
' 5. Вы не имеете права на платное распространение исходного кода, 
'    а также программных модулей, содержащих данный исходный код.
' 6. Программа и исходный код распространяются как есть. Автор не 
'    несёт ответственности за любые трагедии или несчастные случаи, 
'    вызванные использованием программы и исходного кода.
' 7. Для любого пункта данного соглашения может быть сделано 
'    исключение с разрешения автора программы.
' 8. По любым вопросам, связанным с данной программой, обращайтесь 
'    по адресу lindaoneesama@gmail.com
' 
' Загружено с http://purl.oclc.org/Linda_Kaioh/Homepage/
'====================================================================
Option Explicit

Const AppTitle = "AJPapps - Max feeds tweak"

Dim Feeds
Dim NewValue

On Error Resume Next

Set Feeds = CreateObject("Microsoft.FeedsManager")
If Err Then
  MsgBox "Не удалось создать объект управления подписками на RSS. " & _
         "Возможно, версия Internet Explorer ниже седьмой.", _
         vbCritical, AppTitle
  WScript.Quit
End If

Select Case MsgBox("Задать максимальное количество элементов в лентах?" & _
                   vbCrLf & vbCrlf & _
                   "Да - задать 2500 элементов." & vbCrLf & _
                   "Нет - задать 200 элементов (по умолчанию)." & vbCrLf & _
                   "Отмена - выход.", _
                   vbQuestion + vbYesNoCancel, AppTitle)
  Case vbYes
    NewValue = 0
  Case vbNo
    NewValue = 200
  Case vbCancel
    WScript.Quit
End Select

EnumFeedsInFolder Feeds.RootFolder
MsgBox "Готово ^_^v", vbInformation, AppTitle

'====================================================================
Private Sub EnumFeedsInFolder(ByVal FF)
  Dim FE
  Dim TMP
  Dim FD
  
  On Error Resume Next
  
  Set FE = FF.Feeds
  
  For TMP = 0 To FE.Count - 1
    Set FD = FE.Item(TMP)
    
    If FD.MaxItemCount <> NewValue Then FD.MaxItemCount = NewValue
    If Err.Number <> 0 Then
      MsgBox FD.Name & vbCrLf & vbCrLf & _
             "Не удалось обновить информацию о ленте. Возможно, " & _
             "в данный момент она обновляется.", vbExclamation, AppTitle
    End If
    
    Set FD = Nothing
  Next
  
  EnumFoldersInFolder FF
End Sub

Private Sub EnumFoldersInFolder(ByVal FF)
  Dim FE
  Dim TMP
  Dim FD
  
  On Error Resume Next
  
  Set FE = FF.Subfolders
  
  For TMP = 0 To FE.Count - 1
    EnumFeedsInFolder FE.Item(TMP)
  Next
End Sub