VBScript to Autoit Script - Installed Programs

Yzzzub · September 3, 2008

Option Explicit

Dim sTitle
sTitle = "Installed Programs"
Dim StrComputer
strComputer = InputBox("Enter I.P. or name of computer to check for " & _
                       "installed software (leave blank to check " & _
                       "local system)." & vbcrlf & vbcrlf & "Remote " & _
                       "checking only from NT type OS to NT type OS " & _
                       "with same Admin level UID & PW", sTitle)
If IsEmpty(strComputer) Then WScript.Quit
strComputer = Trim(strComputer)
If strComputer = "" Then strComputer = "."

'Wscript.Echo GetAddRemove(strComputer)

Dim sCompName : sCompName = GetProbedID(StrComputer)

Dim sFileName
sFileName = sCompName & "_" & GetDTFileName() & "_Software.rtf"

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)
  '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 = 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

Thanks In Advance.

ptrex · September 3, 2008

@Yzzzub

Maybe this can get you going.

#include<Array.au3>
#include <date.au3>

AutoItSetOption("MustDeclareVars", 1)

Dim $sTitle
$sTitle = "Installed Programs"
Dim $StrComputer
$StrComputer = InputBox("Enter $i.P. or name of computer to check for " & _
                       "installed software (leave blank to check " & _
                       "local system)." & @CRLF & @CRLF & "Remote " & _
                       "checking only from NT type OS to NT type OS " & _
                       "with same Admin level UID & PW", $sTitle)
; If $StrComputer = "" Then Exit
;$StrComputer = Trim($StrComputer)
If $StrComputer = "" Then $StrComputer = "."

;ConsoleWrite(GetAddRemove($StrComputer) & @CRLF) 

Dim $sCompName

$sCompName = GetProbedID($StrComputer)

Dim $sFileName, $File
$sFileName = $sCompName & "_" & GetDTFileName() & "_Software.rtf"

Dim $s = GetAddRemove($StrComputer)

If $s <> " " Then
    WriteFile($s, $sFileName)
  ;optional prompt for display
  If MsgBox(1, $sTitle,"Finished processing.  Results saved to " & $sFileName & _
            @CRLF & @CRLF & "Do you want to view the results now?") = 1 Then
    $File = Objcreate("WScript.Shell")
    $File.Run ($sFileName, 9)
  EndIf
EndIf

Func GetAddRemove($sComp)
    Local $Return
  ;Function credit to Torgeir Bakken
  Dim $cnt, $oReg, $sBaseKey, $iRC, $aSubKeys
  Const $HKLM = 0x80000002 ;HKEY_LOCAL_MACHINE
   $oReg = ObjGet("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 $sKey In $aSubKeys
    $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, "DisplayName", $sValue)
    If $iRC <> 0 Then
      $oReg.GetStringValue ($HKLM, $sBaseKey & $sKey, "QuietDisplayName", $sValue)
    EndIf
    If $sValue <> "" Then
      $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, _
                                "DisplayVersion", $sVersion)
      If $sVersion <> "" Then
        $sValue = $sValue & @TAB & "Ver: " & $sVersion
      Else
        $sValue = $sValue & @TAB 
      EndIf
      $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, _
                                "InstallDate", $sDateValue)
      If $sDateValue <> "" Then
        $sYr =  StringLeft($sDateValue, 4)
        $sMth = StringMid($sDateValue, 5, 2)
        $sDay = StringRight($sDateValue, 2)
        ;some Registry entries have improper date format
;         On Error Resume Next 
        $sDateValue = $sYr & "/" & $sMth & "/" & $sDay
