'=================================================
'For document history look at changelog.docx
'=================================================
Option Explicit

'----- Globale Variablen
Dim WSHShell, FSO, WSHNetwork, InstallDir, Computername, Parameter, LogName, Ret, ACVER, ASAPV, ASAPVER, LockScreenActive
Dim currentDir, LogDir, ProgramFiles, ProgramFiles64, WinDir, Temp
Dim DebugMode, LogEnabled
Dim pName, pVersion, pLang, pRevision

'----- Clients
Dim ASAP_7		: ASAP_7 = 0
Dim IDO_32 		: IDO_32 = 0
Dim C_IDO_32	: C_IDO_32 = 0
Dim ACB_32_O 	: ACB_32_O = 0
Dim AC1_32_O 	: AC1_32_O = 0
Dim AC2_32_O 	: AC2_32_O = 0
Dim C_IDO_64 	: C_IDO_64 = 0
Dim AC2_64_O 	: AC2_64_O = 0
Dim AC3_Alpha 	: AC3_Alpha = 0

Dim AC2_32_N 	: AC2_32_N = 0
Dim AC2_64_N 	: AC2_64_N = 0

Dim AC4_64_O 	: AC4_64_O = 0
Dim AC4_64_N 	: AC4_64_N = 0

'----- Objectdefinitionen
Set WSHShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSHNetwork = WScript.CreateObject("WScript.Network")

'----- Standardvariablen setzen
Computername = WshNetwork.ComputerName
If WScript.Arguments.Count=1 Then Parameter=WScript.Arguments(0)
ASAPV = ReadEnv("ASAPV")
ACVER = ReadEnv("ACVER")
ASAPVER = ReadEnv("ASAPVER")
Temp = ReadEnv("TEMP")
WinDir = ReadEnv("WINDIR")

If GetOSBit() = 64 Then
	ProgramFiles 	= ReadEnv("ProgramFiles(x86)")
	ProgramFiles64 	= ReadEnv("ProgramW6432")
	If ProgramFiles64 = False Then ProgramFiles64 = ReadEnv("ProgramFiles")
Else
	ProgramFiles = ReadEnv("ProgramFiles")
	ProgramFiles64 = ReadEnv("ProgramFiles")
End If

InstallDir = FSO.GetParentFolderName(WScript.ScriptFullName)
WSHShell.CurrentDirectory = InstallDir
currentDir = InstallDir

LogDir = ProgramFiles64 & "\Audi\InstLogs\"
LogName = LogDir & pName & "_" & pVersion & "_" & pLang & "_" & pRevision & ".log"

