Solved

Run using different credentials

Posted on 2009-06-29
10
1,066 Views
Last Modified: 2012-08-13
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

0
Comment
Question by:Simon336697
  • 4
  • 3
  • 2
  • +1
10 Comments
 
LVL 23

Expert Comment

by:debuggerau
ID: 24741419
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
 
LVL 3

Expert Comment

by:astroviper
ID: 24741637
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
 
LVL 23

Expert Comment

by:debuggerau
ID: 24741802
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
Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

 
LVL 1

Author Comment

by:Simon336697
ID: 24741819
Really appreciate your help guys.
0
 
LVL 23

Assisted Solution

by:debuggerau
debuggerau earned 230 total points
ID: 24741828
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
 
LVL 23

Expert Comment

by:debuggerau
ID: 24741849
I might have been to quick, while it does offer the alternate creds, it also doesnt work, giving me a blank window..
0
 
LVL 3

Expert Comment

by:astroviper
ID: 24742099
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
 
LVL 3

Accepted Solution

by:
astroviper earned 270 total points
ID: 24742177
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
 
LVL 1

Author Comment

by:Simon336697
ID: 24749513
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
 
LVL 65

Expert Comment

by:RobSampson
ID: 24752179
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

Featured Post

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This is an addendum to the following article: Acitve Directory based Outlook Signature (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24950055.html) The script is fine, and works in normal client-server domains…
I met Paul Devereux (@pdevereux) today when I responded to his tweet asking “Anybody know how to automate adding files from disk to a folder in #outlook  ?”.  I replied back and told Paul that using automation, in this case scripting, to add files t…
Established in 1997, Technology Architects has become one of the most reputable technology solutions companies in the country. TA have been providing businesses with cost effective state-of-the-art solutions and unparalleled service that is designed…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

770 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