'Konfigurationsanpassungen für bestimmte Computertypen Option Explicit Dim wshshell,fso,i,Fnct Dim strPath,strSystemFolder,strWinFolder,strTempFolder '----------------------------- Objekte erzeugen -------------------------------- Set wshshell = CreateObjectSafely("WScript.Shell") Set fso = CreateObjectSafely("Scripting.FileSystemObject") Set Fnct = CreateObjectSafely("Install.Functions") '--------------------------- Standardpfade ------------------------------------- strPath = GetCurrentPath() strSystemFolder = fso.GetSpecialFolder(1) & "\" strWinFolder = fso.GetSpecialFolder(0) & "\" strTempFolder = fso.GetSpecialFolder(2) & "\" '------------------------------ Main ------------------------------------------- WriteToLog("Start") Dim strMaindir Dim strComputerIni strMaindir = ExpandPath("%Maindir%","c:\") strComputerIni = strMaindir & "Computer.ini" Dim strDocsAndSets strDocsAndSets = "C:\Documents and Settings\" Dim strSource Dim strTarget Dim strOptions strSource = """" & strDocsAndSets & "Focke\*.*""" strTarget = """" & strDocsAndSets & "Default User""" strOptions = "/s /I /R /Y" Call wshshell.run("Xcopy.exe " & strSource & " " & strTarget & " " & strOptions,0,True) Dim bFockeAdminFound Dim bAutologonFound bFockeAdminFound = fso.FolderExists(strDocsAndSets & "FockeAdmin") bAutologonFound = fso.FolderExists(strDocsAndSets & "Autologon") If Not KeyExists("HKEY_Current_User\Control Panel\Mouse") Then If bFockeAdminFound Then strRunas = strPath & "FockeRunAs.exe FockeAdmin !Gemini " & """" & strPath & "RegEntries.bat " & strPath & "ELO.reg" & """" Call wshshell.Run(strRunas,0,true) WScript.sleep 5000 End If If bAutologonFound Then strRunas = strPath & "FockeRunAs.exe Autologon -Pluto " & """" & strPath & "RegEntries.bat " & strPath & "ELO.reg" & """" Call wshshell.Run(strRunas,0,true) End If End If 'Anpassungen für bestimmte Computertypen ' ... Computer identifizieren Dim bIsCp6500 Dim bIsCP7503 Dim bIsC6140XP bIsCp6500 = Fnct.GetIniString("CD1_Setup","ComputerType",strComputerIni) = "CP6500-1003-0020" bIsCP7503 = Fnct.GetIniString("CD1_Setup","ComputerType",strComputerIni) = "CP7503-1002-0020" bIsC6140XP = Fnct.GetIniString("CD1_Setup","ComputerType",strComputerIni) = "CP6140 Spec2003 XPe/SP2" If bIsC6140XP Then ChangeNetworkNamesFor6140 End If If bIsCp6500 Or bIsCP7503 Or bIsC6140XP Then WriteToLog("ApplyingChanges") Dim strNtUserPreset strNtUserPreset = strPath & "ntuser.dat" strOptions = "/s /I /R /Y /h" Call wshshell.run("Xcopy.exe " & strNtUserPreset & " " & strTarget & " " & strOptions,0,true) Dim strRunas Dim strFilenameWithPath(4) strFilenameWithPath(0) = strPath & "LanguageBar.reg" strFilenameWithPath(1) = strPath & "Desktop.reg" strFilenameWithPath(2) = strPath & "FontFix.reg" For i=0 To 2 If bFockeAdminFound Then strRunas = strPath & "FockeRunAs.exe FockeAdmin !Gemini " & """" & strPath & "RegEntries.bat " & strFilenameWithPath(i) & """" Call wshshell.Run(strRunas,0,true) WScript.sleep 5000 End If If bAutologonFound Then strRunas = strPath & "FockeRunAs.exe Autologon -Pluto " & """" & strPath & "RegEntries.bat " & strFilenameWithPath(i) & """" Call wshshell.Run(strRunas,0,true) End If Next 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 'Hilfsfunktion zum Erzeugen von Objekten 'Ist die Erzeugung nicht möglich, wird das Skript beendet Function CreateObjectSafely(p_strObject) Dim i i = 0 On Error Resume Next Do err.Clear i = i+1 Set CreateObjectSafely = CreateObject(p_strObject) WScript.Sleep 1000 Loop Until Err.Number = 0 OR i > 30 If Err.Number <> 0 Then MsgBox "Unable to Create Object: " & p_strObject WScript.Quit End If On Error Goto 0 End Function 'Registry Schlüssel existiert 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 ChangeNetworkNamesFor6140 Dim cstrNetworkIni Dim l_nNetworkCount Dim l_nPosition cstrNetworkIni = strPath & "NetworkC6140XPe.ini" l_nNetworkCount = Fnct.GetIniString("NetworkCards","Cnt",cstrNetworkIni) For l_nPosition = 1 To l_nNetworkCount Dim strFunction,strLabel,strFunctionKey,strLabelKey strFunctionKey = "Function" & l_nPosition strLabelKey = "Label" & l_nPosition strFunction = Fnct.GetIniString("NetworkCards",strFunctionKey,cstrNetworkIni) strLabel = Fnct.GetIniString("NetworkCards",strLabelKey,cstrNetworkIni) Call Fnct.SetIniString("CD1_Setup",strFunction,strLabel,strComputerIni) Next End Sub