VBScript Strange Issue with HTA and Type mismatch error - vbscript

When I run the following script on it's own by double clicking, it works just fine. It returns the last logged on user as expected. But when I run it from the HTA I have been developing as a front end to all of my scripts, I get a type mismatch error on the "wscript.echo strvalue" line. I have tried everything to get it to work, like changing permissions on mshta.exe to full control for myself. I simply can't get it to run from the HTA without getting an error, but it works 100% as expected on its own. I am completely stumped.
strinput = "myserver"
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strinput & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI"
strValueName = "LastLoggedOnUser"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
Wscript.Echo strValue

By default, Windows 64-bit uses MSHTA.EXE 32-bit. The registry has a separate branches for 64-bit and 32-bit apps, thus WMI can't find the registry value you are looking for.
Save the code below to e. g. C:\test\tmp.hta, try to launch it from explorer by double-click (32-bit by default) - you will get null, and then launch via Run dialog (Win+R) with path: %windir%\system32\mshta.exe "C:\test\tmp.hta" (64-bit), the result will be your username.
<html>
<head>
<script language="vbscript">
Sub window_onload()
Const HKEY_LOCAL_MACHINE = &H80000002
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Authentication\LogonUI"
strValueName = "LastLoggedOnUser"
objRegistry.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath, strValueName, strValue
document.body.innerText = strValue
End Sub
</script>
</head>
<body>
</body>
</html>
Note that many other stuff within scripts depends on application architecture, e. g. number of ActiveX are available only in 32-bit version, so they should be launched via %windir%\SysWOW64\ (Windows 32-bit on Windows 64-bit subsystem).

Use Msgbox function instead of Wscript.Echo method. HTAs use the Internet Explorer Scripting Object Model which does not contain Wscript object (this belongs to Windows Script Host Object Model).
Read HTA: Why Can’t I Use Wscript.Echo?:
You might have noticed that when it came time to report back the
operating system version we used the VBScript Msgbox function rather
than the more common Wscript.Echo. Why didn’t we use Wscript.Echo?
Here’s why:
As it turns out the various Wscript methods - Wscript.Echo,
Wscript.Sleep, Wscript.Quit, etc. - are designed solely to run under
the Windows Script Host environment. When we’re working in an HTA
we’re not running under WSH; instead we’re running under the MSHTA
process. Because of that the Wscript methods are not available to us
(nor can we create them). Consequently we need to find workarounds for
each method, and Msgbox is a perfectly adequate replacement for
Wscript.Echo. (We’ll talk about workarounds for other methods - such
as Wscript.Sleep - when we get to them.)
The moral of the story: Don’t bother with Wscript.Echo; it won’t work.
Edit: with Wscript.Echo TypeName(strValue) & vbNewLine & VarType(strValue):
==> C:\Windows\System32\cscript.exe D:\VB_scripts\SO\33505295.vbs
String
8
==> C:\Windows\SysWOW64\cscript.exe D:\VB_scripts\SO\33505295.vbs
Null
1
Tried in a simple HTA which gives the same (different) result
==> C:\Windows\System32\mshta.exe 33505295.hta
versus
==> C:\Windows\SysWOW64\mshta.exe 33505295.hta
Conclusion. Check HTA file type association. For instance, ftype htafile in my Windows 8 (64bit) returns (surprisingly?) the same value which causes wrong behaviour on double click:
==> assoc .hta
.hta=htafile
==> ftype htafile
htafile=C:\Windows\SysWOW64\mshta.exe "%1" {1E460BD7-F1C3-4B2E-88BF-4E770A288AF5}%U{1E460BD7-F1C3-4B2E-88BF-4E770A288AF5} %*

