Code-a-holic: winmgmts

Showing posts with label winmgmts. Show all posts

Friday, January 27, 2006

[VBScript] Where else have I logged in on this network?

It's not so much a question for me -- I remotely log into many pcs daily as part my job, and try to leave as few tracks as possible. However, today a customer rang saying she'd lost a few important Favourites and had no backup. The best way I could think of helping her, was to locate all the machines she's logged into and see if any of the Favourites could be found.

I did find what she was looking for. Here's the code I used.

First the standard header implementing the synthetic include (derived from Rube Goldberg Memorial Scripting Page)

option explicit

Function GetEnv( strEnvVar )
    Dim oProcessEnvironment
    Dim sResult
    With CreateObject( "WScript.Shell" )
        GetEnv = .Environment( "PROCESS" )( UCase( strEnvVar ) )
    End With
End Function

Sub Include( scriptName )
    Dim sScript
    Dim oStream
    'on error resume next
    err.clear
    With CreateObject( "Scripting.FileSystemobject" )
        Set oStream = .OpenTextFile( scriptName )
    End With
    If Err.Number > 0 Then
        MsgBox "Could not open " & scriptName
        WScript.Quit
    End If
    Err.Clear
    sScript = oStream.ReadAll()
    oStream.Close
    ExecuteGlobal sScript
    If Err.Number <> 0 Then
        Die "Error in loaded script"
    End If
    On Error Goto 0
End Sub

Include "C:\Script\StandardLibrary.vbs"

StandardLibrary.vbs is getting big. 1500+ lines of code.

Next a little function for a right fill. Having needed this only once, I haven't included it in the StandardLibrary.

Function RightFill( sText, nLen, sFill )
    RightFill = Left( sText & String( nLen, sFill ), nLen )
End Function

Now the main body of the script.

1. Check commandline to see if a username is specified.
1.1 If nothing specified, throw a fit.
2. Get an array of all the computers currently online.
2.1 No error checking here but there ought to be
3. Tell everyone what's going on.
4. Loop through the names of the online machines
4.1 Trim off the leading \\ put on by NET VIEW
4.2 Write out the name, right filled with dots
4.3 Get an array of the login profiles for the computer
4.4 Scan the array to see if contains the the username (case insensitive search)
4.4.1 If found say so with a CRLF
4.4.2 otherwise issue a CR

The calls to BeginsWith are commented out. They apply only to my situation where a company edict ensures that all desktop pc names start with PC and all laptops with LP.

Dim oArgs
Set oArgs = WScript.Arguments.Unnamed

If oArgs.Count > 0 Then
    sToFind = oArgs( 0 )
Else
    WScript.Echo "Syntax:" & vbNewLine & vbTab & WScript.ScriptName & " domain\username"
    WScript.Quit
End If

Dim aComp
aComp = GetOnLineComputers( "XXXX" ) 

Dim i
Dim sComp
Dim aProf
Dim sToFind

WScript.Echo "Searcing for " & sToFind & " on network"

For i = 0 To UBound( aComp )
    sComp = Replace( aComp( i ), "\\", vbNullString )
    'If BeginsWith( sComp, "PC", True ) Or BeginsWith( sComp, "LP", True ) Then
        WScript.StdOut.Write RightFill( sComp, 10, "." ) 

        aProf = GetLoginProfiles( sComp )
        If StrInArray( sToFind, aProf, True ) Then 
            WScript.StdOut.Write " has " & sToFind & vbNewLine
        Else
            WScript.StdOut.Write vbCR
        End If
    'End If
Next

The supporting library rountines are below, First GetOnLineComputers with its supporting routines, GetNetView, CaptureDOS and ReadFile

Function GetOnlineComputers( sDomain )
    Dim sTemp
    Dim aTemp
    Dim aResult
    Dim i
    sTemp = GetNetView( sDomain )
    aTemp = Split( sTemp, vbNewLine )
    Redim aResult( UBound( aTemp ) - 6 )

    For i = 3 To UBound( aTemp ) - 3
        aResult( i - 3 ) = NthField( aTemp( i ), " ", 1 )
    Next

    GetOnlineComputers = aResult
End Function

Function GetNetView( sDomain )
    GetNetView = CaptureDOS( "%COMSPEC% /C NET VIEW /DOMAIN:" & sDomain, True )
End Function