If LCase(Mid(Wscript.FullName, InstrRev(Wscript.FullName,"\")+1)) = "cscript.exe" Then
	DebugMode = True
End If
LogEnabled = True

ReDim errorList0(-1)

'*********************
'***** FUNCTIONS *****
'*********************

'----- Active Setup -----
'Description:	Creates an active setup
'Usage:			ActiveSetup()
'Output:		n/a
'------------------------
Function ActiveSetup()
	Dim Name : Name = pName & "_" & pVersion & "_" & pLang & "_" & pRevision
	Dim Pfad : Pfad = "wscript.exe ""c:\windows\sw-source\" & Name & "\ActiveSetup.vbs"" //B"
	Dim Version : Version = pVersion
	VbsLog "---------- Execute Active Setup Function: '" & Name & "' '" & Pfad & "' '" & Version & "'"
	If CheckFolder ("ActiveSetup") Then
		CreateFolder WinDir & "\SW-Source\" & Name
		CopyFile "ActiveSetup\*.*", WinDir & "\SW-Source\" & Name & "\"
		CopyFile ".\_Functions.vbs", WinDir & "\SW-Source\" & Name & "\"
	End If

	Version = Replace(Version,".",",")

	Ret = WriteReg ("REG_SZ", "HKLM\SOFTWARE\Microsoft\Active Setup\Installed Components\" & Name & "\", "ActiveSetup " & Name, GetOSBit())
	WriteReg "REG_SZ", "HKLM\SOFTWARE\Microsoft\Active Setup\Installed Components\" & Name & "\StubPath", Pfad, GetOSBit()
	WriteReg "REG_SZ", "HKLM\SOFTWARE\Microsoft\Active Setup\Installed Components\" & Name & "\Version", Version, GetOSBit()

	If Ret = True Then
		VbsLog "---------- RESULT ActiveSetup: OK"
	Else
		ErrorHandling 1,"---------- RESULT ActiveSetup: ERROR"
	End If
End Function


'----- Active Setup Remove (for Usage in _Uninstall.vbs) -----
'Description:	Removes an active setup
'Usage:			ActiveSetupRem()
'Output:		n/a
'------------------------
Function ActiveSetupRem()
	Dim Name : Name = pName & "_" & pVersion & "_" & pLang & "_" & pRevision
	DeleteReg "Key", "HKLM\SOFTWARE\Microsoft\Active Setup\Installed Components\" & Name, GetOSBit()
	DeleteFolder WinDir & "\SW-Source\" & Name
End Function


'----- Client Info -----
'Description:	Prints the ClientInfo and sets Client variables
'Usage:			ClientInfo()
'-----------------------
Sub ClientInfo()
	VbsLog "======================================================="
	VbsLog "  ClientInfo:"
	VbsLog "  Name:            " & computerName
	VbsLog "  OS-Version:      " & GetOSVersion()
	VbsLog "  ACVER:           " & ACVER
	VbsLog "  ASAPV:           " & ASAPV
	VbsLog "  ASAPVER:         " & ASAPVER
	VbsLog "  Client:          " & GetClientVersion()
	VbsLog "  Last boot time:  " & GetLastBootTime()
	VbsLog "  Reboot required: " & GetRebootStatus()
	VbsLog "  Manufacturer:    " & GetHardwareInfo("Manufacturer")
	VbsLog "  Model:           " & GetHardwareInfo("Model")
	VbsLog "  Location:        " & GetLocation()
	VbsLog "  User:            " & GetCurrentUser()
	VbsLog "======================================================="
End Sub

'----- Client Check -----
'Description:	Returns the client version, if version is valid; x if invalid
'Usage:			ClientCheck()
'-----------------------
Function ClientCheck()
	Dim strComputer, objWMIService, objItem, colItems
	Dim systype, objOS
	Dim clientVersion, i
	Dim arrClients

	clientVersion = "x"

	If(IDO_32 = 1)	 Then arrClients = arrClients + "i.Do1.X;"
	If(C_IDO_32 = 1) Then arrClients = arrClients + "C-i.Do.1.X 32 Bit;"
	If(C_IDO_64 = 1) Then arrClients = arrClients + "C-i.Do.1.X 64 Bit;"
	If(ACB_32_O = 1) Then arrClients = arrClients + "AC-B-32-O;"
	If(AC1_32_O = 1) Then arrClients = arrClients + "AC1-32-O;"
	If(AC2_32_O = 1) Then arrClients = arrClients + "AC2-32-O;"
	If(AC2_64_O = 1) Then arrClients = arrClients + "AC2-64-O;"
	If(AC3_Alpha = 1) Then arrClients = arrClients + "AC3-Alpha;"

	If(AC2_32_N = 1) Then arrClients = arrClients + "AC2-32-N;"
	If(AC2_64_N = 1) Then arrClients = arrClients + "AC2-64-N;"

	If(ASAP_7 = 1) 	Then arrClients = arrClients + "ASAP7.X;"

    If(AC4_64_O = 1) Then arrClients = arrClients + "AC4-64-O;"
    If(AC4_64_N = 1) Then arrClients = arrClients + "AC4-64-N;"


	arrClients = Split(arrClients, ";")

	clientVersion = GetClientVersion()

	For i = LBound(arrClients) To UBound(arrClients)-1
		If arrClients(i) = clientVersion Then
			ClientCheck = clientVersion
			Exit Function
		End If
	Next
	ErrorHandling 16010, ""
	FinishScript()
End Function

'----- Change Service -----
'Description:   Change Service startmode or state
'Usage:         ChangeService <ServiceName>, <Action>
'Output:		ErrorCode
'Example:       ChangeService "Spooler", "Restart"
'				ChangeService "Spooler", "Disabled"
'--------------------------------------
Function ChangeService(ServiceName, StartStop)
	Dim WantStarted, DesiredState, StartedStopped, ServiceDescr, Result
	Dim objWMIService, listOfServices, objService, WaitFor
	Result = 0
	Select Case LCase(StartStop) 
		Case "start"
			StartStop = "Start"
			StartedStopped = "started"
			WantStarted = True
			DesiredState = "Running"
		case "stop"
			StartStop = "Stop"
			StartedStopped = "stopped"
			WantStarted = False
			DesiredState = "Stopped"
		Case "manual"
			StartStop = "Manual"
			StartedStopped = "stopped"
			WantStarted = False
			DesiredState = "Stopped"
		Case "disabled"
			StartStop = "Disabled"
			StartedStopped = "stopped" 
			WantStarted = False
			DesiredState = "Stopped"
		Case "automatic", "auto"
			StartStop = "Auto"
			StartedStopped = "started"
			WantStarted = True
			DesiredState = "Running"
		Case "restart"
			ChangeService ServiceName, "stop"
			ChangeService ServiceName, "start"
			Exit function
		Case Else
			VbsLog "  Result: Failed - (Wrond Syntax) in Function:ChangeService"
			Exit Function
	End Select

	' get the service object
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
	Set listOfServices = objWMIService.ExecQuery("select * from Win32_Service where Name = '" & ServiceName & "'")

	If listOfServices.Count = 0 Then
		VbsLog "Information | Service '" & ServiceName & "' not found."
	Else 
		For Each objService In listOfServices
			ServiceDescr = "The " & objService.Name & " service"

			'DesiteState = Servicetype & Start or Stop
			If LCase(DesiredState) = LCase(objService.State) And (LCase(StartStop) = LCase("start") Or LCase(startStop) = LCase("stop")) Then
				VbsLog "Information | Change Service: " & ServiceDescr & " is already " & objService.State & "." 
				Exit Function
			End If

			'StartStop <> Manual & DesiredState = State & StartStop = Servicetyp
			If LCase(startStop) <> "manual" And LCase(DesiredState)= LCase(objService.State) And LCase(StartStop) = LCase(objService.StartMode) Then
				VbsLog "Information | Change Service: " & ServiceDescr & " is already " & objService.State & "."
				Exit Function
			End If			

			' change service startmode
			If StartStop = "Disabled" Then
				Result = objService.changestartmode("disabled")
			ElseIf StartStop = "Manual" Then
				Result = objService.changestartmode("manual")
			ElseIf StartStop = "Auto" Then
				Result = objService.changestartmode("automatic")
			End If

			'change service to manual if disabled and StartMode is start
			If LCase(StartStop) = lcase("Start") And LCase(objService.StartMode) = lcase("disabled") Then
				Result = objService.changestartmode("Manual")
				If Result = 0 Then
					VbsLog "Information | Change Service: " & ServiceDescr & " changed to manual"
				Else
					Errorhandling 1, "Change Service: " & objService.Name
				End If
			End If

			' start or stop service
			If WantStarted = True Then
				Result = objService.StartService()
			Else				
				Result = objService.StopService()
			End If

			' display success or failure message
			Select Case Result
				Case 0, 5, 10
					WaitFor = 60000 '60 seconds
					While WaitFor > 0
						WScript.Sleep(500) : WaitFor = WaitFor - 500 '0.5 seconds
						Set objService = objWMIService.Get("Win32_Service.Name='" & ServiceName & "'")

						'check objService.State / DesiredState (Running/Stopped)
						If LCase(DesiredState) = LCase(objService.State) Then 
							'check objService.StartMode / StartStop 
							'if value StartStop not: start / stop
							If Not LCase(StartStop) = "start" And Not LCase(StartStop) = "stop" And LCase(objService.startmode) = LCase(StartStop) Then 
								VbsLog "OK | Change Service: " & ServiceDescr & " " & StartedStopped
								VbsLog "OK | Change Service: " & ServiceDescr & " changed to " & StartStop
								Exit Function
							Else
								VbsLog "OK | Change Service: " & ServiceDescr & " " & StartedStopped
								If LCase(StartStop) = LCase("Disabled") Then
									VbsLog "OK | Change Service: " & ServiceDescr & " changed to " & StartStop
								End If
								Exit Function
							End If
						Else
							If WaitFor =< 1000 Then VbsLog "ERROR : Failed - in Function:ChangeService"
						End If
					Wend
				Case 2
					Errorhandling 2, "Change Service: " & ServiceDescr & _
					" can't be changed because the user did not have the necessary access"
				Case 3
					Errorhandling 3, "Change Service: " & ServiceDescr & _
					" can't be stopped because dependant services are running."
				Case Else
					Errorhandling Result, "Change Service: " & ServiceDescr & _
					" is in state " & objService.State & "."
			End Select
		Next
		ChangeService = Result
	End If
End Function

'----- Delete Service -----
'Description:   Delete Service
'Usage:         DeleteService <ServiceName>
'Output:		n/a
'Example:       DeleteService "Spooler"			
'--------------------------------------
Function DeleteService(ServiceName)
	Dim objWMIService,colListOfServices,objService
	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
	Set colListOfServices = objWMIService.ExecQuery("Select * from Win32_Service Where Name = '" & ServiceName & "'")
	
	If colListOfServices.Count = 0 Then
		VbsLog "Information | Delete Service (Service doesn't exist) [" & ServiceName & "]"
	Else
		For Each objService in colListOfServices
			objService.StopService()
			objService.Delete()
			VbsLog "OK | Service deleted: [" & ServiceName & "]"
		Next
	End If
End Function

'----- Check File -----
'Description:	Returns if file exists
'Usage:			CheckFile <Name>
'Output:		True / False
'Example:		CheckFile "c:\temp\text.txt"
'--------------------------
Function CheckFile(File)
	CheckFile = FSO.FileExists(File)
End Function

'----- Check Folder -----
'Description:	Returns if folder exists
'Usage:			CheckFolder <Name>
'Output:		True / False
'Example:		CheckFolder "c:\temp"
'--------------------------
Function CheckFolder(Folder)
	CheckFolder = FSO.FolderExists(Folder)
End Function

'----- Check Is Laptop -----
'Description:   Check if client is a Laptop
'Usage:         CheckIsLaptop()
'Output:		True or False
'Example:       CheckIsLaptop()
'-------------------------
Function CheckIsLaptop()
	Dim strComputer, objWMIService, colItems, objItem
	strComputer = "."
	On Error Resume Next
	Set objWMIService = GetObject( "winmgmts://" & strComputer & "/root/cimv2" )
	Set colItems = objWMIService.ExecQuery( "Select * from Win32_Battery", , 48 )
	CheckIsLaptop = False
	For Each objItem in colItems
		CheckIsLaptop = True
	Next
	If Err Then Err.Clear
	On Error Goto 0
End Function

'----- Check Process -----
'Description:	Checks if process(es) is/are running
'Usage:			CheckProc <Name>
'Output:		True / False
'Example:		CheckProc "ccmexec.exe,windword.exe"
'--------------------------
Function CheckProc(strProcess)
	Dim process,v,i
	
	CheckProc = False
	v=Split(strProcess,",")
	For i=0 To UBound(v)
		For Each process In GetObject("winmgmts://.").InstancesOf("win32_process")
			If UCase(Process.name) = UCase(Trim(v(i))) Then
				CheckProc = True
				Exit Function
			End If
		Next
	Next
End Function

'----- Check if Product installed -----
'Description:   Checks if a Product is installed
'Usage:         CheckProduct <ProductCode>
'Output:		TRUE if Product is installed
'Example:       CheckProduct "{B332732A-4958-41DD-B439-DDA2D32753C5}"
'--------------------------------------
Function CheckProduct(ProductCode)
	Dim objInstaller

	Set objInstaller = WScript.CreateObject("WindowsInstaller.Installer")
	ret = objInstaller.ProductState(ProductCode)
	If ret = 5 Then
		VbsLog "Installed: " & objInstaller.ProductInfo(ProductCode, "ProductName") & " (" & objInstaller.ProductInfo(ProductCode, "Publisher") & ") V" & objInstaller.ProductInfo(ProductCode, "VersionString")
		CheckProduct = True
	Else
		VbsLog "Product is NOT installed (" & ProductCode & ")"
		CheckProduct = False
	End If
End Function

'----- Runs commandline and logs into logfile -----
'Description:   Runs a commandline and logs its output into the logfile
'Usage:         CommandWithOutput <Command>,<Errorcodes>
'Output:		Exitcode
'Example:       CommandWithOutput "cmd /c dir c:\","0"
'--------------------------------------
Function CommandWithOutput(Command,Abbruch)
	Dim output,objWSH_Exec,i,v
	Const WSHRunning = &H0
	
	VbsLog "Execute CommandWithOutput Function: '" & Command & "' '" & Abbruch & "'"
	VbsLog "==========> Start CMD Command Output <=========="

	WshShell.CurrentDirectory = InstallDir
	Set objWSH_Exec = WshShell.Exec(command)

	With objWSH_Exec
		Do While .Status = WSHRunning
			Do Until objWSH_Exec.StdOut.AtEndOfStream
				output = objWSH_Exec.StdOut.ReadLine
				VbsLog Trim(output)
			Loop
		Loop	

		Ret = objWSH_Exec.ExitCode
		CommandWithOutput = Ret
		
		VbsLog "==========> End CMD Command Output <=========="

		If Abbruch = "" Then
			VbsLog "+ RESULT CommandWithOutput: OK | Accepting all ExitCodes [" & Ret & "]"
		Else
			v=Split(Abbruch,",")
			For i = LBound(v) To UBound(v)
				If StrComp(Ret,v(i)) = 0 Then
					VbsLog "+ RESULT CommandWithOutput: OK | Accepted ExitCode (" & v(i) & ", " & ErrorText(Ret) & " )"
					Exit Function
				End If
			Next
			VbsLog "+ RESULT CommandWithOutput: ERROR | ExitCode (" & Ret & ", " & ErrorText(Ret) & " )"
			ErrorHandling Ret,ErrorText(Ret)
			FinishScript()
		End If
	End With
End Function

'----- Copy File -----
'Description:	Copies File(s)
'Usage:			CopyFile <Source>, <Destination>
'Output:		True / False
'Example:		CopyFile "text.txt", "c:\temp\"
'				CopyFile "text.txt", "c:\temp\newtext.txt"
'--------------------------
Function CopyFile(Source,ByVal Dest)
	Dim FSO
	Set FSO = CreateObject("Scripting.FileSystemObject")
	On Error Resume Next
	FSO.CopyFile Source, Dest, True

	If Err.Number = 70 Then 
		If Right(Dest, 1) = "\" And InStr(Source, "*") = 0 Then
			If InStr(Source, "\") <> 0 Then
				Dest = Dest & Right(Source,Len(Source) - InStrRev(Source, "\"))
			Else
				Dest = Dest & Source
			End If
		End If
		Err.Clear
		Ret = FSO.GetFile(Dest).Attributes
		FSO.GetFile(Dest).Attributes = 0
		FSO.CopyFile Source, Dest, True
		FSO.GetFile(Dest).Attributes = Ret
	End If

	If Err.Number = 0 Then
		CopyFile = True
		VbsLog "OK | File copy: [" & source & "] --> [" & dest & "]"
	Else
		CopyFile = False
		ErrorHandling Err.Number, "File copy: (" & Err.Description & "): [" & source & "] --> [" & dest & "]"
	End If
	On Error Goto 0
End Function

'----- Copy Folder -----
'Description:	Copy Folder(s)
'Usage:			CopyFolder <Source>, <Destination>
'Output:		True / False
'Example:		CopyFolder "redist", "c:\temp\"
'-----------------------
Function CopyFolder(Source,Dest)
	Dim FSO
	Set FSO = CreateObject("Scripting.FileSystemObject")
	On Error Resume Next
	FSO.CopyFolder Source,Dest,True
	If Err.Number = 0 Then
		CopyFolder = True
		VbsLog "OK | Folder copy [" & source & "] --> [" & dest & "]"
	Else
		CopyFolder = False
		ErrorHandling Err.Number, "Folder copy (" & Err.Description & "): [" & source & "] --> [" & dest & "]"
	End If
	On Error Goto 0
End Function

'----- Copy Folder XCopy -----
'Description:	Copy Folder(s) via XCopy
'Usage:			CopyFolderX <Source>, <Destination>
'Output:		Returncode of xcopy.exe
'Example:		CopyFolderX "C:\Programme\", "D:\Programme"
'-----------------------
Function CopyFolderX(fs, dest)
	CreateFolder dest
	CopyFolderX = run ("XCopy","xcopy.exe """ & fs & """ """ & dest & """ /E /R /Y /Q", "")
End Function

'----- Create Folder -----
'Description:	Create Folder
'Usage:			CreateFolder <Name>
'Output:		True / False
'Example:		CreateFolder "c:\temp\newfolder"
'-------------------------
Function CreateFolder(ByVal folder)
	If Right(folder, 1) <> "\" Then folder = folder + "\"
	Dim fso, pointer, newFolder
	Set fso = CreateObject("Scripting.FileSystemObject")
	pointer=0
	On Error Resume Next
	If FSO.FolderExists(Folder) = True Then 
		VbsLog "Information | Function CreateFolder. Folder [" & folder & "] exist."
		CreateFolder = True
		On Error Goto 0
		Exit Function
	End If
	Do While pointer < Len(Folder)
		pointer = InStr(pointer + 1,folder, "\")
		newFolder = Left(folder, pointer)
		If Not fso.FolderExists(newFolder) Then FSO.CreateFolder(newFolder)
	Loop
	If Err.Number = 0 Then
		VbsLog "OK | Folder [" & folder & "] created."
		CreateFolder = True
	Else
		ErrorHandling Err.Number, "Folder not created: " & Err.Description
		CreateFolder = False
	End If
	On Error Goto 0
End Function

'----- Create ShortCut -----
'Description:	Create a shortcut
'Usage:			CreateShortCut <Dest.Path>, <Name>, <TargetPath>, <Icon>, <Args>
'Output:		True / False
'Example:		CreateShortcut "C:\...\Desktop", "ShortCutName", WinDir & "\System32\cmd.exe", "C:\Test.ico, 5", "-c"
'---------------------------
Function CreateShortcut(lnkDestPath, ByVal lnkName, lnkTargetPath, IconLocation, lnkArguments) 'Bsp: CreateShortcut AllUsersProfile & "\Desktop", "ShortCutName", WinDir & "\System32\cmd.exe", "C:\Test.ico", "-c"
	Dim oShellLink, lnkWorkingDirectory
	Dim f, i, strPath
	VbsLog "Execute CreateShortcut Function: '" & lnkDestPath & "' '" & lnkName & "' '" & lnkTargetPath & "' '" & IconLocation & "' '" & lnkArguments & "'"
	
	On Error Resume Next
	If Not Right(lnkTargetPath, 1) = "\" Then
		f = Split(lnkTargetPath, "\")
		If UBound(f) >= 1 Then
			For i = 0 To UBound(f)-1
				lnkWorkingDirectory = lnkWorkingDirectory & f(i) & "\"
			Next
		End If
	Else
		lnkWorkingDirectory = lnkTargetPath
	End If
	
	If Not Right(LCase(lnkname),4) = ".lnk" And Not Right(LCase(lnkName),4) = ".url" Then 
		lnkName = lnkName & ".lnk"
	End If
	
	If InStr(Right(LCase(IconLocation), 5),", ") = False Then IconLocation = IconLocation & ", 0"
	
	'Set WshShell = WScript.CreateObject("WScript.Shell")
	Set oShellLink = WshShell.CreateShortcut(lnkDestPath & "\" & lnkName)
	oShellLink.TargetPath = lnkTargetPath
	'oShellLink.WindowStyle = 1
	If Not Right(LCase(lnkName),4) = ".url" Then
		oShellLink.WorkingDirectory = lnkWorkingDirectory
		oShellLink.IconLocation = IconLocation
		oShellLink.Description = "Shortcut"
		oShellLink.Arguments = lnkArguments
	End If
	
	oShellLink.Save
	
	If Err.Number <> 0 Then
		ErrorHandling Err.Number, "+ RESULT CreateShortcut: ERROR " & Err.Number & ", " & Err.Description
		CreateShortcut = False
	Else
		VbsLog "+ RESULT CreateShortcut: OK"
		CreateShortcut = True
	End If
	
	On Error Goto 0
End Function

'----- Create Task -----
'Description:	Creates Task
'Usage:			CreateTask <Name>, <File to run>, <Schedule>
'Output:		True / False
'Example:		CreateTask "Taskname","c:\temp\name.exe","EINMAL"
'Parameter:		<Schedule>: MINUTE, STÜNDLICH, TÄGLICH, MONATLICH, EINMAL, BEIMSTART, BEIANMELDUNG, BEILEERLAUF
'-----------------------
Function CreateTask (name, file, plan)
	On Error Resume Next
	Dim strArgument

	If Left(GetOSVersion(), 1) > 5 Then	strArgument = " /F"

	Ret = WSHShell.Run ("schtasks.exe /create /tn """ & name & """ /tr """ & file & """ /sc " & plan & " /ru SYSTEM" & strArgument, 0, True)
	If Ret <> 0 Then
		CreateTask = False
		ErrorHandling Ret, "ERROR (" & Ret & ") | Task not created: [" & name & "] [" & file & "] [" & plan & "]"
	Else
		CreateTask = True
		VbsLog "OK | Task created: [" & name & "] [" & file & "] [" & plan & "]"
	End If
	On Error Goto 0
End Function

'----- Create Uninstall -----
'Description:	Creates Uninstall
'Usage:			CreateUninstall("<Softwarename>")
'Example:		CreateUninstall "MySoftware"
'----------------------------
Function CreateUninstall(Name)
	Dim v, strName, strPublisher, strVersion
	VbsLog "---------- Execute CreateUninstall Function: '" & Name & "'"
	v = Split(name, "_")
	Select Case UBound(v)
		Case 1,2 : strPublisher = v(0) : strName = v(1) : strVersion = pVersion
		Case Else
			v = Empty
			v = Split(pName, "_")
			If UBound(v) >= 1 Then
				strPublisher = v(0)		: strName = v(1)	: strVersion = pVersion : Name = pName
			Else
				strPublisher = pName	: strName = pName	: strVersion = pVersion : Name = pName
			End If
	End Select
	
	'CreateFolder WinDir & "\SW-Source\" & Name
	'CopyFile "_Uninstall.vbs", WinDir & "\SW-Source\" & Name & "\"
	'CopyFile "_Functions.vbs", WinDir & "\SW-Source\" & Name & "\"
	
	WriteReg "SZ"   ,"HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & Name & "\Displayname"    ,strName,32
	WriteReg "SZ"   ,"HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & Name & "\DisplayVersion" ,strVersion,32
	WriteReg "DWORD","HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & Name & "\NoModify"       ,1,32
	WriteReg "DWORD","HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & Name & "\NoRepair"       ,1,32
	WriteReg "DWORD","HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & Name & "\NoRemove"       ,1,32
	WriteReg "SZ"   ,"HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & Name & "\Publisher"      ,strPublisher,32
	WriteReg "SZ"   ,"HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & Name & "\UninstallString","wscript.exe """ & WINDIR & "\sw-source\" & Name & "\_Uninstall.vbs"" //B",32
	VbsLog "---------- RESULT CreateUninstall: OK"
End Function

'----- Delete File -----
'Description:	Deletes File(s)
'Usage:			DeleteFile <Name>
'Output:		True / False
'Example:		DeleteFile "c:\temp\text.txt"
'-----------------------
Function DeleteFile(File)
	On Error Resume Next
	FSO.DeleteFile File, True
	If Err.Number = 0 Then
		DeleteFile = True
		VbsLog "OK | File delete: [" & File & "]"
	ElseIf Err.Number = 53 Then
		DeleteFile = False
		VbsLog "Information | File delete (" & Err.Description & "): [" & File & "]"
	Else
		DeleteFile = False
		ErrorHandling Err.Number, "File delete: (" & Err.Description & ") [" & File & "]"
	End If
	On Error Goto 0
End Function

'----- Delete Folder -----
'Description:	Deletes Folder
'Usage:			DeleteFolder <Name>
'Output:		True / False
'Example:		DeleteFolder "c:\temp\test"
'-----------------------
Function DeleteFolder(Folder)
	On Error Resume Next
	If FSO.FolderExists(Folder) Then
		FSO.DeleteFolder Folder, True
		
		If Err.Number = 70 Then
			Err.Clear
			FSO.GetFolder(Folder).Attributes = 0
			FSO.DeleteFolder Folder, True
		End If
		If Err.Number = 0 Then
			DeleteFolder = True
			VbsLog "OK | Folder delete: [" & Folder & "]"
		Else
			DeleteFolder = False
			ErrorHandling Err.Number, "Folder delete: (" & Err.Description & "): [" & Folder & "]"
		End If
	Else
		DeleteFolder = False
		VbsLog "Information | Folder delete (Folder don't exist): [" & Folder & "]"
	End If
	On Error Goto 0
End Function

'----- Delete Folder 2 -----
'Description:	Deletes Folder
'Usage:			DeleteFolder2 <Name>, <Accepted ErrorCode>
'Output:		True / False
'Example:		DeleteFolder2 "C:\Temp\Testordner", "1,70"
'---------------------------
Function DeleteFolder2(Folder, AcceptedErrNr)
	Dim ErrNr, i, TempErr, TempErrDesc
	DeleteFolder2 = False
	If FSO.FolderExists(Folder) Then
		On Error Resume Next
		FSO.DeleteFolder Folder, True
		TempErr = Err.Number : TempErrDesc = Err.Description
		On Error Goto 0

		If TempErr = 0 Then
			DeleteFolder2 = True
			VbsLog "OK | Folder delete: [" & Folder & "]"
		Else
			ErrNr = Split(AcceptedErrNr, ",")
			If UBound(ErrNr) >= 0 Then
				For i = LBound(ErrNr) To UBound(ErrNr)
					If CInt(ErrNr(i)) = CInt(TempErr) Then
						VbsLog "Information | Folder delete accepted ExitCode (" & TempErr & "): (" & TempErrDesc & "): [" & Folder & "]"
						Exit Function
					End If
				Next
			End If
		End If
		ErrorHandling TempErr, "Folder delete: (" & TempErrDesc & "): [" & Folder & "]"
	Else
		VbsLog "Information | Folder delete (Folder don't exist): [" & Folder & "]"
	End If
End Function

'----- Delete Registry -----
'Description:	Deletes Registry values, keys
'Usage:			DeleteReg <Type>, <Registry Key>, <Hive>
'Output:		ErrorCode
'Example:		DeleteReg "KEY", "HKLM\Software\Testvalue", 64
'Parameters:	<Type>: KEY, VALUE
'---------------------------
Function DeleteReg (strRegType, key, hive)
	Dim strRootKey, strKey, strValueName, objCtx, objLocator, objReg, intReturnCode, rootKey, keys, i, OPName
	
	keys = Split(key,"\")
	strRootKey = keys(0)
	For i = 1 To UBound(keys)
		strKey = strKey + keys(i) + "\"
	Next
	strValueName = keys(UBound(keys))
	
	Select Case UCase(strRootKey)
		Case "HKCR", "HKEY_CLASSES_ROOT"
		rootKey = &h80000000
		Case "HKCU", "HKEY_CURRENT_USER"
		rootKey = &h80000001
		Case "HKLM", "HKEY_LOCAL_MACHINE"
		rootKey = &h80000002
		Case "HKU", "HKEY_USERS"
		rootKey = &h80000003
		Case "HKCC", "HKEY_CURRENT_CONFIG"
		rootKey = &h80000005
	End Select

	Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
	objCtx.Add "__ProviderArchitecture", hive
	Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
	Set objReg = objLocator.ConnectServer("", "root\default", "", "", , , , objCtx).Get("StdRegProv")

	If UCase(strRegType) = "KEY" Then
		OPName = "Delete Key"
		Dim iRC,SubKeys,sKey
		iRC = objReg.EnumKey (rootKey, strKey, SubKeys)
		
		If iRC = 0 Then
			If Not IsNull(SubKeys) Then
				For Each sKey In SubKeys
					DeleteReg "Key",strRootKey & "\" & strKey & sKey, hive
				Next
			End If
			intReturnCode = objReg.DeleteKey (rootKey, strKey)
		Else
			intReturnCode = objReg.DeleteKey (rootKey, strKey)
		End If
	End If

	If UCase(strRegType) = "VALUE" Then
		OPName = "Delete Value"
		strKey = Mid(key, Len(keys(0)) + 2, Len(key) - Len(keys(UBound(keys))) - Len(keys(0)) - 2)
		strValueName = keys(UBound(keys))
		intReturnCode = objReg.DeleteValue(rootKey,strKey,strValueName,"")
	End If
	DeleteReg = intReturnCode
	If intReturnCode = 0 Then
		VbsLog "OK | " & OPName & " [(" & hive & ") " & key & "]"
	ElseIf intReturnCode = 2 Then
		VbsLog "Information (" & intReturnCode & ") | " & OPName & ": Value not found [(" & hive & ") " & key & "]"
	Else
		ErrorHandling intReturnCode, OPName & ": [(" & hive & ") " & key & "]"
	End If
End Function

'----- Delete Task -----
'Description:	Deletes a task
'Usage:			DeleteTask <Name>
'Output:		True / False
'Example:		DeleteTask "Testtask"
'---------------------------
Function DeleteTask(name)
	On Error Resume Next
	If Left(GetOSVersion(), 1) < 6 Then
		ReDim arrTaskName(-1)
		Dim oExec, x, i, output

		Set oExec = WshShell.Exec("cmd /C schtasks.exe /Query /nh /fo csv")

		Ret = 1
		Do Until oExec.StdOut.AtEndOfStream
			output = oExec.StdOut.ReadLine
			If Len(output) > 1 And InStr(1, output, ",",1) <> 0 then
				x = Split(output, ",")
				ReDim preserve arrTaskName(Ubound(arrTaskName) + 1)
				arrTaskName(UBound(arrTaskName)) = x(0)
			End If
		Loop
 
		For i = LBound(Arrtaskname) To UBound(arrTaskName)
			If LCase(Replace(arrTaskName(i),"""", "")) = LCase(name) Then 
				Ret = 0
			End If
		Next
	Else	
		Ret = WSHShell.Run ("schtasks.exe /QUERY /TN """ & name & """", 0, True)
	End If
		VbsLog "TaskCommand = schtasks.exe /QUERY /TN """ & name & """ = "&Ret
	If Ret <> 0 Then
		VbsLog "Information | Delete Task (Task don't exist) [" & name & "]"
		DeleteTask = False : Err.Clear
		Exit Function
	End If
	Ret = WSHShell.Run ("schtasks.exe /Delete /TN """ & name & """ /f", 0, True)
	If ret <> 0 Then
		DeleteTask = False
		ErrorHandling ret, "Task delete: [" & name & "]"
	Else
		DeleteTask = True
		VbsLog "OK | Task delete: [" & name & "]"
	End If
	On Error Goto 0
End Function

'----- Delete Uninstall -----
'Description:	Deletes Uninstall in 32Bit-hive
'Usage:			DeleteUninstall("<Softwarename>")
'Example:		DeleteUninstall "MySoftware"
'----------------------------
Function DeleteUninstall(Name)
	If Name = "" Then Name = pName
	DeleteReg "KEY","HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & Name,32
End Function


'----- Delete Uninstall 64-----
'Description:	Deletes Uninstall in 64Bit-hive
'Usage:			DeleteUninstall64("<Softwarename>")
'Example:		DeleteUninstall64 "MySoftware"
'----------------------------
Function DeleteUninstall64(Name)
	If Name = "" Then Name = pName
	DeleteReg "KEY","HKLM\Software\Microsoft\Windows\CurrentVersion\Uninstall\" & Name,64
End Function


'----- ErrorHandling -----
' Function: 	ErrorHandling
' Input:		errorCode
' Description:	Collects error codes
'**********************************************************************
Sub ErrorHandling(errorCode,errorDescription)
	If InStr(errorCode, "0") = 1 Then Exit Sub
	If errorDescription = Empty Then ErrorDescription = ErrorText(errorCode)
	VbsLog "ERROR (" & errorCode & ") | " & ErrorDescription
	ReDim preserve errorList0(Ubound(errorList0) + 1)
	errorList0(UBound(errorList0)) = errorCode
End Sub


'----- Error Text -----
'Description:	Returns Errortext
'Usage:			ErrorText <Number>
'Example:		ErrorName = ErrorText (3010)
'---------------------------
Function ErrorText(number)
	If CheckFile("ErrorHandling.xml") Then
		ErrorText = XMLErrordescription(number)
		If ErrorText = "" Then ErrorText = "<unknown Error>"
	Else
		Select Case number
			Case "0" ErrorText="OK"
			Case "1" ErrorText="Unspecific error occured"
			Case "999"  ErrorText="User info screen canceled by user."
			Case "1601" ErrorText="The Windows Installer service could not be accessed."
			Case "1603" ErrorText="Fatal error during installation."
			Case "1605" ErrorText="This action is only valid for products that are currently installed."
			Case "1618" ErrorText="Another installation is already in progress."
			Case "1619" ErrorText="This installation package could not be opened."
			Case "1624" ErrorText="Error applying transforms."
			Case "1641" ErrorText="The installer has started a reboot."
			Case "1642" ErrorText="The installer cannot install the upgrade patch because the program being upgraded may be missing, or the upgrade patch updates a different version of the program."
			Case "3010" ErrorText="A restart is required to complete the install."
			Case "5100" ErrorText="Restart required before installation can start."
			Case "16005" ErrorText="Not by software-deployment installed and by Client Management I/FP-94 predetermined Version."
			Case "16010" ErrorText="Audi Client not supported."
			Case Else ErrorText="<unknown Error>"
		End Select
	End If
End Function

'----- Finish Script -----
'Description:	Script-Finish-Wrapper
'Usage:			FinishScript()
'Example:		FinishScript()
'---------------------------
Function FinishScript()
	Dim errorItem, failed, v, strFinish
	failed = 0
	VbsLog "======================================================="
	For Each errorItem In errorList0
		VbsLog "= ERROR: " & errorItem
		If failed = 0 Then
			failed = errorItem
		Else
			failed = 1
		End If
	Next

	strFinish = "Installation"
	If InStr(UCase(WScript.ScriptName),"UNINSTALL") > 0 Then
		strFinish = "Deinstallation"
	End If

	If failed <> 0 Or Err <> 0 Then
		VbsLog "= " & pName & " " & pVersion & " " & strFinish & " FAILED"
		VbsLog "======================================================="
		WScript.Quit(failed)
	Else
		VbsLog "= " & pName & " " & pVersion & " " & strFinish & " SUCCEEDED"
		VbsLog "======================================================="
		WScript.Quit(0)
	End If
End Function

'----- FreeSpace Script -----
'Description:	Free Space on Drive
'Usage:			FreeSpace <Drive>
'Example:		FreeSpace "c:"
'Returns:		Free space in MB
'---------------------------
Function FreeSpace(drv)
	Dim drive,fso
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set drive = fso.GetDrive(drv)
	FreeSpace = Round(drive.FreeSpace/1024/1024)
End Function

'----- Get Client Version -----
'Description:	Returns the Audi-Client-Version
'Usage:			GetClientVersion()
'Output:		ClientVersion
'Example:		ClientVersion = GetClientVersion()
'------------------------------
Function GetClientVersion()
	Dim clientVersion : clientVersion = "unknown"

	If GetOSBit() = 64 And Left(GetOSVersion(), 3) = "6.3" Then
		clientVersion = "AC3-Alpha"
		GetClientVersion = clientVersion
		Exit Function
	End If

	If ACVER = Empty Then 
		GetClientVersion = "unknown"
		Exit Function
	End If

	Select Case Mid(ACVER, 3, 2)
		Case 99 : clientVersion = "ASAP6.X"
		Case 98 : clientVersion = "ASAP7.X"
		Case 97 : clientVersion = "i.Do1.X"
		Case 96 : clientVersion = "C-i.Do.1.X 32 Bit"
		Case 95 : clientVersion = "C-i.Do.1.X 64 Bit"
		Case 94 : clientVersion = "AC1-32-O"
		Case 93 : clientVersion = "MED-V auf Basis AC-B-32-N"
		
		Case 11 : clientVersion = "AC4-64-N"
		Case 10	: clientVersion = "AC4-64-O" 	
		
		Case 06 : clientVersion = "AC-B-32-N"
		Case 05 : clientVersion = "AC-B-32-O"
		Case 04 : clientVersion = "AC2-64-N"
		Case 03 : clientVersion = "AC2-64-O"
		Case 02 : clientVersion = "AC2-32-N"
		Case 01 : clientVersion = "AC2-32-O"
		case else : clientVersion = "unknown"
	End Select
	
	GetClientVersion = clientVersion
End Function

'----- Get Current User -----
'Description:	Returns if the currently logged on user
'Usage:			GetCurrentUser()
'Output:		Domain\User
'Example:		CurrentUser  = GetCurrentUser()
'----------------------------
Function GetCurrentUser()
	Dim strComputer, objWMIService, colItems, objItem
	Dim tempLastUseTime, tempSID
	On Error Resume Next
	strComputer = "."
	GetCurrentUser = ""

	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
	Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem",,48)
	For Each objItem In colItems
		GetCurrentUser = objItem.UserName
	Next
	On Error Goto 0
End Function

'----- Get Current User SID -----
'Description:	Returns the SID of the currently logged on user
'Usage:			GetCurrentUserSID()
'Output:		SID
'Example:		CurrentUserSID  = GetCurrentUserSID()
'--------------------------------
Function GetCurrentUserSID()
	Dim strComputer, objWMIService, colItems, objItem
	Dim tempLastUseTime, tempSID
	On Error Resume Next
	strComputer = "."
	GetCurrentUserSID = ""
	tempSID = ""

	' Part 1 (1st Try)
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
	Set colItems = objWMIService.ExecQuery( _
	"SELECT * FROM Win32_UserProfile WHERE Loaded = 1 And Special = 0",,48)
	For Each objItem In colItems 
		If Left(objItem.SID, 8) = "S-1-5-21" And Not Left(Right(objItem.SID, 4), 1) = "-" Then
			If objItem.LastUseTime > tempLastUseTime Then
				tempLastUseTime = objItem.LastUseTime
				GetCurrentUserSID = objItem.SID
				tempSID = objItem.SID
			End If
		End If
	Next
	Err.Clear

	If Len(tempSID) > 0 Then 
		GetCurrentUserSID = tempSID
		On Error Goto 0
		Exit Function
	End If

	' Part 2 (2nd Try)
	Dim user, objAccount

	Set colItems = objWMIService.ExecQuery("Select UserName from Win32_ComputerSystem",,48)
	For Each objItem In colItems
		user = Split(objItem.UserName, "\")
	Next

	If UBound(user) > 0 Then
		Set colItems = objWMIService.ExecQuery( _
		"SELECT * FROM Win32_UserAccount WHERE Name='" + user(1) + " And Domain='" + user(0) + "'",,48)

		Set objAccount = objWMIService.Get("Win32_UserAccount.Name='" & user(1) & _
		"',Domain='" & User(0) & "'")
		tempSID = objAccount.SID

		If Len(tempSID) > 0 Then
			GetCurrentUserSID = tempSID
			On Error Goto 0
			Exit Function
		End If
	End If

	' Part 3 (3rd Try)
	Dim oReg : Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
	Dim subKey, arrSubKeys
	oReg.EnumKey &H80000003, "", arrSubKeys

	For Each subKey In arrSubKeys
		If Left(subKey, 8) = "S-1-5-21" And InStr(subKey, "Classes") = 0 And Not Left(Right(subKey, 4), 1) = "-" Then
			tempSID = subKey
		End If
	Next

	GetCurrentUserSID = tempSID
	On Error Goto 0
End Function

'----- Get File Version -----
'Description:	Determines the version of a file
'Usage:			GetFileVersion()
'Output:		FileVersion
'Example:		FileVersion = GetFileVersion "file.exe"
'----------------------------
Function GetFileVersion(file)
	If Not FSO.FileExists(file) Then
		VbsLog "Information | Version of File: " + file + " : NOT FOUND"
		GetFileVersion = "0"
		Exit Function
	End If
	GetFileVersion = FSO.GetFileVersion(file)
	VbsLog "Version of File: " + file + " : " + GetFileVersion
End Function

'----- Get Hardware Info -----
'Description:	Reads Hardware Info
'Usage:			GetHardwareInfo(Type)
'Output:		Desired Value
'Example:		Manufacturer = GetHardwareInfo "Manufacturer"
'----------------------------
Function GetHardwareInfo(text)
	Dim objWMIService,colItems,objItem
	Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
	Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem")
	For Each objItem In colItems
		If UCase(text) = "MANUFACTURER" Then GetHardwareInfo = objItem.Manufacturer
  		If UCase(text) = "MODEL" Then GetHardwareInfo = objItem.Model
	Next
End Function

'----- Get Language -----
'Description:	Determines the client language
'Usage:			GetLanguage()
'Output:		DE/HU/EN/FR/IT/ES
'Example:		Language = GetLanguage()
'------------------------
Function GetLanguage()
	Dim langID
	langId = GetRegKeyValue("REG_SZ", "HKLM\SYSTEM\CurrentControlSet\Control\Nls\Language\Default", GetOSBit())
	Select Case UCase(Right(langId,2))
		Case "0E"
			GetLanguage = "HU"
		Case "07"
			GetLanguage = "DE"
		Case "09"
			GetLanguage = "EN"
		Case "0C"
			GetLanguage = "FR"
		Case "10"
			GetLanguage = "IT"
		Case "0A"
			GetLanguage = "ES"
		Case Else
			VbsLog "Error | Function: GetLanguage [Language unknown]"
			GetLanguage = "unknown"
	End Select
End Function

'----- Get Last Boot Time -----
'Description:	Returns boot date and time
'Usage:			GetLastBootTime()
'Output:		Boot date and time
'Example:		GetLastBootTime()
'------------------------
Function GetLastBootTime()
	Dim objOperatingSystem, strComputer
	Dim objSWbemDateTime, objWMIService, colOperatingSystems

	Set objSWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")

	strComputer = "."

	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	Set colOperatingSystems = objWMIService.ExecQuery ("Select * from Win32_OperatingSystem")

	For Each objOperatingSystem in colOperatingSystems
		objSWbemDateTime.Value = objOperatingSystem.LastBootUpTime
		GetLastBootTime = objSWbemDateTime.GetVarDate(True)
	Next
	
	Dim HoursSince,DaysSince,strOut
	HoursSince = DateDiff("h",GetLastBootTime,Now())
	If HoursSince>24 Then
		DaysSince=Int(HoursSince/24)
		strOut = DaysSince & "d " & HoursSince Mod 24 & "h"
	Else
		strOut = HoursSince & "h"
	End If
	
	GetLastBootTime = GetLastBootTime & " (" & strOut & ")"
End Function 

'----- Get Location -----
'Description:	Determines the client location
'Usage:			GetLocation()
'Output:		IN/NE/GY/BX/SJ
'Example:		Location = GetLocation()
'------------------------
Function GetLocation()
	Dim strComputername,oTSEnv,strSiteCode,oSMSClient
	
	GetLocation = "unknown" 'default
	strSiteCode = ""

'	Detecting Location
	On Error Resume Next
	Set oTSEnv = CreateObject("Microsoft.SMS.TSEnvironment")
	
	If Err.Number = 0 Then
'		Determine SCCM site and computer name by OSD variables
		strComputername = Ucase(oTSEnv("OSDComputerName"))
		strSiteCode = Ucase(oTSEnv("_SMSTSSiteCode"))
	Else
		Err.Clear
		Set oSMSClient = CreateObject("Microsoft.SMS.Client")
		If Err.Number = 0 Then
'			Determine SCCM site by clients assigned site
			strComputername = Computername
			strSiteCode = UCase(oSMSClient.GetAssignedSite)
		End If
		Set oSMSClient = Nothing
	End If
	Set oTSEnv = Nothing
	Err.Clear
	
	If strSiteCode = Empty Then
		Set oSMSClient = CreateObject("Microsoft.SMS.Client")
		If Err.Number = 0 Then
'			Determine SCCM site by clients assigned site
			strSiteCode = UCase(oSMSClient.GetAssignedSite)
			Set oSMSClient = Nothing
		End If
	End If
	
	On Error Goto 0

'	Determine SCCM site code
	Select Case UCase(strSiteCode)
		Case "IN0","IN1","INT","PI0","PI1","IA0","IA1"
			GetLocation = "IN"
		Case "NE0","NE1","NET","PN0","PN1"
			GetLocation = "NE"
		Case "GY0","GY1","PG0","PG1"
			GetLocation = "GY"
		Case "BX0","BX1","PB0","PB1"
			GetLocation = "BX"
		Case "PS0","SJ1","PJ1"
			GetLocation = "SJ"
		Case Else
'			Determine Location by ACVER
			If ACVER <> False Then
				Select Case Mid(ACVer,9,1)
					Case 1 : GetLocation = "GY" : Exit Function
					Case 2 : GetLocation = "BX" : Exit Function
					Case 3 : GetLocation = "SJ" : Exit Function
				End Select
			Else
				'ACVER not found.
			End If

'			Determine Location by Computername
			Select Case UCase(Mid(strComputerName,5,2))
				Case "IN"
					GetLocation = "IN"
				Case "NE"
					GetLocation = "NE"
				Case "BX"
					GetLocation = "BX"
				Case "GY"
					GetLocation = "GY"
				Case "SJ"
					GetLocation = "SJ"
				Case Else
'					Could not determine location. Location = unknown
			End Select
	End Select
End Function

'----- Get OS-Bit -----
'Description:	Returns the bitsystem
'Usage:			GetOSBit()
'Output:		32 / 64
'Example:		OSBit = GetOSBit()
'--------------------
Function GetOSBit()
	Dim strComputer, objWMIService, objItem, colItems

	strComputer = "." 
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
	Set colItems = objWMIService.ExecQuery( _
	"SELECT SystemType FROM Win32_ComputerSystem",,48) 
	For Each objItem In colItems
		If (objItem.SystemType = "x64-based PC") Then
			GetOSBit = 64
		Else
			GetOSBit = 32
		End If
	Next
End Function

'----- Get OS-Version -----
'Description:	Returns the Windows-OS-Version
'Usage:			GetOSVersion()
'Output:		OS Version
'Example:		OSVersion = GetOSVersion()
'------------------------
Function GetOSVersion()
	Dim strComputer, objWMIService, objItem, colItems

	strComputer = "." 
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
	Set colItems = objWMIService.ExecQuery( _
	"SELECT Version FROM Win32_OperatingSystem",,48) 
	For Each objItem In colItems
		GetOSVersion = objItem.Version
	Next
End Function

'----- Check for Pending Reboots -----
'Description:	Returns the status of pending reboots
'Usage:			GetRebootStatus()
'Output:		Reboot source / False
'Example:		GetRebootStatus()
'------------------------
Function GetRebootStatus()
	Dim sRebootNeeded, localdummy, localPFROarr, localErg, iHive
	Dim objWMIService, colItems, objItem
	Dim objWUSysInfo, objRegint, objAgentInfo
	Dim oCtx, oLocator
	Const HKEY_LOCAL_MACHINE = &H80000002
	sRebootNeeded = False

	Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2") 
	Set colItems = objWMIService.ExecQuery( _
	"SELECT SystemType FROM Win32_ComputerSystem",,48) 
	For Each objItem In colItems
		If (objItem.SystemType = "x64-based PC") Then
			iHive = 64
		Else
			iHive = 32
		End If
	Next

	'VbsLog "Information | Checking Windows Update..."
	Set objWUSysInfo = CreateObject("Microsoft.Update.SystemInfo")
	If objWUSysInfo.RebootRequired Then
		sRebootNeeded = "Windows Update"
	End If
	Set objWUSysInfo = Nothing

	Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
	oCtx.Add "__ProviderArchitecture", iHive
	Set oLocator = CreateObject("Wbemscripting.SWbemLocator")

	'VbsLog "Information | Checking Component Based Servicing (CBS)..."
	Set objRegint = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv")
	localErg = objRegint.EnumKey(HKEY_LOCAL_MACHINE,"Software\Microsoft\Windows\CurrentVersion\Component Based Servicing\RebootPending", localdummy)
	If (localErg = 0) And (Err.Number = 0) Then
		If sRebootNeeded <> False Then
			sRebootNeeded = sRebootNeeded & " | Component Based Servicing"
		Else
			sRebootNeeded = "Component Based Servicing"
		End If
	End If
	Set objRegInt = Nothing

	'VbsLog "Information | Checking Pending File Rename Operations..."
	Set objRegint = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
	LocalErg = objRegInt.GetMultiStringValue(HKEY_LOCAL_MACHINE,"SYSTEM\CurrentControlSet\Control\Session Manager","PendingFileRenameOperations", localPFROarr)
	If (LocalErg = 0) And (Err.Number = 0) Then
		If sRebootNeeded <> False Then
			sRebootNeeded = sRebootNeeded & " | PendingFileRenameOperations"
		Else
			sRebootNeeded = "PendingFileRenameOperations"
		End If
	End If
	Set objRegInt = Nothing

	If sRebootNeeded = False Then sRebootNeeded = "No"
	GetRebootStatus = sRebootNeeded
End Function

'----- Get RegKey-Value -----
'Description:	Determines the value of a RegValue
'Usage:			GetRegKeyValue <KeyType>, <Key>, <Hive>
'Output:		Value
'Example:		Value = GetRegKeyValue ("REG_SZ", "HKLM\Software\AudiAG\MeinTest\MeinKey", 32)
'Parameters:	<KeyType>: REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ, REG_DWORD, REG_QWORD, REG_BINARY
'				<Hive>: 32, 64
'----------------------------
Function GetRegKeyValue(keyType, key, hive)
	Dim oCtx, oLocator, oReg, oInParams, oOutParams
	Dim hk, r, i, path, operation
	Dim strValue, strTemp

	Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")

	If (hive = 32 Or hive = 64) Then oCtx.Add "__ProviderArchitecture", hive

	Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
	Set oReg = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv")

	r = Split(key, "\")
	r(0) = UCase(r(0))
	If r(0) = "HKEY_CLASSES_ROOT" Or r(0) = "HKCR" Then
		hk = &H80000000
	ElseIf r(0) = "HKEY_CURRENT_USER" Or r(0) = "HKCU" Then
		hk = &H80000001
	ElseIf r(0) = "HKEY_LOCAL_MACHINE" Or r(0) = "HKLM" Then
		hk = &H80000002
	ElseIf r(0) = "HKEY_USERS" Or r(0) = "HKU" Then
		hk = &H80000003
	End If

	path = Mid(key, Len(r(0)) + 2, Len(key) - Len(r(UBound(r))) - Len(r(0)) - 2)

	If Left(UCase(keyType),4) <> "REG_" Then keyType = "REG_" + keyType
	Select Case UCase(keyType)
		Case "REG_SZ"		 	: operation = "GetStringValue"
		Case "REG_EXPAND_SZ"	: operation = "GetExpandedStringValue"
		Case "REG_MULTI_SZ" 	: operation = "GetMultiStringValue"
		Case "REG_DWORD"		: operation = "GetDWORDValue"
		Case "REG_QWORD"		: operation = "GetQWORDValue"
		Case "REG_BINARY"		: operation = "GetBinaryValue"
		case Else 				: ErrorHandling 16000, "Function GetRegKeyValue: Unknown keytype"
	End Select

	Set oInParams = oReg.Methods_(operation).InParameters
	oInParams.hDefKey = hk
	oInParams.sSubKeyName = path
	oInParams.sValueName = r(UBound(r))

	Set oOutParams = oReg.ExecMethod_(operation, oInParams, , oCtx)

	Select Case UCase(keyType)
		Case "REG_SZ", "REG_EXPAND_SZ"
			GetRegKeyValue = oOutParams.sValue
		Case "REG_MULTI_SZ"
				If Not IsNull(oOutParams.sValue) Then GetRegKeyValue = Join(oOutParams.sValue, "|")
		Case "REG_BINARY"
			For Each strValue in oOutParams.uvalue
				If len (Hex(strValue)) < 2 Then  
					strValue = "0" & Hex(strValue)
				Else
					strValue = Hex(strValue)
				End If
				strTemp = strTemp & strValue & "|"
			Next
			If Right(strTemp, 1) = "|" Then  strTemp = Left(strTemp, Len(strTemp) - 1)
			GetRegKeyValue = strTemp
		Case "REG_DWORD", "REG_QWORD"
			GetRegKeyValue = oOutParams.uValue
	End Select
End Function

'----- Get SCCMSiteCode -----
'Description:	Show the SCCM-Site-Code
'Usage:			GetSCCMSiteCode()
'Output:		SiteCode or "unknown"
'----------------------------
Function GetSCCMSiteCode()
	On Error Resume Next
	Dim oClient
	Set oClient = CreateObject("Microsoft.SMS.Client")
	If Err.Number <> 0 then 
		VbsLog "ERROR | Could not create SMS Client Object." 
		GetSCCMSiteCode = "unknown"
	Else
		GetSCCMSiteCode = UCase(oClient.GetAssignedSite)
	End if 
	On Error Goto 0
End Function

'----- GetScriptArchitecture() -----
' Description:	Returns the script is run as 32 or 64Bit
' Input:		n/a
' Output:		32 / 64 / unknown
' Example:		GetScriptArchitecture()
' Author(s):	AL
' Last Edit:	02.05.2014
'----------------------------
Function GetScriptArchitecture()
	Dim objFSO, WSHShell, EnvProc
	Set objFSO = WScript.CreateObject("Scripting.Filesystemobject")
	Set WshShell = WScript.CreateObject("WScript.Shell")
	Set EnvProc = WSHShell.Environment("PROCESS")
	
	Dim strComputer, objWMIService, objItem, colItems, iOS

	strComputer = "." 
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
	Set colItems = objWMIService.ExecQuery("SELECT SystemType FROM Win32_ComputerSystem",,48)
	For Each objItem in colItems
		If (objItem.SystemType = "x64-based PC") Then
			iOS = 64
		Else
			iOS = 32
		End If
	Next
	If iOS = 64 Then
		If objFSO.FolderExists(EnvProc("winDir")) Then
			If objFSO.FolderExists(EnvProc("winDir") & "\Sysnative") Then
				GetScriptArchitecture = 32
			Else
				GetScriptArchitecture = 64
			End If
		Else
			GetScriptArchitecture = "unknown"
		End If
	Else
		GetScriptArchitecture = 32
	End If
End Function

'----- Get Userlanguage -----
'Description:	Show the Userlanguage
'Usage:			GetUserLanguage()
'Output:		"DE", "HU", "EN", "FR", "ES", "IT", "unknown"
'----------------------------
Function GetUserLanguage()
	If Left(GetOSVersion(),1) < 6 Then
		Dim strTempLanguage
		strTempLanguage = GetRegKeyValue("REG_SZ", "HKCU\Control Panel\Desktop\MUILanguagePending", 32)
		If IsNull(strTempLanguage) Then
			VbsLog "Information: RegKey not found 'HKCU\Control Panel\Desktop\MUILanguagePending'. Userlanguage is Clientlanguage"
			strTempLanguage = GetLanguage()
		End If
		Select Case strTempLanguage
			Case "00000407", "DE" 'Deutsch
				GetUserLanguage = "DE"
			Case "0000040e", "HU" 'Ungarisch
				GetUserLanguage = "HU"
			Case "00000409", "EN" 'Englisch
				GetUserLanguage = "EN"
			Case "0000040c", "FR" 'Französisch
				GetUserLanguage = "FR"
			Case "00000c0a", "ES" 'Spanisch
				GetUserLanguage = "ES"
			Case "00000410", "IT" 'Italienisch
				GetUserLanguage = "IT"
			Case Else
				GetUserLanguage = "unknown"
		End Select
	Else
		Select Case LCase(GetRegKeyValue("REG_MULTI_SZ", "HKCU\Control Panel\Desktop\PreferredUILanguages", 32))
			Case "de-de"
				GetUserLanguage = "DE"
			Case "hu-hu"
				GetUserLanguage = "HU"
			Case "us-us", "en-us"
				GetUserLanguage = "EN"
			Case "fr-fr"
				GetUserLanguage = "FR"
			Case "es-es"
				GetUserLanguage = "ES"
			Case "it-it"
				GetUserLanguage = "IT"
			Case Else
				GetUserLanguage = "unknown"
		End Select
	End If
	VbsLog "Userlanguage: " & GetUserLanguage
End Function

'----- Infoblende -----
'Description:	Shows InfoPanel when no tasksequence is running
'Usage:			InfoBlende "xmlfile.xml"
'Example:		InfoBlende "" or InfoBlende "info.xml"
'Returns:		True if panel was shown, False if not
'------------------------------
Function InfoBlende(XML)
	If CheckProc("TsBootShell.exe,TsmBootstrap.exe,TSManager.exe,TSProgressUI.exe,SMSBoot.exe") = True Then
		VbsLog "Information | OSD-Installation or tasksequence is running. Panel skipped."
		InfoBlende = False
		Exit Function
	End If
	
	If XML = "" Then
		run "Infoblende","Infoblende\AudiSysWrapper.exe /w Infoblende.exe","0"
	Else
		run "Infoblende","Infoblende\AudiSysWrapper.exe /w Infoblende.exe """ & XML & """","0"
	End If
	
	InfoBlende = True
End Function

'----- Infoblendenowait -----
'Description:	Shows InfoPanel when no tasksequence is running
'Usage:			Infoblendenowait "xmlfile.xml"
'Example:		Infoblendenowait "" or Infoblendenowait "info.xml"
'Returns:		True if panel was shown, False if not
'------------------------------
Function InfoBlendeNoWait(XML)
	If CheckProc("TsBootShell.exe,TsmBootstrap.exe,TSManager.exe,TSProgressUI.exe,SMSBoot.exe") = True Then
		VbsLog "Information | OSD-Installation or tasksequence is running. Panel skipped."
		InfoBlendeNoWait = False
		Exit Function
	End If

	If XML = "" Then
		RunNoWait "Infoblende","Infoblende\AudiSysWrapper.exe /w Infoblende.exe"
	Else
		RunNoWait "Infoblende","Infoblende\AudiSysWrapper.exe /w Infoblende.exe """ & XML & """"
	End If

	InfoBlendeNoWait = True
End Function

'----- InstallCertificate -----
'Description:	Install certificates from folder "CertificateFolder"
'Usage:			InstallCertificate <CertFolder>, <StoreLocation>, <IncludeSubFolders>
'Example:		InstallCertificate "C:\...\Certificates", "TrustedPublisher", False
'Parameter:		<StoreLocation>: "Root", "TrustedPublisher"
'------------------------------
Sub InstallCertificate(CertificateFolder, StoreLocation, IncludeSubFolders)
	Dim colFiles, objFile, objFolder

	'Prüft, ob die Datei "CertMgr.exe" im Ordner oder Unterorder enthalten ist
	'Wenn diese nicht vorhanden ist, wird das Script beendet
	Dim objWSH_Exec, outLine, strCertMgr
	Const WSHRunning = &H0

	strCertMgr = False
	Set objWSH_Exec = WSHShell.Exec ("cmd.exe /c dir """ & currentDir & """ /s /b")
	'Wait for shell to be terminated
	With objWSH_Exec
		Do While Not objWSH_Exec.StdOut.AtEndOfStream
			outLine = Trim(objWSH_Exec.StdOut.ReadLine)
			If InStr(1, LCase(outLine), LCase("CertMgr.Exe"),0) Then
				strCertMgr = outLine
			End If
		Loop
	End With
	If strCertMgr = False Then
		ErrorHandling 1627, "InstallCertificate: CertMgr.exe ist not in the package"
		FinishScript()
	End If
	
	Set objFolder = FSO.GetFolder(CertificateFolder)
	
	Set colFiles = objFolder.Files
	For Each objFile In colFiles
		Select Case LCase(Right(objFile.Name,4))
			Case ".cer"
			run "Install Certificate","""" & strCertMgr & """ -add """ & objFile.Path & """ -s -r localMachine " & StoreLocation, ""
			Case ".p7b"
			run "Install Certificate","""" & strCertMgr & """ -add -all """ & objFile.Path & """ -s -r localMachine " & StoreLocation, ""
		End Select
	Next

	If IncludeSubfolders = True Then
		Dim SubFolder
		For Each SubFolder In objFolder.SubFolders
			InstallCertificate SubFolder, StoreLocation, True
		Next
	End If
End Sub

'----- InstallDrivers -----
'Description:	Install all drivers in "DriversPath" Folder
'Usage:			InstallDrivers <DriverPath>, <IncludeSubFolders>
'Example:		InstallDrivers "c:\...\Drivers", True
'--------------------------
Sub InstallDrivers(DriversPath, IncludeSubfolders)
	Dim colFiles, objFile, objFolder, SubFolder, strDevconExe
	Dim objWSH_Exec, outLine
	Const WSHRunning = &H0

	If Not Right(DriversPath, 1) = "\" Then DriversPath = DriversPath & "\"

	Set objFolder = FSO.GetFolder(DriversPath)
	Set colFiles = objFolder.Files

	'Find Devcon (only XP)
	If Left(GetOSVersion(),1) < "6" Then
		If Not(InStr(IncludeSubFolders, Currentdir)) And IncludeSubfolders = True Or IncludeSubfolders = False Then
			Set objWSH_Exec = WSHShell.Exec ("cmd.exe /c dir """ & currentDir & """ /s /b")
			'Wait for shell to be terminated
			With objWSH_Exec
				Do While Not objWSH_Exec.StdOut.AtEndOfStream
					outLine = Trim(objWSH_Exec.StdOut.ReadLine)
					If InStr(1, LCase(outLine), LCase("devcon.exe"),0) Or InStr(1, LCase(outLine), LCase("devcon_" & GetOSBit() & ".exe"),0) Then
						strDevconExe = outLine
					End If	
				Loop
			End With
		Else
			strDevconExe = IncludeSubfolders
		End If
		If strDevconExe = "" Then
			ErrorHandling 1627, "InstallDrivers: ERROR: Devcon.exe ist not in the package"
			FinishScript()
		End If 

		If Not IncludeSubfolders = False Then
			IncludeSubfolders = strDevconExe
		End If
	End If

	For Each objFile In colFiles
		If LCase(Right(objFile.Name, 4)) = ".inf" Then
			Select Case Left(GetOSVersion(), 1)
				Case 5
					If strDevconExe = False Or strDevconExe = "" Then
						ErrorHandling 1627, "InstallDrivers: Devcon.exe ist not in the package"
						FinishScript()
					End If 
					
					If Not IncludeSubfolders = False Then
						IncludeSubfolders = strDevconExe
					End If
					run "Driver","""" & strDevconExe & """ dp_add """ & objFile.Path & """", "0,1"
				Case 6
					If GetOSBit() = 32 Then
						run "Driver","pnputil.exe -i -a """ & objFile.Path & """", "0,259"
					Else
						'OperatingSystem x64 > XP
						If FSO.FileExists(WinDir & "\System32\pnputil.exe") Then
							run "Driver","""" & WinDir & "\System32\pnputil.exe"" -i -a """ & objFile.Path & """", "0,259"
						Else 
							run "Driver","""" & WinDir & "\sysnative\pnputil.exe"" -i -a """ & objFile.Path & """", "0,259"
						End If
					End If
			End Select
		End If
	Next

	'Install Drivers from Subfolders if "IncludeSubfolders = True"
	If Not IncludeSubfolders = False Then
		Set objFolder = FSO.GetFolder(DriversPath)
		For Each SubFolder In objFolder.SubFolders
			InstallDrivers SubFolder.Path, IncludeSubfolders
		Next
	End If
End Sub

'----- Kill Process(es) -----
'Description:	Kills Processes
'Usage:			KillProc <ProcessList>
'Example:		KillProc "outlook.exe,word.exe"
'----------------------------
Sub KillProc(proc)
	Dim colProcess,objProcess,objWMIService,v,i,colProcess2
	Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
	v=Split(proc,",")
	For i = 0 To UBound(v)
		v(i) = Trim(v(i))
		Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = '" & v(i) & "'")
		If colProcess.Count = 0 Then vbslog "Information | Prozess [" & v(i) & "] nicht aktiv!"
		For Each objProcess In colProcess
			On Error Resume Next
			Ret = objProcess.Terminate()
			On Error Goto 0
			WScript.Sleep (2000)
			If Ret = 0 Then
				vbslog "OK | Process [" & v(i) & "] successfull killed"
			Else
				ErrorHandling 1, "Process [" & v(i) & "] could not be killed"
			End If
			Ret = empty
		Next
	Next
End Sub

'----- PanelWait -----
'Description:	Repeats Info Panel x times until Process ist closed
'Usage:			PanelWait <Process>, <WaitTime in s>, <Repeats>
'Output:		TRUE if Process was closed, FALSE if Process is still running
'Example:		PanelWait "notepad.exe",300,3
'---------------------
Function PanelWait(process,timewait,rep)
	Dim Count : Count = 0
	
	VbsLog "---------- Execute PanelWait Function: '" & process & "' '" & timewait & "' '" & rep & "'"
	PanelWait = True
	If CheckProc("TsBootShell.exe,TsmBootstrap.exe,TSManager.exe,TSProgressUI.exe,SMSBoot.exe") = True Then
		VbsLog "Information | OSD-Installation or tasksequence is running. Panel skipped."
		Exit Function
	End If

	Do While (rep>0) And (CheckProc(process))
		run "Blende SCCM","Infoblende\AudiSysWrapper.exe Infoblende.exe /w","0"
		Do While (Count<(timewait/10)) And CheckProc(process) = True
			WScript.Sleep(10000)
			Count = Count + 1
		Loop
		rep = rep - 1
		Count = 0
	Loop
	If CheckProc(process) = True Then PanelWait = False
	VbsLog "---------- RESULT PanelWait: " & PanelWait
End Function

'----- PatchInstalled -----
'Description:   Check Hotfix or Security Update is installed
'Usage:         PatchInstalled <KB>
'Output:		True or False
'Example:       PatchInstalled "KB2510636"
'-------------------------
Function PatchInstalled(Patch)
	On Error Resume Next
	Dim objSession, objSearcher, intHistorycount, colHistory, objEntry, HotFixKB

	Set objSession = CreateObject("Microsoft.Update.Session")
	Set objSearcher = objSession.CreateUpdateSearcher
	intHistoryCount = objSearcher.GetTotalHistoryCount

	Set colHistory = objSearcher.QueryHistory(0, intHistoryCount)
	If Err.Number <> 0 Then
		VbsLog "Error (" & Err.Number & ") | Function: Patchinstalled (" & Patch & ")"
		On Error Goto 0
		Exit Function
	End If
	On Error Goto 0

	For Each objEntry in colHistory
		If InStr(1, objEntry.Title, "(KB", 1) And objEntry.ResultCode = 2 Then
			HotFixKB = Mid(objEntry.Title, InStr(1,objEntry.Title, "(KB", 1)+1)
			HotFixKB = Left(HotFixKB, InStr(HotFixKB, ")")-1)
			If UCase(Patch) = UCase(HotFixKB) Then
				PatchInstalled = True
				VbsLog "Information: Patch installed (" & Patch & ")"
				Exit Function
			End If
		End If
	Next
	PatchInstalled = False
	VbsLog "Information: Patch not installed (" & Patch & ")"
End Function

'----- Reads Environment Variable -----
'Description:	Reads Environment Variable
'Usage:			ReadEnv <Variable>
'Example:		ret = ReadEnv "WINDIR"
'				FALSE if not readable
'---------------------------------
Function ReadEnv(Environ)
	ReadEnv=WSHShell.ExpandEnvironmentStrings("%" & environ & "%")
	If Left(ReadEnv,1)="%" Then ReadEnv = False
End Function

'----- Set/Create, Add to, Modify and Delete Environment Variable -----
'Description:   			Set Environment Variable
'Usage:         			SetEnv <Environmentvariable>, <Value>, <Operation>
'Parameter for Operation:	SET, ADD, DEL, DELV
'Example:      				SetEnv "PATH","c:\temp","ADD"
'--------------------------------------------------------------
Function SetEnv(Environment,Value,Operation)
	Dim EnvironmentPath, EnvironmentData, NewValue, Env, DelValue, oEnv, oShell
	EnvironmentPath = "HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\" & Environment
	EnvironmentData = GetRegKeyValue( "SZ","HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\" & Environment, GetOSBit())

	If UCase(Operation) = "DEL" Then
		If Not IsNull(EnvironmentData) Then
			DeleteReg "VALUE",EnvironmentPath,GetOSBit()
		Else
			VbsLog "Information | Delete Environment '" & Environment & "': Was not set."
		End If
	ElseIf UCase(Operation) = "DELV" Then
		'Environment vorhanden
		Set oShell = WScript.CreateObject("WScript.Shell")
		Set oEnv = oShell.Environment("SYSTEM")
		Env = oEnv(Environment)
		DelValue =";" & Value
		NewValue = Replace(Env,DelValue,"")
		oEnv(Environment) = NewValue
		VbsLog "OK | '" & Value & "' was removed from '" & Environment & "'"
	ElseIf IsNull(EnvironmentData) Or UCase(Operation) = "SET" Then
		'Environment nicht vorhanden
		VbsLog "OK | Set Environment: '" & Environment & "' to '" & Value & "'"
		WriteReg "SZ",EnvironmentPath,Value,GetOSBit()
	ElseIf UCase(Operation) = "ADD" Then
		'Environment vorhanden
		Dim i, x
		i = Split(Replace(EnvironmentData,";;",";"), ";")
		For x = LBound(i) To UBound(i)
			If UCase(i(x)) = UCase(Value) Then
				VbsLog "Information | Value '" & Value & "' is already in Environment '" & Environment & "'"
				Exit Function
			End If
		Next
		If Right(EnvironmentData, 1) = ";" Then
			WriteReg "SZ",EnvironmentPath,EnvironmentData & Value, GetOSBit()
		Else
			WriteReg "SZ",EnvironmentPath,EnvironmentData & ";" & Value, GetOSBit()
		End If
		VbsLog "OK | Added '" & Value & "' to '" & Environment & "'"
	End If	
End Function

'----- Run Commandline -----
'Description:	Executes a Commandline
'Usage:			run <Description>, <Commandline>, <OK ErrorCode(s)>
'Example:		run "Install","msiexec.exe /i prog.msi","0,3010"
'----------------
Function Run(Text,Line,Abbruch)
	Dim ErrCount, ErrOK, I
	VbsLog "Execute Run Function: '" & Text & "' '" & Line & "' '" & Abbruch & "'"
	On Error Resume Next
	Ret = WSHShell.Run (Line, 0, True)

	WSHShell.CurrentDirectory = InstallDir

	ErrOK = False
	If Abbruch = "" Or Abbruch = False Then ErrOK = True
	If Text = "" Then Text = "Run"
	If Ret = Empty Then Ret = Err.Number

	If Ret = 0 Then
		VbsLog "+ RESULT Run " & Text & ": OK"
	Else
		ErrCount = Split(Replace(Abbruch, " ", ""),",")
		If UBound(ErrCount) >=0 Then
			For I = LBound(ErrCount) To UBound(ErrCount)
				If StrComp(ErrCount(I), Ret) = 0 Then 
					VbsLog "+ RESULT Run " & Text & ": OK | Accepted ExitCode (" & Ret & ", " & ErrorText(Ret) & ")"
					run = Ret
					On Error Goto 0
					Exit Function
				End If
			Next
		End If
		
		If ErrOK = True Then
			VbsLog "+ RESULT Run " & Text & ": OK | Accepting all ExitCodes"
			run = Ret
			On Error Goto 0
			Exit Function
		Else
			ErrorHandling Ret, "+ RESULT Run " & Text & ": ERROR (" & Ret & ", " & ErrorText(Ret) & ")"
			FinishScript()
		End If
	End If
	On Error Goto 0
End Function

'----- Run Commandline no wait -----
'Description:   Executes a Commandline without waiting for completion
'Usage:         run <Description>, <Commandline>
'Example:       run "Install","msiexec.exe /i prog.msi"
'-----------------------------------
Sub RunNoWait(Text,Line)
	Dim ErrText, ErrCount, I
	
	VbsLog "Execute RunNoWait Function: '" & Line & "'"
	
	On Error Resume Next
	WSHShell.Run Line, 0, False
	WSHShell.CurrentDirectory = InstallDir

	If Text = "" Then Text = "Started"

	VbsLog Text & ": " & Line

	On Error Goto 0
End Sub

'----- Uninstall Product -----
'Description:	Uninstall application with if installed
'Usage:			UninstallProduct <Name>,<ProductCode>
'Output			Returncode of uninstall if product ist deinstalled, False if product was not installed
'Example:		UninstallProduct "Apple QuickTime","{B332732A-4958-41DD-B439-DDA2D32753C5}"
'-----------------------------
Function UninstallProduct(Name,ProductCode)
	Dim objInstaller

	Const msiInstallStateUnknown = -1	'The product is neither advertised or installed.
	Set objInstaller = WScript.CreateObject("WindowsInstaller.Installer")
	If objInstaller.ProductState(ProductCode) <> msiInstallStateUnknown Then
		VbsLog "Uninstall " & Name & ": " & ProductCode
		VbsLog "+ ProductName: " & objInstaller.ProductInfo(ProductCode, "ProductName")
		VbsLog "+ Version:     " & objInstaller.ProductInfo(ProductCode, "VersionString")
		VbsLog "+ Publisher:   " & objInstaller.ProductInfo(ProductCode, "Publisher")
		run "Uninstall","msiexec.exe /x " & ProductCode & " /qn /norestart /lvoicewarmup """ & LogName & """", "0,1605,3010"
		UninstallProduct = True
	Else
		VbsLog "Information | Uninstall Function:" & Name & " is not installed " & ProductCode
		UninstallProduct = False
	End If
End Function

'----- Unzip File -----
'Description:	Unzip a compressed file
'Usage:			UnzipFile <ZIP-File>,<DestinationFolder>
'Output			Returncode of Unzip
'Example:		UnzipFile "test.zip","c:\temp"
'-----------------------------
Function UnzipFile(ZipFilePath, DestFolder)
	Dim strCommand
	
	strCommand = "7za.exe x -y -o""" & DestFolder & """ """ & ZipFilePath & """"
	
	VbsLog "Unzip File: " & ZipFilePath
	VbsLog "+Run: " & strCommand
	UnzipFile = wshshell.run (strCommand, 0, True)
	If UnzipFile <> 0 Then
		Errorhandling UnzipFile, "Failed to extract file :'" & ZipFilePath & "' | Output directory: " & DestFolder
		FinishScript()
	Else
		VbsLog "+OK | File extract :'" & ZipFilePath & "' | Output directory: " & DestFolder
	End If
End Function

'----- Write VBSLog -----
'Description:	Writes Line into logfile
'Usage:			VbsLog <Line>
'Example:		VbsLog "This is Text"
'-----------------------------
Sub VbsLog(LogText)
	If DebugMode = True Then WScript.Echo (Now & "|" & LogText)
	If LogEnabled = False Then Exit Sub

	Dim fso, WSHShell, LogFile, pointer, newFolder
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set WSHShell = CreateObject("WScript.Shell")
	'----- Verzeichnis anlegen falls es nicht existiert
	If fso.FolderExists(LogDir) = False Then
		CreateFolder(LogDir)
	End If

	Set LogFile = FSO.OpenTextFile(LogName, 8, True, -1)
	LogFile.WriteLine Now & "|" & LogText
	LogFile.Close
End Sub

'----- Write Registry -----
'Description:	Writes Registry values, keys
'Usage:			WriteReg <KeyType>, <Registry Key>, <Value>, <Hive>
'Output:		Errorcode if failed, True if successfull
'Example:		WriteReg "REG_SZ", "HKLM\Software\Testvalue", "Text", 64
'Parameters:	<KeyType>: REG_SZ, REG_DWORD, REG_BINARY, REG_EXPAND_SZ, REG_MULTI_SZ
'				<Hive>: 32, 64
'-------------------------
Function WriteReg(KeyType, key, value, hive)
	Dim oCtx, oLocator, oReg, oInParams, oOutParams
	Dim hk, r, i, path, operation
	Dim strTemp
	
	If IsArray(Value) Then
		VbsLog "Execute WriteReg Function: '" & KeyType & "' '" & Key & "' '" & Join(Value,"|") & "' '" & Hive & "'"
	Else
		VbsLog "Execute WriteReg Function: '" & KeyType & "' '" & Key & "' '" & Value & "' '" & Hive & "'"
	End If

	Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")

	If (hive = 32 Or hive = 64) Then
		oCtx.Add "__ProviderArchitecture", hive
	Else
		ErrorHandling 2, "WriteReg: Wrong Parameter (Hive)"
		Exit Function
	End If
	
	Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
	Set oReg = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv")

	r = Split(key, "\")
	r(0) = UCase(r(0))
	If r(0) = "HKEY_CLASSES_ROOT" Or r(0) = "HKCR" Then
		hk = &H80000000
	ElseIf r(0) = "HKEY_CURRENT_USER" Or r(0) = "HKCU" Then
		hk = &H80000001
	ElseIf r(0) = "HKEY_LOCAL_MACHINE" Or r(0) = "HKLM" Then
		hk = &H80000002
	ElseIf r(0) = "HKEY_USERS" Or r(0) = "HKU" Then
		hk = &H80000003
	End If

	For i = 1 To UBound(r)-1
		path = path & r(i) & "\"
		Set oInParams = oReg.Methods_("CreateKey").InParameters
		oInParams.hDefKey = hk
		oInParams.sSubKeyName = path
		Set oOutParams = oReg.ExecMethod_("CreateKey", oInParams, , oCtx)
	Next

	If UCase(Left(keyType,4)) <> "REG_" Then keyType = "REG_" & keyType
	Select Case UCase(keyType)
		Case "REG_SZ"
		operation = "SetStringValue"

		Set oInParams = oReg.Methods_(operation).InParameters
		oInParams.hDefKey = hk
		oInParams.sSubKeyName = path
		oInParams.sValueName = r(UBound(r))
		oInParams.sValue = value

		Set oOutParams = oReg.ExecMethod_(operation, oInParams, , oCtx)
		Case "REG_DWORD"
		operation = "SetDWORDValue"

		Set oInParams = oReg.Methods_(operation).InParameters
		oInParams.hDefKey = hk
		oInParams.sSubKeyName = path
		oInParams.sValueName = r(UBound(r))
		oInParams.uValue = value

		Set oOutParams = oReg.ExecMethod_(operation, oInParams, , oCtx)
		
		'Array(&h00,&h01,&h02,&hff)
		Case "REG_BINARY"
		operation = "SetBinaryValue"
		
		Set oInParams = oReg.Methods_(operation).InParameters
		oInParams.hDefKey = hk
		oInParams.sSubKeyName = path
		oInParams.sValueName = r(UBound(r))
		oInParams.uValue = value

		Set oOutParams = oReg.ExecMethod_(operation, oInParams, , oCtx)

		Case "REG_EXPAND_SZ"
		operation = "SetExpandedStringValue"

		Set oInParams = oReg.Methods_(operation).InParameters
		oInParams.hDefKey = hk
		oInParams.sSubKeyName = path
		oInParams.sValueName = r(UBound(r))
		oInParams.sValue = value

		Set oOutParams = oReg.ExecMethod_(operation, oInParams, , oCtx)
		
		'Array ("Value 1","Value 2","Value 3")
		Case "REG_MULTI_SZ"
		operation = "SetMultiStringValue"

		Set oInParams = oReg.Methods_(operation).InParameters
		oInParams.hDefKey = hk
		oInParams.sSubKeyName = path
		oInParams.sValueName = r(UBound(r))
		oInParams.sValue = value

		Set oOutParams = oReg.ExecMethod_(operation, oInParams, , oCtx)

		Case Else
			ErrorHandling 1, "WriteReg: Wrong Parameter (KeyType)"
			Exit Function
	End Select

	ret = oOutParams.ReturnValue

	On Error Resume Next
	keyType = UCase(keyType)

	Select Case UCase(keyType)
	Case "REG_SZ","REG_DWORD","REG_EXPAND_SZ"
		strTemp = "WriteReg: " & key & ", " & CStr(value) & ", " & keyType & ", " & CStr(hive)
	Case "REG_BINARY"
		strTemp = "WriteReg: " & key & ", " & Join(value,"|") & ", " & keyType & ", " & CStr(hive)
	Case "REG_MULTI_SZ"
		strTemp = "WriteReg: " & key & ", " & Join(value," | ") & ", " & keyType & ", " & CStr(hive)
	End Select
	
	On Error Goto 0

	If ret = 0 Then
		VbsLog "+ RESULT WriteReg: OK"
		Ret = True
	Else
		ErrorHandling ret, "+ RESULT WriteReg: ERROR | (" & ret & ")"
	End If

	WriteReg = ret 
End Function

'----- ReadINI -----
'Description:   Reads a value from a INI-File
'Usage:         ReadINI <File>,<Section>,<Key>
'Output:		Value if found (space if value is blank), False if not, 
'Example:       ReadINI "win.ini","Setup","Sample"
'-------------------------
Function ReadINI( myFilePath, mySection, myKey )
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

    Dim intEqualPos
    Dim objFSO, objIniFile
    Dim strFilePath, strKey, strLeftString, strLine, strSection

    Set objFSO = CreateObject( "Scripting.FileSystemObject" )

    ReadIni     = ""
    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )

    If objFSO.FileExists( strFilePath ) Then
        Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False, -2 )
        Do While objIniFile.AtEndOfStream = False
            strLine = Trim( objIniFile.ReadLine )

            ' Check if section is found in the current line
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                strLine = Trim( objIniFile.ReadLine )

                ' Parse lines until the next section is reached
                Do While Left( strLine, 1 ) <> "["
                    ' Find position of equal sign in the line
                    intEqualPos = InStr( 1, strLine, "=", 1 )
                    If intEqualPos > 0 Then
                        strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                        ' Check if item is found in the current line
                        ' Chr(9) = TAB
                        If LCase( Replace(strLeftString, Chr(9), "") ) = LCase( strKey ) Then
                            ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
                            ' In case the item exists but value is blank
                            If ReadIni = "" Then
                                ReadIni = " "
                            End If
                            ' Abort loop when item is found
                            Exit Do
                        End If
                    End If

                    ' Abort if the end of the INI file is reached
                    If objIniFile.AtEndOfStream Then Exit Do

                    ' Continue with next line
                    strLine = Trim( objIniFile.ReadLine )
                Loop
            Exit Do
            End If
        Loop
        objIniFile.Close
    Else
        ReadINI = False
    End If
End Function

'----- WriteINI -----
'Description:   Writes a value to a INI-File
'Usage:         WriteINI <File>,<Section>,<Key>,<Value>
'Output:		True if set, False if not
'Example:       WriteINI "win.ini","Setup","Sample","Text"
'Parameters:	<Key> will be deleted if <Value> is "<DELETE_THIS_VALUE>"
'-------------------------
Function WriteINI( myFilePath, mySection, myKey, myValue )
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8

    Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
    Dim intEqualPos
    Dim objFSO, objNewIni, objOrgIni
    Dim strFilePath, strFolderPath, strKey, strLeftString
    Dim strLine, strSection, strTempDir, strTempFile, strValue

    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )
    strValue    = Trim( myValue )

    Set objFSO   = CreateObject( "Scripting.FileSystemObject" )

    strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
    strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )

    Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True, -2 )
    Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )

    blnInSection     = False
    blnSectionExists = False
    ' Check if the specified key already exists
    blnKeyExists     = ( ReadIni( strFilePath, strSection, strKey ) <> "" )
    blnWritten       = False

    ' Check if path to INI file exists, quit if not
    strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
    If Not objFSO.FolderExists ( strFolderPath ) Then
        
        ErrorHandling 1, "Folder of INI-File does not exist"
        Set objOrgIni = Nothing
        Set objNewIni = Nothing
        Set objFSO    = Nothing
        WriteINI = False
        Exit Function
    End If

    While objOrgIni.AtEndOfStream = False
        strLine = Trim( objOrgIni.ReadLine )
        If blnWritten = False Then
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                blnSectionExists = True
                blnInSection = True
            ElseIf InStr( strLine, "[" ) = 1 Then
                blnInSection = False
            End If
        End If

        If blnInSection Then
            If blnKeyExists Then
                intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
                If intEqualPos > 0 Then
                    strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                    If LCase( strLeftString ) = LCase( strKey ) Then
                        If strValue <> "<DELETE_THIS_VALUE>" Then
                        	VbsLog "OK | Set Value: " & strKey & "=" & strValue & " in [" & strSection & "]"
                            objNewIni.WriteLine strKey & "=" & strValue
                            WriteINI = True
                        End If
                        blnWritten   = True
                        blnInSection = False
                    End If
                End If
                If Not blnWritten Then
                    objNewIni.WriteLine strLine
                End If
            Else
                objNewIni.WriteLine strLine
                    If strValue <> "<DELETE_THIS_VALUE>" Then
                        VbsLog "OK | New Value: " & strKey & "=" & strValue & " in [" & strSection & "]"
                        objNewIni.WriteLine strKey & "=" & strValue
                        WriteINI = True
                    End If
                blnWritten   = True
                blnInSection = False
            End If
        Else
            objNewIni.WriteLine strLine
        End If
    Wend

    If blnSectionExists = False Then ' section doesn't exist
        objNewIni.WriteLine
        VbsLog "OK | New Section: " & "[" & strSection & "]"
        objNewIni.WriteLine "[" & strSection & "]"
            If strValue <> "<DELETE_THIS_VALUE>" Then
            	VbsLog "OK | New Value: " & strKey & "=" & strValue
                objNewIni.WriteLine strKey & "=" & strValue
                WriteINI = True
            End If
    End If

    objOrgIni.Close
    objNewIni.Close

    ' Delete old INI file
    objFSO.DeleteFile strFilePath, True
    ' Rename new INI file
    objFSO.CopyFile strTempFile, strFilePath
    objFSO.DeleteFile strTempFile, True

    Set objOrgIni = Nothing
    Set objNewIni = Nothing
    Set objFSO    = Nothing
End Function

'----- VersionCheck -----
'Description:   Compares version numbers
'Usage:         VersionCheck <Version 1>,<Version 2>
'Output:		Position of different version, positiv or negativ value, 0 if no difference
'Example:       VersionCheck "1.2.3","1.2.5"
'				Returns -3, because the first version ist lower at position three
'------------------------
Function VersionCheck(a,b)
Dim Nr1,Nr2,i
Nr1=split(a,".")
Nr2=split(b,".")

For i=0 To UBound(Nr1)
	If i > UBound(Nr2) Then
	    Versioncheck = 0
    	Exit Function
	End If
  
	If Int(Nr1(i)) < Int(Nr2(i)) Then
		Versioncheck = -(i + 1)
    	Exit Function
	ElseIf Int(Nr1(i)) > Int(Nr2(i)) Then
		Versioncheck = i + 1
		Exit Function
	End If
	Versioncheck = 0
Next
End Function

'===== VersionCheckNew =========================================================================
'Description:   Compares version numbers
'Usage:         VersionCheckNew <Version 1>,<Version 2>
'Output:		If Version1 < Version2, returns -1
'				if Version1 = Version2, returns  0
'				If Version1 > Version2, returns  1
'Example:       
'				Dim Version1
'				Dim Version2
'
'				Version1 = GetFileVersion (ProgramFiles & "\Internet Explorer\iexplore.exe")
'				Version2 = "46.1.879778.258"
'
'				if VersionCheckNew (Version1, Version2) = -1 Then
' 					VbsLog Version1 + " ist kleiner als " + Version2 + "do something"
'				End If
'
'				if VersionCheckNew (Version1, Version2) = 1 Then
'  					VbsLog Version1 + " ist groesser als " + Version2 + "do something"
'				End If
'
'				if VersionCheckNew (Version1, Version2) = 0 Then + "do something"
'					VbsLog Version1 + " ist gleich " + Version2
'				End If
'

' Compares two versions "a.b.c.d". If Version1 < Version2,
' returns -1; if Version1 = Version2, returns 0;
' If Version1 > Version2, Returns 1.
Function VersionCheckNew(ByVal Version1, ByVal Version2)
  Dim Ver1, Ver2, Result
  Ver1 = GetVersionStringAsArray(Version1)
  Ver2 = GetVersionStringAsArray(Version2)
  If Ver1(0) < Ver2(0) Then
    Result = -1
  ElseIf Ver1(0) = Ver2(0) Then
    If Ver1(1) < Ver2(1) Then
      Result = -1
    ElseIf Ver1(1) = Ver2(1) Then
      Result = 0
    Else
      Result = 1
    End If
  Else
    Result = 1
  End If
  
  VersionCheckNew = Result
   
  End Function
  
' Bitwise left shift. (used in GetVersionStringAsArray)
Sub Lsh(ByVal N, ByVal Bits)
  Lsh = N * (2 ^ Bits)
End Sub

' Returns a version string "a.b.c.d" as a two-element numeric
' array. The first array element is the most-significant 32 bits,
' and the second element is the least-significant 32 bits. (used in VersionCheckNew)
Sub GetVersionStringAsArray(ByVal Version)
  Dim VersionAll, VersionParts, N
  VersionAll = Array(0, 0, 0, 0)
  VersionParts = Split(Version, ".")
  For N = 0 To UBound(VersionParts)
    VersionAll(N) = CLng(VersionParts(N))
  Next

  Dim Hi, Lo
  Hi = Lsh(VersionAll(0), 16) + VersionAll(1)
  Lo = Lsh(VersionAll(2), 16) + VersionAll(3)

  GetVersionStringAsArray = Array(Hi, Lo)
End Sub
'=================================================================================================

'----- XMLErrordescription -----
'Description:   Get Errordescription from XML-File
'Usage:         XMLErrordescription <Errornumber>
'Output:		XMLErrordescription
'Example:       XMLErrordescription 1603
'------------------------
Function XMLErrordescription(ErrorNumber)
	Dim xmlDoc, xmlNodes
	Set xmlDoc = CreateObject("Microsoft.XMLDOM")

	xmlDoc.Async = "False"
	xmlDoc.Load("Errorhandling.xml")
	For Each xmlNodes In xmlDoc.SelectNodes("//Errorhandling/Errorlist/Error")
		If Trim(xmlnodes.getAttribute("Errornumber")) = Trim(Errornumber) Then
			XMLErrordescription = xmlNodes.getAttribute("Description")	
		End If
	Next
	For Each xmlNodes In xmlDoc.SelectNodes("//Errorhandling/Successlist/Success")
		If Trim(xmlnodes.getAttribute("Errornumber")) = Trim(Errornumber) Then
			XMLErrordescription = xmlNodes.getAttribute("Description")	
		End If
	Next
End Function


'----- GetOUByComputerName -----
'Description:   Find OU-AD for Computername 
'Usage:         GetOUByComputerName(computerName)
'Output:		"OU-Container" or "Not" 
'               "OU=CAT,OU=CAT,OU=AUDI AG,dc=audi,dc=vwg"
'--------------------------------------
Function GetOUByComputerName(byval computerName)
	
	Dim namingContext, ldapFilter, ou
	Dim cn, cmd, rs
	Dim objRootDSE
	
	' Bind RootDSE for Default Namenscontext
	Set objRootDSE = getobject("LDAP://RootDSE")
	namingContext = objRootDSE.Get("defaultNamingContext")
	Set objRootDSE = nothing
    
    ' Create Computerobjekts
	ldapFilter = "<LDAP://" & namingContext & _
 	">;(&(objectCategory=Computer)(name=" & computerName & "))" & _
	";distinguishedName;subtree"

	' ADO Query to Database
	Set cn = createobject("ADODB.Connection")
	Set cmd = createobject("ADODB.Command")

	cn.open "Provider=ADsDSOObject;"
	cmd.activeconnection = cn
	cmd.commandtext = ldapFilter
	
	set rs = cmd.execute
	
	If rs.eof <> true and rs.bof <> true then
		ou = rs(0)
		' to: CN=AUDIINXxxxxxxx OU=Computers,OU=IFP822,OU=FP,OU=F,OU=AUDI AG,DC=audi,DC=vwg
		' e.g. OU=CAT,OU=CAT,OU=AUDI AG,dc=audi,dc=vwg
		getOUByComputerName = ou
	Else
		getOUByComputerName = "NOT"
	End if

	rs.close
	cn.close

End Function

'----- CreateBrandingInformation -----
'Description:	Create branding information from values out of _install.vbs
'Usage:			CreateBrandingInformation()
'-------------------------------------
Function CreateBrandingInformation(pName, pVersion, pLang, pRevision)
	
	DIM pNow: pNow = Now
	
	WriteReg "REG_SZ", 	regpath& "\" & pBrandingName & "\ProductName" ,pName, 32
	WriteReg "REG_SZ",	regpath& "\" & pBrandingName & "\ProductVerion", pVersion, 32
	WriteReg "REG_SZ",	regpath& "\" & pBrandingName & "\ProductLanguage", pLang, 32
	WriteReg "REG_SZ",	regpath& "\" & pBrandingName & "\Revision", pRevision, 32
	WriteReg "REG_SZ",  regpath& "\" & pBrandingName & "\InstallDate", pNow, 32
	WriteReg "REG_SZ",  regpath& "\" & pBrandingName & "\AES", pAES, 32
	
End Function

'----- DeleteOldBrandingInformation -----
'Description:	Delete previous branding information from values out of _uninstall.vbs
'Usage:			DeleteOldBrandingInformation <Old Version>, <Old Lang>, <Old Revision>, <OldVersion>
'-------------------------------------
Function DeleteOldBrandingInformation(pNameOld, pLangOld, pRevisionOld, pVersionOld)
	Dim pBrandingName : pBrandingName = pNameOld &"_"& pVersionOld &"_"& pLangOld &"_"& pRevisionOld
	Dim pRegpath : pRegpath = "HKLM\Software\"&pCustomer&"\InstalledProducts"
	dim pRegType : pRegType = "KEY"
	DeleteReg pRegType, pRegpath &"\"& pBrandingName, 32
	
End Function

'----- CreateBrandingInformationExt -----

Function CreateBrandingInformationExt(pName, pVersion, pLang, pRevision, pRegpath)
	
	Dim pNow: pNow = Now
	DIM pCustomer : pCustomer = "VWG"
	Dim pBrandingName : pBrandingName = pName &"_"& pVersion &"_"& pLang &"_"& pRevision

	WriteReg "REG_SZ", 	pRegpath& "\" & pBrandingName & "\ProductName" ,pName, 32
	WriteReg "REG_SZ",	pRegpath& "\" & pBrandingName & "\ProductVersion", pVersion, 32
	WriteReg "REG_SZ",	pRegpath& "\" & pBrandingName & "\ProductLanguage", pLang, 32
	WriteReg "REG_SZ",	pRegpath& "\" & pBrandingName & "\Revision", pRevision, 32
	WriteReg "REG_SZ",  pRegpath& "\" & pBrandingName & "\InstallDate", pNow, 32
	WriteReg "REG_SZ",  pRegpath& "\" & pBrandingName & "\AES", pAES, 32
	
End Function

'----- DeleteBrandingInformation -----
'Description:	Delete branding information from values out of _uninstall.vbs
'Usage:			DeleteBrandingInformation()
'-------------------------------------
Function DeleteBrandingInformation()
	
	Dim pCustomer : pCustomer = "VWG"
	Dim pBrandingName : pBrandingName = pName &"_"& pVersion &"_"& pLang &"_"& pRevision
	Dim pRegpath : pRegpath = "HKLM\Software\"& pCustomer &"\InstalledProducts"
	dim pRegType : pRegType = "KEY"
	DeleteReg pRegType, pRegpath &"\"& pBrandingName, 32
	
End Function

'----- CheckLockScreen -----

Function CheckLockScreen()
	DIM IsWorkstationLocked
	Dim wmi : Set wmi = GetObject("winmgmts://" & computername & "/root/cimv2")
    Dim logonScreenCount : logonScreenCount = wmi.ExecQuery ("SELECT * FROM Win32_Process WHERE Name = 'LogonUI.exe'").Count
    If logonScreenCount > 0 then 
		LockScreenActive = true
		vbslog "LockScreen is active"
	else
		LockScreenActive = false
		vbslog "LockScreen is inactive"
	end if	

End Function

' ---- PanelWait2 ----

Function PanelWait2(process,timewait,rep, xmlFile)
	Dim Count : Count = 0
	PanelWait2 = True
	If CheckProc("TsBootShell.exe,TsmBootstrap.exe,TSManager.exe,TSProgressUI.exe,SMSBoot.exe") = True Then
		VbsLog "Information | OSD-Installation or tasksequence is running. Panel skipped."
		Exit Function
	End If
	dim CurrentUserSID : CurrentUserSID  = GetCurrentUserSID()
	If CurrentUserSID <> "" then VbsLog "CurrentUserSID | "&CurrentUserSID&""
	DIM CurrentUser : CurrentUser = GetCurrentUser()
	If CurrentUser <> "" then 
		VbsLog "CurrentUser | "&CurrentUser&""

		Do While (rep>0) And (CheckProc(process))
		run "Blende SCCM","Infoblende\AudiSysWrapper.exe Infoblende.exe " & xmlFile & " /w","0"
		KillProc process
			Do While (Count<(timewait/10)) And CheckProc(process) = True
			VbsLog "Process = "&process&""
			WScript.Sleep(10000)
			Count = Count + 1
			Loop
		rep = rep - 1
		Count = 0
		Loop
		If CheckProc(process) = True Then PanelWait2 = False
	
	end if
End Function


'----- Check VPN Connected ----

Function CheckVPNConnected()
	Dim objWMIService, colItems, objItem, objItem2
	Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2") 
	Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration",,48) 
	CheckVPNConnected = False

	For Each objItem in colItems
		If InStr(objItem.Description, "Check Point") <> 0 Or InStr(objItem.Description, "Cisco AnyConnect") <> 0 Then
			If objItem.IPEnabled = True Then
				For Each objItem2 In objItem.IPAddress
					If Left(objItem2, 2) <> "0." Then
						CheckVPNConnected = True
    				End If
    			Next
    		End If
    	End If
	Next
End Function