I have had the same challenge a few weeks ago.
The following code provided me the possibility to see who is currently logged onto a remote computer.
I hope this can help you.
Sub ActionGetCurrentUser(strCPU) 'strCPU is the computername
set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strCPU & "\root\cimv2")
set Items = objWMI.ExecQuery("Select * From Win32_ComputerSystem")
For Each obj in Items
OutStr = right(obj.username,9)
Next
Resultstring = "Logged in User is: " & OutStr
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strTarget = "LDAP://" & strDNSDomain
' ---------------- Write the User's account & password to a variable -------------------
strCurrentuser = Currentuser.value
strPassword = PasswordArea.value
' ---------------- Connect to Ad Provider ----------------
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Properties("User ID") = strCurrentUser ' pass credentials - if you omit this, the search is performed....
objConnection.Properties("Password") = strPassword ' ... with the current credentials
objConnection.Properties("Encrypt Password") = True ' only needed if you set "User ID" and "Password"
objConnection.Open "Active Directory Provider"
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = objConnection
objCmd.CommandText = "SELECT DisplayName FROM '" & strTarget & "' WHERE extensionAttribute11 = '" & OutStr & "'"
Const ADS_SCOPE_SUBTREE = 2
objCmd.Properties("Page Size") = 100
objCmd.Properties("Timeout") = 30
objCmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCmd.Properties("Cache Results") = False
Set objRecordSet = objCmd.Execute
If objRecordset.Recordcount = 0 then ' If no user is found then the recordcount will be 0
msgbox "No user is logged on"
Resultstring = ""
Set objCmd = Nothing
Set objRootDSE = Nothing
Set objRecordSet = Nothing
Set objWMI = Nothing
Set Items = Nothing
exit sub
End if
Set objRecordSet = objCmd.Execute
objRecordSet.MoveFirst
Resultstring = Resultstring & vbcrlf & "Name: " & objRecordset.fields("DisplayName")
Msgbox Resultstring
Resultstring = ""
Set objCmd = Nothing
Set objRootDSE = Nothing
Set objRecordSet = Nothing
Set objWMI = Nothing
Set Items = Nothing
End Sub

Related

800A0408, 800A0400 errors [duplicate]

I am trying to create a registry key and subkey for enabling IE 11 enterprise mode for all users on a machine. This is what I am using for my VBScript currently and it is failing horribly (does not add the key). I could use some assistance in getting this corrected.
Const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
Set ObjRegistry = _
GetObject("winmgmts:{impersonationLevel = impersonate}! \\" & _
strComputer & "\root\default:StdRegProv")
strPath = strKeyPath & "\" & strSubPath
strKeyPath = "Software\Policies\Microsoft"
strSubPath = "Internet Explorer\Main\EnterpriseMode"
strName = "Enabled"
ObjRegistry.CreateKey (HKEY_LOCAL_MACHINE, strPath)
ObjRegistry.SetStringValue HKEY_LOCAL_MACHINE, strPath, strName, strValue
MsgBox "Successfully enabled Internet Explorer Enterprise Mode."
End Function
There are several issues with your code, aside from the fact that you posted an incomplete code sample.
"winmgmts:{impersonationLevel = impersonate}! \\" & strComputer & "\root\default:StdRegProv"
The WMI moniker contains a spurious space between security settings and path (...! \\...). Remove it.
As a side note, it's pointless to use a variable for the hostname if that hostname never changes.
strPath = strKeyPath & "\" & strSubPath
You define strPath before you define the variables you build the path from. Also, your path components are defined as string literals, so you could drop the concatenation and the additional variables and simply define strPath as a string literal.
ObjRegistry.CreateKey (HKEY_LOCAL_MACHINE, strPath)
You must not put argument lists in parentheses unless you're calling the function/method/procedure in a subexpression context. See here for more details. However, you may want to check the return value of your method calls to see if they were successful.
And FTR, hungarian notation is pointless code bloat. Don't use it.
Modified code:
Function SetEnterpriseMode(value)
Const HKLM = &h80000002
Set reg = GetObject("winmgmts:{impersonationLevel=impersonate}!//./root/default:StdRegProv")
path = "Software\Policies\Microsoft\Internet Explorer\Main\EnterpriseMode"
name = "Enabled"
rc = reg.CreateKey(HKLM, path)
If rc <> 0 Then
MsgBox "Cannot create key (" & rc & ")."
Exit Function
End If
rc = reg.SetStringValue(HKLM, path, name, value)
If rc = 0 Then
MsgBox "Successfully enabled Internet Explorer Enterprise Mode."
Else
MsgBox "Cannot set value (" & rc & ")."
End If
End Function

Listing printers on remote machines. Not seeing the same results as I would if I were logged on locally as the user

