Sharing Knowledge | System Admin Articles

Login Script to Collect Installed Softwares on PC Desktop/Laptops on Network



Here is the Login script which can be used to collect the installed softwares list on PC Desktops/Laptops over network. This script is used by me in production for more than a year. If you have questions on this, feel free to

post your questions in comments


Script Start Here.. Copy from below...      



Option Explicit


Dim StrComputer


strComputer = Trim(strComputer)
'If strComputer = "" Then 


strComputer = "."


Dim sCompName : sCompName = GetProbedID(StrComputer)


Wscript.Echo GetAddRemove(strComputer)


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 = sCompName & sValue & vbTab & "Installed: " & sDateValue
        End If
      End If
      sTmp = sCompName & 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)


  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 Ends Here                                                                                            


My Profile PhotoAbout the Author

I'm Parthiban, An UNIX System Admin by Profession. I'm Experienced in Linux/Unix System Administration and Scripting. I have done lot of work on the infrastructure Mgmt side in Linux, UNIX and Windows system administration, Hardware, Storage and Data center. I'm blogging since 2008.
Follow Me On Twitter or On Facebook

4 Comments for "Login Script to Collect Installed Softwares on PC Desktop/Laptops on Network"

and works for sure!!!

How can I copy the content of output to a file.

You need to add this line after 6th line in the script.


Dim sFileName
sFileName = "OUTPUT_PATH_LOCATION" & sCompName & "_Software.txt"

Replace, OUTPUT_PATH_LOCATION with the path where you want to save the output.

Hope it helps..!

What do you think about this Article? Add your Opinion..!

Back To Top