Link to home
Start Free TrialLog in
Avatar of bsharath
bsharathFlag for India

asked on

Combine 2 Hta codes.

Hi,

I have these 2 codes. i want the code in the snippet added to the one attached as a txt file.
Basically need to install software on the current logged in user account or alternative credentials.
Log the reports on installed softwares
Regards
Sharath main-code.txt
<head>
<title>Choose Software To Install</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Choose Software To Install"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal"
>
</head>
 
<script language="VBScript">
 
Dim arrSoftware, strHTAPath
 
Sub Window_onLoad
	intWidth = 800
	intHeight = 600
	Me.ResizeTo intWidth, intHeight
	Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2))
	Set objNetwork = CreateObject("WScript.Network")
	span_currentuser.InnerHTML = "<b>" & objNetwork.UserDomain & "\" & objNetwork.UserName & "</b>"
      arrSoftware = Array(_
            "Utilities;WinZip;\\server\share\Winzip\Winzip9\winzip90.exe", _
            "Utilities;Adobe Reader 7;\\server\share\Adobe Reader\AdobeRdr709_Extracted\Adobe Reader 7.0.9.msi", _
            "Utilities;Windows Installer 3;\\server\share\Windows Installer 3.1\WindowsInstaller-KB893803-v2-x86.exe", _
            "Messengers;Windows Messenger;\\server\share\WinMessenger\setup.exe", _
            "Utilities;Security Test;\\server\share\PS4LICENSE\setup.exe", _
            "Databases;SQL Server Tools;\\server\share\SQL Server\Tools\setup.exe")
 
	Populate_SoftwareType
	txt_username.Value = objNetwork.UserDomain & "\Administrator"
    txt_password.Focus
 
    If Mid(document.location, 6, 3) = "///" Then
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
    Else
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
    End If
 
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    strWindows = objShell.ExpandEnvironmentStrings("%WINDIR%")
    strCMDKey = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "cmdkey.exe"
	If objFSO.FileExists(strWindows & "\System32\cmdkey.exe") = False Then
	    If objFSO.FileExists(strCMDKey) = True Then
	    	On Error Resume Next
	    	objFSO.CopyFile strCMDKey, strWindows & "\System32\", False
	    	If Err.Number <> 0 Then
	    		MsgBox "Unable to copy " & strCMDKey & " to " & strWindows & "\System32\" & VbCrLf & "Please re-launch the application " & _
	    			"with administrative rights."
	    	Else
	    		MsgBox strCMDKey & " has been copied to " & strWindows & "\System32\"
	    	End If
	    	Err.Clear
	    	On Error GoTo 0
	    Else
	    	MsgBox "Could not find cmdkey.exe at " & strCMDKey & " to copy to the System32 folder."
	    End If
	End If
    
End Sub
 
