2866 lines
96 KiB
Plaintext
2866 lines
96 KiB
Plaintext
'=================================================
|
||
'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<53>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<6E>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<50>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
|