I've been facing this dialogue box just after I start my script
Script: C:\konica.vbs
Line: 14
Char: 1
Error: Out of Memory: 'GetObject'
Code: 800A0007
Source: Microsoft VBScript runtime error
This is my script:
Set wshShell = CreateObject("WScript.Shell")
strCurrDir = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
'### Konica ###
strIPAddress = "192.168.110.168"
strComputer = "."
strPrinterName = "Konica"
strDriverName = "KONICA MINOLTA C353 Series PS"
strLocation = "Konica"
strInfFile = "\\stp\HHard\Printers\KONICA MINOLTA\XP(x86)\BHC353PSWinx86_6500RU\BHC353PSWinx86_6500RU\KOAZXA__.INF"
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(LoadDriver)}!\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer Where PortName = 'IP_" & strIPAddress & "' ")
For Each objPrinter in colPrinters
MsgBox "Unable to install printer, printer already found on port 'IP_" & strIPAddress & "'." & VbCrlf & VbCrlf & "Found: " & objPrinter.DeviceID, vbExclamation + vbSystemModal, "Printer Port already assigned"
WSCript.Quit 114001
Next
'MsgBox(strIPAddress)
Set objNewPort = objWMIService.Get("Win32_TCPIPPrinterPort").SpawnInstance_
objNewPort.Name = "IP_" & strIPAddress
objNewPort.Protocol = 1
objNewPort.HostAddress = strIPAddress
objNewPort.PortNumber = "9100"
objNewPort.SNMPEnabled = False
objNewPort.Put_
wshShell.Run "rundll32 printui.dll,PrintUIEntry /if /b """ & strPrinterName & """ /f """ & strInfFile & """ /r ""IP_" & strIPAddress & """ /m """ & strDriverName & """", 1, True
Set colPrinters = objWMIService.ExecQuery("Select * From Win32_Printer Where DeviceID = '" & strPrinterName & "' ")
For Each objPrinter in colPrinters
objPrinter.Location = strLocation
objPrinter.Put_
Next
You can see, that it script for installing in my system printer 'Konica'. In other system, it script works fine. Where mistake? Please help ?
I'm probably on a wrong tangent here but try giving the MsgBox a variable and then using code that doesn't do anything.
For example:
MsgBox "Unable to install printer, printer already found on port 'IP_" & strIPAddress & "'." & VbCrlf & VbCrlf & "Found: " & objPrinter.DeviceID, vbExclamation + vbSystemModal, "Printer Port already assigned"
becomes
x = MsgBox "Unable to install printer, printer already found on port 'IP_" & strIPAddress & "'." & VbCrlf & VbCrlf & "Found: " & objPrinter.DeviceID, vbExclamation + vbSystemModal, "Printer Port already assigned"
Then you could write
If x Then
Else
End If
Which would run and do nothing because x is always x but there's nothing to run inside the If statement.
That error means that your system is low on memory. The line numbering is questionable in your post, but I would venture a guess that the size of the printer driver is pretty large.
Related
I am trying to use .Exec to pull back the IP configuration of a machine. From the given output of the command I then want to return all the wireless and Ethernet LAN IPv4 addresses or "media disconnected" if not present. I am pretty stuck on how to approach this as users can often have multiple NIC's. I can get the output however I am not sure how to iterate through the results of the ipconfig to store the information I need.
Set objShell = CreateObject("WScript.Shell")
StrIPConfig = "ipconfig /all"
Set IPConfig = objShell.Exec(StrIPConfig)
strText = ""
Do While Not IPConfig.StdOut.AtEndOfStream
strText = IPConfig.StdOut.Readline
If InStr(strText, "Wireless Network Connection") Then
strWLAN = IPConfig.StdOut.Readline +2
WScript.Echo strWLAN
End If
Loop
Do While Not IPConfig.StdOut.AtEndOfStream
strText = IPConfig.StdOut.Readline
If InStr(strText, "Local Area Connection") Then
strLAN = IPConfig.StdOut.Readline +2
WScript.Echo strWLAN
End If
Loop
Has to be done via WMI Windows batch file or WMI VBscript or VBScript using Exec as above. PowerShell, unfortunately, is not an option.
Use WMI (specifically the Win32_NetworkAdapterConfiguration class) instead of shelling out:
Set wmi = GetObject("winmgmgts://./root/cimv2")
qry = "SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True"
For Each nic In wmi.ExecQuery(qry)
For Each addr In nic.IPAddress
WScript.Echo addr
Next
Next
I have adapted an answer from another forum, using a WMI script wrapped by VBScript. It is currently storing the information as a string however it will be easy enough to adapt now:
strWLAN = ""
strLAN = ""
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set IPAdapterSet = objWMIService.ExecQuery("Select AdapterType, NetConnectionID, MACAddress from Win32_NetworkAdapter WHERE NetConnectionID LIKE 'Wireless network%'")
For Each IPConfig in IPAdapterSet
Set IPConfigSet = objWMIService.ExecQuery("Select IPEnabled, Description, Caption, IPAddress, MACAddress from Win32_NetworkAdapterConfiguration where IPEnabled='True' AND MACAddress = '" & IPConfig.MACAddress & "' ")
For Each IPConf in IPConfigSet
if NOT strWLAN="" then
strWLAN = strWLAN & vbCrLf
end if
strWLAN = strWLAN & " " & IPConfig.NetConnectionID & " "
If Not IsNull(IPConf.IPAddress) Then
For i = LBound(IPConf.IPAddress) to UBound(IPConf.IPAddress)
If Not ((Instr(IPConf.IPAddress(i), ":") > 0) or (Instr(IPConf.IPAddress(i), "none") > 0)) Then
if i=0 then
strWLAN = strWLAN & " " & IPConf.IPAddress(i)
else
strWLAN = strWLAN & ", " & IPConf.IPAddress(i)
end if
End If
Next
End If
next
Next
Set objWMIService2 = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set IPAdapterSet2 = objWMIService2.ExecQuery("Select AdapterType, NetConnectionID, MACAddress from Win32_NetworkAdapter WHERE NetConnectionID LIKE 'Local Area Connection%'")
For Each IPConfig in IPAdapterSet2
Set IPConfigSet = objWMIService.ExecQuery("Select IPEnabled, Description, Caption, IPAddress, MACAddress from Win32_NetworkAdapterConfiguration where IPEnabled='True' AND MACAddress = '" & IPConfig.MACAddress & "' ")
For Each IPConf in IPConfigSet
if NOT strLAN="" then
strLAN = strLAN & vbCrLf
end if
strLAN = strLAN & " " & IPConfig.NetConnectionID & " "
If Not IsNull(IPConf.IPAddress) Then
For i = LBound(IPConf.IPAddress) to UBound(IPConf.IPAddress)
If Not ((Instr(IPConf.IPAddress(i), ":") > 0) or (Instr(IPConf.IPAddress(i), "none") > 0)) Then
if i=0 then
strLAN = strLAN & " " & IPConf.IPAddress(i)
else
strLAN = strLAN & ", " & IPConf.IPAddress(i)
end if
End If
Next
End If
next
Next
wscript.Echo strWLAN
wscript.Echo strLAN
I am trying to run following VB Script to run command on remote machine. I want this script to wait until command is executed completely.
Here is my code:
Function RemoteExecute(strServer, strUser, strPassword, strCommand,pro)
Dim objLocator , objWMIService
wbemImpersonationLevelImpersonate = 3
wbemAuthenticationLevelPktPrivacy = 6
RemoteExecute = -1
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
On Error Resume Next
Set objWMIService = objLocator.ConnectServer(strServer,"root\cimv2", strUser,strPassword)
objWMIService.Security_.ImpersonationLevel = wbemImpersonationLevelImpersonate
objWMIService.Security_.AuthenticationLevel = wbemAuthenticationLevelPktPrivacy
If Err.Number <> 0 Then
WScript.Echo "Failed to connect to " &strServer, "Error # " & CStr(Err.Number) & " " & Err.Description & vbcrlf & _
"Please check if " & strServer & " is pingable from this client & credentials are correct"
Err.Clear
On Error GoTo 0
RemoteExecute = -1
Set objWMIService = nothing
Set objLocator = nothing
Exit function
end if
' Configure the process to show a window
Set objStartup = objWMIService.Get("Win32_ProcessStartup")
Set objConfig = objStartup.SpawnInstance_
objConfig.ShowWindow = SW_NORMAL
Set Process = objWMIService.Get("Win32_Process")
'Process.Create Syntax: '
' uint32 Create(
'[in] string CommandLine,
'[in] string CurrentDirectory,
'[in] Win32_ProcessStartup ProcessStartupInformation,
'[out] uint32 ProcessId
');
'Return code Description
'0 Successful Completion
'2 Access Denied
'3 Insufficient Privilege
'8 Unknown failure
'9 Path Not Found
'21 Invalid Parameter
intReturn = Process.Create(strCommand,NULL, objConfig, intProcessID)
If intReturn <> 0 Then
Wscript.Echo "Process could not be created." & _
vbNewLine & "Command line: " & strCommand & _
vbNewLine & "Return value: " & intReturn
Wscript.Quit
Else
Wscript.Echo "Process created." & _
vbNewLine & "Command line: " & strCommand & _
vbNewLine & "Process ID: " & intProcessID
RemoteExecute = intProcessID
End If
' Set objWMIService = GetObject("winmgmts:\\" & strServer & "\root\cimv2")
Set colMonitoredProcesses = objWMIService.ExecNotificationQuery_("SELECT *" +" FROM __InstanceDeletionEvent " +"WITHIN 5 WHERE TargetInstance ISA 'Win32_Process' " )
Do
Set objProcess = colMonitoredProcesses.NextEvent
Wscript.Echo objProcess.TargetInstance.Name
Wscript.Echo objProcess.TargetInstance.ExecutablePath
Wscript.Echo "1"
Wscript.Echo "proc:" & objProcess.TargetInstance.ProcessID
Wscript.Echo "int:" & intProcessID
If objProcess.TargetInstance.ProcessID = intProcessID Then
Wscript.Echo "I will end the monitoring of the process "
Wscript.Echo pro & objProcess.TargetInstance.Name
Exit Do
end If
Loop
Set objWMIService = nothing
Set objLocator = nothing
End Function
strServer = WScript.Arguments.Item(0)
strUser = WScript.Arguments.Item(1)
strPassword = WScript.Arguments.Item(2)
strCommand = WScript.Arguments.Item(3)
pro = WScript.Arguments.Item(4)
Call RemoteExecute(strServer, strUser, strPassword, strCommand,pro)
But problem I am facing is that, script run the process in background but not waiting for it.
Another point that I do not understand is, when try to echo following:
Wscript.Echo objProcess.TargetInstance.Name
Wscript.Echo objProcess.TargetInstance.ExecutablePath
Wscript.Echo "proc:" & objProcess.TargetInstance.ProcessID
it does no echo anything, whereas following are properly echoed with a nice pop up
Wscript.Echo "1"
Wscript.Echo "int:" & intProcessID
Can someone please resolve my problem, may be this problem is naive for someone, sorry I am naive here.
I need some help with deleting network printer driver remotely on a Windows 7 client machine using a vbscript with an account having administrator privileges (Elevated Account) on the remote computer. The problem is that I can't delete the connected printer the user have connected. Everything else seems to work. Below is the code for the script.
The script does several things, but the ultimate goal is to physically remove the printer-drivers. The current version of the script fails since the driver files are in use. The script contains code to avoid deleting special printers. It also stops and starts the print spooler.
intSleep = 4000
strService = " 'Spooler' "
strComputer = "<remote computer name>"
Set fsobj = CreateObject("Scripting.FileSystemObject") 'Calls the File System Object
Set objNetwork = CreateObject("WScript.Network")
arrPrinters = Array("PDF", "Adobe", "Remote", "Fax", "Microsoft", "Send To", "Generic")
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
' List drivers
Set colInstalledPrinters = objWMIService.ExecQuery _
("Select * from Win32_PrinterDriver")
Set drivrutinCol = CreateObject("Scripting.Dictionary")
For each objPrinter in colInstalledPrinters
' Wscript.Echo "Configuration File: " & objPrinter.ConfigFile
' Wscript.Echo "Data File: " & objPrinter.DataFile
' Wscript.Echo "Description: " & objPrinter.Description
' Wscript.Echo "Driver Path: " & objPrinter.DriverPath
' Wscript.Echo "File Path: " & objPrinter.FilePath
' Wscript.Echo "Help File: " & objPrinter.HelpFile
' Wscript.Echo "INF Name: " & objPrinter.InfName
' Wscript.Echo "Monitor Name: " & objPrinter.MonitorName
' Wscript.Echo "Name: " & objPrinter.Name
' Wscript.Echo "OEM Url: " & objPrinter.OEMUrl
' Wscript.Echo "Supported Platform: " & objPrinter.SupportedPlatform
' Wscript.Echo "Version: " & objPrinter.Version
if InArray(objPrinter.Name, arrPrinters ) = False then
Wscript.Echo "Name: " & objPrinter.Name
drivrutinCol.Add drivrutinCol.Count, Replace(objPrinter.ConfigFile, "C:", "\\" & strComputer & "\c$")
drivrutinCol.Add drivrutinCol.Count, Replace(objPrinter.DataFile, "C:", "\\" & strComputer & "\c$")
drivrutinCol.Add drivrutinCol.Count, Replace(objPrinter.DriverPath, "C:", "\\" & strComputer & "\c$")
end if
Next
' Remove network printers
Const NETWORK = 22
Set colInstalledPrinters = objWMIService.ExecQuery _
("Select * From Win32_Printer")
For Each objPrinter in colInstalledPrinters
If objPrinter.Attributes And NETWORK Then
' The code never gets here for user connected network printers
End If
Next
' Stop Print Spooler Service
Set colListOfServices = objWMIService.ExecQuery _
("Select * from Win32_Service Where Name ="_
& strService & " ")
For Each objService in colListOfServices
objService.StopService()
WSCript.Sleep intSleep
Next
' Delete drivers
for i = 0 to drivrutinCol.Count-1
Wscript.Echo "Deleting driver: " & drivrutinCol.Item(i)
fsobj.DeleteFile(drivrutinCol.Item(i))
Next
' Start Print Spooler Service
For Each objService in colListOfServices
WSCript.Sleep intSleep
objService.StartService()
Next
Function InArray(item,myarray)
Dim i
For i=0 To UBound(myarray) Step 1
If InStr(lcase(item), lcase(myarray(i)))>0 Then
InArray=True
Exit Function
End If
Next
InArray=False
End Function
The failing part of the code is the "Remove network printers" - part. The script does not list the network printers that the user have connected in the user profile, but only the local printers connected to the computer profile.
To remove a (network) printer connection of a user who isn't logged in you need to load the user hive into the registry and delete the respective value from the Printers\Connections subkey:
Function qq(str) : qq = Chr(34) & str & Chr(34) : End Function
Set sh = CreateObject("WScript.Shell")
username = "..."
hive = "\\" & strComputer & "\C$\Users\" & username & "\ntuser.dat"
sh.Run "reg load HKU\temp " & qq(hive), 0, True
sh.RegDelete "HKEY_USERS\temp\Printers\Connections\server,printer"
sh.Run "reg unload HKU\temp", 0, True
You need to load the hive from a network share, because unlike other subcommands load and unload don't work with remote registries.
To delete a printer driver (after you removed the printer connection from the user's config) you need to acquire the SeLoadDriverPrivilege first and then remove the respective instance of the Win32_PrinterDriver class (see section "Remarks"):
objWMIService.Security_.Privileges.AddAsString "SeLoadDriverPrivilege", True
qry = "SELECT * FROM Win32_PrinterDriver"
For Each driver In objWMIService.ExecQuery(qry)
If driver.Name = "..." Then driver.Delete_
Next
I have a couple questions and am hoping this is the correct place.
basically what i want to do is to be able to remotely get info about a domain computer.
i have 3 seperate scripts that give me 1( IP configuration, comp name ... ), 2 ( installed software ) and 3 ( mapped drives ).
the first two ask for the IP/computer name and the 3rd i have to input that into the script... i would like to only have to input the IP address once and have it work for all 3
secondly i would like the output file that this info is put into to be named like the installed software script does and then just have the other two scripts add ( ammend ) to the already created output.
I am super new to vbs so any help would be awesome
SCRIPT 1 ( gets IP configuration )
dim strComputer 'for computer name or IP
dim colAdapters 'collection of adapters
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("output.txt", True)
strComputer = ""
'open a dialog box asking for the computer name/IP
do
strComputer = inputbox( "Please enter a computername/IP, or . for local computer", "Input" )
Loop until strComputer <> "" 'run until a name/IP is entered
Set objWMIService = GetObject ("winmgmts:" & "!\\" & strComputer & "\root\cimv2") 'open the WMI service on the remote PC
Set colAdapters = objWMIService.ExecQuery ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled = True")
'go through the list of adapters and gather data
For Each objAdapter in colAdapters
objFile.Writeline "Host name: " & objAdapter.DNSHostName
objFile.Writeline "DNS domain: " & objAdapter.DNSDomain
objFile.Writeline "DNS suffix search list: " & objAdapter.DNSDomainSuffixSearchOrder
objFile.Writeline "Description: " & objAdapter.Description
objFile.Writeline "Physical address: " & objAdapter.MACAddress
objFile.Writeline "DHCP enabled: " & objAdapter.DHCPEnabled
If Not IsNull(objAdapter.IPAddress) Then
For i = LBound(objAdapter.IPAddress) To UBound(objAdapter.IPAddress)
objFile.Writeline "IP address: " & objAdapter.IPAddress(i)
Next
End If
If Not IsNull(objAdapter.IPSubnet) Then
For i = LBound(objAdapter.IPSubnet) To UBound(objAdapter.IPSubnet)
objFile.Writeline "Subnet: " & objAdapter.IPSubnet(i)
Next
End If
If Not IsNull(objAdapter.DefaultIPGateway) Then
For i = LBound(objAdapter.DefaultIPGateway) To UBound(objAdapter.DefaultIPGateway)
objFile.Writeline "Default gateway: " & objAdapter.DefaultIPGateway(i)
Next
End If
objFile.Writeline "DHCP server: " & objAdapter.DHCPServer
If Not IsNull(objAdapter.DNSServerSearchOrder) Then
For i = LBound(objAdapter.DNSServerSearchOrder) To UBound(objAdapter.DNSServerSearchOrder)
objFile.Writeline "DNS server: " & objAdapter.DNSServerSearchOrder(i)
Next
End If
objFile.Writeline "Primary WINS server: " & objAdapter.WINSPrimaryServer
objFile.Writeline "Secondary WINS server: " & objAdapter.WINSSecondaryServer
objFile.Writeline "Lease obtained: " & objAdapter.DHCPLeaseObtained
objFile.Writeline "Lease expires: " & objAdapter.DHCPLeaseExpires
Next
SCRIPT 2 ( gets installed software )
Option Explicit
Dim sTitle
sTitle = "InstalledPrograms.vbs by Bill James"
Dim StrComputer
strComputer = InputBox("Enter I.P. or name of computer to check for " & _
"installed software (leave blank to check " & _
"local system)." & vbcrlf & vbcrlf & "Remote " & _
"checking only from NT type OS to NT type OS " & _
"with same Admin level UID & PW", sTitle)
If IsEmpty(strComputer) Then WScript.Quit
strComputer = Trim(strComputer)
If strComputer = "" Then strComputer = "."
'Wscript.Echo GetAddRemove(strComputer)
Dim sCompName : sCompName = GetProbedID(StrComputer)
Dim sFileName
sFileName = sCompName & "_" & GetDTFileName() & "_Software.txt"
Dim s : s = GetAddRemove(strComputer)
If WriteFile(s, sFileName) Then
'optional prompt for display
If MsgBox("Finished processing. Results saved to " & sFileName & _
vbcrlf & vbcrlf & "Do you want to view the results now?", _
4 + 32, sTitle) = 6 Then
WScript.CreateObject("WScript.Shell").Run sFileName, 9
End If
End If
Function GetAddRemove(sComp)
'Function credit to Torgeir Bakken
Dim cnt, oReg, sBaseKey, iRC, aSubKeys
Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
sComp & "/root/default:StdRegProv")
sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
iRC = oReg.EnumKey(HKLM, sBaseKey, aSubKeys)
Dim sKey, sValue, sTmp, sVersion, sDateValue, sYr, sMth, sDay
For Each sKey In aSubKeys
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, "DisplayName", sValue)
If iRC <> 0 Then
oReg.GetStringValue HKLM, sBaseKey & sKey, "QuietDisplayName", sValue
End If
If sValue <> "" Then
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
"DisplayVersion", sVersion)
If sVersion <> "" Then
sValue = sValue & vbTab & "Ver: " & sVersion
Else
sValue = sValue & vbTab
End If
iRC = oReg.GetStringValue(HKLM, sBaseKey & sKey, _
"InstallDate", sDateValue)
If sDateValue <> "" Then
sYr = Left(sDateValue, 4)
sMth = Mid(sDateValue, 5, 2)
sDay = Right(sDateValue, 2)
'some Registry entries have improper date format
On Error Resume Next
sDateValue = DateSerial(sYr, sMth, sDay)
On Error GoTo 0
If sdateValue <> "" Then
sValue = sValue & vbTab & "Installed: " & sDateValue
End If
End If
sTmp = sTmp & sValue & vbcrlf
cnt = cnt + 1
End If
Next
sTmp = BubbleSort(sTmp)
GetAddRemove = "INSTALLED SOFTWARE (" & cnt & ") - " & sCompName & _
" - " & Now() & vbcrlf & vbcrlf & sTmp
End Function
Function BubbleSort(sTmp)
'cheapo bubble sort
Dim aTmp, i, j, temp
aTmp = Split(sTmp, vbcrlf)
For i = UBound(aTmp) - 1 To 0 Step -1
For j = 0 to i - 1
If LCase(aTmp(j)) > LCase(aTmp(j+1)) Then
temp = aTmp(j + 1)
aTmp(j + 1) = aTmp(j)
aTmp(j) = temp
End if
Next
Next
BubbleSort = Join(aTmp, vbcrlf)
End Function
Function GetProbedID(sComp)
Dim objWMIService, colItems, objItem
Set objWMIService = GetObject("winmgmts:\\" & sComp & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select SystemName from " & _
"Win32_NetworkAdapter",,48)
For Each objItem in colItems
GetProbedID = objItem.SystemName
Next
End Function
Function GetDTFileName()
dim sNow, sMth, sDay, sYr, sHr, sMin, sSec
sNow = Now
sMth = Right("0" & Month(sNow), 2)
sDay = Right("0" & Day(sNow), 2)
sYr = Right("00" & Year(sNow), 4)
sHr = Right("0" & Hour(sNow), 2)
sMin = Right("0" & Minute(sNow), 2)
sSec = Right("0" & Second(sNow), 2)
GetDTFileName = sMth & sDay & sYr & "_" & sHr & sMin & sSec
End Function
Function WriteFile(sData, sFileName)
Dim fso, OutFile, bWrite
bWrite = True
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set OutFile = fso.OpenTextFile(sFileName, 2, True)
'Possibly need a prompt to close the file and one recursion attempt.
If Err = 70 Then
Wscript.Echo "Could not write to file " & sFileName & ", results " & _
"not saved." & vbcrlf & vbcrlf & "This is probably " & _
"because the file is already open."
bWrite = False
ElseIf Err Then
WScript.Echo err & vbcrlf & err.description
bWrite = False
End If
On Error GoTo 0
If bWrite Then
OutFile.WriteLine(sData)
OutFile.Close
End If
Set fso = Nothing
Set OutFile = Nothing
WriteFile = bWrite
End Function
SCRIPT 3 ( gets mapped drives )
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("mappedoutput.txt", True)
' List Mapped Network Drives
On Error Resume Next
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_MappedLogicalDisk")
For Each objItem in colItems
objFile.Writeline "Compressed: " & objItem.Compressed
objFile.Writeline "Description: " & objItem.Description
objFile.Writeline "Device ID: " & objItem.DeviceID
objFile.Writeline "File System: " & objItem.FileSystem
objFile.Writeline "Free Space: " & objItem.FreeSpace
objFile.Writeline "Maximum Component Length: " & objItem.MaximumComponentLength
objFile.Writeline "Name: " & objItem.Name
objFile.Writeline "Provider Name: " & objItem.ProviderName
objFile.Writeline "Session ID: " & objItem.SessionID
objFile.Writeline "Size: " & objItem.Size
objFile.Writeline "Supports Disk Quotas: " & objItem.SupportsDiskQuotas
objFile.Writeline "Supports File-Based Compression: " & _
objItem.SupportsFileBasedCompression
objFile.Writeline "Volume Name: " & objItem.VolumeName
objFile.Writeline "Volume Serial Number: " & objItem.VolumeSerialNumber
objFile.Writeline
Next
Again thank you
Can you put all the three scripts as 1 single script? In that case, you will need to input the IP address only once.
Or else write another script which will ask for the IP address and call these scripts by using cscript and passing the IPaddress to them as a parameter. Try this code for that:
strcomputer = inputbox("Enter the IP address")
set obj1 = createobject("wscript.shell")
set obj2 = createobject("wscript.shell")
set obj3 = createobject("wscript.shell")
pgm1 = "cscript script1.vbs " & strcomputer
pgm2 = "cscript script2.vbs " & strcomputer
pgm3 = "cscript script3.vbs " & strcomputer
obj1.run pgm1,3,true
obj2.run pgm2,3,true
obj3.run pgm3,3,true
set obj1 = nothing
set obj2 = nothing
set obj3 = nothing
In above code, script1.vbs, script2.vbs, script3.vbs are your 3 scripts and you are executing them one by one using a new script.
In script1.vbs, add this line of code :
strcomputer = wscript.Arguments.item(0)
It will store the 1rst argument that you have passed from your new script to script1.vbs, into the variable 'strcomputer'(in your case, the IP address).
Similarly, in both script2.vbs and script3.vbs also, add the statement
strcomputer = wscript.Arguments.item(0)
Regarding your output file, I am not sure what you are asking for. Maybe this can help:
Use the below to write to a file (overwrites if data is already present):
Set fso1 = CreateObject("Scripting.FileSystemObject" )
Set file1 = fso1.OpenTextFile("C:\New\textfile1.txt",2,true)
Use the below to add data or append to a file (does NOT overwrite):
Set fso1 = CreateObject("Scripting.FileSystemObject" )
Set file1 = fso1.OpenTextFile("C:\New\textfile1.txt",8,true)
Use the below to read from a file:
Set fso1 = CreateObject("Scripting.FileSystemObject" )
Set file1 = fso1.OpenTextFile("C:\New\textfile1.txt",1,true)
I need to create a subroutine to check for certain policies on a system. I'm currently just trying to do that.
strComputerFQDN is defined at the beginning of the program and that is working fine.
Do you see anything wrong?
Here is my code:
'*************************************************************************
' This Subroutine checks Local Policies
'*************************************************************************
Sub CheckPolicies()
Dim objGPOSrvc,colItems,objItem
Set objGPOSrvc = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerFQDN & "\root\RSOP")
Set colItems = objGPOSrvc.ExecQuery("SELECT * FROM RSOP_GPO")
WScript.Echo("Check Policies")
WScript.Echo("------------------------------------")
For Each objItem in colItems
If InStr(UCase(objItem.Name),"WSUS") Then
If InStr(UCase(objItem.Name),"SERVER") Then
WScript.Echo("Policy applied: " & objItem.Name)
Else
WScript.Echo("Wrong WSUS Policy Applied - Check Computer object location")
End If
End If
Next
If strWSUSApplied = "FALSE" Then
WScript.Echo("No WSUS Policy Applied!")
End If
WScript.Echo vbCrLf
End Sub
The namespace should be root\RSOP\Computer
Set objGPOSrvc = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerFQDN & "\root\RSOP\Computer")
or root\RSOP\User
Set objGPOSrvc = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerFQDN & "\root\RSOP\User")
Most typically you would do something like this:
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\RSOP\Computer")
Set colItems = objWMIService.ExecQuery("Select * from RSOP_GPO")
For Each objItem in colItems
WScript.Echo "Name: " & objItem.Name
WScript.Echo "GUID Name: " & objItem.GUIDName
WScript.Echo "ID: " & objItem.ID
WScript.Echo "Access Denied: " & objItem.AccessDenied
WScript.Echo "Enabled: " & objItem.Enabled
WScript.Echo "File System path: " & objItem.FileSystemPath
WScript.Echo "Filter Allowed: " & objItem.FilterAllowed
WScript.Echo "Filter ID: " & objItem.FilterId
WScript.Echo "Version: " & objItem.Version
WScript.Echo
Next
If you receive Error 0x80041003, you will need to run this script with administrator credentials. For Vista and later, open your start menu and type cmd. When "Command Prompt" appears, right-click and choose Run As Administrator. You can now launch your script from the elevated command prompt without error.