Function CaptureDOS( sCommand, bSynch )
    Dim sFolder
    Dim sName
    Dim sTempFile
    Dim sResult

    sResult = vbNullString

    sFolder = oFSO.GetSpecialFolder( TEMPORARY_FOLDER )
    sName = oFSO.GetTempName
    sTempFile = oFSO.BuildPath( sFolder, sName )
    oShell.Run sCommand & "> " & DQ( sTempFile ), 0, bSynch
    sResult = ReadFile( sTempFile )
    oFSO.DeleteFile( sTempFile )
    CaptureDOS = sResult
End Function

Function ReadFile( FileName)
    Dim oStream
    Dim sData

    sData = VBNullString

    Set oStream = oFSO.OpenTextFile(FileName)
    sData = oStream.ReadAll
    oStream.Close

    ReadFile = sData
End Function

Next, BeginsWith (included for completeness sake)

Function BeginsWith( sText, sBeginning, bCaseInsensitive )
    Dim bResult

    bResult = False
    If sBeginning = VBNullString Then
        bResult = True
    Else
        If sText <> VBNullString Then
            If bCaseInsensitive = True Then
                bResult = ( Left( UCase( sText ), Len( sBeginning ) ) = UCase( sBeginning ) )
            Else
                bResult = ( Left( sText, Len( sBeginning ) ) = sBeginning )
            End If
        End If
    End If

    BeginsWith = bResult
End Function

Then GetLoginProfiles, plus support routine AAdd

Function GetLoginProfiles( sComputer )
    Dim cItems
    Dim oItem
    Dim aResult
    ReDim aResult( -1 )

    On Error Resume Next
    Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
    If Err.Number = 0 Then
        Set cItems = oWMI.ExecQuery("Select Name from Win32_NetworkLoginProfile",,48)
        For Each oItem in cItems
            AAdd aResult, oItem.Name 
        Next

    End If
    Err.Clear
    On Error Goto 0

    GetLoginProfiles = aResult 
End Function

Function AAdd( ByRef aToThis, ByVal xAddThis )
    Dim nPos
    nPos = UBound( aToThis ) + 1
    ReDim Preserve aToThis( nPos )
    aToThis( nPos ) = xAddThis
    AAdd = nPos
End Function

And, finally, StrInArray.

Function StrInArray( sItem, aList, bCaseInsensitive )
    Dim i
    Dim u
    Dim bResult
    bResult = False
    u = UBound( aList )
    For i = 0 To u
        If bCaseInsensitive Then
            bResult = ( LCase( sItem ) = LCase( aList( i ) ) )
        Else
            bResult = ( sItem = aList( i ) )
        End If
    Next
    StrInArray = bResult
End Function

Unfortunately, this does not run quickly. It can take ages to get through the entire list and sometimes hangs inexplicably. Your mileage may vary.

If anyone comes up with a faster way of doing this I'd be very interested.

Tuesday, January 10, 2006

[VBScript] Threads ... thin ones

