Break On
Dim $SO,$Software,$Application,$x,$File,$Send,$Excel,$Report
$SO=SetOption('Explicit','On')
$SO=SetOption('NoVarsInStrings','On')
$SO=SetOption('WrapAtEOL','On')
$Excel = ReadValue('HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\Excel.exe','')
$File = '%TEMP%\' + @USERID + '_' + @WKSTA + '.XLS'
If Exist($File)
Del $File
EndIf
$Software = QS(Split(GetSoftwareInfo(),@CRLF))
ImportToXLS($Software,$File)
If Exist($File)
$Report = $Excel+CHR(32)+$File
RUN $Report
EndIf
Exit 1
Function ImportToXLS($List,$Output)
Dim $Excel, $Workbook, $Row, $App, $, $Error
If VarType($List) <> 8204 ; Not a string array
EXIT 1 ; ERROR_INVALID_FUNCTION
Endif
$Excel = CreateObject("Excel.Application")
If $Excel
$Excel.DisplayAlerts = 0
$Workbook = $Excel.Workbooks.Add(-4167)
If $Workbook
$Workbook.ActiveSheet.Rows(1).Columns(1).Value = "Application"
$Workbook.ActiveSheet.Rows(1).Columns(1).Interior.Color = &EED2BD
$Workbook.ActiveSheet.Rows(1).Columns(1).Font.Bold = -1
$Workbook.ActiveSheet.Rows(1).RowHeight = 25
$Workbook.ActiveSheet.Rows(1).VerticalAlignment = 2
$Workbook.ActiveSheet.Rows(1).HorizontalAlignment = -4131
$Workbook.ActiveSheet.Rows(1).Columns(2).Value = "Path"
$Workbook.ActiveSheet.Rows(1).Columns(2).Interior.Color = &EED2BD
$Workbook.ActiveSheet.Rows(1).Columns(2).Font.Bold = -1
$Workbook.ActiveSheet.Rows(1).Columns(3).Value = "Version"
$Workbook.ActiveSheet.Rows(1).Columns(3).Interior.Color = &EED2BD
$Workbook.ActiveSheet.Rows(1).Columns(3).Font.Bold = -1
$Row = 2
For Each $App In $List
If Instr($App,"*")
$Workbook.ActiveSheet.Rows($Row).Columns(1).Value = Split($App,"*")[0]
$Workbook.ActiveSheet.Rows($Row).Columns(2).Value = Split($App,"*")[1]
$Workbook.ActiveSheet.Rows($Row).Columns(3).Value = Split($App,"*")[2]
$Row=$Row+1
Endif
Next
; This line adds a hyperlink into the worksheet
; $= $Workbook.ActiveSheet.Hyperlinks.Add($Workbook.ActiveSheet.Range("D4")
; ,"http://www.kixhelp.com",,"For further information on KiXtart please go here", "KiXhelp")
$= $Workbook.ActiveSheet.Columns(1).AutoFit
$= $Workbook.ActiveSheet.Columns(2).AutoFit
$= $Workbook.ActiveSheet.Columns(3).AutoFit
$= $Workbook.ActiveSheet.Select
$Workbook.ActiveSheet.Name = "Software Inventory"
Endif
$= $WorkBook.SaveAs($Output)
$Workbook = 0
$Excel.Quit()
$Excel = 0
Endif
EXIT @ERROR
EndFunction
Function GetSoftwareInfo()
Dim $HKLMAppPaths1, $HKLMAppPaths2, $App1, $App2, $Key, $SoftInfo, $Path,$AppName,$AppVer
Dim $DisplayName, $DisplayVersion, $FileVer
$HKLMAppPaths1 = 'HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths'
$HKLMAppPaths2 = 'HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall'
$App1=ArrayEnumKey($HKLMAppPaths1)
$App2=ArrayEnumKey($HKLMAppPaths2)
For Each $Key in $App1
$Path = ReadValue($HKLMAppPaths1 + "\" + $Key,"")
If Len($Path)
If InStr($Path,'%') $Path = ExpandEnvironmentVars($Path) EndIf
If InStr($Path,'"') $Path=Split($Path,'"')[1] EndIf
$Path = IIF(InStr($Key,'WRITE.EXE'),'',$Path)
$Path = IIF(InStr($Key,'winzip.exe'),'',$Path)
If Trim(GetFileVersion($Path,'FileDescription')) <> ""
If Trim(GetFileVersion($Path,'BinFileVersion'))='0.0.0.0'
$FileVer = 'FileVersion'
Else
$FileVer = 'BinFileVersion'
EndIf
$SoftInfo = $SoftInfo + Trim(GetFileVersion($Path,'FileDescription')) + CHR(42)
+ $Path + CHR(42) + Trim(GetFileVersion($Path,$FileVer)) + @CRLF
EndIf
EndIf
Next
For Each $Key in $App2
$DisplayName = ReadValue($HKLMAppPaths2 + "\" + $Key,'DisplayName')
$DisplayVersion = ReadValue($HKLMAppPaths2 + "\" + $Key,'DisplayVersion')
$DisplayName = IIF(InStr($SoftInfo,$DisplayName),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'ACDSee'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Adobe Acrobat 6.0'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Adobe Illustrator'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Adobe Photoshop 5.5'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Adobe Photoshop 6.0'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Adobe Photoshop 7.0'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Adobe Reader'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Alcohol 120'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Dreamweaver MX'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Fireworks MX'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Flash MX'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'FreeHand MX'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'LiveReg'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'LiveUpdate'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'MSN Messenger'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Macromedia FreeHand'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Microsoft Office FrontPage'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Microsoft Outlook'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Net2Phone'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'RoboHelp Office'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'SnagIt'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Symantec AntiVirus'),'',$DisplayName)
$DisplayName = IIF(InStr($DisplayName,'Windows Media Encoder'),'',$DisplayName)
If Len($DisplayName)
If Len($DisplayVersion)
$SoftInfo = $SoftInfo + Trim($DisplayName) + CHR(42) + Trim($Key) + CHR(42) + Trim($DisplayVersion) + @CRLF
EndIf
EndIf
Next
$GetSoftwareInfo=$SoftInfo
EndFunction
Function ArrayEnumKey($regsubkey)
Dim $retcode, $subkeycounter, $currentsubkey, $subkeyarray
If Not KeyExist($regsubkey)
Exit 87
EndIf
$subkeycounter=0
Do
$currentsubkey=EnumKey($regsubkey,$subkeycounter)
If Not @ERROR
ReDim Preserve $subkeyarray[$subkeycounter]
$subkeyarray[$subkeycounter]=$currentsubkey
$subkeycounter=$subkeycounter+1
EndIf
Until @ERROR
$arrayenumkey=$subkeyarray
Exit 0
EndFunction
Function QS($a)
DIM $b[32],$c[32],$d,$e,$f,$g,$h,$i,$j,$k,$l
$b[0]=0
$c[0]=Ubound($a)
$d=0
While $d >=0
$e=$b[$d]
$f=$c[$d]
While $e < $f
$h=$e+($f-$e)/2
$k=$a[$e]
$A[$e]=$A[$h]
$A[$h]=$k
$i=$e+1
$j=$f
$l=0
Do
While ($i<$j) And $A[$e] > $A[$i]
$i=$i+1
Loop
While ($j>=$i) And $A[$j] > $A[$e]
$j=$j-1
Loop
IF $i>=$j
$l=1
Else
$k=$A[$i]
$A[$i]=$A[$j]
$A[$j]=$k
$j=$j-1
$i=$i+1
EndIf
Until $l=1
$k=$a[$e]
$a[$e]=$a[$j]
$a[$j]=$k
$g=$j
If $g-$e <= $f - $g
If $g+1 < $f
$b[$d]=$g+1
$c[$d]=$f
$d=$d+1
EndIf
$f=$g-1
Else
If $g-1 > $e
$b[$d]=$e
$c[$d]=$g-1
$d=$d+1
EndIf
$e=$g+1
EndIf
Loop
$d=$d-1
Loop
$qs=$a
EndFunction
