'=================================================
'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 pValidity, pName, pOSValidity, 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"
LogName = LogDir & pValidity & "_" & pName & "_" & pOSValidity & "_" & 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) = "6" 	Then strArgument = " /F"
	If Left(GetOSVersion(), 2) = "10" 	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) = "5" 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 "PS1","SA1"
			GetLocation = "SA"
		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
					Case 4 : GetLocation = "SA" : 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 "SA"
					GetLocation = "SA"
				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) = "5" 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(), 2)
				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
				Case "10"
					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 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, UninstallLogName

	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")
		UninstallLogName = LogDir & pName & "_" & pVersion & "_" & pLang & "_" & pRevision & "_msi-uninstall.log"
		run "Uninstall","msiexec.exe /x " & ProductCode & " /qn /norestart /lvoicewarmup+ """ & UninstallLogName & """", "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
  

' 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

' Bitwise left shift. (used in GetVersionStringAsArray)
Sub Lsh(ByVal N, ByVal Bits)
  Lsh = N * (2 ^ Bits)
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 pBrandingName : pBrandingName = pName &"_"& pVersion &"_"& pLang &"_"& pRevision
	DIM pNow: pNow = Now
	
	WriteReg "REG_SZ", 	regpath& "\" & pBrandingName & "\ProductName" ,pName, 32
	WriteReg "REG_SZ",	regpath& "\" & pBrandingName & "\ProductVersion", 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(Name, Version, Lang, Revision)
'-------------------------------------
Function DeleteBrandingInformation(Name, Version, Lang, Revision)
	
	Dim pBrandingName : pBrandingName = Name & "_" & Version & "_" & Lang & "_" & Revision
	Dim pRegpath : pRegpath = "HKLM\Software\VWG\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

'===========================================================================================
'				Addition from 15.09.2016
'===========================================================================================

'----- CreateBranding -----
Function CreateBranding(Validity, Name, Version, OSValidity, Lang, Revision, AES)
	
	Dim BrandingName 	: BrandingName = Validity & "_" & Name & "_" & OSValidity & "_" & Version & "_" & Lang & "_" & Revision
	DIM pRegpath 		: pRegpath = "HKLM\Software\VWG\InstalledProducts"
	DIM pCustomer 		: pCustomer = "VWG"
	Dim pNow			: pNow = Now
	
	WriteReg "REG_SZ", 		pRegpath& "\" & BrandingName & "\ProductName" ,Validity & "_" & Name & "_" & OSValidity, 32
	WriteReg "REG_SZ",		pRegpath& "\" & BrandingName & "\ProductVersion", Version, 32
	WriteReg "REG_SZ",		pRegpath& "\" & BrandingName & "\ProductLanguage", Lang, 32
	WriteReg "REG_SZ",		pRegpath& "\" & BrandingName & "\Revision", Revision, 32
	WriteReg "REG_SZ",  	pRegpath& "\" & BrandingName & "\InstallDate", Now, 32
	WriteReg "REG_DWORD", 	pRegpath& "\" & BrandingName & "\Installed", 1, 32
	WriteReg "REG_SZ",  	pRegpath& "\" & BrandingName & "\AES", AES, 32
	
End Function

'----- DeleteBranding -----
Function DeleteBranding(Validity, Name, Version, OSValidity, Lang, Revision)
	
	Dim DelBranding : DelBranding = Validity & "_" & Name & "_" & OSValidity & "_" & Version & "_" & Lang & "_" & Revision
	Dim pRegpath : pRegpath = "HKLM\Software\VWG\InstalledProducts\"
	DeleteReg "KEY", pRegpath & DelBranding, 32
	
End Function

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

	Dim objInstaller, UninstallLogName
	Dim UninstallName : UninstallName = pValidity & "_" & pName & "_" & pOSValidity & "_" & pVersion & "_" & pLang & "_" & pRevision
	
	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")
		UninstallLogName = LogDir & UninstallName & "_msi-uninstall.log"
		run "Uninstall","msiexec.exe /x " & ProductCode & " /qn /norestart /lvoicewarmup+ """ & UninstallLogName & """", "0,1605,3010"
		UninstallMSI = True
	Else
		VbsLog "Information | Uninstall Function:" & Name & " is not installed " & ProductCode
		UninstallMSI = False
	End If
	
End Function

'----- Uninstall MSI with custom Logfile-----
'Description:	Uninstall application with if installed
'Usage:			UninstallMSICustomLog <Name>,<ProductCode>
'Output			Returncode of uninstall if product ist deinstalled, False if product was not installed
'Example:		UninstallMSICustomLog "Apple QuickTime","{B332732A-4958-41DD-B439-DDA2D32753C5}","Apple_Quicktime_7.1.19_msi-uninstll.log"
'-----------------------------
Function UninstallMSICustomLog(Name,ProductCode,UninstallLogName)

	Dim objInstaller
		
	Const msiInstallStateUnknown = -1	'The product is neither advertised or installed.
	Set objInstaller = WScript.CreateObject("WindowsInstaller.Installer")
	UninstallLogName = LogDir & UninstallLogName
	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+ """ & UninstallLogName & """", "0,1605,3010"
		UninstallMSICustomLog = True
	Else
		VbsLog "Information | Uninstall Function:" & Name & " is not installed " & ProductCode
		UninstallMSICustomLog = False
	End If
	
End Function

'----- Install MSI -----
'Description:	Install MSI Application
'Usage:			InstallMSI <Name>,<Path to MSI>,<MST-Name>,<Additional Properties>
'Output			n/a
'Example:		InstallMSI pName & " " & pVersion,"Files\test.msi","Test.mst",""
'-----------------------------
Function InstallMSI(Name,PathtoMSI,MST,Properties)

	Dim InstallLogName
	If Properties <> "" Then Properties = " " & Properties
	If MST <> "" Then MST = " TRANSFORMS=" & MST 
	VbsLog "Installation: " & Name  
	InstallLogName = LogDir & Name & "_msi-install.log"
	run "Install " & Name,"msiexec.exe /i """ & PathtoMSI & """" & MST & " ARPNOREMOVE=1 ARPNOMODIFY=1 ARPNOREPAIR=1" & Properties & " /qn /norestart /lvoicewarmup """ & InstallLogName & """", "0,3010"

End Function

'----- Install MSI with custom defined Log Name -----
'Description:	Install MSI application with custom defined Log Name
'Usage:			InstallMSICustomLogName <Name>,<Path to MSI>,<MST-Name>,<Additional Properties>,<InstallLogName>
'Output			n/a
'Example:		InstallMSICustomLogName pName & " " & pVersion,"Files\test.msi","Test.mst","","Test_MSI-Install.log"
'-----------------------------
Function InstallMSICustomLogName(Name,PathtoMSI,MST,Properties,InstallLogName)

	If Properties <> "" Then Properties = " " & Properties
	If MST <> "" Then MST = " TRANSFORMS=" & MST 
	VbsLog "Installation: " & Name  
	InstallLogName = LogDir & InstallLogName
	run "Install " & Name,"msiexec.exe /i """ & PathtoMSI & """" & MST & " ARPNOREMOVE=1 ARPNOMODIFY=1 ARPNOREPAIR=1" & Properties & " /qn /norestart /lvoicewarmup """ & InstallLogName & """", "0,3010"

End Function

'----- Create Active Setup -----
'Description:	Creates an active setup
'Usage:			CreateActiveSetup()
'Output:		n/a
'------------------------
Function CreateActiveSetup()

	Dim ActiveSetupName : ActiveSetupName = pValidity & "_" & pName & "_" & pOSValidity & "_" & pVersion & "_" & pLang & "_" & pRevision
	Dim Pfad : Pfad = "wscript.exe ""c:\windows\sw-source\" & ActiveSetupName & "\ActiveSetup.vbs"" //B"
	Dim Version : Version = pVersion
	VbsLog "---------- Execute Active Setup Function: '" & ActiveSetupName & "' '" & Pfad
	If CheckFolder ("ActiveSetup") Then
		CreateFolder WinDir & "\SW-Source\" & ActiveSetupName
		CopyFile "ActiveSetup\*.*", WinDir & "\SW-Source\" & ActiveSetupName & "\"
		CopyFile ".\_Functions.vbs", WinDir & "\SW-Source\" & ActiveSetupName & "\"
	End If

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

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

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


'----- Remove Active Setup -----
'Description:	Removes an active setup
'Usage:			RemoveActiveSetup()
'Output:		n/a
'------------------------
Function RemoveActiveSetup()

	Dim RemovalName : RemovalName = pValidity & "_" & pName & "_" & pOSValidity & "_" & pVersion & "_" & pLang & "_" & pRevision
	DeleteReg "Key", "HKLM\SOFTWARE\Microsoft\Active Setup\Installed Components\" & RemovalName, GetOSBit()
	DeleteFolder WinDir & "\SW-Source\" & RemovalName
	
End Function