asked on

HTA code that can list all softwares in a machine and have a small box to enter comments in them.

Hi,

HTA code that can list all softwares in a machine and have a small box to enter comments in them.
I want help with a HTA that when run gets all locally installed softwares on screen and a box next to it to type explanation on the software need
For example

Visual Studio 6.0 (This is needed for production)
Visual Studio 2008 (This is needed for compilation)

So the data in brackets will be typed by the user.

A submit button when clicked saves the results into a txt file.in a UNC path.

Regards
Sharath

jostrander

See if this works for you:

<html>
<head>
<hta:application
	ID="objSoftwareList"
	ApplicationName="SoftwareList"
	SINGLEINSTANCE="YES"
	CONTEXTMENU="NO"
	SYSMENU="YES"
	MINIMIZEBUTTON="YES"
	MAXIMIZEBUTTON="NO"
/>

<title>Software List</title>

<head>



<script language="vbscript">

window.resizeTo 800,600

Dim strUNC
Dim strFileFormat

Set DataList = CreateObject("System.Collections.ArrayList")
Set fso=CreateObject("Scripting.FileSystemObject")

'--------------------------------------------------------------
'	User Variables
'--------------------------------------------------------------

'File format ("text" or "html")
strFileFormat="text"

'Enter the UNC path
strUNC="\\SERVER123\MYSHARE"

'--------------------------------------------------------------

Sub Window_OnLoad
	GetSoftware
	ListSoftware
End Sub

Sub SaveAll

	If right(strUNC,1)<>"\" then strUNC=strUNC & "\"
	Set WshNetwork=CreateObject("Wscript.Network")
	strFilename=strUNC & WshNetwork.Computername
	
	for i = 1 to DataList.Count
		Set elmTitle=document.getElementById("tdTitle" & i)
		Set elmDesc=document.getElementById("txtDesc" & i)
		all=all & "<tr><td>" & elmTitle.innerText & "</td><td>(" & elmDesc.value & ")</td></tr>"
		Set elmTitle=Nothing
		Set elmDesc=Nothing
	Next
	
	if strFileFormat="text" then
		all=replace(all,"</td><td>",vbTab)
		all=replace(all,"<tr><td>","")
		all=replace(all,"</td></tr>",vbCrLf)
		strFilename=strFilename & ".txt"
	else
		all="<html><body><table>" & all & "</table></body></html>"
		strFilename=strFilename & ".html"
	end if
	
	
	

	Set oFile=fso.OpenTextFile(strFilename,2,true)
	oFile.WriteLine all
	oFile.close
	msgbox "File saved:" & vbCrLf & vbCrLf & strFilename,vbInformation,"Software List"
End Sub

Sub ListSoftware
	
	html="<table>"
	For each itm in DataList
		count=count+1
		if count mod 2=0 then 
			myClass="even"
		else
			myClass="odd"
		end if
		html=html & "<tr><td id=""tdTitle" & count & """ class=""" & myClass & """>" & itm & "</td><td class=""" & myClass & """><input type=""text"" id=""txtDesc" & count & """</td></tr>" & vbCrLf
	Next
	DataArea.innerHTML=html & "</table>"
End Sub

Sub GetSoftware
	on error resume next
	const HKEY_LOCAL_MACHINE = &H80000002
	
	
	
	strComputer = "."
	
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
	strComputer & "\root\default:StdRegProv")
	
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
	strValueName="DisplayName"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey,strValueName,strValue
		If strValue <> "" then
			If instr(strValue,"Windows XP Hotfix")=FALSE and instr(strValue," (KB")=FALSE then
				DataList.Add strValue
			End If
		End If
	Next
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey & "\InstallProperties",strValueName,strValue
		If strValue <> "" then
			If instr(strValue,"Windows XP Hotfix")=FALSE and instr(strValue," (KB")=FALSE then
				DataList.Add strValue
			End If
		End If
	Next
	
End Sub


Sub highlight(elem)
	if elem.className <> "selected" then
		if elem.className="highlight_on" then
			elem.className="highlight_off"
		else
			elem.className="highlight_on"
		end if
	end if
End Sub

</script>

<style>
body
{
	font: 10pt arial;
	background-color: #303030;
}

td {
	font: 10pt arial;
}


.odd{
	background-color: lightgray;
}

.even {
	background-color: white;
}
table {
	border-collapse: collapse;
}

button {
	float: right;
	color: white;
	width: 100px;
}