My script is supposed to list all the printers installed on a remote machine and write that data to a text file while designating if the printer is Local or Network. When I run the script against my local machine with my profile logged on I get the following results:
Local
Microsoft XPS Document Writer
Network
\\PrintServer\PT-NJ-CPR-B-CORPIT-1
Network
\\PrintServer\PT-NJ-CPR-B-ITTEMP-1
Network
\\PrintServer\CPR5A26D1A
These results are exactly what I want however when I run the same script against a remote machine I still get results but they seem to be for a more generic user
Local
Send To OneNote 2010
Local
Microsoft XPS Document Writer
Local
Fax
My question is how do I customize my script to truly impersonate the logged on user thus returning me the full results even from a remote machine?
Const ForAppending = 8
Const ForReading = 1
Dim WshNetwork, objPrinter, intDrive, intNetLetter, fso
Set fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("C:\xVBS Scripts\Printer Scripts\Computers.txt", 1)
Do Until InputFile.AtEndOfStream
strComputer = InputFile.ReadLine
Set WshNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer")
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objItem in colItems
UserName = objItem.UserName
arrUserName = Split(UserName, "\", -1, 1)
varUserName = arrUserName(1)
Next
filOutput = varUserName & ".txt"
If objFSO.FileExists(filOutput) Then
objFSO.DeleteFile(filOutput)
End If
Set objOutputFile = objFSO.OpenTextFile (filOutput, ForAppending, True)
For Each objPrinter in colInstalledPrinters
If objPrinter.Attributes And 64 Then
strPrinterType = "Local"
strTest = Left(objPrinter.Name, 2)
objOutputFile.WriteLine(strPrinterType)
objOutputFile.WriteLine(objPrinter.Name)
objOutputFile.WriteLine(vbNewLine)
Else
strPrinterType = "Network"
strTest = Left(objPrinter.Name, 2)
objOutputFile.WriteLine(strPrinterType)
objOutputFile.WriteLine(objPrinter.Name)
objOutputFile.WriteLine(vbNewLine)
End If
Next
Wscript.Sleep 1500
MsgBox "Printer mapping report is located" & vbNewLine & "in the following directory: " & filOutput , vbInformation, "Report Located At"
WshShell.Run "Notepad " & filOutput,1,False
Loop
InputFile.Close
Wscript.Quit
I dont think there is an actual answer to this. The more I learn about VB Script and Powershell it appears as if WMI is most useful when run interactively. It doesn't know how to process users who are not currently logged in. I bypass this problem by running the script as a GPO Link/Enforced that calls the script as a log on script. – JRN just now edit

ignore workstations that are offline and resume

I have this VBScript to help me remove local users from the local admins. I can't seem to get it to ignore workstations that are not on the network.
Is there a way to ignore workstations that are not found and have it continue to the next line under the computers.txt file?
For example, say PC1 and PC3 are found but PC2 is not found I want it to ignore not found workstations and continue until the end of the list of computers.
I've tried On Error Resume Next (didnt work), and I tried Const ForReading = 1, Const ForAppending = 8, Const OverwriteExisting = True (didnt work either).
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("C:\adminScript\computers.txt")
strComputer = objFile.ReadLine
Set objGroup = GetObject("WinNT://" & strComputer & "/Administrators")
For Each objUser In objGroup.Members
If objUser.Name <> "Administrator" AND objUser.Name <> "Domain Admins" AND objUser.Name <> "G_SCCMAgent" AND objUser.Name <> "User" Then
Wscript.Echo objUser.Name
objGroup.Remove(objUser.ADsPath)
End If
Next
wscript.Echo "I am done!"
Contrary to popular belief On Error Resume Next doesn't magically make errors go away. Neither does defining symbolic constants for parameters of the OpenTextFile method.
If you want to skip over computers that aren't available you need to actually test the availability of each computer. A common way to do this is the Win32_PingStatus WMI class.
Set wmi = GetObject("winmgmts://./root/cimv2")
isAvailable = False
qry = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
For Each res In wmi.ExecQuery(qry)
If res.StatusCode = 0 Then isAvailable = True
Next
If isAvailable Then
'modify administrators group
End If
Also, you probably need to process the content of computers.txt in a loop. Your current code reads only the first line. To process more than one line from the file use something like this:
Set objFile = objFSO.OpenTextFile("C:\adminScript\computers.txt")
Do Until objFile.AtEndOfStream
strComputer = objFile.ReadLine
'...
Loop
objFile.Close

Small VBScript Does Not Work in HTA

I'm using the following VBSript and it works fine, however when I a attempt to add it to a .hta app I've created, it does not function correctly.
Firstly, the 'strValue' does not show in the MsgBox and secondly script errors appear such as "Type mismatch: 'fso.FolderExists'"
Any help would be greatly appreciated as I've been struggling to figure this out.
sub LyncFix
dim oReg, strKeyPath, strValueName, strValue, oWS, userProfile
Const HKEY_LOCAL_MACHINE = &H80000002
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Components\C7376A18AE70EB645A6EA7E5F5CE44F9"
strValueName = "71B0EB18B3654D541B8975126E6C56DC"
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
MsgBox "Folder required to resolve Lync Install prompt: " & strValue
Dim fso
Dim Folder
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FolderExists(strValue)) Then
MsgBox("The folder '" + strValue + "' already exists")
end If
If NOT (fso.FolderExists(strValue)) Then
' Delete this if you don't want the MsgBox to show
MsgBox("Local folder doesn't exist, creating...")
' Create folder
MsgBox("'" + strValue + "'" + " created")
fso.CreateFolder(strValue)
MsgBox("Please now try launching Lync again")
End If
end sub
Two side-notes only:
querying HTML with GetStringValue method gives different results for different Windows Script Host executable versions (32 bit vs. 64 bit as manifested in next example);
CreateFolder method might require elevated privileges.
Example: with strComputer = "." and next amendment
'
oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
' the amendment in 29026643.vbs as follows:
Wscript.Echo VarType(strValue) & vbTab & TypeName(strValue)
'
I have got next output on Windows 8, 64 bit:
==>%windir%\sysWOW64\cscript.exe D:\VB_scripts\SO\29026643.vbs
1 Null
==>%windir%\system32\cscript.exe D:\VB_scripts\SO\29026643.vbs
8 String
==>
Analogous output (with windowed echo) with different versions of wscript.exe.
Analogous output with sub LyncFix defined and used in a basic hta (with msgbox instead of Wscript.Echo) and with different versions of mshta.exe as follows:
==>%winDir%\sysWOW64\mshta.exe D:\VB_scripts\SO\29026643.hta
==>%winDir%\system32\mshta.exe D:\VB_scripts\SO\29026643.hta

