Yzzzub Posted September 3, 2008 Posted September 3, 2008 expandcollapse popupOption 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 Posted September 3, 2008 Posted September 3, 2008 @Yzzzub Maybe this can get you going. expandcollapse popup#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 Contributions :Firewall Log Analyzer for XP - Creating COM objects without a need of DLL's - UPnP support in AU3Crystal Reports Viewer - PDFCreator in AutoIT - Duplicate File FinderSQLite3 Database functionality - USB Monitoring - Reading Excel using SQLRun Au3 as a Windows Service - File Monitor - Embedded Flash PlayerDynamic Functions - Control Panel Applets - Digital Signing Code - Excel Grid In AutoIT - Constants for Special Folders in WindowsRead data from Any Windows Edit Control - SOAP and Web Services in AutoIT - Barcode Printing Using PS - AU3 on LightTD WebserverMS LogParser SQL Engine in AutoIT - ImageMagick Image Processing - Converter @ Dec - Hex - Bin -Email Address Encoder - MSI Editor - SNMP - MIB ProtocolFinancial Functions UDF - Set ACL Permissions - Syntax HighLighter for AU3ADOR.RecordSet approach - Real OCR - HTTP Disk - PDF Reader Personal Worldclock - MS Indexing Engine - Printing ControlsGuiListView - Navigation (break the 4000 Limit barrier) - Registration Free COM DLL Distribution - Update - WinRM SMART Analysis - COM Object Browser - Excel PivotTable Object - VLC Media Player - Windows LogOnOff Gui -Extract Data from Outlook to Word & Excel - Analyze Event ID 4226 - DotNet Compiler Wrapper - Powershell_COM - New
weaponx Posted September 3, 2008 Posted 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 Posted December 8, 2010 Posted 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: expandcollapse popup#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
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now