The following is an attempt at threads in VBScript. The code owes a lot to Greg Chapman of MouseTrax Computing Solutions. There are two scripts, the first calling the second (in many instances). The means for communicating between the two is via the Volatile environment. When the script runs, Outlook flickers (don't know why).

There are comments, but the basic idea is to keep a watch over how many instances of cscript.exe there are running and while there's only so many, add more. Use the Volatile environment for semaphores and make sure there's enough delay in there to get stuff to and from Volatile (which is actually in Registry and not blazingly fast).

First the controller.

'~ get list of pcs
'~ for each pc in list
    '~ while threadcount <= max
        '~ launch thread with i, <pc>
        '~ for i = 0 to max
            '~ if var thread.i.status in volatile = "completed" then
                '~ load up text in thread.i.name.txt to database
                '~ 'remove thread.i.status and thread.i.name from volatile env
                '~ remove thread.i.name.txt
            '~ end if
    '~ wend
'~ next

'~ for i = 0 to max
    '~ remove thread.i.name from volatile
    '~ remove thread.i.status from volatile
'~ next


'~ threadcode:
    '~ get thread number from arguments (i)
    '~ get pc from arguments
    '~ put "running" into thread.i.status in volatile env
    '~ get owner of explorer.exe 
    '~ store in <pc>.txt file
    '~ put path of <pc>.txt file into thread.i.name of volative env
    '~ put "completed" into thread.i.status
    '~ exit
Option Explicit

Dim oFSO
Set oFSO = CreateObject( "Scripting.FileSystemobject" )

Dim oShell
Set oShell = CreateObject( "WScript.Shell" )

Dim oVolatile
Set oVolatile = oShell.Environment("VOLATILE")

Const THREADS_MAX = 7
Dim i
For i = 0 To THREADS_MAX
    oVolatile( "Thread." & i & ".status" ) = ""
Next

Dim aReport

Dim nAvailable
Dim aComputers
Dim j
Dim sFile
Dim sData
Dim nMaxComp
Dim sStatus
Dim sName

ReDim aReport( 0 )

aComputers = GetDomainComputers( "THEDOMAIN" )
nMaxComp = UBound( aComputers )
i = 0
Do While True
    If ThreadCount() <= THREADS_MAX Then
        nAvailable = AvailableThread( THREADS_MAX )
        '~ WScript.Echo "next available slot " & nAvailable
        IF nAvailable = -1 Then 'Error Condition. Crash out.
            '~ WScript.Echo "nAvailable = -1 but ThreadCount says " & ThreadCount() & " against a max of " & THREADS_MAX
            ProcessCompletions
        Else
            '~ WSCript.Echo "Launching " & nAvailable & " on " & aComputers( i )
            WScript.Echo aComputers( i ) & " @ " & nAvailable
            LaunchThread nAvailable, aComputers( i )
            WScript.Sleep 1000        
            i = i + 1
        End If
    Else
        ProcessCompletions
    End If
    If i > nMaxComp Then
        Exit Do
    End If
Loop
WriteFile2 oFSO.GetParentFolderName( WScript.ScriptFullName ) & "\Report.txt", Join( aReport, vbNewLine ), WF_CREATE

Sub ProcessCompletions
    Dim j
    Dim sName
    Dim sStatus
    Dim sFile
    Dim sData
    
    For j = 0 To THREADS_MAX
        sName = "Thread." & j & ".name"
        sStatus = "Thread." & j & ".status"
        If oVolatile( sStatus ) = "completed" Then
            '~ WScript.Echo "Thread " & j & " completed."
            sFile = oVolatile( sName )
            '~ WScript.Echo "Trying to read " & sFile
            On Error Resume Next
            sData = ReadFile( sFile ) 
            If Err.Number <> 0 Then
                sData = "Could not open " & sFile
            End If
            Err.Clear
            On Error Goto 0
            AAdd aReport, sData ' put into database later
            On Error Resume Next
            oFSO.DeleteFile( sFile )
            Err.Clear
            On Error GoTo 0
            oVolatile( "Thread." & j & ".status" ) = ""
        End If
    Next
End Sub


'http://www.windowsitpro.com/WindowsScripting/Article/ArticleID/4734/4734.html
'----------------------------------------------------------------
' Function:     GetDomainComputers
' Description:  Returns a listing of NT Computer Accounts for a 
'   given domain
' Parameters:   ByVal strDomain - Name of an NT Domain to retrieve 
'   the list of Computer from.
' Returns:      Variant array of NT Computer names for the 
'   specified domain.
'----------------------------------------------------------------
Public Function GetDomainComputers(ByVal strDomain)
   Dim objIADsContainer          ' ActiveDs.IADsDomain -
   '   Container object
   Dim objIADsComputer           ' ActiveDs.IADsComputer 
   Dim vReturn                   ' Variant
   
   ' connect to the computer.
   Set objIADsContainer = GetObject("WinNT://" & strDomain)

   ' set the filter to retrieve only objects of class Computer
   objIADsContainer.Filter = Array("Computer")

   ReDim vReturn(0)
   For Each objIADsComputer In objIADsContainer
      If Trim(vReturn(0)) <> "" Then
         ReDim Preserve vReturn(UBound(vReturn) + 1)
      End If
      vReturn(UBound(vReturn)) = objIADsComputer.Name
   Next
   
   GetDomainComputers = vReturn
   Set objIADsComputer = Nothing
   Set objIADsContainer = Nothing
End Function

Function ThreadCount()
    Dim cProcs, oProc
    Dim nCount
    
    Set cProcs = GetObject( "winmgmts:{ImpersonationLevel = Impersonate}\\.").InstancesOf( "Win32_Process" )
    nCount = 0
    
    For Each oProc in cProcs
        If LCase( oProc.Caption ) = "cscript.exe" Then
            nCount = nCount + 1
        End If
    Next
    '~ WScript.Echo "ThreadCount is " & nCount
    Set cProcs = Nothing
    ThreadCount = nCount
End Function

Function AvailableThread( nMax )
    Dim i
    Dim sThread
    Dim nAvailable
    Dim sValue
    
    nAvailable = -1
    
    For i = 0 To nMax
        sThread = "Thread." & i & ".status" 
        sValue = oVolatile( sThread )
        If sValue = vbNullString Then
            nAvailable = i
            Exit For
        End If
    Next
    AvailableThread = nAvailable 
End Function

Sub LaunchThread( nThread, sPC )
    Dim sCmd
    sCmd = "cscript.exe " & dq( oFSO.GetParentFolderName( WScript.ScriptFullName ) ) & "\db_build_thread.vbs" & " " & nThread & " " & sPC
    oShell.Run sCmd,0,False
End Sub

Function DQ( sText )
    DQ = Chr( 34 ) & sText & Chr( 34 )
End Function 

Function ReadFile( FileName)
    Dim oStream
    Dim sData

    sData = VBNullString

    Set oStream = oFSO.OpenTextFile(FileName)
    sData = oStream.ReadAll
    oStream.Close

    ReadFile = sData
End Function

Function AAdd( ByRef aToThis, ByVal xAddThis )
    Dim nPos
    nPos = UBound( aToThis ) + 1
    '~ WScript.Echo nPos
    ReDim Preserve aToThis( nPos )
    aToThis( nPos ) = xAddThis
    AAdd = nPos
End Function

Const WF_APPEND = 1
Const WF_CREATE = 2

Const WF_FOR_APPENDING = 8
Const WF_FOR_WRITING = 2
Const WF_CREATE_NONEXISTING = True

Sub WriteFile2( sFilename, sContents, nMode )
    Dim oStream

    If nMode = WF_APPEND Then
        Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_APPENDING, WF_CREATE_NONEXISTING )
    ElseIf nMode = WF_CREATE Then
        Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_WRITING, WF_CREATE_NONEXISTING )
    Else
        Die "Mode incorrectly set for WriteFile2"
    End If

    oStream.Write sContents
    oStream.Close
