viewing paste Unknown #48449 | VBScript

Posted on the
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
'==========================================================================
'
' VBScript Source File 2.0
'
' NAME: PingSweep-OfficeVersion2.vbs
'
'
' COMMENT:
'   Sets up log file
'   Builds IP range & sweeps range using for next Loop
'   Gets computer name from IP for better logging
'   Gets office (WINWORD.exe) install path from registry
'   Gets office (WINWORD.exe) version number and logs result
' I'm using WINWORD.exe as the basis for determining the office version
' You could easily change it to check for msexcel.exe by changing the registry path and file name.
'
' COMMENT SECOND VERSION:
'   Script works with actual windows and office versions
'   Script doesn't brake up on NON-Windows PCs
'   Script doesn't brake up on "Office not found"
'   Script shows exact internal+external Office verison
'
'   >You have to run the script with network administrator rights
'
'==========================================================================
BaseIP = "192.168.100." 'Set this to match your IP subnet. Don't delete the period at the end.
StartIP = "1"           'Set this to the first IP in the range to scan
EndIP = "254"           'Set this to the last IP in the range to scan
Dim OfficeLog: OfficeLog = "OfficeVersionLog.txt"   'Used to build office log.  Will be created in path where script is run.
Const ForAppending = 8
Const HKEY_LOCAL_MACHINE = &H80000002   'Used for connecting to remote registry to find Outlook install path
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
'=================================
'Setup log file
'=================================
'Checks for log file.  If it doens't exist, it creates it.  
'Created in whatever directory the script is run from.
 
If NOT objFSO.FileExists (OfficeLog) Then
    Set checkLog = objFSO.CreateTextFile(OfficeLog)
    checkLog.Close
End If
 
'Opens log for use
Set objLog = objFSO.OpenTextFile(OfficeLog, ForAppending)
 
'================================
'Build IP range.  Currently only sweeps class C subnets.
'================================
'For loop to create IP address range
For i = StartIP To EndIP    
IP = BaseIP & i
 
'================================
'Ping PC before checking for Office
'================================
'Checks the PC to see if it is accessible.  Writes result to log.  
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}")._
    ExecQuery("select * from Win32_PingStatus where address = '"& IP & "'")
 
    For Each objStatus in objPing      
        If IsNull(objStatus.StatusCode) Or objStatus.StatusCode<>0 Then
            objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & "No response")
            WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & "No response"
        ElseIf objStatus.StatusCode=0 Then
        '****************
        'This section captures the PC name and writes it to the log
        ' in addition to the IP address for more useful logging.
        '****************
            On Error Resume Next
            Set objWMIService = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & IP & "\root\cimv2")
            If Err = 0 Then
                Set colQry = objWMIService.ExecQuery("SELECT Name FROM Win32_ComputerSystem")
                For Each Name In colQry
                PCName = Name.name
        '****************
        'End PC name capture
        '****************
            'objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "PC responded to connection")
            'WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "PC responded to connection"
 
 
'================================
'Check Registry to find install path of office
'================================
                'Access remote registry and read a string (REG_SZ) value.
                'Use to check registry for the install path of Outlook.exe  
                Dim strKeyPath      'everything after the main key IE:  KHEY_LOCAL_MACHINE
                Dim strValueName    'The name of the actual value within a key that you want to read
                Dim strOutlookPath  'Output of path from registry
 
                Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & IP & "\root\default:StdRegProv")
                'strKeyPath is everything after the main key IE:  KHEY_LOCAL_MACHINE
                strKeyPath = "Software\Microsoft\Windows\Currentversion\App Paths\OUTLOOK.EXE"  
                'strValueName is the name of the actual value within a key that you want to read
                strValueName = "Path"      
                objReg.getStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strOutlookPath
 
'================================
'Get Office version
'================================
 
                IF strOutlookPath <> "" THEN
 
                    getFile=strOutlookPath & "WINWORD.EXE"
                    getFile=Replace(getFile,":","$")
                    getFile = "\\" & IP & "\" & getFile
 
                    OfficeVersion = objFSO.GetFileVersion(getFile)
 
                        Select Case left(OfficeVersion,2)
                            Case "9."
                                OfficeExternalVersion = "(Office 2000)"
                            Case "10"      
                                OfficeExternalVersion = "(Office XP)"
                            Case "11"
                                OfficeExternalVersion = "(Office 2003)"
                            Case "12"
                                OfficeExternalVersion = "(Office 2007)"
                            Case "14"
                                OfficeExternalVersion = "(Office 2010)"
                            Case "15"
                                OfficeExternalVersion = "(Office 2013)"
                            Case "16"
                                OfficeExternalVersion = "(Office 2016)"
                        End Select
 
                    objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "Office version is: " & vbTab & OfficeVersion & vbTab & OfficeExternalVersion)
                    WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "Office version is: " & vbTab & OfficeVersion & vbTab & OfficeExternalVersion
                ELSE            
                    objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "Office not installed")
                    WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & PCName & vbTab & "Office not installed"
                END IF
                NEXT
            ELSE
            objLog.WriteLine (Date & vbTab & Time & vbTab & IP & vbTab & "No Windows-Domain PC")
            WScript.Echo Date & vbTab & Time & vbTab & IP & vbTab & "No Windows-Domain PC"
            END IF
 
        END IF
        NEXT
NEXT
 
WScript.Echo "Script Complete"
Viewed 649 times, submitted by unknown.