.highlight_off {background-color: #E8F2FF;border:1px solid #84ACDD;color: black;}
.highlight_on {background-color: #303030;border: 1px solid white;color: white;}

input {
	width: 300px;
}

</style>

</head>

<body>
<div id="DataArea"></div>
<br>
<button onclick="SaveAll"  class="highlight_off" onmouseover="highlight(me)" onmouseout="highlight(me)" >Save</button>
</body>

</html>

Open in new window

jostrander

Use this instead... eliminates duplicates and slightly prettier...

<html>
<head>
<hta:application
	ID="objSoftwareList"
	ApplicationName="SoftwareList"
	SINGLEINSTANCE="YES"
	CONTEXTMENU="NO"
/>

<title>Software List</title>

<head>



<script language="vbscript">

window.resizeTo 800,600

Dim strUNC
Dim strFileFormat

Set oDict = CreateObject("Scripting.Dictionary")
Set fso=CreateObject("Scripting.FileSystemObject")

'--------------------------------------------------------------
'	User Variables
'--------------------------------------------------------------

'File format ("text" or "html")
strFileFormat="html"

'Enter the UNC path
strUNC="\\SERVER123\MYSHARE"


'--------------------------------------------------------------

Sub Window_OnLoad
	GetSoftware
	ListSoftware
End Sub

Sub SaveAll

	If right(strUNC,1)<>"\" then strUNC=strUNC & "\"
	Set WshNetwork=CreateObject("Wscript.Network")
	strFilename=strUNC & WshNetwork.Computername
	
	for i = 1 to oDict.Count
		Set elmTitle=document.getElementById("tdTitle" & i)
		Set elmDesc=document.getElementById("txtDesc" & i)
		all=all & "<tr><td>" & elmTitle.innerText & "</td><td>(" & elmDesc.value & ")</td></tr>"
		Set elmTitle=Nothing
		Set elmDesc=Nothing
	Next
	
	if strFileFormat="text" then
		all=replace(all,"</td><td>",vbTab)
		all=replace(all,"<tr><td>","")
		all=replace(all,"</td></tr>",vbCrLf)
		strFilename=strFilename & ".txt"
	else
		all="<html><body><table>" & all & "</table></body></html>"
		strFilename=strFilename & ".html"
	end if
	

	Set oFile=fso.OpenTextFile(strFilename,2,true)
	oFile.WriteLine all
	oFile.close
	msgbox "File saved:" & vbCrLf & vbCrLf & strFilename,vbInformation,"Software List"
End Sub

Sub ListSoftware
	
	html="<table><th>Software Title</th><th>Description</th>"
	For each key in oDict.Keys
		count=count+1
		if count mod 2=0 then 
			myClass="even"
		else
			myClass="odd"
		end if
		html=html & "<tr><td id=""tdTitle" & count & """ class=""" & myClass & """>" & key & "</td><td class=""" & myClass & """><input type=""text"" id=""txtDesc" & count & """</td></tr>" & vbCrLf
	Next
	DataArea.innerHTML=html & "</table>"
End Sub

Sub GetSoftware
	on error resume next
	const HKEY_LOCAL_MACHINE = &H80000002
	
	
	
	strComputer = "."
	
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
	strComputer & "\root\default:StdRegProv")
	
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
	strValueName="DisplayName"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey,strValueName,strValue
		If strValue <> "" then
			If instr(strValue,"Windows XP Hotfix")=FALSE and instr(strValue," (KB")=FALSE then
				If oDict.Exists(strValue)=False then oDict.Add strValue,""
			End If
		End If
	Next
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey & "\InstallProperties",strValueName,strValue
		If strValue <> "" then
			If instr(strValue,"Windows XP Hotfix")=FALSE and instr(strValue," (KB")=FALSE then
				If oDict.Exists(strValue)=False then oDict.Add strValue,""
			End If
		End If
	Next
	
End Sub


Sub highlight(elem)
	if elem.className <> "selected" then
		if elem.className="highlight_on" then
			elem.className="highlight_off"
		else
			elem.className="highlight_on"
		end if
	end if
End Sub

</script>

<style>
body
{
	font: 10pt arial;
	background-color: #303030;
}

td {
	font: 10pt arial;
	width: 100%;
}

th {
	color: white;
	border: 1px solid white;
	background-color: gray;
}

.odd{
	background-color: lightgray;
}

.even {
	background-color: white;
}
table {
	border-collapse: collapse;
}

button {
	float: right;
	color: white;
	width: 100px;
}

.highlight_off {background-color: #E8F2FF;border:1px solid #84ACDD;color: black;}
.highlight_on {background-color: #303030;border: 1px solid white;color: white;}

input {
	width: 300px;
}

</style>

</head>

<body>
<div id="DataArea"></div>
<br>
<button onclick="SaveAll"  class="highlight_off" onmouseover="highlight(me)" onmouseout="highlight(me)" >Save</button>
</body>

</html>

Open in new window

bsharath

ASKER

Perfect Joe thanks
Few Q..'s

Can i mention some names in the script. So it excludes those software names starting with say

IOP this work can be in any part of the software name and i dont want them listed on the screen. As we know they are a needed ones
And example Microsoft office

And how can i get all these html\txt files into a report say each user data into each sheet i excel. So its easy reviewed

And Can i get the machinename and user name shown on the top most of the screen thats intact even when scrolled down

And i get the below 2 errors

And Can i have the colors in a different way like its a little difficult to read

And if already saved by a user and he opens again can we over write the same file he previously saved.
Capture.JPG
Capture1.JPG

jostrander

If you set strFileFormat="html", they will be easy to read 1 at a time. You can also set it to "text", and then open up the file (or paste) in Excel. It's Tab separated, so it should look fine once columns are adjusted.

Otherwise... I think an MS Access would be a better choice than Excel for this... would that be OK?

-->"And Can i get the machinename and user name shown on the top most of the screen thats intact even when scrolled down"
Did you want that on the HTA itself or were you talking reporting?

I'll work on the other changes too.

bsharath

ASKER

Access to combine the final report or each file save?
I want the machine name and user name on the hta and the report as well

bsharath

ASKER

I the Hta can i have a dropdown with these options

Developer, Tester, Architect, Designer , and some more later

jostrander

dropdown, sure.

I'm rethinking Access... it may or may not be a better option. I need some more info first. When you said earlier that if the user ran it a 2nd time that you wanted it to overwrite. Did you just want it to start fresh every time and create a new file? It already should be doing that. OR... did you mean that you want it to reload what they previously wrote?

bsharath

ASKER

Sorry one more addition from the System serial no got from the machine on screen and record in report.
Date of submiting the HTA

bsharath

ASKER

My idea was to create a new file each time run
But the reload of the same file when run would be more better
But say toda when user enters the data he ma have Vs 6.0 and tommorow when he loads for another update that would have been uninstalled. In that case how can we handle.

If those uninstalled details can be shown at the bottom it would be great an other ideas from you

Hope you understood whats the need for this to me.
1. I want users to validate what softwares they have and if the have a software thats not autorized to uninstall them
2. if they give a proper justification then we will validate it later with the users
3. Microsoft licensing recording

jostrander

Try these updates:

<html>
<head>
<hta:application
	ID="objSoftwareList"
	ApplicationName="SoftwareList"
	SINGLEINSTANCE="YES"
	CONTEXTMENU="NO"
	SCROLL="NO"
	MAXIMIZEBUTTON="NO"
	BORDER="THIN"
/>

<title>Software List</title>

<head>

<script language="vbscript">
on error resume next

me.resizeTo 800,600

Dim strUNC
Dim strFilename
Dim strWindowTitle
Dim strComputerName
Dim strUsername
Dim strCurrentRole
Dim arrExclusionList
Dim arrRoles
Dim oDict

Set oDict = CreateObject("Scripting.Dictionary")
Set fso=CreateObject("Scripting.FileSystemObject")
Set WshNetwork=CreateObject("Wscript.Network")

'--------------------------------------------------------------
'	User Variables
'--------------------------------------------------------------

strWindowTitle="Software List"

'Enter the UNC path to store text files
strUNC="\\SERVER123\MYSHARE"

'Array of software that will not be listed...
arrExclusionList=Array(	"Sample Entry 1", _
						"Sample Entry 2", _
						"Sample Entry 3", _
						"Adobe Reader 9.2")

'List the possible user roles
arrRoles=Array(	"","Developer","Tester","Architect","Designer")

'--------------------------------------------------------------
strComputerName=ucase(WshNetwork.Computername)
strUsername=ucase(WshNetwork.Username)

If right(strUNC,1)<>"\" then strUNC=strUNC & "\"
strFilename=strUNC & strComputerName & "-" & strUsername & ".txt"

Sub Window_OnLoad
	GetExisting
	GetSoftware
	ListSoftware
End Sub

Sub SaveAll
	
	If selRole.value="" then
		msgbox "Please select a role.",vbExclamation,strWindowTitle
		selRole.focus
		Exit Sub
	End If
	
	for i = 1 to oDict.Count
		Set elmTitle=document.getElementById("tdTitle" & i)
		Set elmDesc=document.getElementById("txtDesc" & i)
		all=all & elmTitle.innerText & vbTab & elmDesc.value & vbCrLf
		Set elmTitle=Nothing
		Set elmDesc=Nothing
	Next
	

	Set oFile=fso.OpenTextFile(strFilename,2,true)
	oFile.WriteLine "ROLE:" & selRole.value
	oFile.WriteLine "SN:" & GetSerial
	oFile.WriteLine "SUBMITTED:" & Now
	oFile.WriteLine "SOFTWARE:"
	oFile.WriteLine all
	oFile.close
	msgbox "File saved:" & vbCrLf & vbCrLf & strFilename,vbInformation,strWindowTitle
End Sub

Sub ListSoftware
	ON ERROR RESUME NEXT
	'select role dropdown
	HeaderArea.innerHTML="<h3>" & strComputerName & "-" & strUsername & "</h3>"
	
	html="Select Role:  <select id=""selRole"">"
	for each rol in arrRoles
		If rol=strCurrentRole then 
			html = html & "<option selected value=""" & rol & """>" & rol & "</option>"
		Else
			html = html & "<option value=""" & rol & """>" & rol & "</option>"
		End If
	next
	html=html & "</select><br><br>"
	RoleArea.innerHTML=html
	
	html=""
	html=html & "<table><th>Software Title</th><th>Description</th>"
	For each key in oDict.Keys
		count=count+1
		if count mod 2=0 then 
			myClass="even"
		else
			myClass="odd"
		end if
		html=html & "<tr><td id=""tdTitle" & count & """ class=""" & myClass & """>" & _
			key & "</td><td class=""" & myClass & """><input type=""text"" id=""txtDesc" & _
			count & """ value=""" & oDict(key) & """></td></tr>" & vbCrLf
	Next
	DataArea.innerHTML=html & "</table>"
End Sub

Sub GetExisting
	ON ERROR RESUME NEXT
	If fso.FileExists(strFilename) then
		Set oFile=fso.OpenTextFile(strFilename,1)
		text = oFile.ReadAll
		oFile.Close

		arrText = split(text,vbCrLf)
		
		recording=False
		For each line in arrText
			If line <> "" then
				If recording=True then
					arrLine="" : strValue="" : strDesc=""
					arrLine=split(line,vbTab)
					strValue=arrLine(0)
					strDesc=arrLine(1)
					If oDict.Exists(strValue)=False then
						If NOT InArray(arrExclusionList,strValue) then oDict.Add strValue,strDesc
					End If
					
				Else
					If Instr(line,"ROLE:") then strCurrentRole=split(line,"ROLE:")(1)
					If Instr(line,"SOFTWARE:") then recording=True
				End If
			End If
		Next
	End If
End Sub

Sub GetSoftware
	on error resume next
	const HKEY_LOCAL_MACHINE = &H80000002
		
	strComputer = "."
	
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
	strComputer & "\root\default:StdRegProv")
	
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
	strValueName="DisplayName"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey,strValueName,strValue
		If strValue <> "" then
			strValue=replace(strValue,"  "," ")
			If instr(strValue,"Windows XP Hotfix")=FALSE and instr(strValue," (KB")=FALSE then
				If oDict.Exists(strValue)=False then
					If NOT InArray(arrExclusionList,strValue) then oDict.Add strValue,""
				End If
			End If
		End If
	Next
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey & "\InstallProperties",strValueName,strValue
		If strValue <> "" then
			strValue=replace(strValue,"  "," ")
			If instr(strValue,"Windows XP Hotfix")=FALSE and instr(strValue," (KB")=FALSE then
				If oDict.Exists(strValue)=False then 
					If NOT InArray(arrExclusionList,strValue) then oDict.Add strValue,""
				End If
			End If
		End If
	Next
	
End Sub


Sub highlight(elem)
	if elem.className <> "selected" then
		if elem.className="highlight_on" then
			elem.className="highlight_off"
		else
			elem.className="highlight_on"
		end if
	end if
End Sub

Function InArray(arrTemp,strSearch)
	If Instr(vbNullChar & Join(arrTemp,vbNullChar) & vbNullChar,vbNullChar & strSearch & vbNullChar) then
		InArray=True
	Else
		InArray=False
	End If
	
	
End Function

Function GetSerial
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct",,48)
	For Each objItem in colItems
		GetSerial=objItem.IdentifyingNumber
	Next
End Function

</script>

<style>
body
{
	font: 10pt arial;
	background-color: #303030;
	color: white;
}

td {
	font: 10pt arial;
	width: 100%;
	color: black;
}

th {
	color: white;
	border: 1px solid white;
	background-color: gray;
}

.odd{
	background-color: #f0f0f0;
}

.even {
	background-color: white;
}
table {
	border-collapse: collapse;
}

button {
	float: right;
	color: white;
	width: 100px;
}

.highlight_off {background-color: #E8F2FF;border:1px solid #84ACDD;color: black;}
.highlight_on {background-color: #303030;border: 1px solid white;color: white;}

input {
	width: 300px;
}

#DataArea {
	overflow-y: scroll;
	height: 400px;
}

</style>

</head>

<body>
<div id="HeaderArea"></div>
<div id="RoleArea"></div>
<div id="DataArea"></div>
<br>
<button accesskey="s" onclick="SaveAll"  class="highlight_off" onmouseover="highlight(me)" onmouseout="highlight(me)" ><u>S</u>ave</button>
</body>

</html>

Open in new window

bsharath

ASKER

Thanks Joe very nice
Any comments on these
ID: 33153997
and how can we handle the exclusions. say i dont want the Office 2003\2007 or Project shown as those i know its a need. I will need to exclude few 100 softwares if available. So can we do something about this

jostrander

If that works for you, I could write a separate script to view the reports.

bsharath

ASKER

Ok
What about excluding softwares from appearing in the HTA or
Known softwares can we ourselfves make them with data as "Known Software so no updates needed"

1. Excluding known softwares from appearing
2. Display a comment in the comments box for those 100 + softwares i dont want users to comment

jostrander

-->how can we handle the exclusions
see the section under user variables where you can add items. I've included samples, just replace the text with the exact names you want to exclude.

-->My idea was to create a new file each time run
It will do this on 1st run and load existing file on subsequent runs

-->But say toda when user enters the data he ma have Vs 6.0 and tommorow when he loads for another update that would have been uninstalled. In that case how can we handle.
Not sure I understand completely. If the script is re-run and some software was removed since the prior run, then it will probably still show in the list because we're loading previous list as well. If this is an issue, let me know and I'll try to change.

-->If those uninstalled details can be shown at the bottom it would be great an other ideas from you
assuming this is related to above. I'll think about that

Was there anything else specific you needed with it?

jostrander

This should fix so that if software was removed, it will not list:

<html>
<head>
<hta:application
	ID="objSoftwareList"
	ApplicationName="SoftwareList"
	SINGLEINSTANCE="YES"
	CONTEXTMENU="NO"
	SCROLL="NO"
	MAXIMIZEBUTTON="NO"
	BORDER="THIN"
/>

<title>Software List</title>

<head>

<script language="vbscript">
on error resume next

me.resizeTo 800,600

Dim strUNC
Dim strFilename
Dim strWindowTitle
Dim strComputerName
Dim strUsername
Dim strCurrentRole
Dim arrExclusionList
Dim arrRoles
Dim oDictOLD
Dim oDict

Set oDictOLD = CreateObject("Scripting.Dictionary")
Set oDict = CreateObject("Scripting.Dictionary")
Set fso=CreateObject("Scripting.FileSystemObject")
Set WshNetwork=CreateObject("Wscript.Network")

'--------------------------------------------------------------
'	User Variables
'--------------------------------------------------------------

strWindowTitle="Software List"

'Enter the UNC path to store text files
strUNC="\\SERVER123\MYSHARE"

'Array of software that will not be listed...
arrExclusionList=Array(	"Sample Entry 1", _
						"Sample Entry 2", _
						"Sample Entry 3", _
						"Adobe Reader 9.2")

'List the possible user roles
arrRoles=Array(	"","Developer","Tester","Architect","Designer")

'--------------------------------------------------------------
strComputerName=ucase(WshNetwork.Computername)
strUsername=ucase(WshNetwork.Username)

If right(strUNC,1)<>"\" then strUNC=strUNC & "\"
strFilename=strUNC & strComputerName & "-" & strUsername & ".txt"

Sub Window_OnLoad
	GetExisting
	GetSoftware
	ListSoftware
End Sub

Sub SaveAll
	
	If selRole.value="" then
		msgbox "Please select a role.",vbExclamation,strWindowTitle
		selRole.focus
		Exit Sub
	End If
	
	for i = 1 to oDict.Count
		Set elmTitle=document.getElementById("tdTitle" & i)
		Set elmDesc=document.getElementById("txtDesc" & i)
		all=all & elmTitle.innerText & vbTab & elmDesc.value & vbCrLf
		Set elmTitle=Nothing
		Set elmDesc=Nothing
	Next
	

	Set oFile=fso.OpenTextFile(strFilename,2,true)
	oFile.WriteLine "ROLE:" & selRole.value
	oFile.WriteLine "SN:" & GetSerial
	oFile.WriteLine "SUBMITTED:" & Now
	oFile.WriteLine "SOFTWARE:"
	oFile.WriteLine all
	oFile.close
	msgbox "File saved:" & vbCrLf & vbCrLf & strFilename,vbInformation,strWindowTitle
End Sub

Sub ListSoftware
	ON ERROR RESUME NEXT
	'select role dropdown
	HeaderArea.innerHTML="<h3>" & strComputerName & "-" & strUsername & "</h3>"
	
	html="Select Role:  <select id=""selRole"">"
	for each rol in arrRoles
		If rol=strCurrentRole then 
			html = html & "<option selected value=""" & rol & """>" & rol & "</option>"
		Else
			html = html & "<option value=""" & rol & """>" & rol & "</option>"
		End If
	next
	html=html & "</select><br><br>"
	RoleArea.innerHTML=html
	
	html=""
	html=html & "<table><th>Software Title</th><th>Description</th>"
	For each key in oDict.Keys
		count=count+1
		if count mod 2=0 then 
			myClass="even"
		else
			myClass="odd"
		end if
		html=html & "<tr><td id=""tdTitle" & count & """ class=""" & myClass & """>" & _
			key & "</td><td class=""" & myClass & """><input type=""text"" id=""txtDesc" & _
			count & """ value=""" & oDict(key) & """></td></tr>" & vbCrLf
	Next
	DataArea.innerHTML=html & "</table>"
End Sub

Sub GetExisting
	ON ERROR RESUME NEXT
	If fso.FileExists(strFilename) then
		Set oFile=fso.OpenTextFile(strFilename,1)
		text = oFile.ReadAll
		oFile.Close

		arrText = split(text,vbCrLf)
		
		recording=False
		For each line in arrText
			If line <> "" then
				If recording=True then
					arrLine="" : strValue="" : strDesc=""
					arrLine=split(line,vbTab)
					strValue=arrLine(0)
					strDesc=arrLine(1)
					If oDictOLD.Exists(strValue)=False then
						If NOT InArray(arrExclusionList,strValue) then oDictOLD.Add strValue,strDesc
					End If
					
				Else
					If Instr(line,"ROLE:") then strCurrentRole=split(line,"ROLE:")(1)
					If Instr(line,"SOFTWARE:") then recording=True
				End If
			End If
		Next
	End If
End Sub

Sub GetSoftware
	on error resume next
	const HKEY_LOCAL_MACHINE = &H80000002
		
	strComputer = "."
	
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
	strComputer & "\root\default:StdRegProv")
	
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
	strValueName="DisplayName"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey,strValueName,strValue
		If strValue <> "" then
			strValue=replace(strValue,"  "," ")
			If instr(strValue,"Windows XP Hotfix")=FALSE and instr(strValue," (KB")=FALSE then
				If oDict.Exists(strValue)=False then
					oldDesc=""
					oldDesc=oDictOLD(strValue)
					If NOT InArray(arrExclusionList,strValue) then oDict.Add strValue,oldDesc
				End If
			End If
		End If
	Next
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey & "\InstallProperties",strValueName,strValue
		If strValue <> "" then
			strValue=replace(strValue,"  "," ")
			If instr(strValue,"Windows XP Hotfix")=FALSE and instr(strValue," (KB")=FALSE then
				If oDict.Exists(strValue)=False then 
					If NOT InArray(arrExclusionList,strValue) then oDict.Add strValue,""
				End If
			End If
		End If
	Next
	
End Sub


Sub highlight(elem)
	if elem.className <> "selected" then
		if elem.className="highlight_on" then
			elem.className="highlight_off"
		else
			elem.className="highlight_on"
		end if
	end if
End Sub

Function InArray(arrTemp,strSearch)
	If Instr(vbNullChar & Join(arrTemp,vbNullChar) & vbNullChar,vbNullChar & strSearch & vbNullChar) then
		InArray=True
	Else
		InArray=False
	End If
	
	
End Function

Function GetSerial
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct",,48)
	For Each objItem in colItems
		GetSerial=objItem.IdentifyingNumber
	Next
End Function

</script>

<style>
body
{
	font: 10pt arial;
	background-color: #303030;
	color: white;
}

td {
	font: 10pt arial;
	width: 100%;
	color: black;
}

th {
	color: white;
	background-color: gray;
}

.odd{
	background-color: #f0f0f0;
}

.even {
	background-color: white;
}
table {
	border-collapse: collapse;
}

button {
	float: right;
	color: white;
	width: 100px;
}

.highlight_off {background-color: #E8F2FF;border:1px solid #84ACDD;color: black;}
.highlight_on {background-color: #303030;border: 1px solid white;color: white;}

input {
	width: 300px;
}

#DataArea {
	overflow-y: scroll;
	height: 400px;
}

</style>

</head>

<body>
<div id="HeaderArea"></div>
<div id="RoleArea"></div>
<div id="DataArea"></div>
<br>
<button accesskey="s" onclick="SaveAll"  class="highlight_off" onmouseover="highlight(me)" onmouseout="highlight(me)" ><u>S</u>ave</button>
</body>

</html>

Open in new window

jostrander

If you'd prefer to have a text file that lists all software to exclude, I can set it to check that text file.

bsharath

ASKER

Yes exactly wanted that.
if a txt file can have all those 1000's of exclusions i need then that would be easier.
Below the selected roles drop down
Can i get a few lines of data to mention like

"The below listed softwares are not in our authorized list. Please take time to comment on each need. If there is any software that you want to uninstall. Do it and then run the Hta again"

bsharath

ASKER

And anything thats with a word Microsoft and not in my excluded list can i get a drop down rather than a comment box as

MSDN license
Do not know

And a final comments box at the bottom next to save...
So he can enter any specific data

Can we exclude any patches\Hotfixes\Service packs from showing up itself
Like these
Security Update for Microsoft Office system 2007 (972581)

bsharath

ASKER

Leaving a comment box blank should warn the user before save that some boxes are left blank and if he wants them to be blank

bsharath

ASKER

Joe if time permits please have a look at this

https://www.experts-exchange.com/questions/26268959/Script-to-add-1-user-to-all-Distribution-Security-groups-that-are-mailed-enabled-in-thre-Managed-tab.html

jostrander

Try this update. Make sure to check user variables section.

<html>
<head>
<hta:application
	ID="objSoftwareList"
	ApplicationName="SoftwareList"
	SINGLEINSTANCE="YES"
	CONTEXTMENU="NO"
	SCROLL="NO"
	MAXIMIZEBUTTON="NO"
	BORDER="THIN"
/>

<title>Software List</title>

<head>

<script language="vbscript">
on error resume next

me.resizeTo 800,700

Dim strUNC
Dim strFilename
Dim strWindowTitle
Dim strComputerName
Dim strUsername
Dim strCurrentRole
Dim strComments
Dim strExclusionsFile
Dim arrExclusionList
Dim arrExclusionStrings
Dim arrRoles
Dim oDictOLD
Dim oDict

Set oDictOLD = CreateObject("Scripting.Dictionary")
Set oDict = CreateObject("Scripting.Dictionary")
Set fso=CreateObject("Scripting.FileSystemObject")
Set WshNetwork=CreateObject("Wscript.Network")

'--------------------------------------------------------------
'	User Variables
'--------------------------------------------------------------

strWindowTitle="Software List"

'Enter the UNC path to store text files
strUNC="\\SERVER123\MYSHARE\PC_REPORTS"


'Exclusions list #1
'text file with list of software to exclude
'each line in the file must match the exact software name
strExclusionsFile="\\SERVER123\MYSHARE\DIFFERENTFOLDER\exclusions.txt"


'Exclustions list #2.  These exclustions are special... 
'If the software title matches any part of this string, it will be exluded
arrExclusionStrings=Array(	"Windows XP Hotfix", _
							" (KB", _
							"Security Update for Microsoft", _
							"Windows Driver Package", _
							"Microsoft Office")



'List the possible user roles
arrRoles=Array(	"","Developer","Tester","Architect","Designer")

'--------------------------------------------------------------
strComputerName=ucase(WshNetwork.Computername)
strUsername=ucase(WshNetwork.Username)

If right(strUNC,1)<>"\" then strUNC=strUNC & "\"
strFilename=strUNC & strComputerName & "-" & strUsername & ".txt"

Sub Window_OnLoad
	GetExclusions
	GetExisting
	GetSoftware
	ListSoftware
End Sub

Sub GetExclusions
	If fso.FileExists(strExclusionsFile) then
		Set oFile=fso.OpenTextFile(strExclusionsFile,1)
		text=oFile.ReadAll
		oFile.Close
		arrExclusionList=split(text,vbCrLf)
	End If
End Sub

Sub SaveAll
	
	If selRole.value="" then
		msgbox "Please select a role.",vbExclamation,strWindowTitle
		selRole.focus
		Exit Sub
	End If
	
	all=""
	emptyFields=False
	for i = 1 to oDict.Count
		Set elmTitle=document.getElementById("tdTitle" & i)
		Set elmDesc=document.getElementById("txtDesc" & i)
		all=all & elmTitle.innerText & vbTab & elmDesc.value & vbCrLf
		If elmDesc.value="" then emptyFields=True
		Set elmTitle=Nothing
		Set elmDesc=Nothing
	Next
	
	If emptyFields=True then
		ret=msgbox("Some fields were left blank, continue saving?",vbQuestion+vbOKCancel,strWindowTitle)
		If ret<>vbOK then Exit Sub
	End If
	
	strComments=txtComments.value

	Set oFile=fso.OpenTextFile(strFilename,2,true)
	oFile.WriteLine "ROLE:" & selRole.value
	oFile.WriteLine "SN:" & GetSerial
	oFile.WriteLine "SUBMITTED:" & Now
	oFile.WriteLine "COMMENTS:" & strComments
	oFile.WriteLine "SOFTWARE:"
	oFile.WriteLine all
	oFile.close
	msgbox "File saved:" & vbCrLf & vbCrLf & strFilename,vbInformation,strWindowTitle
	
	me.Close
End Sub

Sub ListSoftware
	ON ERROR RESUME NEXT
	'select role dropdown
	HeaderArea.innerHTML="<h3>" & strComputerName & "-" & strUsername & "</h3>"
	
	html="Select Role:  <select id=""selRole"">"
	for each rol in arrRoles
		If rol=strCurrentRole then 
			html = html & "<option selected value=""" & rol & """>" & rol & "</option>"
		Else
			html = html & "<option value=""" & rol & """>" & rol & "</option>"
		End If
	next
	html=html & "</select><br><br>"
	RoleArea.innerHTML=html
	
	html=""
	html=html & "<table><th>Software Title</th><th>Description</th>"
	For each key in oDict.Keys
		count=count+1
		if count mod 2=0 then 
			myClass="even"
		else
			myClass="odd"
		end if
		html=html & "<tr><td id=""tdTitle" & count & """ class=""" & myClass & """>" & _
			key & "</td><td class=""" & myClass & """><input type=""text"" id=""txtDesc" & _
			count & """ value=""" & oDict(key) & """></td></tr>" & vbCrLf
	Next
	DataArea.innerHTML=html & "</table>"
End Sub

Sub GetExisting
	ON ERROR RESUME NEXT
	If fso.FileExists(strFilename) then
		Set oFile=fso.OpenTextFile(strFilename,1)
		text = oFile.ReadAll
		oFile.Close

		arrText = split(text,vbCrLf)
		
		recording=False
		For each line in arrText
			If line <> "" then
				If recording=True then
					arrLine="" : strValue="" : strDesc=""
					arrLine=split(line,vbTab)
					strValue=arrLine(0)
					strDesc=arrLine(1)
					If oDictOLD.Exists(strValue)=False then
						If NOT InArray(arrExclusionList,strValue) then oDictOLD.Add strValue,strDesc
					End If
					
				Else
					If Instr(line,"ROLE:") then strCurrentRole=split(line,"ROLE:")(1)
					If Instr(line,"COMMENTS:") then
						strComments=split(line,"COMMENTS:")(1)
						txtComments.value=strComments
					End If
					If Instr(line,"SOFTWARE:") then recording=True
				End If
			End If
		Next
	End If
End Sub

Sub GetSoftware
	on error resume next
	const HKEY_LOCAL_MACHINE = &H80000002
		
	strComputer = "."
	
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
	strComputer & "\root\default:StdRegProv")
	
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
	strValueName="DisplayName"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey,strValueName,strValue
		If strValue <> "" then
			strValue=replace(strValue,"  "," ")
			If InArrayString(arrExclusionStrings,strValue)=False and InArray(arrExclusionList,strValue)=False then
				If oDict.Exists(strValue)=False then
					oldDesc=""
					oldDesc=oDictOLD(strValue)
					oDict.Add strValue,oldDesc
				End If
			End If
		End If
	Next
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey & "\InstallProperties",strValueName,strValue
		If strValue <> "" then
			strValue=replace(strValue,"  "," ")
			If InArrayString(arrExclusionStrings,strValue)=False and InArray(arrExclusionList,strValue)=False then
				If oDict.Exists(strValue)=False then 
					oldDesc=""
					oldDesc=oDictOLD(strValue)
					oDict.Add strValue,oldDesc
				End If
			End If
		End If
	Next
	
End Sub


Sub highlight(elem)
	if elem.className <> "selected" then
		if elem.className="highlight_on" then
			elem.className="highlight_off"
		else
			elem.className="highlight_on"
		end if
	end if
End Sub

Function InArray(arrTemp,strSearch)
	If Instr(vbNullChar & Join(arrTemp,vbNullChar) & vbNullChar,vbNullChar & strSearch & vbNullChar) then
		InArray=True
	Else
		InArray=False
	End If
End Function

Function InArrayString(arrTemp,strSearch)
	InArrayString=False
	For each itm in arrTemp
		If Instr(strSearch,itm) then InArrayString=True
	Next
End Function

Function GetSerial
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct",,48)
	For Each objItem in colItems
		GetSerial=objItem.IdentifyingNumber
	Next
End Function

</script>

<style>
body
{
	font: 10pt arial;
	background-color: #303030;
	color: white;
}

td {
	font: 10pt arial;
	width: 100%;
	color: black;
}

th {
	color: white;
	background-color: gray;
}

.odd{
	background-color: #f0f0f0;
}

.even {
	background-color: white;
}
table {
	border-collapse: collapse;
}

button {
	color: white;
	width: 100px;
}

.highlight_off {background-color: #E8F2FF;border:1px solid #84ACDD;color: black;}
.highlight_on {background-color: #303030;border: 1px solid white;color: white;}

input {
	width: 300px;
}

#DataArea {
	overflow-y: scroll;
	height: 375px;
}

</style>

</head>

<body>
<div id="HeaderArea"></div>
<div id="RoleArea"></div>
The applications listed below are not in our authorized list.  Please take time to comment on each item that is needed.<br>
If there is any unneeded software, please uninstall it and then run this Hta again.<br><br>
<div id="DataArea"></div>
<br>
Comments:  <input id="txtComments" type="text">&nbsp;
<button accesskey="s" onclick="SaveAll"  class="highlight_off" onmouseover="highlight(me)" onmouseout="highlight(me)" ><u>S</u>ave</button>
</body>

</html>

Open in new window

jostrander

i didn't add a dropdown for microsoft... that might get a little too complicated

bsharath

ASKER

Thanks Joe
1. Can i get another dropdown next to existing as
Msdn User
yes
No
No idea

2. There are cases after exclusions there could be no softwares at all that are unautorized. So can we have a message box that states. "You have no unauthorized softwares. Select the drop downs and save"

3. Can we make the comments box in the bottom bigger in breath
4. save should be mandatory if user selects X to close then mention please save
5. Hta should be run from a specific UNC only
6. Can we have no's as 1,2,3,4 next to the softwares. And the total at the boittom to show how many are not autorized. all this in the log also

Sorry for so many additions. But this has become so interesting and would be so useful

jostrander

K, i added all the changes except for putting the total software count in the log. This can be done in the log viewer I will write. If you could please post another request for that one :)

<html>
<head>
<hta:application
	ID="objSoftwareList"
	ApplicationName="SoftwareList"
	SINGLEINSTANCE="YES"
	CONTEXTMENU="NO"
	SCROLL="NO"
	MAXIMIZEBUTTON="NO"
	BORDER="THIN"
/>

<title>Software List</title>

<head>

<script language="vbscript">
on error resume next

me.resizeTo 800,700

Dim strUNC
Dim strFilename
Dim strWindowTitle
Dim strComputerName
Dim strUsername
Dim strCurrentRole
Dim strCurrentMSDN
Dim strComments
Dim strExclusionsFile
Dim arrExclusionList
Dim arrExclusionStrings
Dim arrRoles
Dim arrMSDN
Dim oDictOLD
Dim oDict
Dim boolSaved
Dim SourceDir
Dim strUNC_CHECK

Set oDictOLD = CreateObject("Scripting.Dictionary")
Set oDict = CreateObject("Scripting.Dictionary")
Set fso=CreateObject("Scripting.FileSystemObject")
Set WshNetwork=CreateObject("Wscript.Network")

FullName = replace(objSoftwareList.commandLine,chr(34),"")
pos=InstrRev(FullName,"\")
FileName=Mid(FullName,pos+1)
SourceDir=Left(FullName,pos)


'--------------------------------------------------------------
'	User Variables
'--------------------------------------------------------------

strWindowTitle="Software List"

'This script can only be launched from this location
strUNC_CHECK = "\\MYSERVER\MYSHARE"


'Enter the UNC path to store text files
strUNC="\\SERVER123\MYSHARE\PC_REPORTS"


'Exclusions list #1
'text file with list of software to exclude
'each line in the file must match the exact software name
strExclusionsFile="\\SERVER123\MYSHARE\DIFFERENTFOLDER\exclusions.txt"



'Exclustions list #2.  These exclustions are special... 
'If the software title matches any part of this string, it will be exluded
arrExclusionStrings=Array(	"Windows XP Hotfix", _
							" (KB", _
							"Security Update for Microsoft", _
							"Windows Driver Package", _
							"Microsoft Office")



'List the possible user roles
arrRoles=Array("","Developer","Tester","Architect","Designer")

'MSDN Dropdown values
arrMSDN=Array("","Yes","No","No Idea")

'--------------------------------------------------------------

boolSaved=False

'Close if not launched from specific UNC
If lcase(SourceDir) <> lcase(strUNC_CHECK & "\") then
	boolSaved=True
	me.close
End If


strComputerName=ucase(WshNetwork.Computername)
strUsername=ucase(WshNetwork.Username)

If right(strUNC,1)<>"\" then strUNC=strUNC & "\"
strFilename=strUNC & strComputerName & "-" & strUsername & ".txt"

Sub Window_OnLoad
	GetExclusions
	GetExisting
	GetSoftware
	ListSoftware
End Sub

Sub Window_OnBeforeUnload
	If boolSaved=False then
		msgbox "Please save before exiting.",vbExclamation,strWindowTitle
		Set WshShell=CreateObject("Wscript.Shell")
		WshShell.run objSoftwareList.commandLine
	End If
End Sub


Sub GetExclusions
	If fso.FileExists(strExclusionsFile) then
		Set oFile=fso.OpenTextFile(strExclusionsFile,1)
		text=oFile.ReadAll
		oFile.Close
		arrExclusionList=split(text,vbCrLf)
	End If
End Sub

Sub SaveAll
	
	If selRole.value="" then
		msgbox "Please select a role.",vbExclamation,strWindowTitle
		selRole.focus
		Exit Sub
	End If
	
	If selMSDN.value="" then
		msgbox "Please select MSDN User.",vbExclamation,strWindowTitle
		selMSDN.focus
		Exit Sub
	End If
	
	all=""
	emptyFields=False
	for i = 1 to oDict.Count
		Set elmTitle=document.getElementById("tdTitle" & i)
		Set elmDesc=document.getElementById("txtDesc" & i)
		all=all & elmTitle.innerText & vbTab & elmDesc.value & vbCrLf
		If elmDesc.value="" then emptyFields=True
		Set elmTitle=Nothing
		Set elmDesc=Nothing
	Next
	
	If emptyFields=True then
		ret=msgbox("Some fields were left blank, continue saving?",vbQuestion+vbOKCancel,strWindowTitle)
		If ret<>vbOK then Exit Sub
	End If
	
	strComments=txtComments.value
	strComments=replace(strComments,vbCrLf," ")

	Set oFile=fso.OpenTextFile(strFilename,2,true)
	oFile.WriteLine "ROLE:" & selRole.value
	oFile.WriteLine "MSDN:" & selMSDN.value
	oFile.WriteLine "SN:" & GetSerial
	oFile.WriteLine "SUBMITTED:" & Now
	oFile.WriteLine "COMMENTS:" & strComments
	oFile.WriteLine "SOFTWARE:"
	oFile.WriteLine all
	oFile.close
	msgbox "File saved:" & vbCrLf & vbCrLf & strFilename,vbInformation,strWindowTitle
	
	boolSaved=True
	
	me.Close
	
End Sub

Sub ListSoftware
	ON ERROR RESUME NEXT
	
	'select role dropdown
	HeaderArea.innerHTML="<h3>" & strComputerName & "-" & strUsername & "</h3>"
	
	html="Select Role:  <select id=""selRole"">"
	for each rol in arrRoles
		If rol=strCurrentRole then 
			html = html & "<option selected value=""" & rol & """>" & rol & "</option>"
		Else
			html = html & "<option value=""" & rol & """>" & rol & "</option>"
		End If
	next
	html=html & "</select>&nbsp;"
	
	'MSDN dropdown
	html=html & "MSDN User:  " & "<select id=""selMSDN"">"
	for each itm in arrMSDN
		if itm=strCurrentMSDN then
			html=html & "<option selected value=""" & itm & """>" & itm & "</option>"
		Else
			html=html & "<option value=""" & itm & """>" & itm & "</option>"
		End If
	next
	html=html & "</select><br><br>"
	
	RoleArea.innerHTML=html
	
	html=""
	
	If oDict.Count > 0 then
		html="The applications listed below are not in our authorized list.  " & _
			"Please take time to comment on each item that is needed.<br>" & _
			"If there is any unneeded software, please uninstall it and then run this Hta again.<br><br>"
		html=html & "<table><th>#</th><th>Software Title</th><th>Description</th>"
		For each key in oDict.Keys
			count=count+1
			if count mod 2=0 then 
				myClass="even"
			else
				myClass="odd"
			end if
			html=html & "<tr><td class=""tdcnt"">" & count & "</td><td id=""tdTitle" & count & """ class=""" & myClass & """>" & _
				key & "</td><td class=""" & myClass & """><input type=""text"" id=""txtDesc" & _
				count & """ value=""" & oDict(key) & """></td></tr>" & vbCrLf
		Next
		html=html & "</table>Total:  " & count
	Else
		SoftwareArea.className=""
		html="You have no unathorized applications.  Please select the dropdowns and save."
	End If
	
	SoftwareArea.innerHTML=html
End Sub

Sub GetExisting
	ON ERROR RESUME NEXT
	If fso.FileExists(strFilename) then
		Set oFile=fso.OpenTextFile(strFilename,1)
		text = oFile.ReadAll
		oFile.Close

		arrText = split(text,vbCrLf)
		
		recording=False
		For each line in arrText
			If line <> "" then
				If recording=True then
					arrLine="" : strValue="" : strDesc=""
					arrLine=split(line,vbTab)
					strValue=arrLine(0)
					strDesc=arrLine(1)
					If oDictOLD.Exists(strValue)=False then
						If NOT InArray(arrExclusionList,strValue) then oDictOLD.Add strValue,strDesc
					End If
					
				Else
					If Instr(line,"ROLE:") then strCurrentRole=split(line,"ROLE:")(1)
					If Instr(line,"MSDN:") then strCurrentMSDN=split(line,"MSDN:")(1)
					If Instr(line,"COMMENTS:") then
						strComments=split(line,"COMMENTS:")(1)
						txtComments.value=strComments
					End If
					If Instr(line,"SOFTWARE:") then recording=True
				End If
			End If
		Next
	End If
End Sub

Sub GetSoftware
	on error resume next
	const HKEY_LOCAL_MACHINE = &H80000002
		
	strComputer = "."
	
	Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
	strComputer & "\root\default:StdRegProv")
	
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
	strValueName="DisplayName"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey,strValueName,strValue
		If strValue <> "" then
			strValue=replace(strValue,"  "," ")
			If InArrayString(arrExclusionStrings,strValue)=False and InArray(arrExclusionList,strValue)=False then
				If oDict.Exists(strValue)=False then
					oldDesc=""
					oldDesc=oDictOLD(strValue)
					oDict.Add strValue,oldDesc
				End If
			End If
		End If
	Next
	
	strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Installer\UserData\S-1-5-18\Products\"
	
	oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
	
	For Each subkey In arrSubKeys
		oReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath & subkey & "\InstallProperties",strValueName,strValue
		If strValue <> "" then
			strValue=replace(strValue,"  "," ")
			If InArrayString(arrExclusionStrings,strValue)=False and InArray(arrExclusionList,strValue)=False then
				If oDict.Exists(strValue)=False then 
					oldDesc=""
					oldDesc=oDictOLD(strValue)
					oDict.Add strValue,oldDesc
				End If
			End If
		End If
	Next
	
End Sub


Sub highlight(elem)
	if elem.className <> "selected" then
		if elem.className="highlight_on" then
			elem.className="highlight_off"
		else
			elem.className="highlight_on"
		end if
	end if
End Sub

Function InArray(arrTemp,strSearch)
	If Instr(vbNullChar & Join(arrTemp,vbNullChar) & vbNullChar,vbNullChar & strSearch & vbNullChar) then
		InArray=True
	Else
		InArray=False
	End If
End Function

Function InArrayString(arrTemp,strSearch)
	InArrayString=False
	For each itm in arrTemp
		If Instr(strSearch,itm) then InArrayString=True
	Next
End Function

Function GetSerial
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystemProduct",,48)
	For Each objItem in colItems
		GetSerial=objItem.IdentifyingNumber
	Next
End Function

</script>

<style>
body
{
	font: 10pt arial;
	background-color: #303030;
	color: white;
}

td {
	font: 10pt arial;
	width: 100%;
	color: black;
}

th {
	color: white;
	background-color: gray;
}

.odd{
	background-color: #f0f0f0;
}

.even {
	background-color: white;
}
table {
	border-collapse: collapse;
}

button {
	color: white;
	width: 100px;
}

.highlight_off {background-color: #E8F2FF;border:1px solid #84ACDD;color: black;}
.highlight_on {background-color: #303030;border: 1px solid white;color: white;}

input {
	width: 300px;
}



.table {
	height: 375px;
	overflow-y: scroll;
}

.tdcnt {
	width: 30px;
	color: white;
	background-color: gray;
	text-align: right;
}

</style>

</head>

<body>
<div id="HeaderArea"></div>
<div id="RoleArea"></div>
<div id="SoftwareArea" class="table"></div>
<br>
Comments:<br><textarea rows="4" cols="40" id="txtComments"></textarea>&nbsp;
<button accesskey="s" onclick="SaveAll"  class="highlight_off" onmouseover="highlight(me)" onmouseout="highlight(me)" ><u>S</u>ave</button>
</body>

</html>

Open in new window

bsharath

ASKER

Thanks Joe will post a related Q..
Can we have 2 files generated for each machine. Like one with exclusions and one without. Both in 2 different UNC paths. So we can run reports accordingly....

ASKER CERTIFIED SOLUTION

jostrander

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

bsharath

ASKER

Thanks a lot joe awosome one.. :-)
Related post please have a look
https://www.experts-exchange.com/questions/26337690/Script-to-combine-all-the-logs-into-1-excel-file-As-per-the-selections-in-a-UNC.html