BECKHOFF/四车间/M779-10号车（已改）/BACK-C/Servicepacks/SystemSettings/dcs_dcom.vbs

Option Explicit
Dim wshshell,fso,i,Fnct
Dim strPath,strSystemFolder,strWinFolder,strTempFolder
'----------------------------- Objekte erzeugen --------------------------------
i = 0
On Error Resume Next
Do 
	err.Clear
	i = i+1
	Set wshshell = CreateObject("WScript.Shell")
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set Fnct = CreateObject("Install.Functions")
	WScript.Sleep 1000
Loop Until Err.Number = 0 OR i > 30

If Err.Number <> 0 Then
	WScript.Quit
End If

On Error Goto 0

'--------------------------- Standardpfade -------------------------------------
strPath = GetCurrentPath()
strSystemFolder = fso.GetSpecialFolder(1) & "\"
strWinFolder = fso.GetSpecialFolder(0) & "\"
strTempFolder = fso.GetSpecialFolder(2) & "\"


'------------------------------ Main -------------------------------------------
WriteToLog("Start")
Dim strDcsFolder, strComputerXml
strDcsFolder = ExpandPath("%FOCKEDCSDIR%","C:\FockeDcs") & "\"
strComputerXml = "c:\Computer.xml"


Dim Xml

Dim bComputerXmlFound
bComputerXmlFound = fso.FileExists(strComputerXml)

Dim strFockeTools
strFockeTools = ExpandPath("%FOCKETOOLSDIR%","C:\FockeTools") & "\"
Call wshshell.Run("regedit /s " & GetCurrentPath() & "fdcs_changes.reg",1,True)

Dim strDcsDir
strDcsDir = ExpandPath("%FOCKEDCSDIR%","C:\FockeDcs")
If fso.FileExists(strSystemFolder & "xcacls.exe") Then
	WriteToLog("xcacls " & strDcsDir & " /T /E /G Operator:F;F /Y")
	Call wshshell.Run("xcacls " & strDcsDir & " /T /E /G Operator:F;F /Y",0,True)
End If


If fso.FileExists(strFockeTools & "\fwprgadd.bat") Then
	Call wshshell.Run(strFockeTools & "\fwprgadd.bat " + """c:\Visiwin\VisiwinStudio\System\VweManager.exe"" VweManager",0,True)
	Call wshshell.Run(strFockeTools & "\fwportadd.bat " + "TCP 135 RPC_TCP all",0,True)
	
	'RPC-Einstellungen korrigieren
	Dim strInternetKey
	strInternetKey = "HKEY_LOCAL_MACHINE\Software\Microsoft\Rpc\Internet\"
	Dim strValue(5)
	strValue(0) = "HKEY_LOCAL_MACHINE\Software\Microsoft\Rpc\Internet\PortsInternetAvailable"
	strValue(1) = "HKEY_LOCAL_MACHINE\Software\Microsoft\Rpc\Internet\Ports"
	strValue(2) = "HKEY_LOCAL_MACHINE\Software\Microsoft\Rpc\Internet\UseInternetPorts"
	strValue(3) = "HKEY_LOCAL_MACHINE\Software\Microsoft\Rpc\Internet\"
	For i=0 To 3
		On Error Resume Next
			wshshell.RegDelete(strValue(i))
		Err.Clear
		On Error Goto 0
	Next
	'XML-Datei korrigieren
	If(bComputerXmlFound) Then
        Call RemoveUnnecessaryNodes()		
        Call ChangeDcsShares()
	End If
End If

WriteToLog("End")



'------------------------------- Funktionen ------------------------------------
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

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

Function KeyExists(p_strKey)
	Dim l_strTemp
	On Error Resume Next
	Err.Clear
	l_strTemp = wshshell.RegRead(p_strKey)
	If Err.Number <> 0 Then 
		KeyExists = False
	Else
		KeyExists = True
	End If
	On Error Goto 0
End Function

'----------------------------------- Sub --------------------------------------
Sub WriteToLog(p_strMessage)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8 
    Dim strLineToWrite
    strLineToWrite = WScript.ScriptName & " -- " & p_strMessage
    Dim strLogFile
    strLogFile = ExpandPath("%SERVICEPACK_LOG%","c:\fockeservicepack.log")
  ' msgbox sLine & LogFile
   Dim FileObject
   if fso.FileExists(strLogFile) then
       set FileObject = fso.OpenTextFile( strLogFile,ForAppending,false,0)
   else
       set FileObject = fso.OpenTextFile( strLogFile,ForWriting,  true,0)
   end if
   FileObject.WriteLine(strLineToWrite)
   FileObject.Close
   set FileObject=nothing   
End Sub

Sub OpenXml
    Set Xml = CreateObject("Msxml.DOMDocument")
    Dim strComputerXmlDoc
    Dim ComputerXmlFile
    Set ComputerXmlFile = fso.OpenTextFile(strComputerXml)
    strComputerXmlDoc = ComputerXmlFile.ReadAll()
    ComputerXmlFile.Close
    Call Xml.LoadXml(strComputerXmlDoc)
End Sub

Sub RemoveUnnecessaryNodes
    'Dokument lesen
    Call OpenXml()

    'Knoten l<>schen
    Dim bChanged
    bChanged = false
    Dim strNodes(3)
    strNodes(0) = "SysMgmt/RegistrySettings/DCOM_Availability"
    strNodes(1) = "SysMgmt/RegistrySettings/DCOM_Ports"
    strNodes(2) = "SysMgmt/RegistrySettings/DCOM_UsePorts"

    For i = 0 To 2
	    Dim Nodes
	    Set Nodes = Xml.SelectNodes(strNodes(i))
	    If(Nodes.Length > 0) Then
	        Nodes.RemoveAll()
	        bChanged = true
	    End If
	    Set Nodes = Nothing
    Next
    'Ergebnis speichern
    If bChanged Then
        Xml.Save(strComputerXml)
    End If
    Set Xml = Nothing
End Sub

Sub ChangeDcsShares
    'Dokument lesen
    Call OpenXml()

    'Problemknoten
    Dim strDcsNode
    strDcsNode = "SysMgmt/Shares/DCS"
    Dim DcsNodes
    Set DcsNodes = Xml.SelectNodes(strDcsNode)
    If DcsNodes.Length = 1 Then
        DcsNodes.RemoveAll()
        Dim NewXml
        Set NewXml = CreateObject("Msxml.DOMDocument")
        Dim NewNode,DCSNode,strNewNode
        strNewNode = _
            "<FockeDCS>" & vbCrLf & _
                "<Path>%FockeDCSDIR%</Path>" & vbCrLf & _
                "<Access>(A;OICI;GA;;;$PLC$)(A;OICI;GA;;;$Administrators$)(A;OICI;GA;;;$DCS$)</Access>" & vbCrLf & _
                "<MaxUses>-1</MaxUses>" & vbCrLf & _
                "<Remark>dcs folder</Remark>" & vbCrLf & _
            "</FockeDCS>"
        NewXml.LoadXml(strNewNode)
        Set NewNode = NewXml.SelectSingleNode("FockeDCS")
        Set DcsNode = Xml.SelectSingleNode("SysMgmt/Shares")
        DcsNode.AppendChild(NewNode)
        'Ergebnis speichern
        Xml.Save(strComputerXml)
        If fso.FileExists(strSystemFolder & "Netshare.exe") Then
	        Call wshshell.Run("Netshare " & strDcsDir & " FockeDcs PLC,Administrators,uDCS A,A,R",0,True)
        End If
    End If
    Set Xml = Nothing
End Sub