help with script for Software inventory over a large network

Discussion in 'Scripting' started by Kenneth, Aug 24, 2004.

  1. Kenneth

    Kenneth Guest

    I need help to edit the following script to be able to get all installed
    programs (not just windows intaller ones) that are on all 500 computers on
    the network and imput it into a databe at once.

    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)
    Dim cnt, oReg, sBaseKey, iRC, aSubKeys
    Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
    Set oReg = GetObject("winmgmts:\\" & _
    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
     
    Kenneth, Aug 24, 2004
    #1
    1. Advertisements

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments (here). After that, you can post your question and our members will help you out.