End Sub

Then the controlled.

'~ threadcode:
    '~ get thread number from arguments (i)
    '~ get pc from arguments
    '~ put "running" into thread.i.status in volatile env
    '~ get owner of explorer.exe 
    '~ store in <pc>.txt file
    '~ put path of <pc>.txt file into thread.i.name of volative env
    '~ put "completed" into thread.i.status
    '~ exit

'objects and vars
Dim oFSO
Set oFSO = CreateObject( "Scripting.FileSystemobject" )

Dim oShell
Set oShell = CreateObject( "WScript.Shell" )

Dim oNetwork
Set oNetwork = CreateObject("WScript.Network")

Dim oVolatile
Set oVolatile = oShell.Environment("VOLATILE")

Const WF_APPEND = 1
Const WF_CREATE = 2

Const WF_FOR_APPENDING = 8
Const WF_FOR_WRITING = 2
Const WF_CREATE_NONEXISTING = True

Sub WriteFile2( sFilename, sContents, nMode )
    Dim oStream

    If nMode = WF_APPEND Then
        Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_APPENDING, WF_CREATE_NONEXISTING )
    ElseIf nMode = WF_CREATE Then
        Set oStream = oFSO.OpenTextFile( sFilename, WF_FOR_WRITING, WF_CREATE_NONEXISTING )
    Else
        Die "Mode incorrectly set for WriteFile2"
    End If

    oStream.Write sContents
    oStream.Close
End Sub

Function GetDomainUser( sComputer )
 Dim cProc
 Dim oProcess
 Dim sUser, sDomain
 Dim sResult
 Dim oWMI
 
 sResult = "<not switched on>"
 If ResolveIP( sComputer ) <> Empty Then

  On Error Resume Next
  Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2")
  If Err.Number = 0 Then
   'Get currently logged on user and update CurrentUser element.
   'This bit of code is "cheating" slightly in that all it's doing is getting the owner of the explorer.exe process.  Seeing as explorer.exe
   'only runs if a user is logged on it is a reliable (but sneaky) way of getting the logged-on user.  It does, however, mean that even if a
   'user is logged on locally or the account is a generic account, it will retrieve the correct values (WMI cannot do this).

   Set cProc = oWMI.ExecQuery("Select Name from Win32_Process Where Name='explorer.exe' and  SessionID=0")
   
   If cProc.Count > 0 Then
    For Each oProcess In cProc
     oProcess.GetOwner sUser, sDomain
     sResult = sDomain & "\" & sUser
    Next
    Else
    sResult = "<not logged on>"
   End If
   Err.Clear
   On Error Goto 0
  End If
 End If
 GetDomainUser = sResult