Sub Relaunch_Application
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Left(strHTAPath, 2) = "\\" Then
	    strPSExecPath = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "psexec.exe"
	    If objFSO.FileExists(strPSExecPath) Then
	    	strPSExecPath = objFSO.GetFile(strPSExecPath).ShortPath
			Set objNetwork = CreateObject("WScript.Network")
		    strComputer = objNetwork.ComputerName
		
			If txt_username.Value = "" Then
				MsgBox "Please enter a user name."
				txt_username.Focus
			ElseIf txt_password.Value = "" Then
				MsgBox "Please enter a password."
				txt_password.Focus
			Else
				Set objShell = CreateObject("WScript.Shell")
				strUser = txt_username.Value
				strPass = txt_password.Value
				strCommand = strPSExecPath & " -accepteula -i -d -u " & strUser & " -p " & strPass & " \\" & strComputer & " mshta.exe """ & strHTAPath & """"
				'MsgBox strCommand
				' Exit Code 1326 is invalid password from PSExec 1.85
				strExitCode = objShell.Run(strCommand, 0, True)
				If strExitCode = 1326 Then
					MsgBox "Username or Password invalid. Please verify your credentials."
					txt_password.Value = ""
					txt_password.Focus
				Else
					window.Close
				End If
			End If
	    Else
	    	MsgBox "Could not find PSExec at:" & VbCrLf & strPSExecPath
	    	'Window.Close
	    End If
	Else
		MsgBox "This application must be run from a UNC path for this feature to work correctly."
	End If
End Sub
 
Sub Populate_SoftwareType
 
	strHTML = "<select size='1' name='cbo_softwaretype' onchange='vbs:Populate_Application'>" & VbCrLf
	strHTML = strHTML & "<option selected value='cbo_softwaretype'> --- Select Software Type --- </option>" & VbCrLf
	
	strTypes = ";"
	For Each strProduct In arrSoftware
		strType = Split(strProduct, ";")(0)
		If InStr(LCase(strTypes), LCase(";" & strType & ";")) = 0 Then
			strTypes = strTypes & strType & ";"
			strHTML = strHTML & "<option value='" & strType & "'>" & strType & "</option>" & VbCrLf
		End If
	Next
	
	strHTML = strHTML & "</select>"
	
	span_softwaretype.InnerHTML = strHTML
 
End Sub
 
Sub Populate_Application
 
      strHTML = "<select size='1' name='cbo_application' onChange='vbs:Show_App_Location'>" & VbCrLf
      strHTML = strHTML & "<option selected value='cbo_application'> --- Select Application --- </option>" & VbCrLf
      
      For Each strProduct In arrSoftware
            If LCase(Split(strProduct, ";")(0)) = LCase(cbo_softwaretype.Value) Then
                  strApplication = Split(strProduct, ";")(1)
                  strFilePath = Split(strProduct, ";")(2)
                  strHTML = strHTML & "<option value='" & strApplication & ";" & strFilePath & "'>" & strApplication & "</option>" & VbCrLf
            End If
      Next
      
      strHTML = strHTML & "</select>"
 
      span_application.InnerHTML = strHTML
	  Show_App_Location
End Sub
 
Sub Show_App_Location
	If cbo_application.Value = "cbo_application" Then
		span_app_location.InnerHTML = "<br><br>"
	Else
		span_app_location.InnerHTML = "Application will be installed from<br>" & Split(cbo_application.Value, ";")(1)
	End If
End Sub
 
Sub Default_Buttons
      If Window.Event.KeyCode = 13 Then
            btn_install.Click
      End If
End Sub
 
Sub Install_Software
	  Disable_Controls
	  strLogFile = strHTAPath & "HTA_Install_Log.csv"
      Const intForAppending = 8
      If cbo_softwaretype.Value = "cbo_softwaretype" Then
            MsgBox "Please select a software type."
            cbo_softwaretype.Focus
      ElseIf cbo_application.Value = "cbo_application" Then
            MsgBox "Please select an application."
            cbo_application.Focus
      Else
            strProduct = Split(cbo_application.Value, ";")(0)
            strExecutable = Split(cbo_application.Value, ";")(1)
            If InStr(strExecutable, " /") > 0 Then
            	strSwitches = Mid(strExecutable, InStr(strExecutable, " /"))
            	strExecutable = Left(strExecutable, Len(strExecutable) - Len(strSwitches))
            ElseIf InStr(strExecutable, " TRANSFORMS=") > 0 Then
            	strSwitches = Mid(strExecutable, InStr(strExecutable, " TRANSFORMS="))
            	strExecutable = Left(strExecutable, Len(strExecutable) - Len(strSwitches))
            Else
            	strSwitches = ""
            End If
            Set objFSO = CreateObject("Scripting.FileSystemObject")
            Set objShell = CreateObject("WScript.Shell")
            Set objNetwork = CreateObject("WScript.Network")
            'Software file,Machinename,Install Username,Access Username,Date and time
            If txt_accessusername.Value = "" Then
            	strDetails = strExecutable & "," & objNetwork.ComputerName & "," & txt_UserName.Value & "," & txt_UserName.Value & "," & Now
            Else
            	strDetails = strExecutable & "," & objNetwork.ComputerName & "," & txt_UserName.Value & "," & txt_AccessUserName.Value & "," & Now
            End If
 
            If objFSO.FileExists(strExecutable) = False Then
	            ' Add cached credentials for the server
	            If txt_accessusername.Value <> "" Then
	                strServer = Mid(Split(cbo_application.Value, ";")(1), 3)
	                strServer = Left(strServer, InStr(strServer, "\") - 1)
	                Add_Credentials strServer, txt_accessusername.Value, txt_accesspassword.Value
	            End If
	            intTry = 1
	            While objFSO.FileExists(strExecutable) = False And intTry < 20
	            	HTASleep 1
	            	intTry = intTry + 1
	            Wend
	            'MsgBox "There were " & intTry & " attempts to access " & strExecutable
	        Else
	        	'MsgBox strExecutable & " exists."
	        End If
 
            If objFSO.FileExists(strExecutable) = True Then
                  'objShell.Run strExecutable
                  If LCase(Right(strExecutable, 4)) = LCase(".msi") Then
                        strCommand = "msiexec /i " & objFSO.GetFile(strExecutable).ShortPath & " /qf /norestart"
                  Else
                        If strSwitches = "" Then
                        	strCommand = "cmd /c """ & objFSO.GetFile(strExecutable).ShortPath & """"
                        Else
                        	strCommand = "cmd /c """ & objFSO.GetFile(strExecutable).ShortPath & """" & strSwitches
                        End If
                  End If
                  
                  'MsgBox "Installing: " & strProduct & VbCrLf & "From:" & VbCrLf & strExecutable & VbCrLf & "With: " & strCommand
                  strExitCode = objShell.Run(strCommand, 1, True)
                
                  If Left(strCommand, 7) = "msiexec" And strExitCode = 1619 Then
                        MsgBox "You do not have permission to install this application." & VbCrLf & "Please contact the Help Desk."
                  ElseIf Left(strCommand, 6) = "cmd /c" And strExitCode = 1 Then
                        MsgBox "You do not have permission to install this application." & VbCrLf & "Please contact the Help Desk."
                  End If
                  On Error Resume Next
                  Set objOutputFile = objFSO.OpenTextFile(strLogFile, intForAppending, True)
                  If Err.Number = 0 Then
                  	On Error GoTo 0
	                  objOutputFile.WriteLine strDetails
	                  objOutputFile.Close
	                  Set objOutputFile = Nothing
	              Else
	              	Err.Clear
	              	On Error GoTo 0
	              	MsgBox "Could not write to log file: " & strLogFile & VbCrLf & "Please make sure strLogFile is set correctly."
	              End If
            Else
                  MsgBox "The file does not exist, or you do not have permission to access it." & VbCrLf & "Please contact the Help Desk."
            End If
 
			' Now remove credentials
            If txt_accessusername.Value <> "" Then
                strServer = Mid(Split(cbo_application.Value, ";")(1), 3)
                strServer = Left(strServer, InStr(strServer, "\") - 1)
                Remove_Credentials strServer
            End If
 
            Set objShell = Nothing
            Set objFSO = Nothing
            Set objNetwork = Nothing
      End If
      Enable_Controls
End Sub
 
Sub Disable_Controls
      txt_username.disabled = True
      txt_password.disabled = True
      btn_relaunchapplication.disabled = True
      cbo_softwaretype.disabled = True
      cbo_application.disabled = True
      txt_accessusername.disabled = True
      txt_accesspassword.disabled = True
      btn_install.disabled = True
End Sub
 
Sub Enable_Controls
      txt_username.disabled = False
      txt_password.disabled = False
      btn_relaunchapplication.disabled = False
      cbo_softwaretype.disabled = False
      cbo_application.disabled = False
      txt_accessusername.disabled = False
      txt_accesspassword.disabled = False
      btn_install.disabled = False
End Sub
 
Sub Add_Credentials(strServer, strUsername, strPassword)
	strCommand = "cmd /c cmdkey /add:" & strServer & " /user:" & strUsername & " /pass:" & strPassword
	Set objShell = CreateObject("WScript.Shell")
	objShell.Run strCommand, 0, True
	'MsgBox strUsername & " has been added to the credentials list."
End Sub
 
Sub Remove_Credentials(strServer)
	strCommand = "cmd /c cmdkey /delete:" & strServer
	Set objShell = CreateObject("WScript.Shell")
	objShell.Run strCommand, 0, True
	'MsgBox "Credentials removed for " & strServer
End Sub
 
Sub HTASleep(intSeconds)
	Set objShell = CreateObject("WScript.Shell")
	objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
End Sub
 
</script>
 
<body STYLE="font:14 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient
(GradientType=1, StartColorStr='#000033', EndColorStr='#0000FF')" onkeypress='vbs:Default_Buttons'>
      <table width='90%' height = '100%' align='center' border='0'>
            <tr>
                  <td align="center" colspan="2">
                        <h2>Choose Software To Install</h2>
                  </td>
            </tr>
            <tr>
                  <td align='center' colspan="2">
                        This application is currently being run by: <span id="span_currentuser"></span>
                  </td>
            </tr>
			<tr>
				<td align='center' style="font-family: arial; font-size: 16px; font-weight: bold;" colspan="2">
					Enter username to install applications: <input type="text" maxlength="30" size="40" id="txt_username" name="txt_username" style="font-size: 14px;"><BR><BR>
					Enter password to install applications: <input type="password" maxlength="30" size="40" id="txt_password" name="txt_password" style="font-size: 14px;"><BR>
				</td>
			</tr>
            <tr>
                  <td align='center' colspan="2">
                        <input type="button" value="Relaunch Application" name="btn_relaunchapplication"  onClick="vbs:Relaunch_Application"><br><br>
                  </td>
            </tr>            <tr>
                  <td align='center' colspan="2">
                        Choose from the options in each list:
                  </td>
            </tr>
            <tr>
                  <td width="150px">
                        Software Type:
                  </td>
                  <td align="left">
                        <span id="span_softwaretype">
                              <select size="1" name="cbo_softwaretype">
                                    <option selected value="cbo_softwaretype"> --- Select Software Type --- </option> 
                              </select>
                        </span>
                  </td>
            </tr>
            <tr>
                  <td>
                        Application:
                  </td>
                  <td>
                        <span id="span_application">
                              <select size="1" name="cbo_application">
                                    <option selected value="cbo_application"> --- Select Application --- </option> 
                              </select>
                        </span>
                  </td>
            </tr>
            <tr>
            	<td colspan="2">
                        <span id="span_app_location">
                        	<br><br>
            			</span>
            	</td>
            </tr>
			<tr>
				<td align='center' style="font-family: arial; font-size: 16px;" colspan="2">
					<b>Note: </b>Leave the below fields blank to use the same user account as shown above<br>
					<b>Enter username to access application: </b><input type="text" maxlength="30" size="40" id="txt_accessusername" name="txt_accessusername" style="font-size: 14px;"><BR><BR>
					<b>Enter password to access application: </b><input type="password" maxlength="30" size="40" id="txt_accesspassword" name="txt_accesspassword" style="font-size: 14px;"><BR>
				</td>
			</tr>
            <tr>
                  <td align='center' colspan="2">
                        <input type="button" value="Install" name="btn_install"  onClick="vbs:Install_Software"><br><br>
                  </td>
            </tr>
      </table>
 
</body>

Open in new window

Avatar of RobSampson
RobSampson
Flag of Australia image

Hi Sharath, try this.  This requires that you run the HTA from a UNC path, and also have PSExec in the same folder as the HTA.
Regards,
Rob.

<head>
<title>Choose Software To Install</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Choose Software To Install"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="no"
     WINDOWSTATE="normal"
     CONTEXTMENU="NO"
     MINIMIZEBUTTON="NO"
     MAXIMIZEBUTTON="NO"
>
</head>
 
<script language="VBScript">

intWidth = 800
intHeight = 600
Me.ResizeTo intWidth, intHeight
Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2)) 

Const intForAppending = 8

Dim arrSoftware
Dim strDetails
Dim strLogFile
Dim strHTAPath

strDate = Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)
strLogFile = "\\dev-chen-nas02\profilemanager\HTA_Install_Log_" & strDate & ".csv"

Set objFSO = CreateObject("Scripting.FileSystemObject")
 
Sub Window_onLoad

    If Mid(document.location, 6, 3) = "///" Then
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
    Else
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
    End If
    strHTAPath = Left(strHTAPath, InStrRev(strHTAPath, "\"))
    strRequiredPath = "\\dev\filemanager\"
    If strRequiredPath <> "" Then
          If Right(strRequiredPath, 1) <> "\" Then strRequiredPath = strRequiredPath & "\"
          If LCase(strRequiredPath) <> LCase(strHTAPath) Then
                MsgBox "This HTA is not being run from the required location and will now close."
                window.close
          End If
    End If

    If Mid(document.location, 6, 3) = "///" Then
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
    Else
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
    End If

	Set objNetwork = CreateObject("WScript.Network")
	span_currentuser.InnerHTML = "<b>" & objNetwork.UserDomain & "\" & objNetwork.UserName & "</b>"

	GetComputerDetails
	
      arrSoftware = Array(_
           "Office Products;Office 2003;\\in\FS\Office_Products\Office_2003\SETUP.EXE;Add a description for Office 2003", _
           "Office Products;Office Xp;\\dev\Office XP\SETUPPRO.EXE;Add a description for Office XP", _
            "Utilities;WinZip;\\dev\WinZip\SETUP.EXE;Add a description for WinZip", _
            "Utilities;Adobe Reader 7;\\server\share\Adobe Reader\AdobeRdr709\Adobe Reader 7.0.9.msi;Add a description for Adobe Reader", _
            "Utilities;Windows Installer 3;\\server\share\Windows Installer 3.1\WindowsInstaller-KB893803-v2-x86.exe;Add a description for Windows Installer 3.1", _
            "Messengers;Windows Messenger;\\server\share\WinMessenger\setup.exe;Add a description for Windows Messenger", _
            "Utilities;Security Test;\\server\share\temp\PS4LICENSE\setup.exe;Add a description for Security Test", _
            "Databases;SQL Server Tools;\\server\share\SQL Server\Tools\setup.exe;Add a description for SQL Server Tools.  Here is a sample description that is very long.  It is for example only to show what it will look like... blah blah blah...")
            
	Populate_SoftwareType
    
End Sub

Sub Populate_SoftwareType
	span_desc.innerText=""
      strTypes = ";"
      For Each strProduct In arrSoftware
		  strType = Split(strProduct, ";")(0)
		  If InStr(LCase(strTypes), LCase(";" & strType & ";")) = 0 Then
				strTypes = strTypes & strType & ";"
				AddOption "select_type",strType,strType
		  End If
      Next
      
End Sub
 
Sub Populate_Application
	span_desc.innerText=""
	ClearOptions "select_application"
 
      For Each strProduct In arrSoftware
            If LCase(Split(strProduct, ";")(0)) = LCase(cbo_softwaretype.Value) Then
                  strApplication = Split(strProduct, ";")(1)
                  strFilePath = Split(strProduct, ";")(2)
                  strDescription = Split(strProduct, ";")(3)
				strText = strApplication
				strValue = strApplication & ";" & strFilePath & ";" & strDescription
				AddOption "select_application",strText,strValue
            End If
      Next
      
 
End Sub

Sub AddOption(elem_id,myText,myValue)
	Set elem=document.getElementById(elem_id)
	Set objNewOption = document.createElement("OPTION")
	objNewOption.Text = myText
	objNewOption.value = myValue
	elem.options.Add(objNewOption)
End Sub

Sub ClearOptions(elem_id)
	Set elem=document.getElementById(elem_id)
	elem.options.length=1

End Sub
 
Sub Default_Buttons
      If Window.Event.KeyCode = 13 Then
            btn_install.Click
      End If
End Sub

Sub Install_Software
	On Error Resume Next

	If cbo_softwaretype.Value = "cbo_softwaretype" Then
		MsgBox "Please select a software type."
		cbo_softwaretype.Focus
	ElseIf cbo_application.Value = "cbo_application" Then
		MsgBox "Please select an application."
		cbo_application.Focus
	Else
		strProduct = Split(cbo_application.Value, ";")(0)
		strExecutable = Split(cbo_application.Value, ";")(1)

		Set objShell = CreateObject("WScript.Shell")
		Set objNetwork = CreateObject("WScript.Network")
		'Software file,Machinename,Username,Install START time,Install END time,Install RESULT

		strDetails = """" & strExecutable & """," & _
			"""" & objNetwork.ComputerName & """," & _
			"""" & objNetwork.UserName & """," & _
			"""" & Now & ""","

		If objFSO.FileExists(strExecutable) = True Then
			'objShell.Run strExecutable
			If LCase(Right(strExecutable, 4)) = LCase(".msi") Then
				strCommand = "msiexec /i " & objFSO.GetFile(strExecutable).ShortPath & " /qf /norestart"
			Else
				strCommand = "cmd /c " & objFSO.GetFile(strExecutable).ShortPath
			End If
			'MsgBox "Installing: " & strProduct & VbCrLf & "From:" & VbCrLf & strExecutable & VbCrLf & "With: " & strCommand
			If Left(strCommand, 7) = "msiexec" Then
				strExitCode = objShell.Run(strCommand, 1, True)
			Else
				strExitCode = objShell.Run(strCommand, 0, True)
			End If
			' Record the END time
			strDetails = strDetails & """" & Now & ""","
			If Left(strCommand, 7) = "msiexec" And strExitCode = 1619 Then
				MsgBox "You do not have permission to install this application." & VbCrLf & "Please contact the Help Desk."
			ElseIf Left(strCommand, 6) = "cmd /c" And strExitCode = 1 Then
				MsgBox "You do not have permission to install this application." & VbCrLf & "Please contact the Help Desk."
			End If
			If strExitCode = 0 Then
				strDetails = strDetails & """SUCCESS"""
			Else
				strDetails = strDetails & """ERROR " & strExitCode & """"
			End If
			Set objOutputFile = objFSO.OpenTextFile(strLogFile, intForAppending, True)
			objOutputFile.WriteLine strDetails
			objOutputFile.Close
			Set objOutputFile = Nothing
		Else
			MsgBox "The file does not exist, or you do not have permission to access it." & VbCrLf & "Please contact the Help Desk."
		End If
		Set objShell = Nothing
		Set objNetwork = Nothing
	End If