;         On Error GoTo 0
        If $sDateValue <> "" Then
          $sValue = $sValue & @TAB & "Installed: " & $sDateValue
        EndIf
      EndIf
      $sTmp = $sTmp & $sValue & @CRLF
    $cnt = $cnt + 1
    EndIf
  Next
  
  $sTmp = BubbleSort($sTmp)
  
  local $iCntr, $iRetVal, $sCr, $sText
    If (IsArray($sTmp)) Then
        For $iCntr = 0 To (UBound($sTmp) - 1)
            $iRetVal = 1
            If $iCntr > 0 Then
                $sCr = @CRLF
            EndIf
               If Asc($sTmp[$iCntr]) <>  0 Then ; Ignore Blanks
                $sText = $sText & $sCr & $sTmp[$iCntr]
                EndIf
        Next
    EndIf
 
  $Return = "INSTALLED SOFTWARE (" & $cnt & ") - " & $sComp & " - " & _Now() 
    Return $Return & @CRLF & @CRLF & $sText
EndFunc

Func BubbleSort($sTmp)
    Local $Return
  ;cheapo bubble sort
  Dim $aTmp, $i, $j, $temp
  $aTmp = StringSplit($sTmp, @CRLF)  
  $i = 0
  For $i = UBound($aTmp) -1 To 0 Step -1
    For $j = 0 to $i - 1
        
      If StringLower($aTmp[$j]) > StringLower($aTmp[$j+1]) Then
        $temp = $aTmp[$j + 1]
        $aTmp[$j + 1] = $aTmp[$j]
        $aTmp[$j] = $temp
      EndIf
    Next
  Next
  $Return = $aTmp & @CRLF
    Return $Return
EndFunc

Func GetProbedID($sComp)
    Local $Return
  Dim $objWMIService, $colItems, $objItem
   $objWMIService = ObjGet("winmgmts:\\" & $sComp & "\root\cimv2")
   $colItems = $objWMIService.ExecQuery("Select SystemName from " & _
                                         "Win32_NetworkAdapter")
  For $objItem in $colItems
    $Return = $objItem.SystemName
  Next
    Return $Return
EndFunc

Func GetDTFileName()
    Local $Return
  dim $sNow, $sMth, $sDay, $sYr, $sHr, $sMin, $sSec
  ;$sNow = _Now()
  $sMth = @MON ;StringRight("0" & Month($sNow), 2)
  $sDay = @MDAY ;StringRight("0" & Day($sNow), 2)
  $sYr = @YEAR ;StringRight("00" & Year($sNow), 4)
  $sHr = @HOUR ;StringRight("0" & Hour($sNow), 2)
  $sMin = @MIN ;StringRight("0" & Minute($sNow), 2)
  $sSec = @SEC ;StringRight("0" & Second($sNow), 2)
  $Return = $sMth & $sDay & $sYr & "_" & $sHr & $sMin & $sSec
    Return $Return
EndFunc

Func WriteFile($sData, $sFileName)
    Local $Return
  Dim $fso, $OutFile, $bWrite
  $bWrite = 1
   $fso = ObjCreate("Scripting.FileSystemObject")
;   On Error Resume Next
   $OutFile = $fso.OpenTextFile($sFileName, 2, 1)
  ;Possibly need a prompt to close the file and one recursion attempt.
  If @error  Then
    ConsoleWrite ("Could not write to file " & $sFileName & ", results " & _
                 "not saved." & @CRLF & @CRLF & "This is probably " & _
                 "because the file is already open.")
    $bWrite = 0
  EndIf
;   On Error GoTo 0
  If $bWrite Then
    $OutFile.WriteLine($sData)
    $OutFile.Close()
  EndIf
   $fso = ""
   $OutFile = ""
  $Return = $bWrite
    Return $Return
EndFunc

regards

ptrex

weaponx · September 3, 2008

$colItems = ""
$strComputer = "localhost"

$Output=""
$objWMIService = ObjGet("winmgmts:\\" & $strComputer & "\root\CIMV2")
$colItems = $objWMIService.ExecQuery("SELECT * FROM Win32_Product", "WQL", 0x10 + 0x20)

