'Wiedreherstellungsroutine f. TWinCAT Build 727

Option Explicit
Dim wshshell
Dim MachineType(4)
Dim MachineNumber(4)
Dim FileName,SearchKey,SysMgrFilename,TsmFileName
Dim CmdLine
Dim RtsCount
Dim i,j
Dim Dlg
Dim fso,SysServer
Dim TWinCat
Dim key,TmpKey
Dim Fnct,TempFile,strTemp, strPath
Dim IpString
Const ComputerIni = "C:\Computer.ini"

'Konstanten für den Systemmanager
const TREEITEMTYPE_DEVICE = 2
const IODEVICETYPE_CP5412A2 = 7
const IODEVICETYPE_FC3100 = 38
const IODEVICETYPE_FC3100_SLAVE = 60

On Error Resume Next
i = 0
do
	WScript.Sleep 2000
	err.Clear
	set wshshell = CreateObject("WScript.Shell")
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set Fnct = CreateObject("Install.Functions")
	set SysServer = CreateObject("TcSystemSrv.TcSystemServer")
	i= i+1
Loop Until Err.Number = 0 Or i > 30

If err.Number <> 0 Then
	Set Dlg = CreateObject("Install.MessageDlg")
	Dlg.Caption = "End"
	Call Dlg.SetLine(0, "Error restoring TWinCAT!")
	Call Dlg.SetLine(0, "Unable to create objects!")
	Dlg.Show
	WScript.Quit
End If

On error Goto 0

strPath = GetCurrentPath()


Set TwinCat = CreateObject("Install.TWinCat")
If TWinCat.Started Then
   		If(wshshell.AppActivate("Busy!")) Then wshshell.SendKeys("%{F4}")
   		WScript.Sleep(1000)
   		Set Dlg = CreateObject("Install.MessageDlg")
   		Dlg.Caption = "End"
   		Call Dlg.SetLine(0, "Error restoring TWinCAT!")
   		Call Dlg.SetLine(1, "Stop TWinCat first (Icon must be red)!")
   		Call Dlg.SetLine(2, "TWinCAT-Restore will be terminated!")
   		Dlg.Show
		WScript.Quit
End If

Call wshshell.Run(strPath & "Warning.vbs")
WScript.Sleep(1000)

Call GetInputs

'-------------------- Anzahl der Laufzeitsysteme -------------------
Key = "HKEY_LOCAL_MACHINE\SOFTWARE\Beckhoff\TwinCAT\Plc\NumberOfRunTimeSystems"
wshshell.RegWrite key,RtsCount,"REG_DWORD"

strTemp = ExpandPath("%SAR_DIR%","c:\saveAndRestore")
Call wshshell.Run("""" & strTemp & "\TcRemoveBootSettings.vbs""",1,True)

'------ SPS-Projekte: Runtime-Port festlegen und neu kompilieren -------
Call wshshell.Run(strPath & "ServerBusy.vbs")