End Sub

Sub Set_Description
	strSelectValue=select_application.value
	If InStr(strSelectValue, ";") > 0 Then
		span_desc.innerText=split(strSelectValue,";")(2)
	Else
		span_desc.InnerText=""
	End If
End Sub

Sub HighLight
	If btn_install.className="on" then
		btn_install.className="off"
	Else
		btn_install.className="on"
	End If
End Sub 

Sub GetComputerDetails
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
	span_time.InnerHTML = Now
	For Each objItem in colItems
		span_model.InnerHTML = objItem.Model
		span_computer.InnerHTML = objItem.Name
		span_systemtype.InnerHTML = objItem.SystemType
		span_user.InnerHTML = objItem.UserName
	Next
	
	Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration WHERE IPEnabled = True",,48)
	For Each objItem in colItems
		If objItem.MACAddress <> "" Then
			If span_macaddress.InnerHTML = "" Then
				span_macaddress.InnerHTML = objItem.MACAddress
			Else
				span_macaddress.InnerHTML = span_macaddress.InnerHTML & " - " & objItem.MACAddress
			End If
		end if
	Next	
	
	Set colItems = objWMIService.ExecQuery ("Select * from Win32_BIOS")
	For Each objItem in colItems
		span_servicetag.InnerHTML = objItem.SerialNumber
	Next
	 
	Set objItem = Nothing
	Set colItems = Nothing
	Set objWMIService = Nothing
