Solved

Combine 2 Hta codes.

Posted on 2010-08-17
38
700 Views
Last Modified: 2012-05-10
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

0
Comment
Question by:bsharath
  • 23
  • 14
38 Comments
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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

0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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

0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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.


0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Hi Rob just a reminder :-)
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Thanks Rob
Ya that seems fine too
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Hi Rob any views...
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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

0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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...
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Hi Rob please have a look at my posts... Remider :-)
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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.
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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.
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 11

Author Comment

by:bsharath
Comment Utility
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
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
I never did ask.....what operating system are you running this on?  If it's Vista / Windows 7, that might be an issue....
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Hi Rob,
I am running it on Vista now...
But the timing test was done on xp as well
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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.
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
>> 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.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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.

0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
So do we need to change the command in the HTA, or is it working now?

Rob.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Can we remove the cmd prompt being shown in both OS but record the time correctly
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Hi Rob after the change the HTA does not get updated at all.
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
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.
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
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  
---------------------------
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Hi Rob any views on this....
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
Comment Utility
OK, I still don't understand what is happening, but try this.....

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

				Set objExec = objShell.Exec(strCommand)

				While objExec.Status = 0

					HTASleep 1

				Wend

				strExitCode = objExec.ExitCode

				'strExitCode = objShell.Run(strCommand, 1, True)

			Else

				Set objExec = objShell.Exec(strCommand)

				While objExec.Status = 0

					HTASleep 1

				Wend

				strExitCode = objExec.ExitCode

				'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



Sub HTASleep(intSeconds)

	Set objShell = CreateObject("WScript.Shell")

	objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True

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

0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Hi Rob..
Hope you had a great weekend
Can you help with this
http://www.experts-exchange.com/Programming/Languages/Q_26493570.html
0
 
LVL 11

Author Comment

by:bsharath
Comment Utility
Hi Rob... How are you doing. Hope all fine and a very happy new year

Can you help on this Q
http://www.experts-exchange.com/Programming/Languages/Q_26718796.html
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

If you haven’t already, I encourage you to read the first article (http://www.experts-exchange.com/articles/18680/An-Introduction-to-R-Programming-and-R-Studio.html) in my series to gain a basic foundation of R and R Studio.  You will also find the …
This article is meant to give a basic understanding of how to use R Sweave as a way to merge LaTeX and R code seamlessly into one presentable document.
The viewer will learn how to user default arguments when defining functions. This method of defining functions will be contrasted with the non-default-argument of defining functions.
The viewer will learn the basics of jQuery, including how to invoke it on a web page. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery.: (CODE)

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now