Attempting to extract printers from users machine and then outputting to a text fill.

I am attempting to extract the printers from a users machine and then output to a text file but when I run the test I get a invalid procedure call or argument for this specific line of code.
Set objOutputFile = objFSO.OpenTextFile(outFile, ForAppending, True)
I have attempted to change OpenTextFileto CreateTextFile but I need the lines to appended to file as it will be running as a log on script.
I have done some research and used the Microsoft developer articles to help me debug the issue in the code but I don't have much experience in Visual Basic.
I have added the entire script to give context to the what is going on.
dim objComputerName, ObjNetwork , strText , objfile, StrComputer
dim wshnetwork
Set wshnetwork = CreateObject ("Wscript.network")
StrComputer = WshNetwork.ComputerName
If IsEmpty(StrComputer) Then Wscript.Quit
Set WshNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer")
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
outFile = "C:\scripts\Printers" & StrComputer
Set objOutputFile = objFSO.OpenTextFile(outFile, ForAppending, True)
For Each objPrinter in colInstalledPrinters
strTest = Left(objPrinter.Name, 2)
objOutputFile.WriteLine(objPrinter.Name)
objfile.close
Next
Set objPrinter = WshNetwork.EnumPrinterConnections
'Set objOutputFile = objFSO.OpenTextFile (filOutput, ForAppending, True)
If objPrinter.Count = 0 Then
WScript.Echo "No Printers Mapped "
else
For intDrive = 0 To (objPrinter.Count -1) Step 2
intNetLetter = IntNetLetter +1
printer = "UNC Path " & objPrinter.Item(intDrive) & " = " & objPrinter.Item(intDrive +1) & " Printer : " & intDrive
objOutputFile.WriteLine(printer)
Next
end if
objOutputFile.Close``*
Invalid procedure call or argument
You passed an invalid parameter in your procedure call. This could be because the parameter was out of range, or contained invalid data. Alternately, you may have invoked a procedure at an unexpected time.
To correct this error
Verify that the parameters being passed to the procedure are valid.
Verify that you are calling the function at an appropriate time.
My guess is this line is an ilegal filename.
outFile = "C:\scripts\Printers" & StrComputer
On my computer this is c:\scripts\PrintersSerenity which is probably not right that your text file is called PrintersSerenity without an extension.

Resources