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