End Sub

Sub Relaunch_Application
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Left(strHTAPath, 2) = "\\" Then
	    strPSExecPath = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "psexec.exe"
	    If objFSO.FileExists(strPSExecPath) Then
	    	strPSExecPath = objFSO.GetFile(strPSExecPath).ShortPath
			Set objNetwork = CreateObject("WScript.Network")
		    strComputer = objNetwork.ComputerName
		
			If txt_username.Value = "" Then
				MsgBox "Please enter a user name."
				txt_username.Focus
			ElseIf txt_password.Value = "" Then
				MsgBox "Please enter a password."
				txt_password.Focus
			Else
				Set objShell = CreateObject("WScript.Shell")
				strUser = txt_username.Value
				strPass = txt_password.Value
				strCommand = strPSExecPath & " -accepteula -i -d -u " & strUser & " -p " & strPass & " \\" & strComputer & " mshta.exe """ & strHTAPath & """"
				' Exit Code 1326 is invalid password from PSExec 1.85
				strExitCode = objShell.Run(strCommand, 0, True)
				If strExitCode = 1326 Then
					MsgBox "Username or Password invalid. Please verify your credentials."
					txt_password.Value = ""
					txt_password.Focus
				Else
					window.Close
				End If
			End If
	    Else
	    	MsgBox "Could not find PSExec at:" & VbCrLf & strPSExecPath
	    	'Window.Close
	    End If
	Else
		MsgBox "This application must be run from a UNC path for this feature to work correctly."
	End If
End Sub

</script>

<STYLE>
body {
	font:12 pt arial;
	color:white;
	filter:progid:DXImageTransform.Microsoft.Gradient
		(GradientType=1, StartColorStr='black', EndColorStr='gray');
}


td {
	vertical-align: top;
	font: 10pt arial;
}

.td_lbl {
	width: 100px;
}

#td_desc {
	width: 60%;
	background: gray;
	color: black;
	border: 2px solid gray;
	height: 200px;
}

.on {
	border: 2px solid white;
	color: white;
	background-color: black;
}

.off {
	border: 2px solid gray;
	color: black;
	background-color: buttonface;
}

select {
	width: 190px;
	color: white;
	background-color: black;
	
}
</STYLE>
 
<body onkeypress='Default_Buttons'>
<h2>Choose Software To Install</h2>
<table>
	<tr>
		<td align='center'>
			This application is currently being run by: <span id="span_currentuser"></span>
		</td>
	</tr>
	<tr>
		<td align='center'>
			Enter username to install applications: <input type="text" maxlength="30" size="40" id="txt_username" name="txt_username" style="font-size: 14px;"><BR><BR>
			Enter password to install applications: <input type="password" maxlength="30" size="40" id="txt_password" name="txt_password" style="font-size: 14px;"><BR>
		</td>
	</tr>
	<tr>
		<td align='center'>
			<input type="button" value="Relaunch Application" name="btn_relaunchapplication"  onClick="vbs:Relaunch_Application"><br><br>
		</td>
	</tr>
</table>
System Specifications:<br><br>
<table>
	<tr>
		<td>
			Current Time:
		</td>
		<td>
			<span id="span_time">
		</td>
	</tr>
	<tr>
		<td>
			Computer Model:
		</td>
		<td>
			<span id="span_model">
		</td>
	</tr>
	<tr>
		<td>
			Computer Name:
		</td>
		<td>
			<span id="span_computer">
		</td>
	</tr>
	<tr>
		<td>
			System Type:
		</td>
		<td>
			<span id="span_systemtype">
		</td>
	</tr>
	<tr>
		<td>
			Logged on User:
		</td>
		<td>
			<span id="span_user">
		</td>
	</tr>
	<tr>
		<td>
			MAC Address:
		</td>
		<td>
			<span id="span_macaddress">
		</td>
	</tr>
	<tr>
		<td>
			Service Tag:
		</td>
		<td>
			<span id="span_servicetag">
		</td>
	</tr>
</table>
<br>
Choose from the options in each list:<br><br>
<table>
	<tr>
		<td>
			<table>
			<tr>
				<td class="td_lbl">Software Type:</td>
				<td>
					<span id="span_softwaretype">
						<select size="1" name="cbo_softwaretype" id="select_type" onchange="Populate_Application" >
							<option selected value="cbo_softwaretype"> --- Select Software Type --- </option> 
						</select>
					</span>
				</td>
			</tr>
			<tr>	
				<td class="td_lbl">Application:</td>
				<td>
					<span id="span_application">
						<select size="1" name="cbo_application" id="select_application" onchange="Set_Description">
							<option selected value="cbo_application" > --- Select Application --- </option> 
						</select>
					</span>
				</td>
			</tr>
			<tr>
				<td><br><button id="btn_install" class="off" onClick="Install_Software" onmouseover="HighLight" onmouseout="HighLight">Install</button></td>
				<td></td>
			</tr>	
			</table>
		</td>
		<td id="td_desc"><span id="span_desc"></span></td>
	</tr>
</table>
</body>

Open in new window

Avatar of bsharath

ASKER

Thanks Rob works perfect
I am going to make this with 50+ applications that will be displayed
Was woundering if we can give the users a path to install that has these 2 dropdowns selected as per there request

the users raises a call log. We will send them a link. I wanted to know if there is a way we can send them a link . When opened the 2 dropdown are selected
Rob about the logging i get as this

8/18/2010 9:31      8/18/2010 9:31      SUCCESS

Say i open and close also it says Success
Can i have it open only once no matter how many times we click
Can you please add the below HTA also into the main one. To some corner please.

<html>
<head>
<hta:application
	ID="objFolderSize"
	ApplicationName="FolderSize"
	SINGLEINSTANCE="YES"
	CONTEXTMENU="NO"
	MINIMIZEBUTTON="NO"
	MAXIMIZEBUTTON="NO"
	SCROLL="NO"
	BORDER="THIN"
	ICON=""
/>

<head>



<script language="vbscript">

'jostrander
	
window.resizeTo 400,230
	
Dim strWindowTitle
strWindowTitle="Folder Sizes"
document.title=strWindowTitle

Const MY_DOCUMENTS = &H5&
Const FAVORITES = &H6&
Const APPLICATION_DATA = &H1a&
Const DESKTOP = &H10&
Const MY_MUSIC = &Hd&
Const MY_VIDEOS = &He&
Const MY_PICTURES = &H27&
Const TEMPORARY_INTERNET_FILES = &H20&



Dim html
Dim strUserProfile
Dim TotalDiskSize
Dim strTempFolder

Set WshShell=CreateObject("Wscript.Shell")
Set fso=CreateObject("Scripting.FileSystemObject")

strUserProfile = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")
strUser = WshShell.ExpandEnvironmentStrings("%USERNAME%")
strTempFolder=WshShell.ExpandEnvironmentStrings("%TEMP%")

Set objShell = CreateObject("Shell.Application")

Sub Window_OnLoad
	Go
End Sub

Sub Go
	
	GetSize MY_DOCUMENTS
	GetSize FAVORITES
	GetSize APPLICATION_DATA
	GetSize DESKTOP
	GetSize MY_MUSIC
	GetSize MY_VIDEOS
	GetSize MY_PICTURES
	GetSize TEMPORARY_INTERNET_FILES
		
	GetTemp
	
	DataArea.innerHTML= "<b>" & strWindowTitle & "</b><table>" & html & "</table>"
	
	allDisks=GetDisks
	DataArea.innerHTML=DataArea.innerHTML & "<br><b>Total HDD:  " & PrettySize(TotalDiskSize) & "</b><table>" & allDisks & "</table>"

	bigPST=FindPST
	If bigPST<>"" then 
		DataArea.innerHTML=DataArea.innerHTML & "<br><b>PST Files > 50MB</b><table>" & bigPST & "</table>"
	End If
	
	window.ResizeTo 400,DataArea.offsetHeight + 60
	
End Sub

Sub GetSize(FLDR)
	ON ERROR RESUME NEXT
	
	Set objFolder = objShell.Namespace(FLDR)
	Set objFolderItem = objFolder.Self
	strPath = objFolderItem.Path
	If right(strPath,8)="\Roaming" then strPath=left(strPath,len(strPath)-8)
	
	size=GetFolderSize(strPath)
	If size="" then
		size="UNKNOWN"
	Else
		size=PrettySize(size)
	End If

	Set objFolder=Nothing
	Set objFolderItem=Nothing
	
	pos=InstrRev(strPath,"\")+1
	Foldername=mid(strPath,pos)
	
	sp = "                    "
	
	html = html & "<tr><td class=""link"" onclick=""launchFolder('" & strPath & "')"">" & Foldername & "</td><td align=""right"">" & size & "</td></tr>"

End Sub

Sub GetTemp
	ON ERROR RESUME NEXT
	
	size=GetFolderSize(strTempFolder)
	If size="" then
		size="UNKNOWN"
	Else
		size=PrettySize(size)
	End If

	html = html & "<tr><td class=""link"" onclick=""launchFolder('" & strTempFolder & "')"">TEMP</td><td align=""right"">" & size & "</td></tr>"

End Sub
 
Sub launchFolder(myFolder)
	WshShell.Run Chr(34) & myFolder & Chr(34)
End Sub 

Function GetFolderSize(folderName)
    On Error Resume Next

    Dim folder
    Dim subfolder
    Dim size
    Dim hasSubfolders

    size = 0
    hasSubfolders = False

    Set folder = fso.GetFolder(folderName)
    ' Try the non-recursive way first (potentially faster?)
    Err.Clear
    size = folder.Size
    If Err.Number <> 0 then     ' Did not work; do recursive way:
        For Each subfolder in folder.SubFolders
            size = size + GetFolderSize(subfolder.Path)
            hasSubfolders = True
        Next

        If not hasSubfolders then
            size = folder.Size
        End If
    End If

    GetFolderSize = size

    Set folder = Nothing        ' Just in case	
End Function

Function FindPST
	ON ERROR RESUME NEXT
	myCMD="cmd /c dir """ & strUserProfile & "\*.pst"" /s /b"
	pst_list=""
		
	Set oExec = WshShell.Exec(myCMD)
	
	Do While Not oExec.StdOut.AtEndOfStream
		myFile = oExec.StdOut.ReadLine
		Set oPSTfile=fso.GetFile(myFile)
		parentFolder=fso.GetParentFolderName(oPSTfile)
		
		pst_bytes=oPSTfile.size
		If pst_bytes > 50 * 1024 * 1024 then
			pst_list=pst_list & "<tr><td class=""link"" onclick=""launchFolder('" & parentFolder & "')"">" & oPSTfile.name & "</td><td>" & PrettySize(pst_bytes) & "</td></tr>" & vbCrLf
		End If
		Set oPSTfile=Nothing
		myFile=""
		pst_bytes=""
		parentFolder=""
	Loop
	
	FindPST=pst_list
