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'

$Software = QS(Split(GetSoftwareInfo(),@CRLF))

ImportToXLS($Software,$File)

$Send = SendOutlookMail('John.Doe@@MyCompany.com','Software Inventory for ' + @FULLNAME + ' on ' + @WKSTA,'Here is the software inventory for my pc ' + @WKSTA,$File)

 

If Exist($File)

  Del $File

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

  

Function SendOutlookMail($To, $Subject, optional $Body, optional $Attachment)

  Dim $objOutlook, $Msg, $Recip, $Attach, $Deliver

  $objOutlook = CreateObject("Outlook.Application")

  $Msg = $objOutlook.CreateItem(0)

  $Msg.Subject = ($Subject)

  $Msg.Body = ($Body + @CRLF)

  $Recip = $Msg.Recipients.Add($To)

  If Not $Recip.Resolve

    $Msg.Display

  EndIf  

  $Msg.attachments.add($Attachment)

  $Msg.Display

;  $Deliver = $Msg.Send

  $objOutlook = ""

EndFunction