If IsObj($colItems) then
   For $objItem In $colItems
      $Output &= "Caption: " & $objItem.Caption & @CRLF
      $Output &= "Description: " & $objItem.Description & @CRLF
      $Output &= "IdentifyingNumber: " & $objItem.IdentifyingNumber & @CRLF
      $Output &= "InstallDate: " & $objItem.InstallDate & @CRLF
      $Output &= "InstallDate2: " & WMIDateStringToDate($objItem.InstallDate2) & @CRLF
      $Output &= "InstallLocation: " & $objItem.InstallLocation & @CRLF
      $Output &= "InstallState: " & $objItem.InstallState & @CRLF
      $Output &= "Name: " & $objItem.Name & @CRLF
      $Output &= "PackageCache: " & $objItem.PackageCache & @CRLF
      $Output &= "SKUNumber: " & $objItem.SKUNumber & @CRLF
      $Output &= "Vendor: " & $objItem.Vendor & @CRLF
      $Output &= "Version: " & $objItem.Version & @CRLF
      $Output &= "+--------------------------------------------------------" & @CRLF
  Next
  ConsoleWrite($Output & @CRLF)
Else
   Msgbox(0,"WMI Output","No WMI Objects Found for class: " & "Win32_Product" )
Endif

Func WMIDateStringToDate($dtmDate)
    Return StringRegExpReplace($dtmDate, "\A(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})(?:.*)","$2/$3/$1 $4:$5:$6") 
EndFunc

darkleton · December 8, 2010

@Yzzzub

Maybe this can get you going.
regards

ptrex

hi ptrex,

i had a thread open on here a couple of months back with exactly the same script and was getting stuck on the same areas.

your script has worked wonders!

i have altered mine a bit so that it now reads the installed product, and then the uninstall string and puts them in a csv file. is there a way to make it skip writing a line if the text is empty? for example if it finds software x is installed but has no uninstall string, it doesn't write that line at all?

at the moment i have this:

#include<Array.au3>
#include <date.au3>

AutoItSetOption("MustDeclareVars", 1)

Dim $StrComputer
$strComputer = InputBox("Welcome","Enter I.P. or name of computer to check")
; If $StrComputer = "" Then Exit
;$StrComputer = Trim($StrComputer)
If $StrComputer = "" Then $StrComputer = "."

;ConsoleWrite(GetAddRemove($StrComputer) & @CRLF)

Dim $sCompName

$sCompName = GetProbedID($StrComputer)

Dim $sFileName, $File
$sFileName = $sCompName & "_" & GetDTFileName() & "_Software.csv"

Dim $s = GetAddRemove($StrComputer)

If $s <> " " Then
    WriteFile($s, $sFileName)
  ;optional prompt for display
  If MsgBox(1, "","Finished processing.  Results saved to " & $sFileName & _
            @CRLF & @CRLF & "Do you want to view the results now?") = 1 Then
    $File = Objcreate("WScript.Shell")
    $File.Run ($sFileName, 9)
  EndIf
EndIf

Func GetAddRemove($sComp)
    Local $Return
  ;Function credit to Torgeir Bakken
  Dim $cnt, $oReg, $sBaseKey, $iRC, $aSubKeys
  Const $HKLM = 0x80000002 ;HKEY_LOCAL_MACHINE
   $oReg = ObjGet("winmgmts:{impersonationLevel=impersonate}!\\" & _
              $sComp & "/root/default:StdRegProv")
  $sBaseKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
  $iRC = $oReg.EnumKey($HKLM, $sBaseKey, $aSubKeys)

  Dim $sKey, $sValue, $sTmp, $sUninstall, $sDateValue, $sYr, $sMth, $sDay

  For $sKey In $aSubKeys
    $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, "DisplayName", $sValue)
    If $iRC <> 0 Then
      $oReg.GetStringValue ($HKLM, $sBaseKey & $sKey, "QuietDisplayName", $sValue)
    EndIf
    If $sValue <> "" Then
      $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, _
                                "UninstallString", $sUninstall)
      If $sUninstall <> "" Then
        $sValue = $sValue & "," & "Uninstall String: " & $sUninstall
      EndIf
      $iRC = $oReg.GetStringValue($HKLM, $sBaseKey & $sKey, _
                                "InstallDate", $sDateValue)

    $sTmp = $sTmp & $sValue & @CRLF
    $cnt = $cnt + 1
    EndIf
  Next

  $sTmp = BubbleSort($sTmp)

  local $iCntr, $iRetVal, $sCr, $sText
    If (IsArray($sTmp)) Then
        For $iCntr = 0 To (UBound($sTmp) - 1)
            $iRetVal = 1
            If $iCntr > 0 Then
                $sCr = @CRLF
            EndIf
               If Asc($sTmp[$iCntr]) <>  0 Then ; Ignore Blanks
                $sText = $sText & $sCr & $sTmp[$iCntr]
                EndIf
        Next
    EndIf

  $Return = "INSTALLED SOFTWARE" & "," & "UNINSTALL STRING"
    Return $Return & @CRLF & @CRLF & $sText