End Function

Function GetDisks
	strComputer="."
	Set objWMIService = GetObject("winmgmts:" _
		& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	
	TotalDiskSize=0
	
	'LOGICAL DISK
	Const HARD_DISK = 3
	Set colDisks = objWMIService.ExecQuery _
		("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK )
	For Each objDisk in colDisks
		disk_list=disk_list & "<tr><td class=""link"" onclick=""launchFolder('" & objDisk.DeviceID & "')"">" & objDisk.DeviceID & " Drive Free</td><td>" & PrettySize(objDisk.FreeSpace) & "</td></tr>" & vbCrLf
		TotalDiskSize=TotalDiskSize + objDisk.Size
	Next
	
	GetDisks = disk_list
End Function

Function PrettySize(myBytes)
	If myBytes > 1024*1024*1024 then
		PrettySize=FormatNumber(myBytes/1024/1024/1024,2) & " GB"
	ElseIf myBytes > 1024*1024 then
		PrettySize=FormatNumber(myBytes/1024/1024,2) & " MB"
	Else
		PrettySize=FormatNumber(myBytes/1024,2) & " KB"
	End If
End Function

</script>

<style>
body
{
	font: 10pt Arial;
	background-color: buttonface;
	border: none;
}

td {
	font: 10pt Arial;
}

td.link {
	cursor: hand;
	color: blue;
	width: 200px;
}
table {
	margin-left: 50px;
}
</style>

</head>

<body>

<div id="DataArea"></div>

</body>

</html>

Open in new window

For the log file....it will only write a line to the log file when you click the Install Software button....I can't see why it writes when you just open it and close it....
For only having one of the HTA open, I had to change SingleInstance from Yes to No to have the alternate credentials work.  To relaunch the same HTA, it actually needs to open a second instance with the alternate credentials, and then close the first.  While this happens very very quickly, two are still open at the same time very shortly.  When you change SingleInstance to Yes, this is not allowed to happen, so the alternate credentials don't work, unless you use a different HTA to start with.
For the addition of the folder sizes, I don't think that's a good idea, because it can take a couple of minutes to load, and doesn't really have anything to do with the software installation.
Regards,
Rob.
Log i meant when opened and clicked install and then cancelled it without installing within few seconds it logs.

Ok the size why i wanted is. the hyperlinks will help users to clear up space from temp and can decide on which drive to install the softwares on the same screen.


Hi Rob just a reminder :-)
OK, I'll have another look at this tomorrow, and a couple of the other ones too.  To add the size HTA to this one, how about we just add a button to this HTA, that will launch the other one, so user's can view it if they need to?
Rob.
Thanks Rob
Ya that seems fine too
Hi Rob any views...
Hi, please try this.

I have added the ability for you to specify strSecondHTA, which you should point to your folder size HTA.  This will let users click the "Show Available Space" button, and have that HTA pop up.

With the log file, it should work properly for an MSI based install, but it might not work correctly for an EXE install if it calls another exe or msi to run from that.

Regards,

Rob.
<head>
<title>Choose Software To Install</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Choose Software To Install"
     BORDER="thin"
     SCROLL="no"
     SINGLEINSTANCE="no"
     WINDOWSTATE="normal"
     CONTEXTMENU="NO"
     MINIMIZEBUTTON="NO"
     MAXIMIZEBUTTON="NO"
>
</head>
 
<script language="VBScript">

intWidth = 800
intHeight = 600
Me.ResizeTo intWidth, intHeight
Me.MoveTo ((Screen.Width / 2) - (intWidth / 2)),((Screen.Height / 2) - (intHeight / 2)) 

Const intForAppending = 8

Dim arrSoftware
Dim strDetails
Dim strLogFile
Dim strHTAPath

strDate = Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2)
strLogFile = "\\dev-chen-nas02\profilemanager\HTA_Install_Log_" & strDate & ".csv"

