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