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

'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