Скрипт для установки платформы 1С

На предприятии около трехсот компов, на которых используется 1с 8.2 и 8.3, при этом домен отсутствует. Естественно приходится побегать при обновлении платформы 1с8. Применение скрипта облегчает этот процесс. Его нужно запускать только в нештатных ситуациях, когда по тем или иным причинам платформа не обновилась автоматом, а так же на всех новых машинках или после переустановки виндовс.

Скрипт написан на VBScript, для его работы больше ничего устанавливать не нужно, просто запустить двойным кликом мыши.

И так приступим.

Дистрибутивы платформы должны быть расположены на шаре \ВашИПШара8.2, \ВашИПШара8.3.

на данный момент у меня следующий набор платформ:

\МойИП1с8.28.2.19.106

\МойИП1с8.3win8.3.6.2041

\МойИП1с8.3win8.3.7.1776

\МойИП1с8.3win8.3.8.1784

Скрипт устанавливает самую большую версию из каждой папки 8.2 и 8.3

Ну и сам скрипт
 

Option Explicit
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

public lenlist,list()
lenlist = 0

on error resume next
install "\МойАйпи1c8.2" ' устанавливаем платформу из папки 8.2
if Err.Number > 0 then
install "\1МойАйпи21c8.2" ', если недоступен МойАйпи, устанавливаем из МойАйпи2
end if
install "\192.168.1.2481c8.3win" ' устанавливаем платформу из папки 8.3
if Err.Number > 0 then
install "\192.168.2.1481c8.3win"  ', если недоступен МойАйпи, устанавливаем из МойАйпи2
end if
on error goto 0

remove     'удаляем версии платформ, которые больше использоваться не будут
writesetting

function osverion
dim opSysSet, opSys
Set opSysSet = GetObject("winmgmts:{impersonationLevel=impersonate}//./root/cimv2")._
ExecQuery("SELECT * FROM Win32_OperatingSystem  WHERE Primary=true")
For Each opSys In OpSysSet
osverion = left(opSys.Version,instr(1,opSys.Version,".")-1)
Next
end function

Sub Install(Dir)

Dim Folder,fil

'On Error Resume Next

Set Folder = FSO.GetFolder(Dir)
Dim Version
Version = ""
For Each fil In Folder.SubFolders 'находим папку с наиболее старшей версией
Dim pos,curVersion
pos = InStrRev ( fil.Path, "")
curVersion = Right(fil.Path, Len(fil.Path)-pos)
if curVersion > Version then Version = curVersion
Next

Set fso = CreateObject("scripting.filesystemobject")
Dim ts,ReadTXTfile
Set ts = fso.OpenTextFile(Dir+Version+"setup.ini", 1, True)
Do While ts.AtEndOfStream<>True
ReadTXTfile = ts.ReadLine
pos = InStr ( ReadTXTfile, "=")
if pos > 0 Then
Dim Name
Name = Left(ReadTXTfile,pos-1)
if Name = "ProductCode" then
Dim Installer,ProductCode,msiPackage,CmdLine,Session
Set Installer = CreateObject("WindowsInstaller.Installer")
ProductCode = Right(ReadTXTfile, Len(ReadTXTfile)-pos)
'Set Session = Installer.OpenProduct (ProductCode)

Dim products : set products = installer.Products
Dim product,installed: installed = false
for each product in products
if product = ProductCode then
installed = True
end if
next

redim preserve list(lenlist)
list(lenlist) = ProductCode
lenlist = lenlist + 1

if not installed Then 'запускаем инсталятор только в том случае, когда платформа не устаналена
if Version < "8.3" Then
msiPackage = Dir+Version + "1CEnterprise 8.2.msi"
else
msiPackage = Dir+Version + "1CEnterprise 8.msi"
end if
cmdLine = "TRANSFORMS=adminstallrelogon.mst;1049.mst DESIGNERALLCLIENTS=0 DESIGNERALLCLIENTS=1 THICKCLIENT=1 THINCLIENTFILE=0 THINCLIENT=1 WEBSERVEREXT=0 SERVER=0 CONFREPOSSERVER=0 CONVERTER77=0 SERVERCLIENT=0 LANGUAGES=RU,UK"
'On Error Goto 0 CLIENT
'Installer.UILevel = 5
Installer.InstallProduct msiPackage,cmdLine : processError
end if
end if
end if
Loop
ts.Close

End Sub

