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

' Setzen von Umgebungsvariablen 
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")

const strEnvironment = "Environment"
const nMaxEntries = 50
Dim Env_strVarName(50)
Dim Env_strPath(50)
Dim Env_bCreateFolderIfNotExists(50)
Dim Env_bOnlyIfFolderExists(50)
Dim Env_bNeverOverwrite(50)
Dim strIniFile
Dim strKeyName
Dim nCntEntries
strIniFile = strPath & "Environment.ini"

nCntEntries = Fnct.GetIniString(strEnvironment,"Cnt",strIniFile)
For i = 1 To nCntEntries
	strKeyName = "VarName" & i
	Env_strVarName(i-1) = Fnct.GetIniString(strEnvironment,strKeyName,strIniFile)
	strKeyName = "Path" & i
	Env_strPath(i-1) = Fnct.GetIniString(strEnvironment,strKeyName,strIniFile)
	Env_strPath(i-1) = Replace(Env_strPath(i-1),"{Lastdrive}",GetLastdrive())
	strKeyName = "CreateFolderIfNotexists" & i
	If Fnct.GetIniString(strEnvironment,strKeyName,strIniFile) = "1" Then
		Env_bCreateFolderIfNotExists(i-1) = True
	Else
		Env_bCreateFolderIfNotExists(i-1) = False
	End If
	strKeyName = "OnlyIfFolderExists" & i
	If Fnct.GetIniString(strEnvironment,strKeyName,strIniFile) = "1" Then
		Env_bOnlyIfFolderExists(i-1) = True
	Else
		Env_bOnlyIfFolderExists(i-1) = False
	End If
	strKeyName = "NeverOverwrite" & i
	If Fnct.GetIniString(strEnvironment,strKeyName,strIniFile) = "1" Then
		Env_bNeverOverwrite(i-1) = True
	Else
		Env_bNeverOverwrite(i-1) = False
	End If
Next

'Umgebungsvariablen setzen
const cstrEnvCurrentUser = "HKEY_CURRENT_USER\Environment\"
const cstrEnvGlobal = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\"



'Werte schreiben
Dim bCreateVar
Dim strCurrentValue
For i = 0 To nCntEntries-1
	'Muss der Ordner erstellt werden?
	bCreateVar = True
	If Env_bCreateFolderIfNotExists(i) Then
		CreateFolderIfNotExists(Env_strPath(i))
	End If
	
	'Muss der Ordner existieren?
	If Env_bOnlyIfFolderExists(i) Then
		bCreateVar = fso.FolderExists(Env_strPath(i))
	End If
	
	'D<>rfen vorhandene Werte <20>berschrieben werden?
	If Env_bNeverOverwrite(i) Then
		strCurrentValue = ""
		On Error Resume Next
		strCurrentValue = wshshell.RegRead(cstrEnvGlobal & Env_strVarName(i))
		err.Clear
		On Error Goto 0
		If(strCurrentValue <> "") Then
			bCreateVar = False
		End If
	End If

	'Schreiben
	Dim strLog
	If bCreateVar Then
		'Log Eintrag schreiben
		strLog = Env_strVarName(i) & " -> " & Env_strPath(i)
		If fso.FolderExists(Env_strPath(i)) Then
			strLog = strLog & " Exists"
		Else
			strLog = strLog & " Not found"
		End If
		WriteToLog(strLog)
		'Environment Variable schreiben
		On Error Resume Next
		Call wshshell.RegWrite(cstrEnvGlobal & Env_strVarName(i),Env_strPath(i))
		On Error Goto 0
		Call wshshell.RegWrite(cstrEnvCurrentUser & Env_strVarName(i),Env_strPath(i))
	Else
		'Log Eintrag schreiben
		strLog = "Skipped" & Env_strVarName(i)
		WriteToLog(strLog)
	End If
	
Next

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 GetLastdrive()
	Dim strResult
	strResult = "c:\"
	Dim Drives
	Dim Drive
	Set Drives = fso.Drives
	For Each Drive in Drives
		If Drive.DriveType=2 Then
			strResult = Drive
		End If
	Next
	GetLastdrive = strResult
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")
   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 CreateFolderIfNotExists(p_strFolder)
	Dim i
	If p_strFolder = "" Then
		Exit Sub
	End If
	For i=1 To Len(p_strFolder)
		If Mid(p_strFolder,i,1) = "\" Then
			If Not fso.FolderExists(Left(p_strFolder,i-1)) Then
				On Error Resume Next
				fso.CreateFolder(Left(p_strFolder,i-1))
				On Error Goto 0
			End If
		End If
	Next
	If Not fso.FolderExists(p_strFolder) Then
		On Error Resume Next
		fso.CreateFolder(p_strFolder)
		On Error Goto 0
	End If
End Sub