Set objFSO = CreateObject("Scripting.FileSystemObject")
 
Sub Window_onLoad

    If Mid(document.location, 6, 3) = "///" Then
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
    Else
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
    End If
    strHTAPath = Left(strHTAPath, InStrRev(strHTAPath, "\"))
    strRequiredPath = "\\dev\filemanager\"
    
    If strRequiredPath <> "" Then
          If Right(strRequiredPath, 1) <> "\" Then strRequiredPath = strRequiredPath & "\"
          If LCase(strRequiredPath) <> LCase(strHTAPath) Then
                MsgBox "This HTA is not being run from the required location and will now close."
                window.close
          End If
    End If

    If Mid(document.location, 6, 3) = "///" Then
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
    Else
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
    End If

	Set objNetwork = CreateObject("WScript.Network")
	span_currentuser.InnerHTML = "<b>" & objNetwork.UserDomain & "\" & objNetwork.UserName & "</b>"

	GetComputerDetails
	
      arrSoftware = Array(_
           "Office Products;Office 2003;\\in\FS\Office_Products\Office_2003\SETUP.EXE;Add a description for Office 2003", _
           "Office Products;Office Xp;\\dev\Office XP\SETUPPRO.EXE;Add a description for Office XP", _
            "Utilities;WinZip;\\dev\WinZip\SETUP.EXE;Add a description for WinZip", _
            "Utilities;Adobe Reader 7;\\server\share\Adobe Reader\AdobeRdr709\Adobe Reader 7.0.9.msi;Add a description for Adobe Reader", _
            "Utilities;Windows Installer 3;\\server\share\Windows Installer 3.1\WindowsInstaller-KB893803-v2-x86.exe;Add a description for Windows Installer 3.1", _
            "Messengers;Windows Messenger;\\server\share\WinMessenger\setup.exe;Add a description for Windows Messenger", _
            "Utilities;Security Test;\\server\share\temp\PS4LICENSE\setup.exe;Add a description for Security Test", _
            "Databases;SQL Server Tools;\\server\share\SQL Server\Tools\setup.exe;Add a description for SQL Server Tools.  Here is a sample description that is very long.  It is for example only to show what it will look like... blah blah blah...")
            
	Populate_SoftwareType
    
End Sub

Sub Populate_SoftwareType
	span_desc.innerText=""
      strTypes = ";"
      For Each strProduct In arrSoftware
		  strType = Split(strProduct, ";")(0)
		  If InStr(LCase(strTypes), LCase(";" & strType & ";")) = 0 Then
				strTypes = strTypes & strType & ";"
				AddOption "select_type",strType,strType
		  End If
      Next
      
End Sub
 
Sub Populate_Application
	span_desc.innerText=""
	ClearOptions "select_application"
 
      For Each strProduct In arrSoftware
            If LCase(Split(strProduct, ";")(0)) = LCase(cbo_softwaretype.Value) Then
                  strApplication = Split(strProduct, ";")(1)
                  strFilePath = Split(strProduct, ";")(2)
                  strDescription = Split(strProduct, ";")(3)
				strText = strApplication
				strValue = strApplication & ";" & strFilePath & ";" & strDescription
				AddOption "select_application",strText,strValue
            End If
      Next
      
 
End Sub

Sub AddOption(elem_id,myText,myValue)
	Set elem=document.getElementById(elem_id)
	Set objNewOption = document.createElement("OPTION")
	objNewOption.Text = myText
	objNewOption.value = myValue
	elem.options.Add(objNewOption)
End Sub

Sub ClearOptions(elem_id)
	Set elem=document.getElementById(elem_id)
	elem.options.length=1

End Sub
 
Sub Default_Buttons
      If Window.Event.KeyCode = 13 Then
            btn_install.Click
      End If
End Sub

Sub Install_Software
	On Error Resume Next

	If cbo_softwaretype.Value = "cbo_softwaretype" Then
		MsgBox "Please select a software type."
		cbo_softwaretype.Focus
	ElseIf cbo_application.Value = "cbo_application" Then
		MsgBox "Please select an application."
		cbo_application.Focus
	Else
		strProduct = Split(cbo_application.Value, ";")(0)
		strExecutable = Split(cbo_application.Value, ";")(1)

		Set objShell = CreateObject("WScript.Shell")
		Set objNetwork = CreateObject("WScript.Network")
		'Software file,Machinename,Username,Install START time,Install END time,Install RESULT

		strDetails = """" & strExecutable & """," & _
			"""" & objNetwork.ComputerName & """," & _
			"""" & objNetwork.UserName & """," & _
			"""" & Now & ""","

		If objFSO.FileExists(strExecutable) = True Then
			'objShell.Run strExecutable
			If LCase(Right(strExecutable, 4)) = LCase(".msi") Then
				strCommand = "msiexec /i " & objFSO.GetFile(strExecutable).ShortPath & " /qf /norestart"
			Else
				strCommand = "cmd /c " & objFSO.GetFile(strExecutable).ShortPath
			End If
			'MsgBox "Installing: " & strProduct & VbCrLf & "From:" & VbCrLf & strExecutable & VbCrLf & "With: " & strCommand
			If Left(strCommand, 7) = "msiexec" Then
				strExitCode = objShell.Run(strCommand, 1, True)
			Else
				strExitCode = objShell.Run(strCommand, 0, True)
			End If
			' Record the END time
			strDetails = strDetails & """" & Now & ""","
			If Left(strCommand, 7) = "msiexec" And strExitCode = 1619 Then
				MsgBox "You do not have permission to install this application." & VbCrLf & "Please contact the Help Desk."
			ElseIf Left(strCommand, 6) = "cmd /c" And strExitCode = 1 Then
				MsgBox "You do not have permission to install this application." & VbCrLf & "Please contact the Help Desk."
			End If
			If strExitCode = 0 Then
				strDetails = strDetails & """SUCCESS"""
			Else
				strDetails = strDetails & """ERROR " & strExitCode & """"
			End If
			Set objOutputFile = objFSO.OpenTextFile(strLogFile, intForAppending, True)
			objOutputFile.WriteLine strDetails
			objOutputFile.Close
			Set objOutputFile = Nothing
		Else
			MsgBox "The file does not exist, or you do not have permission to access it." & VbCrLf & "Please contact the Help Desk."
		End If
		Set objShell = Nothing
		Set objNetwork = Nothing
	End If
End Sub

Sub Set_Description
	strSelectValue=select_application.value
	If InStr(strSelectValue, ";") > 0 Then
		span_desc.innerText=split(strSelectValue,";")(2)
	Else
		span_desc.InnerText=""
	End If
End Sub

Sub HighLight
	If btn_install.className="on" then
		btn_install.className="off"
	Else
		btn_install.className="on"
	End If
End Sub 

Sub GetComputerDetails
	Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
	span_time.InnerHTML = Now
	For Each objItem in colItems
		span_model.InnerHTML = objItem.Model
		span_computer.InnerHTML = objItem.Name
		span_systemtype.InnerHTML = objItem.SystemType
		span_user.InnerHTML = objItem.UserName
	Next
	
	Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration WHERE IPEnabled = True",,48)
	For Each objItem in colItems
		If objItem.MACAddress <> "" Then
			If span_macaddress.InnerHTML = "" Then
				span_macaddress.InnerHTML = objItem.MACAddress
			Else
				span_macaddress.InnerHTML = span_macaddress.InnerHTML & " - " & objItem.MACAddress
			End If
		end if
	Next	
	
	Set colItems = objWMIService.ExecQuery ("Select * from Win32_BIOS")
	For Each objItem in colItems
		span_servicetag.InnerHTML = objItem.SerialNumber
	Next
	 
	Set objItem = Nothing
	Set colItems = Nothing
	Set objWMIService = Nothing
End Sub

Sub Relaunch_Application
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If Left(strHTAPath, 2) = "\\" Then
	    strPSExecPath = Left(strHTAPath, InStrRev(strHTAPath, "\")) & "psexec.exe"
	    If objFSO.FileExists(strPSExecPath) Then
	    	strPSExecPath = objFSO.GetFile(strPSExecPath).ShortPath
			Set objNetwork = CreateObject("WScript.Network")
		    strComputer = objNetwork.ComputerName
		
			If txt_username.Value = "" Then
				MsgBox "Please enter a user name."
				txt_username.Focus
			ElseIf txt_password.Value = "" Then
				MsgBox "Please enter a password."
				txt_password.Focus
			Else
				Set objShell = CreateObject("WScript.Shell")
				strUser = txt_username.Value
				strPass = txt_password.Value
				strCommand = strPSExecPath & " -accepteula -i -d -u " & strUser & " -p " & strPass & " \\" & strComputer & " mshta.exe """ & strHTAPath & """"
				' Exit Code 1326 is invalid password from PSExec 1.85
				strExitCode = objShell.Run(strCommand, 0, True)
				If strExitCode = 1326 Then
					MsgBox "Username or Password invalid. Please verify your credentials."
					txt_password.Value = ""
					txt_password.Focus
				Else
					window.Close
				End If
			End If
	    Else
	    	MsgBox "Could not find PSExec at:" & VbCrLf & strPSExecPath
	    	'Window.Close
	    End If
	Else
		MsgBox "This application must be run from a UNC path for this feature to work correctly."
	End If
End Sub

Sub Run_HTA
	Set objShell = CreateObject("WScript.Shell")
    If Mid(document.location, 6, 3) = "///" Then
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 9)
    Else
    	strHTAPath = Mid(Replace(Replace(document.location, "%20", " "), "/", "\"), 6)
    End If
    strHTAPath = Left(strHTAPath, InStrRev(strHTAPath, "\"))
    strSecondHTA = strHTAPath & "testhta3.hta"
    strCommand = "mshta """ & strSecondHTA & """"
    objShell.Run strCommand, 1, False
End Sub

</script>

<STYLE>
body {
	font:12 pt arial;
	color:white;
	filter:progid:DXImageTransform.Microsoft.Gradient
		(GradientType=1, StartColorStr='black', EndColorStr='gray');
}


td {
	vertical-align: top;
	font: 10pt arial;
}

.td_lbl {
	width: 100px;
}

#td_desc {
	width: 60%;
	background: gray;
	color: black;
	border: 2px solid gray;
	height: 200px;
}

.on {
	border: 2px solid white;
	color: white;
	background-color: black;
}

.off {
	border: 2px solid gray;
	color: black;
	background-color: buttonface;
}

select {
	width: 190px;
	color: white;
	background-color: black;
	
}
</STYLE>
 
<body onkeypress='Default_Buttons'>
<h2>Choose Software To Install</h2>
<table>
	<tr>
		<td align='center'>
			This application is currently being run by: <span id="span_currentuser"></span>
		</td>
	</tr>
	<tr>
		<td align='center'>
			Enter username to install applications: <input type="text" maxlength="30" size="40" id="txt_username" name="txt_username" style="font-size: 14px;"><BR><BR>
			Enter password to install applications: <input type="password" maxlength="30" size="40" id="txt_password" name="txt_password" style="font-size: 14px;"><BR>
		</td>
	</tr>
	<tr>
		<td align='center'>
			<input type="button" value="Relaunch Application" name="btn_relaunchapplication"  onClick="vbs:Relaunch_Application"><br><br>
		</td>
	</tr>
</table>
System Specifications:<br><br>
<table>
	<tr>
		<td>
			Current Time:
		</td>
		<td>
			<span id="span_time">
		</td>
	</tr>
	<tr>
		<td>
			Computer Model:
		</td>
		<td>
			<span id="span_model">
		</td>
	</tr>
	<tr>
		<td>
			Computer Name:
		</td>
		<td>
			<span id="span_computer">
		</td>
	</tr>
	<tr>
		<td>
			System Type:
		</td>
		<td>
			<span id="span_systemtype">
		</td>
	</tr>
	<tr>
		<td>
			Logged on User:
		</td>
		<td>
			<span id="span_user">
		</td>
	</tr>
	<tr>
		<td>
			MAC Address:
		</td>
		<td>
			<span id="span_macaddress">
		</td>
	</tr>
	<tr>
		<td>
			Service Tag:
		</td>
		<td>
			<span id="span_servicetag">
		</td>
	</tr>
	<tr>
		<td colspan="2">
			<input type="button" value="Show Available Space" name="btn_showavailablespace"  onClick="vbs:Run_HTA">
		</td>
	</tr>
</table>
<br>
Choose from the options in each list:<br><br>
<table>
	<tr>
		<td>
			<table>
			<tr>
				<td class="td_lbl">Software Type:</td>
				<td>
					<span id="span_softwaretype">
						<select size="1" name="cbo_softwaretype" id="select_type" onchange="Populate_Application" >
							<option selected value="cbo_softwaretype"> --- Select Software Type --- </option> 
						</select>
					</span>
				</td>
			</tr>
			<tr>	
				<td class="td_lbl">Application:</td>
				<td>
					<span id="span_application">
						<select size="1" name="cbo_application" id="select_application" onchange="Set_Description">
							<option selected value="cbo_application" > --- Select Application --- </option> 
						</select>
					</span>
				</td>
			</tr>
			<tr>
				<td><br><button id="btn_install" class="off" onClick="Install_Software" onmouseover="HighLight" onmouseout="HighLight">Install</button></td>
				<td></td>
			</tr>	
			</table>
		</td>
		<td id="td_desc"><span id="span_desc"></span></td>
	</tr>
</table>
</body>

Open in new window

Thanks Rob now the only thing would be logs. The logs do not get recorded correctly
Can we get the start of the software by monitoring the setup.exe or msi file?
You are the best to decide how.
And Can i get all the mac\hardware etc details recorded in the log...
Hi Rob please have a look at my posts... Remider :-)
I have tested the logging on my computer.  For MSI based installs, it logs SUCCESS or ERROR, and if ERROR, also records the number.  The end time is recorded as the time the installation completes.  I left open an MSI install dialog for 30 seconds, and then for 5 minutes, and the log reflected that.

For EXE based installs though, it depends on whether the EXE has been programmed to return an error code if it fails.  I tested with Version 9 of WinZip, and it always reported SUCCESS even when I cancelled it, because the EXE doesn't return a code, so there's no way of knowing whether it installed successfully or not.  The time recorded was correct though, because I left the EXE install dialog open for 30 seconds, and then for 5 minutes, and the log reflected that too.

To get the hardware details recorded, change this line:
                  objOutputFile.WriteLine strDetails

to this
                  strHardware = "," & span_time.InnerHTML & "," & Trim(span_model.InnerHTML) & "," & span_computer.InnerHTML & "," & span_systemtype.InnerHTML & "," & span_user.InnerHTML & "," & span_macaddress.InnerHTML & "," & span_servicetag.InnerHTML
                  objOutputFile.WriteLine strDetails & strHardware

Regards,

Rob.
Hi Rob

I installed Visual studio. Which takes 20 min to install. But the start time was fine but end time was also the same as start time. No differnce at all.
Hmmm.....I don't understand what's going on....it works for me.  The only thing I can suggest is that you change these lines:

                  If LCase(Right(strExecutable, 4)) = LCase(".msi") Then
                        strCommand = "msiexec /i " & objFSO.GetFile(strExecutable).ShortPath & " /qf /norestart"
                  Else
                        strCommand = "cmd /c " & objFSO.GetFile(strExecutable).ShortPath
                  End If
                  'MsgBox "Installing: " & strProduct & VbCrLf & "From:" & VbCrLf & strExecutable & VbCrLf & "With: " & strCommand
                  If Left(strCommand, 7) = "msiexec" Then
                        strExitCode = objShell.Run(strCommand, 1, True)
                  Else
                        strExitCode = objShell.Run(strCommand, 0, True)
                  End If

to this

                  If LCase(Right(strExecutable, 4)) = LCase(".msi") Then
                        strCommand = "cmd /c start /wait msiexec /i " & objFSO.GetFile(strExecutable).ShortPath & " /qf /norestart"
                  Else
                        strCommand = "cmd /c start /wait " & objFSO.GetFile(strExecutable).ShortPath
                  End If
                  'MsgBox "Installing: " & strProduct & VbCrLf & "From:" & VbCrLf & strExecutable & VbCrLf & "With: " & strCommand
                  If Left(strCommand, 7) = "msiexec" Then
                        strExitCode = objShell.Run(strCommand, 1, True)
                  Else
                        strExitCode = objShell.Run(strCommand, 1, True)
                  End If


This will make a DOS prompt appear during the installation, but it definately should wait for the process to finish.

Regards,

Rob.
Rob i get a command prompt and it closes in a secound and still get the installation showing just few secounds even though it took 15 min in total
I never did ask.....what operating system are you running this on?  If it's Vista / Windows 7, that might be an issue....
Hi Rob,
I am running it on Vista now...
But the timing test was done on xp as well
Can you uncomment this line:
                  'MsgBox "Installing: " & strProduct & VbCrLf & "From:" & VbCrLf & strExecutable & VbCrLf & "With: " & strCommand


and then run the command it displays manually from a command prompt?  Type in the command without the first cmd /c

Regards,

Rob.
After i did as you said it opened a cmd prompt and was waiting till the installation completed and then closed the cmd and recorded the time correctly. I did the same in an XP machine but the command cameout and the installation started.
>> I did the same in an XP machine but the command cameout and the installation started.

I'm not sure what you mean.  On Vista, it worked correctly?  What happened on the XP machine? You would have typed something like this in a command promt:
start /wait msiexec /i \\server\share\software\MyApp.msi /qf /norestart

then what happened?  The command prompt should have been waiting for the MSI to finish.

Rob.
Now both OS Xp and Vista have the cmd prompts waiting till the installation completes. And records the timing correctly.

I dont know why but the first time i ran the same way in Xp it opened the installation but came out of the waiting state but now its fine.

That is really really odd!  So the HTA should do exactly the same thing, and record it correctly......

I don't think I know of another option....it works for me.

Rob.
Now it does work...
Sorry put it on the wrong way above

The first time it did not work and after that i tested 4 machines it works
So do we need to change the command in the HTA, or is it working now?

Rob.
Can we remove the cmd prompt being shown in both OS but record the time correctly
Change this section:

                  If LCase(Right(strExecutable, 4)) = LCase(".msi") Then
                        strCommand = "cmd /c start /wait msiexec /i " & objFSO.GetFile(strExecutable).ShortPath & " /qf /norestart"
                  Else
                        strCommand = "cmd /c start /wait " & objFSO.GetFile(strExecutable).ShortPath
                  End If
                  'MsgBox "Installing: " & strProduct & VbCrLf & "From:" & VbCrLf & strExecutable & VbCrLf & "With: " & strCommand
                  If Left(strCommand, 7) = "msiexec" Then
                        strExitCode = objShell.Run(strCommand, 1, True)
                  Else
                        strExitCode = objShell.Run(strCommand, 1, True)
                  End If

back to this

                  If LCase(Right(strExecutable, 4)) = LCase(".msi") Then
                        strCommand = "msiexec /i " & objFSO.GetFile(strExecutable).ShortPath & " /qf /norestart"
                  Else
                        strCommand = "cmd /c " & objFSO.GetFile(strExecutable).ShortPath
                  End If
                  'MsgBox "Installing: " & strProduct & VbCrLf & "From:" & VbCrLf & strExecutable & VbCrLf & "With: " & strCommand
                  If Left(strCommand, 7) = "msiexec" Then
                        strExitCode = objShell.Run(strCommand, 1, True)
                  Else
                        strExitCode = objShell.Run(strCommand, 0, True)
                  End If


and see what happens.

Rob.
Hi Rob after the change the HTA does not get updated at all.
Do you mean the log file isn't updated?  Does the program run at all?
Uncomment this line and see if the command is still correct.
                  'MsgBox "Installing: " & strProduct & VbCrLf & "From:" & VbCrLf & strExecutable & VbCrLf & "With: " & strCommand

Rob.
I get this

---------------------------

---------------------------
Installing: Visual_studio_team_explorer

From:

\\dev01\visual_studio_team_explorer_2010_x86\Setup.exe

With: cmd /c \\dev01\visual_studio_team_explorer_2010_x86\Setup.exe
---------------------------
OK  
---------------------------
Hi Rob any views on this....
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial