windows - Deduplication and filtering of Add/Remove Programs list (VBScript) -


this script works , tells , me installed in program files.

two problems

duplicate lines

i.e

avg 2011 ver: 10.0.1204

avg 2011 ver: 10.0.1204 installed: 27/01/2011

and

i don't want include lines have key words "update","hotfix","java" can vb gurus out there needed in script?

option explicit  dim stitle stitle = "installed programs on pc -" dim strcomputer  strcomputer = trim(strcomputer) if strcomputer = "" strcomputer = "."  'wscript.echo getaddremove(strcomputer)  dim scompname : scompname = getprobedid(strcomputer)  dim sfilename sfilename = scompname & "_" & getdtfilename() & "_software.txt"  dim s : s = getaddremove(strcomputer)  if writefile(s, sfilename)   'optional prompt display   if msgbox("finished processing.  results saved " & sfilename & _             vbcrlf & vbcrlf & "do want view results now?", _             4 + 32, stitle) = 6     wscript.createobject("wscript.shell").run sfilename, 9   end if end if  function getaddremove(scomp)   'function credit 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    each skey in asubkeys     irc = oreg.getstringvalue(hklm, sbasekey & skey, "displayname", svalue)     if irc <> 0       oreg.getstringvalue hklm, sbasekey & skey, "quietdisplayname", svalue     end if     if svalue <> ""       irc = oreg.getstringvalue(hklm, sbasekey & skey, _                                 "displayversion", sversion)       if sversion <> ""         svalue = svalue & vbtab & "ver: " & sversion       else         svalue = svalue & vbtab        end if       irc = oreg.getstringvalue(hklm, sbasekey & skey, _                                 "installdate", sdatevalue)       if sdatevalue <> ""         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 <> ""           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)     = ubound(atmp) - 1 0 step -1     j = 0 - 1       if lcase(atmp(j)) > lcase(atmp(j+1))         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 " & _                                          "win32_networkadapter",,48)   each objitem in colitems     getprobedid = objitem.systemname   next end function  function getdtfilename()   dim snow, smth, sday, syr, shr, smin, ssec   snow =   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 prompt close file , 1 recursion attempt.   if err = 70     wscript.echo "could not write file " & sfilename & ", results " & _                  "not saved." & vbcrlf & vbcrlf & "this " & _                  "because file open."     bwrite = false   elseif err     wscript.echo err & vbcrlf & err.description     bwrite = false   end if   on error goto 0   if bwrite     outfile.writeline(sdata)     outfile.close   end if   set fso = nothing   set outfile = nothing   writefile = bwrite end function 

@icecurtain: second part of question can solved using instr suggested @oliver, rewritten suit script --

if svalue <> "" _     , (instr(1, svalue, "hotfix", 1)) = 0 _     , (instr(1, svalue, "update", 1)) = 0 _     , (instr(1, svalue, "java", 1)) = 0) 

the first part wouldn't tricky either except fact include version , installation date if found (which of duplicates include in part or not @ all). if bits of data wasn't included, loop through lines , add them scripting.dictory object .exists check prevent duplicate being added.


Comments

Popular posts from this blog

apache - Add omitted ? to URLs -

redirect - bbPress Forum - rewrite to wwww.mysite prohibits login -

php - How can I stop spam on my custom forum/blog? -