Обработка ошибок
Sub processError()
Dim msg
If Err = 0 Then Exit Sub
msg = Err.Source & " " & Hex(Err) & ": " & Err.Description
WScript.Echo msg
WScript.Quit 2
End Sub

Sub Remove() 'удаление "лишних" версий платформ

Dim product,instprod

Dim msi , strProductName
Set msi = CreateObject("WindowsInstaller.Installer")

For each product in msi.Products
strProductName = msi.ProductInfo(product, "InstalledProductName")
if InStr(strProductName,"1C:Предприятие") > 0 then
redim preserve list(lenlist)
list(lenlist) = strProductName
lenlist= lenlist+ 1

Dim need,instproduct
need = false

for each instproduct in list
if instproduct = product then
need = true
exit for
end if
next

if not need then
'WScript.echo product
msi.ConfigureProduct product,0,2 'uninstall
end if
end if
next
End Sub


Sub writesetting

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim WshShell, fso, MyFile, FileName, TextLine,strComputer,objWMIService
Dim IPConfigSet,OK,IPConfig,DefaultIPGateway

Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
' Open the file for output.
'FileName = WshShell.ExpandEnvironmentStrings("%APPDATA%") + "1C1CEStart1CEStart.cfg"

'Set MyFile = fso.OpenTextFile(FileName, ForAppending, True, TristateTrue)

'MyFile.WriteLine "DistributiveLocation=\192.168.1.2481c8.2"
'MyFile.Close

'MsgBox osversion
'WScript.echo "osversion " + osversion
if StrComp(osversion,"5",vbTextCompare ) = 0 then
FileName = WshShell.ExpandEnvironmentStrings("%ALLUSERSPROFILE%") + "Application Data1C1CEStart1CEStart.cfg"
else
FileName = WshShell.ExpandEnvironmentStrings("%ALLUSERSPROFILE%") + "1C1CEStart1CEStart.cfg"
end if

'FileName = WshShell.ExpandEnvironmentStrings("%APPDATA%") + "1C1CEStart1CEStart.cfg"
'WScript.Echo filename
'WScript.echo FileName
on error resume next
Set MyFile = fso.OpenTextFile(FileName, ForAppending, True, TristateTrue)
if Err.Number > 0 then
if StrComp(osversion,"5",vbTextCompare ) = 0 then
FileName = WshShell.ExpandEnvironmentStrings("%APPDATA%") + "Application Data1C1CEStart1CEStart.cfg"
else
FileName = WshShell.ExpandEnvironmentStrings("%APPDATA%") + "1C1CEStart1CEStart.cfg"
end if
end if
on error goto 0
Set MyFile = fso.OpenTextFile(FileName, ForAppending, True, TristateTrue)

strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\" & strComputer & "
ootcimv2")

Set IPConfigSet = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")

OK = 0
For Each IPConfig in IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For Each DefaultIPGateway In IPConfig.DefaultIPGateway
msgbox DefaultIPGateway
If DefaultIPGateway = "192.168.1.1" Then
MyFile.WriteLine "DistributiveLocation=\192.168.1.2481c8.2"
MyFile.WriteLine "DistributiveLocation=\192.168.1.2481c8.3win"
OK = 1
Exit for
ElseIf DefaultIPGateway = "192.168.1.100" Then
MyFile.WriteLine "DistributiveLocation=\192.168.1.2481c8.2"
MyFile.WriteLine "DistributiveLocation=\192.168.1.2481c8.3win"
OK = 1
Exit for
ElseIf DefaultIPGateway = "192.168.12.20" Then
MyFile.WriteLine "DistributiveLocation=\192.168.12.101c8.2"
MyFile.WriteLine "DistributiveLocation=\192.168.12.101c8.3win"
OK = 1
Exit for
ElseIf DefaultIPGateway = "192.168.103.1" Then
MyFile.WriteLine "DistributiveLocation=\192.168.103.481c8.2"
MyFile.WriteLine "DistributiveLocation=\192.168.103.481c8.3win"
OK = 1
Exit for
ElseIf DefaultIPGateway = "192.168.2.1" Then
MyFile.WriteLine "DistributiveLocation=\192.168.2.1481c8.2"
MyFile.WriteLine "DistributiveLocation=\192.168.2.1481c8.3win"
OK = 1
Exit for
End If
Next
End If
Next

MyFile.Close

if OK = 1 then
MsgBox "OK"
else
MsgBox "адрес не определен"
end if

End Sub