Run using different credentials

Hi guys,
A brilliant guru wrote the following code.

All I would like to do is to add one feature to it, so that before it connects to the machine, you have the option to:
1) Connect as currently logged on user (so no details are needed to connect)
or
2) Input a username and password before running the script.

Any help greatly appreciated.

<head>
<title>Server Services</title>
<HTA:APPLICATION 
     APPLICATIONNAME="Server Services"
     BORDER="thin"
     SCROLL="yes"
     SINGLEINSTANCE="yes"
     ID="oHTA"
>
<APPLICATION:HTA>
</head>
 
<script language="VBScript">
 
Sub Window_OnLoad
    Set objlst_groupnames = document.getElementById( "list_servicenames" )
    If objlst_groupnames Is Nothing Then
        MsgBox "A problem was encountered while creating the listview." & vbCRLF & "Please see your administrator."
    Else
        With objlst_groupnames
            .View              = 3
            .Width             = 800
            .Height            = 600
            .SortKey           = 0
            .Arrange           = 0
            .LabelEdit         = 1
            .SortOrder         = 0
            .Sorted            = 1
            .MultiSelect       = 0
            .LabelWrap         = -1
            .HideSelection     = -1
            .HideColumnHeaders = 0
            .OLEDragMode       = 0
            .OLEDropMode       = 0
            .Checkboxes        = 1
            .FlatScrollBar     = 0
            .FullRowSelect     = 1
            .GridLines         = 0
            .HotTracking       = 0
            .HoverSelection    = 0
            .PictureAlignment  = 0
            .TextBackground    = 0
            .ForeColor         = -2147483640
            .BackColor         = -2147483643
            .BorderStyle       = 1
            .Appearance        = 1
            .MousePointer      = 0
            .Enabled           = 1
            .ColumnHeaders.Clear
            .ColumnHeaders.Add , , "Caption", 150
            .ColumnHeaders.Add , , "State", 150
            .ColumnHeaders.Add , , "Name", 150
            .ColumnHeaders.Add , , "Description", 150
            .ColumnHeaders.Add , , "Start Mode", 150
            .ListItems.Clear
        End With
    End If
End SUb
 
Sub btn_Poll_onClick()
    ListServices(txt_computername.value)
End Sub
 
Sub ListServices(sComputer)
    ON ERROR RESUME NEXT
    
    if NOT IsComputerOn(sComputer) then
        response = msgbox("Machine unavailable." & vbCRLF & "Do you wish to retry or cancel?",21,"ERROR!")
        if response = vbRetry then
            ListServices(sComputer)
        else
            Exit Sub
        end if
    end if
    
    set objDic = CreateObject("Scripting.Dictionary")
    objDic.Add "Alerter","Alerter"
    objDic.Add "lanmanworkstation","Workstation"
    objDic.Add "lanmanserver","Server"
    
    Set objList = document.getElementById( "list_servicenames" )
    objList.ListItems.Clear
    
    set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * from Win32_Service")
    For Each objItem in colItems
        if objDic.Exists(objItem.Name) then
            Set objListItem  = objList.ListItems.Add
            objListItem.Text = objItem.Caption
            objListItem.ListSubItems.Add.Text = objItem.State
            objListItem.ListSubItems.Add.Text = objItem.Name
            objListItem.ListSubItems.Add.Text = objItem.Description
            objListItem.ListSubItems.Add.Text = objItem.StartMode
        end if
    Next
End Sub
 
Sub btn_start_onClick()
    strComputer = txt_computername.value
    for n = 1 to list_servicenames.ListItems.Count
        if list_servicenames.ListItems(n).checked = True then
            strService = list_servicenames.ListItems(n).ListSubItems(2).Text
            Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
            Set colServiceList = objWMIService.ExecQuery ("Select * from Win32_Service where Name='" & strService & "'")
            For each objService in colServiceList
                errReturn = objService.StartService()
            Next
        end if
    next
    ListServices(strComputer)
End Sub
 
Sub btn_stop_onClick()
    strComputer = txt_computername.value
    for n = 1 to list_servicenames.ListItems.Count
        if list_servicenames.ListItems(n).checked = True then
            strService = list_servicenames.ListItems(n).ListSubItems(2).Text
            Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
            Set colServiceList = objWMIService.ExecQuery ("Select * from Win32_Service where Name='" & strService & "'")
            For each objService in colServiceList
                errReturn = objService.StopService()
            Next
        end if
    next
    ListServices(strComputer)
End Sub
 
Sub btn_restart_onClick()
    strComputer = txt_computername.value
    'Stop services
    for n = 1 to list_servicenames.ListItems.Count
        if list_servicenames.ListItems(n).checked = True then
            strService = list_servicenames.ListItems(n).ListSubItems(2).Text
            Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
            Set colServiceList = objWMIService.ExecQuery ("Select * from Win32_Service where Name='" & strService & "'")
            For each objService in colServiceList
                errReturn = objService.StopService()
            Next
        end if
    next
    'Start services
    for n = 1 to list_servicenames.ListItems.Count
        if list_servicenames.ListItems(n).checked = True then
            strService = list_servicenames.ListItems(n).ListSubItems(2).Text
            Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
            Set colServiceList = objWMIService.ExecQuery ("Select * from Win32_Service where Name='" & strService & "'")
            For each objService in colServiceList
                errReturn = objService.StartService()
            Next
        end if
    next
    ListServices(strComputer)
End Sub
 
Sub btn_Refresh_onClick()
    ListServices(txt_computername.value)
End Sub
 
Sub btn_exit_onClick()
    Window.Close
End Sub
 
function list_servicenames_ColumnClick(colheader)
    list_servicenames.SortKey = colheader.index-1
end function
 
Function IsComputerOn(computer)
    'Ping to see if computer is active
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & computer & "'")
    For Each objStatus in objPing
        if IsNull(objStatus.StatusCode) or objStatus.StatusCode <> 0 Then
            boolPingReturned = False
        else
            boolPingReturned = True
        end if 
    next
    IsComputerOn = boolPingReturned
End Function
 
</script>
 
<body>
Computer Name <INPUT TYPE="text" ID="txt_computername" NAME="txt_computername" SIZE="40" MAXLENGTH="255"><input type="submit" value="Poll Computer" name="btn_Poll" id="btn_Poll" title="Click to poll the computer"><br />
<OBJECT id="list_servicenames" name="list_servicenames" 
 
classid="clsid:BDD1F04B-858B-11D1-B16A-00C0F0283628"></OBJECT>
<br />
<input type="button" value="Refresh" name="btn_Refresh" id="btn_Refresh" title="Click to refresh the services list"> &nbsp;
<input type="button" value="Start"   name="btn_start"   id="btn_start"   title="Click to Start the Services"> &nbsp;
<input type="button" value="Stop"    name="btn_stop"    id="btn_stop"    title="Click to Stop the Service"> &nbsp;
<input type="button" value="Restart" name="btn_restart" id="btn_restart" title="Click to Restart the Services"> &nbsp;
<input type="button" value="Exit"    name="btn_exit"    id="btn_exit"    title="Click to Exit Form ">
 
</body>

Open in new window

LVL 1
Simon336697Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

debuggerauCommented:
how did you get your GetObject working in IE? I thought this was disabled for security reasons?

and wouldn't the IIS engine need to be running with appropriate credentials for this to work?


0
astroviperCommented:
That's a HTA. Most VBScript is allowed to run bar a couple of objects that I still can not remember.

If found this code to elevate a program on launch. Only tested on win 7.

Set objSh = CreateObject("Shell.Application")
objSh.ShellExecute "notepad.exe", "" , "", "runas", 1

Open in new window

0
debuggerauCommented:
I Like it now..
Thanks, learned something new..

Now running the getobject doesnt allow for specifying the user, but you cannot runas at the desktop level either, still looking..



0
Introduction to Web Design

Develop a strong foundation and understanding of web design by learning HTML, CSS, and additional tools to help you develop your own website.

Simon336697Author Commented:
Really appreciate your help guys.
0
debuggerauCommented:
found the registry settings to enable runas for hta's.

Windows Registry Editor Version 5.00
 
[HKEY_CLASSES_ROOT\htafile\shell\runas]
 
[HKEY_CLASSES_ROOT\htafile\shell\runas\command]
@="C:\\Windows\\system32\\mshta.exe \"%1\" %*"
"IsolatedCommand"="C:\\Windows\\system32\\mshta.ex e \"%1\" %*"

Open in new window

0
debuggerauCommented:
I might have been to quick, while it does offer the alternate creds, it also doesnt work, giving me a blank window..
0
astroviperCommented:
You can launch a command window under different credentials. From what I've read, anything you launch from that command window will also run under those credentials. Would it be an option to launch the hta that way?
0
astroviperCommented:
I launched this script here using my script and got it to display being run by different users.
From: http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/MS_DOS/Q_23101713.html

rettiseert:            
Hi, look at this example:

Option Explicit

Dim Text, Title
Dim WshNetwork         ' Object variable

Text = "Networking information" & vbCrLf & vbCrLf
Title = "WSH sample - by G. Born"

' Create a new WshNetwork object to access network properties.
Set WshNetwork = WScript.CreateObject("WScript.Network")

Text = Text & "Computer name : " & WshNetwork.ComputerName & vbCrLf
Text = Text & "Domain : " & WshNetwork.UserDomain & vbCrLf
Text = Text & "User name : " & WshNetwork.UserName & vbCrLf

MsgBox Text, vbOKOnly + vbInformation, Title
Basically what I'm doing in that line below is using cmd as a wrapper for the vbscript to allow runas to launch it. Note that in my environment I have to enter the username as DOMAIN\user, this may differ in your case.

strUser = InputBox("Please enter username to launch script: ")
Set objShell = CreateObject("WScript.Shell")
objShell.Run "runas /user:" & strUser & " ""cmd /C E:\user.vbs"""

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Simon336697Author Commented:
astro and debugger thanks so much guys for your brilliant help.
I think launching the hta from a runas in a cmd window is what id go with :>)
0
RobSampsonCommented:
Hey Simon, sorry to have missed this one, but you could also try using the HTA that is in the second last post on this thread:
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24336590.html

That will allow you to use PSExec to run MSHTA.exe <HTAfile.hta> as another user.

Regards,

Rob.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.