For i = 1 To RtsCount
	FileName = CreateFilename(MachineNumber(i),MachineType(i)) & ".pro"

	If Not fso.FileExists(FileName) Then
    		wshshell.AppActivate("Busy!")
    		wshshell.SendKeys("%{F4}")
    		WScript.Sleep(1000)
    		Set Dlg = CreateObject("Install.MessageDlg")
    		Dlg.Caption = "End"
    		Call Dlg.SetLine(0, "File not found!")
    		Call Dlg.SetLine(1, FileName)
    		Call Dlg.SetLine(2, "Execution will be terminated!")
    		Dlg.Show
		WScript.Quit
	End If

        Call DeleteAutoCreatedFiles(FileName)


	Set TempFile = fso.OpenTextFile("c:\SaveAndRestore\Rebuild.cmd")
	strTemp = TempFile.ReadAll()
	TempFile.Close

	strTemp = Replace(strTemp,"0.0.0.0.1.1:801",SysServer.AmsNetId & ":" &801 + ((i-1)*10))
	
	Set TempFile = fso.OpenTextFile(GetCurrentPath() & "Temp.cmd",2,true)
	Call TempFile.Write(strTemp)
	TempFile.Close

	CmdLine = "c:\TWinCat\Plc\TCatPlcCtrl.exe """ & FileName & """ /cmd " & GetCurrentPath() & "Temp.cmd"
	Call wshshell.Run(CmdLine,1,true)
	WScript.Sleep(1000)
	Call fso.DeleteFile(GetCurrentPath() & "Temp.cmd",True)
Next

SetupSysManager
'----------------------------------------------------------------------------------

For i = 1 To RtsCount
	FileName = CreateFilename(MachineNumber(i),MachineType(i)) & ".pro"

	CmdLine = "c:\TWinCat\Plc\TCatPlcCtrl.exe """ & FileName & """ /cmd c:\SaveAndRestore\TCatBoot.cmd"
	Call wshshell.Run(CmdLine,1,true)
	WScript.Sleep(1000)
Next
strTemp = ExpandPath("%SAR_DIR%","c:\saveAndRestore")
Call wshshell.Run("""" & strTemp & "\BootSettings.vbs""",1,True)
WScript.Sleep(3000)
wshshell.AppActivate("Busy!")
wshshell.SendKeys("%{F4}")
WScript.Sleep(1000)
'-------------------------------------------------------------------------------
Function GetCurrentPath()
	Dim l_strScriptName
	Dim l_strTemp

	l_strScriptName = WScript.ScriptFullName
	l_strTemp = WScript.ScriptName
	GetCurrentPath = Left(l_strScriptName, Len(l_strScriptName) - Len(l_strTemp))
End Function


Sub GetInputs
    Dim CompFile
    Dim i

	If Not fso.FileExists("c:\Computer.txt") And Not fso.FileExists(ComputerIni) Then
    		wshshell.AppActivate("Busy!")
    		wshshell.SendKeys("%{F4}")
    		WScript.Sleep(1000)
    		Set Dlg = CreateObject("Install.MessageDlg")
    		Dlg.Caption = "End"
    		Call Dlg.SetLine(0, "File not found!")
    		Call Dlg.SetLine(1, "c:\Computer.txt")
    		Call Dlg.SetLine(2, "Execution will be terminated!")
    		Dlg.Show
		WScript.Quit
	ElseIf fso.FileExists("c:\Computer.txt") Then
	    Set CompFile = fso.OpenTextFile("c:\Computer.txt", 1)
	    IPString = CompFile.ReadLine
	    RtsCount = CompFile.ReadLine
	    for i = 1 to RtsCount
	    	MachineType(i) = CompFile.ReadLine
	    	MachineNumber(i) = CompFile.ReadLine
	    next
	    CompFile.Close
	Else
		RtsCount = Fnct.GetIniString("CD1_Setup", "RtsCount", ComputerIni)
	    for i = 1 to RtsCount
	    	MachineType(i) = Fnct.GetIniString("CD1_Setup", "MachineType" & CStr(i), ComputerIni)
	    	MachineNumber(i) = Fnct.GetIniString("CD1_Setup", "MachineNumber" & CStr(i), ComputerIni)
	    next
	    IPString = Fnct.GetIniString("CD1_Setup", "TcpIp" & CStr(i), ComputerIni)
	End If
    IPString = "150.150.98." + IpString
end sub


Function CreateFileName(p_MachineNumber,p_MachineType)
	Dim l_FileName
	If IsNumeric(p_MachineNumber) Then
		l_FileName = "c:\Focke\M" + p_MachineType + "\" + p_MachineType + "e" + p_MachineNumber
		If Not fso.FileExists(l_FileName+".pro") Then
			l_FileName = "c:\Focke\M" + p_MachineType + "\" + p_MachineType + p_MachineNumber
		End If
	Else
    	l_FileName = "c:\Focke\M"  + p_MachineType + "\" + p_MachineNumber
	End If
	CreateFileName = l_FileName
End Function

Function CreateItemName(p_MachineNumber,p_MachineType)
	Dim l_FileName,l_ItemName
	If IsNumeric(p_MachineNumber) Then
		l_FileName = "c:\Focke\M" + p_MachineType + "\" + p_MachineType + "e" + p_MachineNumber
		l_ItemName = p_MachineType + "e" + p_MachineNumber
		If Not fso.FileExists(l_FileName+".pro") Then
			l_FileName = "c:\Focke\M" + p_MachineType + "\" + p_MachineType + p_MachineNumber
			l_ItemName = p_MachineType + p_MachineNumber
		End If
	Else
    	l_FileName = "c:\Focke\M"  + p_MachineType + "\" + p_MachineNumber
    	l_ItemName = p_MachineNumber
	End If
	CreateItemName = l_ItemName
End Function

Sub SetupSysManager
'---------------- System-Manager einstellen --------------------
	dim SysManagerItems 'Im system Manager eingetragene Geräte
	dim CurrentSysManagerDevice
	Dim SysManagerDevice
	Dim AInfo
	Dim m,n
	Dim TsmFileName,WsmFileName


	' Dateinamen erzeugen
	WsmFileName = CreateFileName(MachineNumber(1),MachineType(1)) +".wsm"
	TsmFileName = CreateFileName(MachineNumber(1),MachineType(1)) +".tsm"
	
	SysMgrFilename = ""
	If fso.FileExists(TsmFileName) Then SysMgrFilename = TsmFileName
	If fso.FileExists(WsmFileName) Then SysMgrFilename = WsmFileName

	If SysMgrFilename = "" Then
		wshshell.AppActivate("Busy!")
		wshshell.SendKeys("%{F4}")
		WScript.Sleep(1000)
		Set Dlg = CreateObject("Install.MessageDlg")
		Dlg.Caption = "End"
		Call Dlg.SetLine(0, "File not found!")
		Call Dlg.SetLine(1, SysMgrFilename)
		Call Dlg.SetLine(2, "Execution will be terminated!")
		Dlg.Show
		WScript.Quit
	End If

	
	'Projekte aktualisieren
	dim tsm
	On Error Resume Next
	Do
		Err.Clear
		set tsm = CreateObject("TCatSysManager.TcSysManager")
	Loop Until Err.Number = 0
	Err.Clear
	On Error Goto 0

    Call Special1334(tsm)

	Call wshshell.Run(strPath & "ExchangeProfibus.vbs " & SysMgrFilename,1,True)
	Call wshshell.Run(strPath & "SetAddresses.vbs " & SysMgrFilename,1,True)


	Call tsm.OpenConfiguration(SysMgrFilename)
	set SysManagerItems = tsm.LookupTreeItem("TIPC")
	i=1
	For Each SysManagerDevice In SysManagerItems
		FileName = CreateFileName(MachineNumber(i),MachineType(i)) + ".pro"
	    Set CurrentSysManagerDevice = SysManagerDevice
	    call CurrentSysManagerDevice.ConsumeXml("<TreeItem><PlcDef><ProjectPath>" & FileName & "</ProjectPath><ReScan>1</ReScan></PlcDef></TreeItem>")
	    call CurrentSysManagerDevice.ConsumeXml("<TreeItem><ItemName>" &  _
	    	CreateItemName(MachineNumber(i),MachineType(i)) & _
	    	"</ItemName></TreeItem>")
		i=i+1
	Next
	Set SysManagerItems = Nothing

	On Error Resume Next
	
	call tsm.ActivateConfiguration
	call tsm.StartRestartTwinCAT
	call tsm.SaveConfiguration(SysMgrFilename)

	i = 0
	do
		If wshshell.AppActivate("Server Busy") Then
			wshshell.SendKeys("%r")
		End If
		i = i+1
		WScript.Sleep(1000)
	loop until tsm.IsTwinCATStarted OR i > 30 OR err.number <> 0
	Set tsm = Nothing
	Set SysManagerDevice = Nothing
	Set CurrentSysManagerDevice = Nothing
	
	err.Clear
	On Error Goto 0
	If Not TWinCat.Started Then
		call wshshell.run(strPath & "SetAddressesManually.vbs " & SysMgrFilename,1,true)
		WScript.sleep(5000)
		set tsm = CreateObject("TCatSysManager.TcSysManager")
		Call tsm.OpenConfiguration(SysMgrFilename)
		call tsm.ActivateConfiguration
		On Error Resume Next
		err.Clear
		call tsm.StartRestartTwinCAT
		if err.number = 0 Then
		    call tsm.SaveConfiguration(SysMgrFilename)
		    i = 0
		    do
			    i = i+1
			    If wshshell.AppActivate("Server Busy") Then
				    wshshell.SendKeys("%r")
			    End If
			    WScript.Sleep(1000)
		    loop until tsm.IsTwinCATStarted OR i > 30 OR err.number <> 0
		End If
	End If
	If Not TWinCat.Started Then
			wshshell.AppActivate("Busy!")
			wshshell.SendKeys("%{F4}")
			WScript.Sleep(1000)
			Set Dlg = CreateObject("Install.MessageDlg")
			Dlg.Caption = "End"
			Call Dlg.SetLine(0, "Unable to start TwinCat!")
			Call Dlg.SetLine(1, "Execution will be terminated!")
			Dlg.Show
			WScript.Quit
	End If
	Set tsm = Nothing
	Set SysManagerDevice = Nothing
	Set CurrentSysManagerDevice = Nothing
End Sub

Function ExpandPath(p_strEnvironment,p_strDefault)
	Dim l_strTemp
	l_strTemp = wshshell.ExpandEnvironmentStrings(p_strEnvironment)
	If l_strTemp = p_strEnvironment Then
		l_strTemp = p_strDefault
	End If
	ExpandPath = l_strTemp
End Function


Sub DeleteAutoCreatedFiles(p_strFileName)
	Dim strFileNameWithoutExt
        Dim Extensions(10)
	strFileNameWithoutExt = Replace(FileName,".pro","")
    Extensions(0) = ".sym"
	Extensions(1) = ".sdb"
	Extensions(2) = ".tpy"
	Extensions(3) = "________r.ci"
	Extensions(4) = "________r.ri"
	Extensions(5) = ".bin"
	Extensions(6) = ".wbp"
        Dim i
	For i = 0 To 6
            strTemp = strFileNameWithoutExt & Extensions(i)
 	    On Error Resume Next
	    Call fso.Deletefile(strTemp)
            On Error Goto 0
        Next
End Sub

Sub Special1334(p_tsm)
    Dim SoftwareTxt
    Set SoftwareTxt = fso.OpenTextFile("c:\Software.txt")
    Dim strContent
    strContent = SoftwareTxt.ReadAll
    SoftwareTxt.Close
    If Instr(strContent,"TWinCAT1334") <> 0 Then
	    Call p_tsm.NewConfiguration()
	    call p_tsm.ActivateConfiguration
	    Call p_tsm.StartRestartTwinCAT()
	End If
End Sub