EndFunc

Func BubbleSort($sTmp)
    Local $Return
  ;cheapo bubble sort
  Dim $aTmp, $i, $j, $temp
  $aTmp = StringSplit($sTmp, @CRLF)
  $i = 0
  For $i = UBound($aTmp) -1 To 0 Step -1
    For $j = 0 to $i - 1

      If StringLower($aTmp[$j]) > StringLower($aTmp[$j+1]) Then
        $temp = $aTmp[$j + 1]
        $aTmp[$j + 1] = $aTmp[$j]
        $aTmp[$j] = $temp
      EndIf
    Next
  Next
  $Return = $aTmp & @CRLF
    Return $Return
EndFunc

Func GetProbedID($sComp)
    Local $Return
  Dim $objWMIService, $colItems, $objItem
   $objWMIService = ObjGet("winmgmts:\\" & $sComp & "\root\cimv2")
   $colItems = $objWMIService.ExecQuery("Select SystemName from " & _
                                         "Win32_NetworkAdapter")
  For $objItem in $colItems
    $Return = $objItem.SystemName
  Next
    Return $Return
EndFunc

Func GetDTFileName()
    Local $Return
  dim $sNow, $sMth, $sDay, $sYr, $sHr, $sMin, $sSec
  ;$sNow = _Now()
  $sMth = @MON ;StringRight("0" & Month($sNow), 2)
  $sDay = @MDAY ;StringRight("0" & Day($sNow), 2)
  $sYr = @YEAR ;StringRight("00" & Year($sNow), 4)
  $sHr = @HOUR ;StringRight("0" & Hour($sNow), 2)
  $sMin = @MIN ;StringRight("0" & Minute($sNow), 2)
  $sSec = @SEC ;StringRight("0" & Second($sNow), 2)
  $Return = $sMth & $sDay & $sYr & "_" & $sHr & $sMin & $sSec
    Return $Return
EndFunc

Func WriteFile($sData, $sFileName)
    Local $Return
  Dim $fso, $OutFile, $bWrite
  $bWrite = 1
   $fso = ObjCreate("Scripting.FileSystemObject")
;   On Error Resume Next
   $OutFile = $fso.OpenTextFile($sFileName, 2, 1)
  ;Possibly need a prompt to close the file and one recursion attempt.
  If @error  Then
    ConsoleWrite ("Could not write to file " & $sFileName & ", results " & _
                 "not saved." & @CRLF & @CRLF & "This is probably " & _
                 "because the file is already open.")
    $bWrite = 0
  EndIf
;   On Error GoTo 0
  If $bWrite Then
    $OutFile.WriteLine($sData)
    $OutFile.Close()
  EndIf
   $fso = ""
   $OutFile = ""
  $Return = $bWrite
    Return $Return
EndFunc

thanks in advance for any help you could give

Sign In

VBScript to Autoit Script - Installed Programs

Recommended Posts

Yzzzub

Link to comment

Share on other sites

ptrex

Link to comment

Share on other sites

weaponx

Link to comment

Share on other sites

darkleton

Link to comment

Share on other sites

Create an account or sign in to comment

Create an account

Sign in

Recently Browsing 0 members

Browse

AutoIt Resources

Release

Beta