End Function

Function ResolveIP( sName )
 Dim sHost
 Dim sTarget
 Dim cPingResults
 Dim oPingResult
 Dim sResult
 
 sResult = ""
 sHost = oNetwork.ComputerName
 sTarget = sName
 
 Set cPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//" & _
        sHost & "/root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus " & _
        "WHERE Address = '" + sTarget + "'")

 For Each oPingResult In cPingResults
  If oPingResult.StatusCode = 0 Then
   sResult = oPingResult.ProtocolAddress
  End If
 Next
 ResolveIP = sResult
End Function


Dim oArgs
Set oArgs = WScript.Arguments.Unnamed

Dim nThreadNumber
Dim sPC

If oArgs.Count < 1 Then
    WScript.Echo WScript.ScriptName & " <threadnumber> <pc>"
    WScript.Quit
End If

nThreadNumber = oArgs( 0 )
sPC = oArgs( 1 )

'WScript.Echo nThreadNumber, sPC
Dim sOutput

oVolatile( "Thread." & nThreadNumber & ".status" ) = "running"
sOutput = oFSO.GetParentFolderName( WScript.ScriptFullName ) & "\" & sPC & ".txt"
'~ WScript.Echo sOutput
oVolatile( "Thread." & nThreadNumber & ".name" ) = sOutput

Dim sDomUser
sDomUser = GetDomainUser( sPC )
WriteFile2 sOutput, sPC & vbTab & sDomUser, WF_CREATE

oVolatile( "Thread." & nThreadNumber & ".status" ) = "completed"

There are quite a few extra useful routines in all that code, including an AADD(), and assorted WMI related routines.

I'm in the process of putting the thread functionality inside a Class so that I can change how things are done without causing drastic rewrites of the original VBScripts. I'm not entirely pleased with the Volatile environment and may end up playing with something else that can be used as a shared storage area between many programs ... like subdirectory structures.

Monday, December 19, 2005

[VBScript] Deriving user name from computer name

I found a brilliant bit of code for deriving the username from the computer name. It's found inside Matt Williams's "ManagePC v1.31" HTA. His description of the routine is as follows

This bit of code is "cheating" slightly in that all it's doing is getting the owner of the explorer.exe process. Seeing as explorer.exe only runs if a user is logged on it is a reliable (but sneaky) way of getting the logged-on user. It does, however, mean that even if a user is logged on locally or the account is a generic account, it will retrieve the correct values (WMI cannot do this).
-- Matthew Williams, ManagePC

Below is my routine, combining his code with some extra housekeeping.

Function GetDomainUser( sComputer )
 Dim cProc
 Dim oProcess
 Dim sUser, sDomain
 Dim sResult
 Dim oWMI
 
 sResult = "<not switched on>"
 If ResolveIP( sComputer ) <> Empty Then

  On Error Resume Next
  Set oWMI = GetObject("winmgmts:\\" & sComputer & "\root\CIMV2")
  If Err.Number = 0 Then
   Set cProc = oWMI.ExecQuery("Select Name from Win32_Process Where Name='explorer.exe' and  SessionID=0")
   
   If cProc.Count > 0 Then
    For Each oProcess In cProc
     oProcess.GetOwner sUser, sDomain
     sResult = sDomain & "\" & sUser
    Next
    Else
    sResult = "<not logged on>"
   End If
   Err.Clear
   On Error Goto 0
  End If
 End If
 GetDomainUser = sResult
End Function

Of course, if no one is logged in, you get nothing. My own take on Matt's routine adds in a check to see if the computer is actually running, using ResolveIP() below:

Function ResolveIP( sName )
 Dim sHost
 Dim sTarget
 Dim cPingResults
 Dim oPingResult
 Dim sResult
 
 sResult = ""
 sHost = oNetwork.ComputerName
 sTarget = sName
 
 Set cPingResults = GetObject("winmgmts:{impersonationLevel=impersonate}//" & _
        sHost & "/root/cimv2"). ExecQuery("SELECT * FROM Win32_PingStatus " & _
        "WHERE Address = '" + sTarget + "'")

 For Each oPingResult In cPingResults
  If oPingResult.StatusCode = 0 Then
   sResult = oPingResult.ProtocolAddress
  End If
 Next
 ResolveIP = sResult
End Function