WMI query local administrators including group members - wmi

I know how to fetch a list of local administrators on a remote machine via WMI:
wmic /Node:"ComputerName" path win32_groupuser where (groupcomponent="win32_group.name=\"administrators\",domain=\"Computername\"")
This will return users and groups:
GroupComponent PartComponent
win32_group.domain="Computername",name="administrators" \\Computername\root\cimv2:Win32_UserAccount.Domain="Computername",Name="Administrator"
win32_group.domain="Computername",name="administrators" \\Computername\root\cimv2:Win32_Group.Domain="MYDOMAIN",Name="Domain Admins"
win32_group.domain="Computername",name="administrators" \\Computername\root\cimv2:Win32_Group.Domain="MYDOMAIN",Name="SomeOtherGroup"
win32_group.domain="Computername",name="administrators" \\Computername\root\cimv2:Win32_UserAccount.Domain="MYDOMAIN",Name="MyUser"
However, if a user is a member of SomeOtherGroup above, I need to know that he is a member - and therefore a local admin. So, I need to expand (likely recursively) all group members.
Is there a WMI query that can self-join on win32_group, expanding all usernames of all groups that are local admins?

There is ASSOCIATORS OF statement in the WMI Query Language (WQL):
The ASSOCIATORS OF statement retrieves all instances that are
associated with a particular source instance. The instances that are
retrieved are referred to as the endpoints. Each endpoint is returned
as many times as there are associations between it and the source
object.
The following VBScript should do the job:
option explicit
Function wmiGroupMembers( sGroupName, intLevel)
Dim colSubGroups, colSubGroup, sQuery
sQuery = "Associators of {win32_group.domain=""" & sDomainName & _
""",name=""" & sGroupName & """} " _
& "Where ResultRole = PartComponent"
Set colSubGroups = objWMIService.ExecQuery( sQuery )
For Each colSubGroup in colSubGroups
If LCase( colSubGroup.Path_.Class) = "win32_group" Then
wmiGroupMembers colSubGroup.Name, intLevel + 1
End If
sResult = sResult & vbNewLine & intLevel _
& vbTab & sGroupName _
& vbTab & colSubGroup.Domain _
& vbTab & colSubGroup.Name
Next
End Function
Dim sResult, wshNetwork, sComputerName, sDomainName, objWMIService
sResult = ""
Set wshNetwork = WScript.CreateObject( "WScript.Network" )
sComputerName = wshNetwork.ComputerName
sDomainName = UCase( wshNetwork.UserDomain)
Set objWMIService = GetObject("winmgmts:\\" & sComputerName & "\root\cimv2")
wmiGroupMembers "administrators", 0
Wscript.Echo sResult
Note that although there is a wmic equivalent (see ASSOC verb), it's usage could be a tough problem as all output from any cmd utility is text (i.e. not objects) and must be parsed using for loop command.

Related

Why does this regular expression test give different results for what should be the same body text?

Here's the pertinent code, which is giving different results on the regular expression test for the message body depending on whether I launch it using TestLaunchURL or the message is passed to it by Outlook when an incoming message arrives:
Public Sub OpenLinksMessage(olMail As Outlook.MailItem)
Dim Reg1 As RegExp
Dim AllMatches As MatchCollection
Dim M As Match
Dim strURL As String
Dim RetCode As Long
Set Reg1 = New RegExp
With Reg1
.Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$;_])*)"
.Global = True
.IgnoreCase = True
End With
PlayTheSound "Speech On.wav"
RetCode = Reg1.Test(olMail.Body)
MsgBox "The RetCode from Reg1.Test(olMail.Body) equals" + Str(RetCode)
' If the regular expression test for URLs in the message body finds one or more
If RetCode Then
PlayTheSound "chimes.wav"
' Use the RegEx to return all instances that match it to the AllMatches group
Set AllMatches = Reg1.Execute(olMail.Body)
For Each M In AllMatches
strURL = M.SubMatches(0)
' Don't activate any URLs that are for unsubscribing; skip them
If InStr(1, strURL, "unsubscribe") Then GoTo NextURL
' If the URL ends with a > from being enclosed in darts, strip that > off
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
' The URL to activate to accept must contain both of the substrings in the IF statement
PlayTheSound "tada.wav"
If InStr(1, strURL, ".com") Then
PlayTheSound "TrainWhistle.wav"
' Activate that link to accept the job
RetCode = ShellExecute(0, "Open", strURL)
Set Reg1 = Nothing
Exit Sub
End If
NextURL:
Next
End If
Set Reg1 = Nothing
End Sub
Private Sub TestLaunchURL()
Dim currItem As MailItem
Set currItem = ActiveExplorer.Selection(1)
OpenLinksMessage currItem
End Sub
The test IF Reg1.Test(olMail.Body) always returns a 0 when invoked from an Outlook rule on an incoming message and always returns a -1 when I use the debugger to trigger it for that same message from my inbox.
The code is acting almost as though it has a null message body when it is triggered by an Outlook rule versus having the message body when kicked off by me from exactly the same message once it's in my inbox.
I am completely flummoxed, as I can't understand how one and the same message, with one and the same body, can give 2 different results depending on who hands the message to the subroutine.
Additional Debugging Information:
Since the issue appears to surround the value of the Body of the message, I added the following code, that also examines the HTMLBody as well:
If IsNull(olMail.Body) Then
MsgBox "The message body is null!!"
Else
MsgBox "BODY: " + "|" + olMail.Body + "|"
End If
If IsNull(olMail.HTMLBody) Then
MsgBox "The message HTMLbody is null!!"
Else
MsgBox "BODY: " + "|" + olMail.HTMLBody + "|"
End If
When the script is triggered by the Outlook rule on a message with the content, and only the content, "http://britishtoolworks.com", when it arrives these are the two message boxes:
[I am being forbidden to post images for some reason. These show absolutely nothing between the two pipe characters for BODY and some text, but nothing with the URL in it, for the HTMLBody]
while these are the message boxes if I trigger the script via TestLaunchURL after that very same message is sitting in my inbox:
[Shows the actual expected content. I am forbidden from posting more images.]
If anyone can explain this discrepancy, please do.
Here is the code that finally works. It's clear that the .Body member of olMail is not available until some sort of behind the scenes processing has had time to occur and if you don't wait long enough it won't be there when you go to test using it. Focus on the Public Sub OpenLinksMessage which is where the problem had been occurring.
The major (and only) change that allowed the expected processing of olMail.Body to take place, apparently, was the addition of the line of code: Set InspectMail = olMail.GetInspector.CurrentItem. The time it takes for this set statement to run allows the .Body to become available on the olMail parameter that's passed in by the Outlook rule. What's interesting is that if you immediately display InspectMail.Body after the set statement it shows as empty, just like olMail.Body used to.
Option Explicit
Private Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal Operation As String, _
ByVal Filename As String, _
Optional ByVal Parameters As String, _
Optional ByVal Directory As String, _
Optional ByVal WindowStyle As Long = vbMinimizedFocus _
) As Long
Public Sub OpenLinksMessage(olMail As Outlook.MailItem)
Dim InspectMail As Outlook.MailItem
Dim Reg1 As RegExp
Dim AllMatches As MatchCollection
Dim M As Match
Dim strURL As String
Dim SnaggedBody As String
Dim RetCode As Long
' The purpose of the following Set statement is strictly to "burn time" so that the .Body member of
' olMail is available by the time it is needed below. Without this statement the .Body is consistently
' showing up as empty. What's interesting is if you use MsgBox to display InspectMail.Body immediately after
' this Set statement it shows as empty.
Set InspectMail = olMail.GetInspector.CurrentItem
Set Reg1 = New RegExp
With Reg1
.Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$;_])*)"
.Global = True
.IgnoreCase = True
End With
RetCode = Reg1.Test(olMail.Body)
' If the regular expression test for URLs in the message body finds one or more
If RetCode Then
' Use the RegEx to return all instances that match it to the AllMatches group
Set AllMatches = Reg1.Execute(olMail.Body)
For Each M In AllMatches
strURL = M.SubMatches(0)
' Don't activate any URLs that are for unsubscribing; skip them
If InStr(1, strURL, "unsubscribe") Then GoTo NextURL
' If the URL ends with a > from being enclosed in darts, strip that > off
If Right(strURL, 1) = ">" Then strURL = Left(strURL, Len(strURL) - 1)
' The URL to activate to accept must contain both of the substrings in the IF statement
If InStr(1, strURL, ".com") Then
' Activate that link to accept the job
RetCode = ShellExecute(0, "Open", strURL)
Set InspectMail = Nothing
Set Reg1 = Nothing
Set AllMatches = Nothing
Set M = Nothing
Exit Sub
End If
NextURL:
Next
End If
Set InspectMail = Nothing
Set Reg1 = Nothing
Set AllMatches = Nothing
Set M = Nothing
End Sub
Special thanks to niton for his patience and assistance on other questions that formed the basis for this one. He led me to the solution.
Addendum: Another individual assisting me elsewhere brought up something that deserves noting here, as I think she's got it right. I am using Gmail via IMAP access to download my messages. What appears to be happening is that once the header information is populated into the MailItem object, the Outlook Rule is immediately being triggered. The rest of the members of that object, including .Body, appear to be being populated asynchronously behind the scenes. The speed of processing in your script versus the speed of population processing can lead to situations where the script is triggered with the header information and gets to the point where it accesses the .Body before it's been populated by Outlook itself. What's interesting is when this occurred, and that was most of the time until this solution was found, .Body was not considered to be NULL. The IsNull test never passed, but the content when printed was nothing, as in absolutely nothing between the two pipe characters I used as delimiters. What is "nothing that takes up any characters" but that also is not NULL?
Clearly the whole MailItem passed would not pass the "Is Nothing" test, and I would not think to test an individual member of an object with "Is Nothing."
For myself, I consider this to be buggy. Before a MailItem object is ever handed off for script processing it would be the logical presumption that all Members of that object that can be prepopulated will be prepopulated by Outlook before the handoff. It just doesn't appear to be happening that way, and this is under Outlook 2010 on my machine and Outlook 2016 on another. If you get a member that has not yet been populated it should always have the NULL value, as that should be what everything is initialized to prior to the population process taking place.

Sanitize MS Access query using Regex

I want to sanitize (escape special characters) in a MS Access query, having these fields:
('''2', 'Last Motion', '', 'DooMotion Plugin', 1, '-', True, #12/30/2012 07:55:00#, #12/30/2012 07:55:00#, #01/1/2001 00:00:00#)
The special characters and how they are escaped are listed here: http://support.microsoft.com/kb/826763/en-us.
In short the special characters are: ? # " ' # % ~ ; [ ] { } ( ) and the can be escaped by putting them into brackets [].
My question is if it is possible to sanitize a whole query using regex in one time. If yes, please show an example.
If it is not possible, then I could break it down to field level and sanitize each field seperately. How to do this with regex.
Regards,
Joost.
To follow Anton's advice, how do I use query parameters in .NET? This is the code I am currently using:
objConn = CreateObject("ADODB.Connection")
objCatalog = CreateObject("ADOX.Catalog")
objConn.Open("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strDatabase)
objCatalog.activeConnection = objConn
sql = "INSERT INTO Devices (Code, Name) VALUES ("'" & fCode & "','" & fName & "')"
objConn.execute(sql)
For the ones who want to know the solution to use parameters in .NET, here is the code:
Dim queryString As String = "INSERT INTO Devices (name, version) VALUES (#Name, #Version)"
' Open database connection.
Using connection As New OleDb.OleDbConnection(connectionString)
Dim command As New OleDb.OleDbCommand(queryString)
' Strongly typed.
command.Parameters.Add("#Name", OleDb.OleDbType.VarChar, 255).Value = Me.TextBox1.Text
command.Parameters.Add("#Version", OleDb.OleDbType.Integer).Value = Me.TextBox2.Text
command.Connection = connection 'Set the Connection to the new OleDbConnection
' Open the connection and execute the insert command.
Try
connection.Open()
command.ExecuteNonQuery()
Catch ex As Exception
Console.WriteLine(ex.Message)
End Try
End Using 'The connection is automatically closed when the code exits the Using block
Again, thanks Anton for pointing me to the correct solution.

Need help enhancing a Visual Studio Macro

Here's my current Macro
Public Module CopyrightCode
Sub AddCopyrightHeader()
Dim doc As Document
Dim docName As String
Dim companyName As String = "Urban Now"
Dim authorName As String = "Chase Florell"
Dim authorEmail As String = "chase#infinitas.ws"
Dim copyrightText As String = "' All code is Copyright © " & vbCrLf & _
"' - Urban Now (http://mysite.com)" & vbCrLf & _
"' - Infinitas Advantage (http://infinitas.ws)" & vbCrLf & _
"' All Rights Reserved"
' Get the name of this object from the file name
doc = DTE.ActiveDocument
' Get the name of the current document
docName = doc.Name
' Set selection to top of document
DTE.ActiveDocument.Selection.StartOfDocument()
DTE.ActiveDocument.Selection.NewLine()
Dim sb As New StringBuilder
sb.Append("' --------------------------------")
sb.Append(vbCrLf)
sb.Append("' <copyright file='" & docName & "' company='" & companyName & "'>")
sb.Append(vbCrLf)
sb.Append(copyrightText)
sb.Append(vbCrLf)
sb.Append("' </copyright>")
sb.Append(vbCrLf)
sb.Append("' <author>" & authorName & "</author>")
sb.Append(vbCrLf)
sb.Append("' <email>" & authorEmail & "</email>")
sb.Append(vbCrLf)
sb.Append("' <lastedit>" & FormatDateTime(Date.Now, vbLongDate) & "</lastedit>")
sb.Append(vbCrLf)
sb.Append("' ---------------------------------")
' Write first line
DTE.ActiveDocument.Selection.LineUp()
DTE.ActiveDocument.Selection.Text = sb.ToString
End Sub
End Module
What I need to do is first do a file search for the line ' <lastedit>Monday, July 05, 2010</lastedit> (obviously as a REGEX because the date will always be different)
and if it exists, replace the date with today's date, and if it doesn't run the full insert.
Then what I want to hook up is every time I close a file, the Macro runs to update the edit date.
I'm not sure what you're doing, but if that is XML (as it looks like), you should be using XQuery or whatever to locate/update the lastedit node, since that'll handle the assorted complexities of comments and nesting and so on.
If you're confident of what the input text will be and are certain there's no nasties in there, you can match that specific date format quick and dirty:
<lastedit>\w{6,9}, \w{3,9} \d\d, \d{4}</lastedit>
Or, even quicker and dirtier:
<lastedit>[^<]+<lastedit>
It depends what your needs are, how confident you are of what the file contents will be, and so on.
Oh. So I was curious and went and looked up how Visual Studio actually does it's regex stuff, and well... whoever did the VS regex needs to be whacked round the head.
Translate the above standard regex into VS regex, you get these:
\<lastedit\>:i+, :i+ :d:d, :d:d:d:d\</lastedit\>
and
\<lastedit\>[^<]+</lastedit\>
Maybe. It's hard to read the documentation because Microsoft don't appear to want to write websites that work in modern browsers.
Of course, that assumes macros use this insane regex instead of the normal .NET regex - if it's the latter than the top stuff will be fine and you can ignore this craziness. :)
To implement, try something like this:
Dim reLastEdit As Regex = New Regex("<lastedit>[^<]+<lastedit>")
Dim matches AS MatchCollection = reLastEdit.Matches(Input)
If matches.Count > 0
Then
' Change Header
Dim NewLastEdit As String = "<lastedit>" & FormatDateTime(Date.Now, vbLongDate) & "</lastedit>"
reLastEdit.Replace(Input,NewLastEdit)
Else
' Add Header
EndIf
Or similar. Info here: http://msdn.microsoft.com/en-us/library/system.text.regularexpressions.regex_methods.aspx

Does VBscript have modules? I need to handle CSV

I have a need to read a CSV file, and the only language I can use is VBscript.
I'm currently just opening the file and splitting on commas, and it's working OK because there aren't any quoted commas in fields. But I'm aware this is an incredibly fragile solution.
So, is there such a thing as a VBscript module I can use? Somewhere to get a tried-and-tested regular expression that would only split on commas not in quotes?
Any suggestions gratefully received.
VBScript does not have a module system comparable to Perl. However you can open CSV files with ADO and access them like a database table. The code would go something like this:
(The funny comments are solely to fix SO's broken VB syntax highlighting)
Dim conn ''// As ADODB.Connection
Dim rs ''// As ADODB.RecordSet
Dim connStr ''// As String
Dim dataDir ''// As String
dataDir = "C:\" '"
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dataDir & ";Extended Properties=""text"""
Set conn = CreateObject("ADODB.Connection")
conn.Open(connStr)
Set rs = conn.Execute("SELECT * FROM [data.txt]")
''// do something with the recordset
WScript.Echo rs.Fields.Count & " columns found."
WScript.Echo "---"
WScript.Echo rs.Fields("Col1Name").Value
If Not rs.EOF Then
rs.MoveNext
WScript.Echo rs.Fields("Col3Name").Value
End If
''// explicitly closing stuff is somewhat optional
''// in this script, but consider it a good habit
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Creating a schema.ini file that exactly describes your input is optimal. If you don't, you force the text driver to guess, and all bets are off if it guesses the wrong thing. The schema.ini must reside in the same directory where your data is.
Mine looked like this:
[data.txt]
Format=Delimited(;)
DecimalSymbol=.
ColNameHeader=True
MaxScanRows=0
Col1=Col1Name Long
Col2=Col2Name Long
Col3=Col3Name Text
Col4=Col4Name Text
and with this data.txt:
a;b;c;d
1;2;"foo bar";"yadayada"
1;2;"sample data";"blah"
I get this output:
C:\>cscript -nologo data.vbs
4 columns found.
---
1
sample data
C:\>
Worth a read in this regard: Much ADO About Text Files off the MSDN.
You can try creating an Excel ODBC Data Source to CSV (Called DSN I think. Its in Control Panel -> Administrative Tools -> ODBC Data Sources. Then on, you can query it using SQL.
I am still unsure if you can get what you want. I mean inserting a string with commas in it as a value for a particular cell.
A regexp:
'Credits go to http://www.codeguru.com/cpp/cpp/algorithms/strings/article.php/c8153/
r.Pattern = ",(?=(?:[^""]*""[^""]*"")*(?![^""]*""))"
It will find all commas that are not inside quotes.
Alternatively, you can use this function which I just adapted for vbs.
call test
Function ParseCSV(StringToParse, Quotes)
Dim i, r(), QuotedItemStart, prevpos
ReDim r(0)
prevpos = 1
For i = 1 To Len(StringToParse)
If Mid(StringToParse, i, 1) = "," Then
If QuotedItemStart = 0 Then
r(UBound(r)) = Trim(Mid(StringToParse, prevpos, i - prevpos))
ReDim Preserve r(UBound(r) + 1)
prevpos = i + 1
End If
Else
If InStr(1, Quotes, Mid(StringToParse, i, 1)) Then
If QuotedItemStart Then
r(UBound(r)) = Trim(Mid(StringToParse, QuotedItemStart, i - QuotedItemStart))
ReDim Preserve r(UBound(r) + 1)
QuotedItemStart = 0
prevpos = i + 2
i = i + 1
Else
QuotedItemStart = i + 1
End If
End If
End If
Next
If prevpos < Len(StringToParse) Then r(UBound(r)) = Trim(Mid(StringToParse, prevpos))
ParseCSV = r
End Function
Sub Test()
Dim i, s
s = ParseCSV("""This is, some text!"",25,""Holy holes!"", 286", """")
For i = LBound(s) To UBound(s)
msgbox s(i)
Next
msgbox "Items: " & CStr(UBound(s) - LBound(s) + 1)
End Sub
To answer the other half of your question, I have a vague recollection that you can use Windows Script Host spread across several WSF files. I have never done it myself, link to MSDN. Not pure VBS, but it should work in 'just' windows, if that was the real constraint.
More links:
Scripting Guys
Wikipedia
'Tutorial'

WQL query for monitoring file change

I need some help since I am new to WMI Events.
I am trying to write WQL query for monitoring any changes that occure in a file
that is placed in specific folder(C:\Data)
I come up with the following query,but WMIEvent never occures.
SELECT * FROM __InstanceModificationEvent WITHIN 1 WHERE TargetInstance ISA "CIM_DataFile" AND TargetInstance.Drive="C:" AND TargetInstance.Path="\\Data"
Please can you provide me any feedback, what I do wrong or if you know other way to query for file changes I'll appreciate it as well :)
I think the problem is that you didn't double up the \ characters in your query. \ is a reserved character in WQL so you must use \ instead. Below is the VBScipt I used and was able to get working. I hope this is helpful!
Main
Sub Main()
WScript.Echo "Initializing WMI..."
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & _
strComputer & "\root\CIMV2")
Set EventSink = WScript.CreateObject( _
"WbemScripting.SWbemSink","SINK_")
WScript.Echo "WMI Initialized."
query = "SELECT * FROM __InstanceModificationEvent WITHIN 1 WHERE TargetInstance ISA 'CIM_DataFile' AND TargetInstance.Path='\\data\\'"
WScript.Echo "Executing Query..."
set results = objWMIservice.ExecNotificationQuery(query)
WScript.Echo "Query Returned."
Do
WScript.Echo "Waiting on events..."
Set evt = results.NextEvent
WScript.Echo "Modified Path:" + evt.TargetInstance.Path
WScript.Echo "Modified Path:" + evt.TargetInstance.Name
Loop
End Sub
You might also be interested in looking at using the FileSystemWatcher via some .NET language (such as VB.NET or C#) to do the same.