I'm writing a script that needs to query when several domain users last logged on to a machine. I thought I could do it with the last accessed date of \docs and settings\username but our backup tool scuppered that plan.
Then I looked at using WMI_UserProfile but that only queries local profiles. So that led me to WNI_NetworkLoginProfile but I seem to be able to only get the logon date for the logged on user. Is it possible to query last logon date for multiple users using WNI_NetworkLoginProfile or is there something else I can query?
On Error Resume Next
Set WshNetwork = CreateObject("Wscript.Network")
strComputer = WshNetwork.ComputerName
strDayOfMonth = Right("0" & Day(Date()),2)
strMonth = Right("0" & Month(Date()),2)
strYear = Right (Year(Date()),4)
strDate = strDayOfMonth & "/" & strMonth & "/" & strYear
oLast = DateAdd("d", -60, strDate)
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.Pattern = "NT AUTHORITY\SYSTEM|NT AUTHORITY\SYSTEM|NT AUTHORITY\LOCAL SERVICE|NT AUTHORITY\NETWORK SERVICE"
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkLoginProfile")
For Each objItem in colItems
dtmAccessTime = objItem.LastLogon
strReturn = WMIDateStringToDate(dtmAccessTime)
strUsers = objItem.Name
Set colMatches = objRegEx.Execute(strUsers)
If colMatches.Count < 1 Then
strfolder = objFolder.Name
Wscript.Echo objItem.Name & " " & strReturn
End If
Next
' Format Time and Date
Function WMIDateStringToDate(dtmStart)
WMIDateStringToDate = CDate(Mid(dtmStart, 5, 2) & "/" & _
Mid(dtmStart, 7, 2) & "/" & Left(dtmStart, 4) _
& " " & Mid (dtmStart, 9, 2) & ":" & _
Mid(dtmStart, 11, 2) & ":" & Mid(dtmStart, _
13, 2))
End Function
Testing using the commandline tool wmic as:
C:\> WMIC PATH Win32_NetworkLoginProfile GET Name,LastLogon
shows me the data for all users on my machine. This makes me wonder whether this is locked to whether you have administrative rights or not. On a Windows Vista/7/2008 box, this may also mean that User Access Control is preventing you see all the data.
Try forcing your script to run as an administator.
Related
Apologies in advance for any incorrect terminology (I am a PC Tech, not a developer/programmer).
We have a VBScript running in one of our servers to send an email notice to users that their Windows password will expire and they need to change it. The script is as follows:
*******************Begin Code*****
on error resume next
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400
strDomainDN = "DomainNameHere" 'Domain name here - both Netbios and DNS style names should work
ReminderAge = 10 'Days before the reminders start being sent
'strbody - Body of the message being sent
strbody = "This message is a reminder that your password will be expiring soon." & vbcrlf
strbody = strbody & "Please change your network password before the date listed above to avoid being locked out of the system." & vbcrlf
strbody = strbody & "If you need instructions on how to change your password please contact:" & vbcrlf
strbody = strbody & "the IT Department" & vbcrlf
strbody = strbody & vbcrlf & "Thank you," & vbcrlf
strbody = strbody & "IT Department"
'create logfile
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptPath = objfso.GetParentFolderName(WScript.ScriptFullName)
strLogName = TwoDigits(Year(now)) & TwoDigits(Month(now)) & TwoDigits(Day(now)) & TwoDigits(Hour(now)) & TwoDigits(Minute(now)) &
TwoDigits(Second(now)) & ".txt"
strLogFile = strScriptPath & "Logs\" & StrLogName
Set objLogFile = objFSO.CreateTextFile(strLogFile,1)
objLogfile.Writeline "Email Password Check Script started: " & Now
Dim rootDSE,domainObject
Set rootDSE = GetObject("LDAP://RootDSE")
Set oDomain = GetObject("LDAP://" & strDomainDN)
Set maxPwdAge = oDomain.Get("maxPwdAge")
DomainContainer = rootDSE.Get("defaultNamingContext")
Set fs = CreateObject ("Scripting.FileSystemObject")
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
numDays = CCur((maxPwdAge.HighPart * 2 ^ 32) + maxPwdAge.LowPart) / CCur(-864000000000)
'LDAP string to only find user accounts with mailboxes
ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*) (|
(&(objectCategory=person)(objectClass=user)(!(homeMDB=*))(!(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*))) ));adspath;subtree"
Set rs = conn.Execute(ldapStr)
While Not rs.EOF
Set oUser = GetObject (rs.Fields(0).Value)
dtmValue = oUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
whenpasswordexpires = "The password has never been set."
else
whenPasswordExpires = DateAdd("d", numDays, oUser.PasswordLastChanged)
end if
daysb4expire = Int(whenPasswordExpires - Now)
'write user info to logfile
objLogfile.Writeline "-----------------------------------------"
objLogfile.Writeline "SAM Acct: " & oUser.SamAccountName
objLogfile.Writeline "Disp Name: " & oUser.displayName
objLogfile.Writeline "UPN: " & oUser.userprincipalname
objLogfile.Writeline "PW Changed: " & oUser.PasswordLastChanged
objLogfile.Writeline "PW Expires: " & whenPasswordExpires
dblMaxPwdNano = Abs(MaxPwdAge.HighPart * 2^32 + MaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
objLogfile.Writeline "The password will expire on " & _
DateValue(dtmValue + dblMaxPwdDays) & " (" & _
Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)."
if daysb4expire < ReminderAge and daysb4expire > 0 then
objLogfile.Writeline "Expiring soon - sending eMail"
objLogfile.Writeline "*****************************"
strNoteMessage = "Dear " & oUser.displayName & "," & vbcrlf & vbcrlf
strNoteMessage = strNoteMessage & "Your Network password will expire on " & _
DateValue(dtmValue + dblMaxPwdDays) & " (" & _
Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)." & vbcrlf & vbcrlf
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "me#myCompany.com" 'Your From Address
objEmail.To = oUser.userprincipalname
objEmail.Subject = "Network Password Expiration Notice" 'Message subject
objEmail.TextBody = strNoteMessage & strBody
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"YOUREXCHANGE.SERVER.DomainName.COM" ' Your mailserver here
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
'objEmail.Send 'commented out right now---so you won't send out the email.
End If
set whenpasswordexpires = nothing
err.clear
rs.MoveNext
Wend
Set oUser = Nothing
Set maxPwdAge = Nothing
Set oDomain = Nothing
Logfile.Close
Function TwoDigits(t)
TwoDigits = Right("00" & t,2)
End Function
WScript.quit
Obviously I removed our info from the script for this post.
The errors are that:
It does not send an email everyday if the user does not change their password for a few days. It sends them randomly.
A few random users, if they have not changed their password, around the 5th or 6th day will start getting hundreds of thousands of emails in just a few seconds, completely locking down Outlook on their computer. If they change the password they stop getting them (obviously).
Is there something I'm missing or need to remove from this script to get it to at least stop sending so many emails at once?
Thank you.
A couple of ideas to help you track down the problem.
Only have on error resume next before the command that needs it oUser.PasswordLastChanged, after that line on error goto 0 Then run the script manually and you'll have a better chance of finding some statement that is failing. update - should store the value in a variable and use
Get consistent with what variables are for. whenpasswordexpires is set to text in one part of the if err.number and a date in the other. It's then used as a date to calculate days and finally set whenpasswordexpires = nothing treats it like an object. This could mean some of your if statements are erroring and just going to the next line, instead of skipping the if - so people might be getting mailed when they shouldn't.
Consider calculating a date to pass to the LDAP query and only return people to be emailed - instead of going through all users all the time
(without ever having much to do with LDAP queries) I think your current query simplifies down to ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*)(objectCategory=person)(objectClass=user));adspath;subtree" all the ors and ands with homeMDB and msExchHomeServerName would seem to mean any combination is included. It's probably worth running your query in an LDAP explorer tool to check you're really getting what you want.
LDAP often has a limit of the number of records returned, so you might be erroring all the time because you get more than 1000 (typical) records returned. This can be worked around by getting data in smaller pages (say 250).
Logging to a new file each time may hide issues from you, e.g if the task is restarted by scheduler. Much easier to diagnose if there is just one log per day. You also don't close the log file correctly - should be objLogFile.Close (not logfile.Close). You aren't putting the log in a subdirectory of the scripts folder (e.g. scripts & scripts\logs) but at the same level (e.g. scripts & scriptsLogs)
The logfile not objLogFile issue highlights why it is best to put Option Explicit at the top of your code. This means you have to dim every variable that you use, which can be a pain to do, but ensures that you don't have typos in your variable names which can cause you massive headaches.
The WScript.Quit is the very last line, so won't do anything - the codes about to finish anyway. If you ever want to abort the execution of script, the WScript.Quit needs to where you want to abort from - normally within some if statement.
There are a number of repeated calculations... days, dtmValue + dblMaxPwdDays, etc. I just mention this as it makes the code harder to read and therefore harder to understand what might be wrong.
All that said, I've probably made too many comments now for you to really comprehend without me just making the changes and posting updated script for you to try.
See if this version runs error free for you...
option explicit
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400
Dim strDomainDN, strBody, strNoteMessage
Dim objFSO, objLogFile, objEmail
Dim strScriptPath, strLogName, strLogFile
strDomainDN = "DomainNameHere" 'Domain name here - both Netbios and DNS style names should work
Const ReminderAge = 10 'Days before the reminders start being sent
'strbody - Body of the message being sent
strbody = "This message is a reminder that your password will be expiring soon." & vbcrlf
strbody = strbody & "Please change your network password before the date listed above to avoid being locked out of the system." & vbcrlf
strbody = strbody & "If you need instructions on how to change your password please contact:" & vbcrlf
strbody = strbody & "the IT Department" & vbcrlf
strbody = strbody & vbcrlf & "Thank you," & vbcrlf
strbody = strbody & "IT Department"
'create logfile
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptPath = objfso.GetParentFolderName(WScript.ScriptFullName)
strLogName = TwoDigits(Year(now)) & TwoDigits(Month(now)) & TwoDigits(Day(now)) & ".txt"
strLogFile = strScriptPath & "Logs\" & StrLogName
Set objLogFile = objFSO.OpenTextFile(strLogFile, 8, True)
objLogFile.Writeline "Email Password Check Script started: " & Now
Dim rootDSE, oDomain, DomainContainer
Dim maxPwdAge, numDays
Dim conn, command
Dim ldapStr
Dim rs, oUser, passwordChanged, whenPasswordExpires, daysb4expire
Set rootDSE = GetObject("LDAP://RootDSE")
Set oDomain = GetObject("LDAP://" & strDomainDN)
Set maxPwdAge = oDomain.Get("maxPwdAge")
DomainContainer = rootDSE.Get("defaultNamingContext")
Set conn = CreateObject("ADODB.Connection")
Set command = CreateObject("ADODB.Command")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
Set command.ActiveConnection = conn
command.Properties("Page Size") = 250
numDays = ABS(CCur((maxPwdAge.HighPart * 2 ^ 32) + maxPwdAge.LowPart) / CCur(864000000000))
'LDAP string to only find user accounts with mailboxes
Dim dteCnv, sec1601, strExpireDate, strRemindDate
dteCnv = DateAdd("d", -numDays, Now)
sec1601 = DateDiff("s","1/1/1601",dteCnv)
strExpireDate = CStr(sec1601) & "0000000"
dteCnv = DateAdd("d", ReminderAge - numDays, Now)
sec1601 = DateDiff("s","1/1/1601",dteCnv)
strRemindDate = CStr(sec1601) & "0000000"
ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*)(objectCategory=person)(objectClass=user)(pwdLastSet>=" & strExpireDate & ")(pwdLastSet<=" & strRemindDate & "));adspath;subtree"
command.CommandText = ldapStr
Set rs = command.Execute
While Not rs.EOF
Set oUser = GetObject (rs.Fields(0).Value)
on error resume next
passwordChanged = oUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
passwordChanged = "Never"
whenPasswordExpires = Now
elseIf Err.Number <> 0 Then
passwordChanged = "Unknown - " & Err.Description
whenPasswordExpires = Now
else
whenPasswordExpires = DateAdd("d", numDays, passwordChanged)
end if
on error goto 0
daysb4expire = Int(whenPasswordExpires - Now)
'write user info to logfile
objLogFile.Writeline "-----------------------------------------"
objLogFile.Writeline "SAM Acct: " & oUser.SamAccountName
objLogFile.Writeline "Disp Name: " & oUser.displayName
objLogFile.Writeline "UPN: " & oUser.userprincipalname
objLogFile.Writeline "PW Changed: " & passwordChanged
objLogFile.Writeline "PW Expires: " & whenPasswordExpires
objLogFile.Writeline "The password will expire on " & whenPasswordExpires & " (" & daysb4expire & " days from today)."
if daysb4expire <= ReminderAge and daysb4expire > 0 then
objLogFile.Writeline "Expiring soon - sending eMail"
objLogFile.Writeline "*****************************"
strNoteMessage = "Dear " & oUser.displayName & "," & vbcrlf & vbcrlf
strNoteMessage = strNoteMessage & "Your Network password will expire on " & whenPasswordExpires & " (" & daysb4expire & " days from today)." & vbcrlf & vbcrlf
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "me#myCompany.com" 'Your From Address
objEmail.To = oUser.userprincipalname
objEmail.Subject = "Network Password Expiration Notice" 'Message subject
objEmail.TextBody = strNoteMessage & strBody
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YOUREXCHANGE.SERVER.DomainName.COM" ' Your mailserver here
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
'objEmail.Send 'commented out right now---so you won't send out the email.
End If
err.clear
rs.MoveNext
Wend
Set oUser = Nothing
Set maxPwdAge = Nothing
Set oDomain = Nothing
objLogFile.Writeline "Email Password Check completed: " & Now & vbcrlf & vbcrlf
objLogFile.Close
Function TwoDigits(t)
TwoDigits = Right("00" & t,2)
End Function
I am new to VBS scripting and I am wanting to script the stopping of Windows services other than a core set of services. I have currently written a bit of code that will query all local services and output to a text file their running state, I then wish to read from an input file a list of core services NOT to stop however to stop the rest of the services running on that machine. I would like this to be a generic input file so if a service is listed however is not installed on the server for it to continue onto the next service to stop.
Not sure how to proceed with this, would I need to read the input file into an array then do an IF statement to say if objService.Name not equal to the array (somehow) then to stop the service?
Code below - thanks in advance for any assistance/tips
Const ForAppending = 8
strComputer = "."
strLogPath = "C:\Scripts"
strServicesLog = strLogPath & Replace(Wscript.ScriptName,".vbs","") & ".txt"
Set objWMISvc = GetObject( "winmgmts:\\.\root\cimv2" )
Set colItems = objWMISvc.ExecQuery( "Select * from Win32_ComputerSystem", , 48)
' // Create Output Logs folder for script
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objTS = objFS.CreateTextFile(strServicesLog, True)
objTS.Write "******************************************************************" & vbcrlf
objTS.Write (Replace(Wscript.ScriptName,".vbs","") & " audit log") & vbcrlf
objTS.Write ("Execution Start: " & FormatDateTime(Now(),2) & " " &
FormatDateTime(Now(),3)) & vbcrlf
For Each objItem in colItems
strComputerName = objItem.Name
objTS.Write vbCrlf & "Server Name: " & strComputerName & vbCrlf
Next
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" &
strComputer & "\root\cimv2")
Set colRunningServices = objWMIService.ExecQuery _
("Select * from Win32_Service")
For Each objService in colRunningServices
objTS.Write "Display Name: " & vbTab & (objService.DisplayName) & vbCrlf
objTS.Write "Service Name: " & vbTab & (objService.Name) & vbCrlf
objTS.Write "Service State: " & vbTab & (objService.State) & vbCrlf
objTS.Write "Start Mode: " & vbTab & (objService.StartMode) & vbCrlf
objTS.WriteLine
Next
objTS.Close
You could read your list of services into a Dictionary object. The Dictionary class has an Exists() method that you can use to test if a string/key exists.
Here's how to read a list of strings (services) from a file named c:\input.txt into a dictionary:
Set d = CreateObject("Scripting.Dictionary")
Set objFileIn = objFS.OpenTextFile("c:\input.txt")
Do Until objFileIn.AtEndOfStream
strService = objFileIn.ReadLine()
If Len(strService) > 0 Then If Not d.Exists(strService) Then d.Add strService, ""
Loop
Later, when you're iterating the list of services on the computer, check the service name against your dictionary:
For Each objService in colRunningServices
' If this service is not in the list of core services, stop it...
If Not d.Exists(objService.Name) Then objService.StopService
Next
I am looking for a way to have my current VBScript (it is very big and I don't know if there is a way to pair it down) that currently creates a list of all computers in active directory and outputs it to a file. Once that is completed the rest of my script then calls that text file and creates another one with all the computer names and date/time/ and what the teamviewer ID is by means of either Windows 7 reg key or Windows XP. The issue I am running into is that if a computer doesn't exist in the domain anymore the script places the previous value into the computer that doesn't exist which is creating duplicates.
I would love to find a way to edit my script and ping each of the computers in the original text file and remove the computers out of it that are not online. I will attach my script. Let me know if you have any questions.
' Declare the constants
Dim oFSO
Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
'Const REG_SZ = 1 ' String value in registry (Not DWORD)
Const ForReading = 1
Const ForWriting = 2
' Set File objects...
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objDictionary2 = CreateObject("Scripting.Dictionary")
' Set string variables
strDomain = "my domain" ' Your Domain
strPCsFile = "DomainPCs.txt"
strPath = "C:\logs\" ' Create this folder
strWorkstationID = "C:\logs\WorkstationID.txt"
If objFSO.FolderExists(strPath) Then
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
Else
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
oFSO.CreateFolder strPath
End If
' Get list of domain PCs - Using above variables.
strMbox = MsgBox("Would you like info for entire domain: rvdocs.local?",3,"Hostname")
'an answer of yes will return a value of 6, causing script to collect domain PC info
If strMbox = 6 Then
Set objPCTXTFile = objFSO.OpenTextFile(strPath & strPCsFile, ForWriting, True)
Set objDomain = GetObject("WinNT://" & strDomain) ' Note LDAP does not work
objDomain.Filter = Array("Computer")
For Each pcObject In objDomain
objPCTXTFile.WriteLine pcObject.Name
Next
objPCTXTFile.close
Else
'an answer of no will prompt user to input name of computer to scan and create PC file
strHost = InputBox("Enter the computer you wish to get Workstation ID","Hostname"," ")
Set strFile = objfso.CreateTextFile(strPath & strPCsFile, True)
strFile.WriteLine(strHost)
strFile.Close
End If
' Read list of computers from strPCsFile into objDictionary
Set readPCFile = objFSO.OpenTextFile(strPath & strPCsFile, ForReading)
i = 0
Do Until readPCFile.AtEndOfStream
strNextLine = readPCFile.Readline
objDictionary.Add i, strNextLine
i = i + 1
Loop
readPCFile.Close
' Build up the filename found in the strPath
strFileName = "Workstation ID_" _
& year(date()) & right("0" & month(date()),2) _
& right("0" & day(date()),2) &".txt"
' Write each PC's software info file...
Set objTextFile2 = objFSO.OpenTextFile(strPath & strFileName, ForWriting, True)
For each DomainPC in objDictionary
strComputer = objDictionary.Item(DomainPC)
On error resume next
' WMI connection to the operating system note StdRegProv
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
' These paths are used in the filenames you see in the strPath
pcName = "SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName\"
pcNameValueName = "ComputerName"
objReg.GetStringValue HKLM,pcName,pcNameValueName,pcValue
strKeyPath = "SOFTWARE\Wow6432Node\TeamViewer\Version5.1\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath, strValueName, strValue
If IsNull(strValue) Then
strKeyPath = "SOFTWARE\TeamViewer\Version5.1\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
End If
If IsNull(strValue) Then
strValue = " No Teamviewer ID"
End If
Set objReg = Nothing
Set ObjFileSystem = Nothing
objTextFile2.WriteLine(vbCRLF & "==============================" & vbCRLF & _
"Current Workstation ID: " & UCASE(strComputer) & vbCRLF & Time & vbCRLF & Date _
& vbCRLF & "Teamviewer ID:" & "" & strValue & vbCRLF & "----------------------------------------" & vbCRLF)
'GetWorkstationID()
Next
WScript.echo "Finished Scanning Network check : " & strPath
objFSO.DeleteFile(strPath & strPCsFile)
wscript.Quit
The cause of the issue is that objReg retains its value from the previous iteration when
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
fails due to a non-reachable computer (which is masked by On Error Resume Next).
One way to deal with the issue is to set objReg to Nothing before trying to connect to the remote host and check if the variable still is Nothing afterwards:
On Error Resume Next
Set objReg = Nothing
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
If Not objReg Is Nothing Then
'check for TeamViewer ID
Else
'remote host unavailable
End If
A more elegant solution to the problem (one that doesn't require the infamous On Error Resume Next) is to ping the remote computer before trying to connect to it:
Set wmi = GetObject("winmgmts://./root/cimv2")
qry = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
For Each response In wmi.ExecQuery(qry)
If IsObject(response) Then
hostAvailable = (response.StatusCode = 0)
Else
hostAvailable = False
End If
Next
If hostAvailable Then
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
'check for TeamViewer ID
Else
'remote host unavailable
End If
Here is what I came up with. I had to add the "On Error Resume Next" otherwise it would bring up an error box. Here is the code with the modified piece:
' Declare the constants
Dim oFSO
Const HKLM = &H80000002 ' HKEY_LOCAL_MACHINE
'Const REG_SZ = 1 ' String value in registry (Not DWORD)
Const ForReading = 1
Const ForWriting = 2
' Set File objects...
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objDictionary2 = CreateObject("Scripting.Dictionary")
' Set string variables
strDomain = "mydomain" ' Your Domain
strPCsFile = "DomainPCs.txt"
strPath = "C:\logs\" ' Create this folder
strWorkstationID = "C:\logs\WorkstationID.txt"
If objFSO.FolderExists(strPath) Then
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
Else
Wscript.Echo "This program will collect Workstation ID on remote compter(s)"
oFSO.CreateFolder strPath
End If
' Get list of domain PCs - Using above variables.
strMbox = MsgBox("Would you like info for entire domain: rvdocs.local?",3,"Hostname")
'an answer of yes will return a value of 6, causing script to collect domain PC info
If strMbox = 6 Then
Set objPCTXTFile = objFSO.OpenTextFile(strPath & strPCsFile, ForWriting, True)
Set objDomain = GetObject("WinNT://" & strDomain) ' Note LDAP does not work
objDomain.Filter = Array("Computer")
For Each pcObject In objDomain
objPCTXTFile.WriteLine pcObject.Name
Next
objPCTXTFile.close
Else
'an answer of no will prompt user to input name of computer to scan and create PC file
strHost = InputBox("Enter the computer you wish to get Workstation ID","Hostname"," ")
Set strFile = objfso.CreateTextFile(strPath & strPCsFile, True)
strFile.WriteLine(strHost)
strFile.Close
End If
' Read list of computers from strPCsFile into objDictionary
Set readPCFile = objFSO.OpenTextFile(strPath & strPCsFile, ForReading)
i = 0
Do Until readPCFile.AtEndOfStream
strNextLine = readPCFile.Readline
objDictionary.Add i, strNextLine
i = i + 1
Loop
readPCFile.Close
' Build up the filename found in the strPath
strFileName = "Workstation ID_" _
& year(date()) & right("0" & month(date()),2) _
& right("0" & day(date()),2) & ".txt"
' Write each PC's software info file...
Set objTextFile2 = objFSO.OpenTextFile(strPath & strFileName, ForWriting, True)
For each DomainPC in objDictionary
strComputer = objDictionary.Item(DomainPC)
Set wmi = GetObject("winmgmts://./root/cimv2")
qry = "SELECT * FROM Win32_PingStatus WHERE Address='" & strComputer & "'"
For Each response In wmi.ExecQuery(qry)
If IsObject(response) Then
hostAvailable = (response.StatusCode = 0)
Else
hostAvailable = False
End If
Next
On error resume Next
If hostAvailable Then
'check for TeamViewer ID
' WMI connection to the operating system note StdRegProv
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
' These paths are used in the filenames you see in the strPath
pcName = "SYSTEM\CurrentControlSet\Control\ComputerName\ActiveComputerName\"
pcNameValueName = "ComputerName"
objReg.GetStringValue HKLM,pcName,pcNameValueName,pcValue
strKeyPath = "SOFTWARE\Wow6432Node\TeamViewer\Version5.1\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath, strValueName, strValue
If IsNull(strValue) Then
strKeyPath = "SOFTWARE\Wow6432Node\TeamViewer\Version5\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
End If
If IsNull(strValue) Then
strKeyPath = "SOFTWARE\TeamViewer\Version5.1\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
End If
If IsNull(strValue) Then
strKeyPath = "SOFTWARE\TeamViewer\Version5\"
strValueName = "ClientID"
objReg.GetDWORDValue HKLM,strKeyPath,strValueName,strValue
End If
If IsNull(strValue) Then
strValue = " No Teamviewer ID"
End If
Set objReg = Nothing
Set ObjFileSystem = Nothing
objTextFile2.WriteLine(vbCRLF & "==============================" & vbCRLF & _
"Current Workstation ID: " & UCASE(strComputer) & vbCRLF & Time & vbCRLF & Date _
& vbCRLF & "Teamviewer ID:" & "" & strValue & vbCRLF _
& "----------------------------------------" & vbCRLF)
'GetWorkstationID()
strValue = NULL
Else
'remote host unavailable
End If
Next
WScript.echo "Finished Scanning Network check : " & strPath
'objFSO.DeleteFile(strWorkstationID)
objFSO.DeleteFile(strPath & strPCsFile)
wscript.Quit
Does anyone know how using vbscript one can query the members of a local group and also return their status ie enabled or disabled?
I have this to get the group membership:
Set objNetwork = CreateObject("WScript.Network")
strComputer = objNetwork.ComputerName
strGroup = "Users"
Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup & ",group")
For Each objMember In objGroup.Members
WScript.Echo objMember.Name
Next
OS = Windows 2008
Try something like this:
For Each objMember In objGroup.Members
If objMember.Class = "User" Then
Set objUser = GetObject("WinNT://" & strComputer & "/" & objMember.Name)
WScript.Echo objUser.Name & " [" & objUser.AccountDisabled & "]"
Else
WScript.Echo objMember.Name
End If
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)