Проверяем актуальность версии СБИС оффлайн

Так получилось, что мне досталась внагрузку СБИС оффлайновая версии 2.4
Ну и приходится мониторить актуальность версии и регулярно ее обновлять.
Можно, конечно, каждое утро заходить на сайт СБИС в специальный раздел, но после трех раз эту задачу уже следует автоматизировать.
Вот Вам код сравнения актуальности Вашей СБИС и на сайте.
При необходимости корректируйте под Ваши нужды.
Для отправки почты используем старый добрый blat.
Сохраняем в sbis_ver_check.vbs, в эту же папку кладем blat, запускаем планировщиком или любым другим удобным способом.
На здоровье.

[code]On Error Resume Next

strNew=SbisNewVersion
strCur=SbisCurrentVersion

If strNew>strCur Then
'Wscript.Echo "Есть новая версия СБИС"
SendMail
'ElseIf strNew<strCur Then
' Wscript.Echo "Бред. У Вас версия новее, чем на сайте"
'Else
' Wscript.Echo "У Вас актуальная версия СБИС"
End If


Function SbisNewVersion
On Error Resume Next
strVersionCheck="https://sbis.ru/download?tab=ereport&innerTab=history"
a=GetText(strVersionCheck)
arr=Split(a,"<h2 class=" & chr(34) & "sbis_ru-header-h3" & chr(34) & ">")
If ubound(arr)<1 Then Wscript.Quit
b=arr(1)
i=Instr(1,b,"</h2>")
If i=0 Then Wscript.Quit
c=Ltrim(rtrim(Mid(b,1,i-1)))
If c="" Then Wscript.Quit
arrVer=Split(c," ")
strVer=arrVer(1)
SbisNewVersion=strVer
End Function

Function SbisCurrentVersion
On Error Resume Next
Set objFSO=Createobject("Scripting.Filesystemobject")
tmpVer=objFSO.GetFileVersion ("\\sbisserver\sbissharename\sbis.exe")
arrTmp=Split(tmpVer,".")
For j=0 to 2
Ver=Ver & arrTmp(j) & "."
Next
If Right(Ver,1)="." Then Ver=Left(Ver,Len(Ver)-1)
SbisCurrentVersion=Ver
End Function

Function GetText(strURL)
iTimeout=10
On Error Resume Next
GetText = ""
Set objXML = CreateObject("MSXML2.XMLHTTP")
objXML.Open "GET", strURL, False
objXML.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:77.0) Gecko/20100101 Firefox/77.0"
objXML.Send
x = Timer
Do
If Timer - x >= iTimeOut Then Exit Do
If objXML.ReadyState = 4 Then
If objXML.Status = 200 Then Exit Do
End If
Loop
strResult = objXML.ResponseText
GetText = strResult
End Function
Function FindText(strWhere, strFindStart, strFindEnd)
'
' Выделить кусок текста между выражениями strFindStart и strFindEnd в предоставленном тексте strWhere
'
On Error Resume Next
FindText=""
iFind=Instr(1,strWhere,strFindStart)
If iFind=0 Then Exit Function
iFindEnd=Instr(iFind +Len(strFindStart),strWhere,strFindEnd)
If iFindEnd<=iFind Then Exit Function
FindText=Mid(strWhere,iFind+len(strFindStart),iFindEnd-(iFind+len(strFindStart)))
End Function
Function GetPath
On Error Resume Next
arrPath=Split(Wscript.ScriptFullName,"\")
strPath=""
For i=0 to ubound(arrPath)-1
strPath=strPath & arrPath(i) & "\"
Next
strPath=Left(strPath,Len(strPath)-1)
GetPath=strPath
End Function
Sub SendMail
On Error Resume Next
Set objShell=Createobject("Wscript.Shell")
Set objFSO=Createobject("Scripting.Filesystemobject")
Set objFile=objFSO.OpenTextFile (GetPath & "\send.txt",2, True)
objFile.WriteLine "Добрый день." & vbcrlf & vbcrlf & "Ваша версия СБИС: " & strCur & vbcrlf & "Версия СБИС на сайте: " & strNew & vbcrlf & "Запланируйте обновление"
objFile.Close
strCmd=GetPath & "\blat.exe " & GetPath & "\send.txt -to recipient@domain.com -f sender@domain.com -u authsender@domain.com -pw P@s$W0rD -server mailserver.domain.com -charset windows-1251 -s " & chr(34) & "Новая версия СБИС" & chr(34)
objShell.Run strCmd,1,True
End Sub

[/code]