Here is the code we use were I work for this:
============= BEGIN CODE ==============
<%@ Language=VBScript %>
<% option explicit %>
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<SCRIPT Language=Javascript>
function onclick_Continue()
{
document.form1.PROC.value = "LIST_SVC";
document.form1.submit();
}
function onclick_start()
{
document.form1.PROC.value = "START_SVC";
document.form1.submit();
}
function onclick_stop()
{
document.form1.PROC.value = "STOP_SVC";
document.form1.submit();
}
function onclick_pause()
{
document.form1.PROC.value = "PAUSE_SVC";
document.form1.submit();
}
function onclick_resume()
{
document.form1.PROC.value = "RESUME_SVC";
document.form1.submit();
}
function onclick_info()
{
document.form1.PROC.value = "SVC_INFO";
document.form1.submit();
}
function onclick_otherproc()
{
document.form1.PROC.value = "SVC_PROC";
document.form1.submit();
}
</SCRIPT>
</HEAD>
<BODY >
<%
'*************************
' Program: ServiceAdmin.asp
'
' Author:
'
' date: 11/7/2003
'
' Description: This program allows user to work with specific windows services
' The functionality incudes:
' -- Start, stop, pause or resume selected service
' -- Get detailed service information
' -- Perform additional process associated with certain service
'
'*************************
'win service status types
const cstSvcStopped = 1
const cstSvcStartPending = 2
const cstSvcStopPending = 3
const cstSvcRunning = 4
const cstSvcContinuePending = 5
const cstSvcPausePending = 6
const cstSvcPaused = 7
const cstSvcError = 8
'global variables
const g_strDelimiter= ";"
const g_ServiceListName = "WIN_SERVICES"
const g_DomainListName = "WIN_DOMAINS"
const g_strErrBng ="<p><font face=Arial color=red size=2><strong>"
const g_strErrEnd = "</strong</font><p>"
'Place services allowed to be manipulated by script here
' enter as "servicex, servicey, servicez"
Const cstFetches = "Tomcat_Archiver, Tomcat_Claim_Manager, Tomcat"
dim strDomain
dim strServer
dim strProc
dim strSvcName
dim strSvcList
dim strErrMsg
Dim arrAllowedSvcs
'-------------------------
' Function Main()
'
' Purpose: This is the main program that displays the main page, gets user
' input and invoke functions to process user requests.
'-------------------------
' place server name and domain here
strDomain="FCAS251"
strServer="FCAS251"
strProc = Request.Form("PROC")
strSvcName = Request.Form(g_ServiceList
'debug statements
'Response.Write "proc= " & strProc & "<BR>"
'end debug
'user has press a function button on the web page
' process user request
if (Ucase(strProc) <> "LIST_SVC") AND _
(Ucase(strProc) <> "SVC_INFO") AND _
(len(strSvcName) > 0) then
HandleSvcOperation strProc
end if
'get the list of windows services
if Len(strProc) > 0 then
strSvcList = ListServices()
end if
'display main web page
Response.Write "<h2>Working with Windows Services</B></H2>"
Response.Write "<form name=form1 method=post action='ServiceAdmin.asp'>
Response.Write "<table border=0>"
'display domain name input field
'Response.Write "<TR><TD><b>Domain Name : </b></TD>"
'Response.Write "<TD>" & GetDomainNames() & "</TD></TR>"
'display server name input field
Response.Write "<TR><TD><b>Server Name : </b></TD>"
Response.Write "<TD>" & strServer & "<input type=hidden name=SERVER_NAME value='" & strServer & "'></TD></TR>"
'display function buttons
if (len(strProc) = 0) OR (len(strSvcList) = 0) then
Response.Write "</table><p></p>"
Response.Write "<input type=button name=btn1 value='List Services' onclick=onclick_Continue()
else
Response.Write "<TR><TD><b>Win Services : </b></TD><TD>" & strSvcList & "</td></tr>"
Response.Write "</table>"
Response.Write "<p>"
Response.Write "<input type=button name=btn1 value=' Start ' onclick=onclick_start()>&n
Response.Write "<input type=button name=btn2 value=' Stop ' onclick=onclick_stop()>&nb
Response.Write "<input type=button name=btn3 value=' Pause ' onclick=onclick_pause()>&n
Response.Write "<input type=button name=btn4 value='Resume' onclick=onclick_resume()>&
Response.Write "<input type=button name=btn6 value='Service Info' onclick=onclick_info()>&nb
Response.Write "</p>"
Response.Write "<input type=button name=btn1 value='List Services' onclick=onclick_Continue()
Response.Write "<input type=button name=btn1 value='Service Specific Process' onclick=onclick_otherproc(
end if
Response.Write "<input type=hidden name=PROC >"
Response.Write "<input type=hidden name='SVC_NAME' value='" & strSvcName & "'>"
Response.Write "</form>"
'doing the process that needs to display info at the bottom of the web page
select case Ucase(strProc)
case "SVC_INFO"
GetServiceInfo()
case "SVC_PROC"
HandleSvcSpecificProcess strSvcName
end select
'display error messge if necessary
Response.Write strErrMsg
strErrMsg = ""
'-------------------------
' Function ListServices
'
' Purpose: List windows services that resides on the given server
'
' Inputs: None
'
' Returns: Service names presented in a listbox
'-------------------------
function ListServices()
dim objComputer, objService
dim strADSIPath
dim strList
dim strSelected
dim intStatus
Dim arrAllowedSvcs
'It is more efficient when getting computer object with full ADSI path
strADSIPath = "WinNT://" & strDomain & "/" & strServer & ",computer"
'debug statement
'Response.Write "ADSI Path = " & strADSIPath & "<BR>"
On error resume next
'get computer object with given domain and server names
set objComputer = GetObject(strADSIPath)
'if error occurred, try again without domain name
if err.number <> 0 then
strADSIPath = "WinNT://" & strServer & ",computer"
err.Clear
set objComputer = GetObject(strADSIPath)
'if faied again with only server name, return error message
if err.number <> 0 then
strErrMsg = g_strErrBng & "Err: Unable to get computer object. Please check server names." & g_strErrEnd
err.clear
ListServices=""
exit function
end if
'if suceeded with only server name, search for domain name
if Len(objComputer.parent) > 0 then
strDomain = Right(objComputer.parent, Len(objComputer.parent) - Len("WinNT://"))
end if
end if
'get all services names and current status
objComputer.Filter = Array("service")
strList= ""
' -- Filter For allowed services
arrAllowedSvcs = GetAllowedServices()
for each objService in objComputer
if Len(strList) = 0 then
strList = "<select name='" & g_ServiceListName & "' size='" & Cstr(Ubound(arrAllowedSvcs
end if
if UCase(strSvcName) = UCase(objService.name) then
strSelected = " selected "
else
strSelected = ""
end if
'check if we can get service status
intStatus = objService.Status
if err.number <> 0 then
'if error occurred, we set the status to "unknown"
intStatus = 0
err.clear
end if
If inArray(arrAllowedSvcs, objService.name) Then
'construct a listbox in order to display service list
strList = strList + "<option value='" & objService.name & "' " & strSelected & ">" & _
objService.name & " --- " & _
GetSvcStatusText(intStatus
End if
next
on error goto 0
'add closing tag for listbox
if Len(strList) > 0 then
ListServices = strList & "</select>"
else
listServices = ""
end if
set objComputer = nothing
end function
'-------------------------
' Function GetSvcStatusText
'
' Purpose: According to the given service status value, it returns text
' description
'
' Inputs: intStatus - service status
'
' Returns: the status text string
'-------------------------
Function GetSvcStatusText(intStatus
dim strStat
select case intStatus
case 1:
strStat = "Stopped"
case 2:
strStat = "Start Pending"
case 3:
strStat = "Stop Pending"
case 4:
strStat = "Running"
case 5:
strStat = "Continue Pending"
case 6:
strStat = "Pause Pending"
case 7:
strStat = "Paused"
case 8:
strStat = "Error"
case else:
strStat = "Unknown"
end select
GetSvcStatusText = strStat
end function
'-------------------------
' Function GetSvcStartTypeText
'
' Purpose: According to the service start type value, it returns the status
' description in text
'
' Inputs: intStartType - service start type value
'
' Returns: the start type text string
'-------------------------
Function GetSvcStartTypeText(intSta
dim strType
select case intStartType
case 0:
strType = "Root"
case 1:
strType = "System"
case 2:
strType = "Automatic"
case 3:
strType = "Manual"
case 4:
strType = "Disabled"
case else:
strType = "Unknown"
end select
GetSvcStartTypeText = strType
end function
'-------------------------
' Function BuildListbox
'
' Purpose: It takes multiple items and build a listbox
'
' Inputs: strEntries - a string that contains items separated by a delimiter
' strListname - listbox name
' strDelimiter - string used as delimiter
' strSelectedItem - the item needs to be selected in the listbox
' strEventHandler - event handler string
'
' Returns: the string of the listbox
'-------------------------
function BuildListbox(strEntries, strListName, _
strDelimiter, strSelectedItem, strEventHandler)
dim strTemp
dim arrTemp
dim intSelectIndex
dim intX, intUpper
if Len(strEntries) = 0 OR Len(strListName) = 0 then
BuildListbox = ""
exit function
end if
arrTemp = split(strEntries, strDelimiter,-1,1)
intUpper = UBound(arrTemp)
strTemp = "<select name='" & strListName & "' " & strEventHandler & ">"
for intX=0 to intUpper
if Ucase(arrTemp(intX)) = Ucase(strSelectedItem) then
strTemp = strTemp + "<option value='" & arrTemp(intX) & "' selected>" & arrTemp(intX) & "</option>"
else
strTemp = strTemp + "<option value='" & arrTemp(intX) & "'>" & arrTemp(intX) & "</option>"
end if
next
strTemp = strTemp + "</select>"
BuildListbox = strTemp
end function
'-------------------------
' Function HandleSvcOperation
'
' Purpose: It performs following operations with the selected service:
' start, stop, pause and resume
'
' Inputs: strRequest - operation request type
'
' Returns:
'-------------------------
function HandleSvcOperation(strRequ
dim objService
dim strADSIPath
dim strList
dim strSelected
strErrMsg = ""
on error resume next
strADSIPath = "WinNT://" & strServer & "/" & strSvcName & ",service"
'debug statement
'Response.Write strADSIpath & "<BR>"
'end debug
set objService = GetObject(strADSIPath)
if err.number <> 0 then
Response.Write g_strErrBng & "Err: Unable to get service object." & g_strErrEnd
On error goto 0
exit function
end if
select case strRequest
case "START_SVC"
if objService.status = cstSvcStartPending then
strErrMsg = "<br>" & strSvcName & "'s status is Start Pending. Please wait for a while and check again.<br>"
intSvcStatus = cstSvcStartPending
else
if (objService.status = cstSvcStopped) then
objService.start
if err.number <> 0 then
strErrMsg = g_strErrBng & "Err: Unabel to start service " & strSvcName & g_strErrEnd
err.clear
else
sleep(2)
end if
end if
end if
case "STOP_SVC"
if objService.status = cstSvcStopPending then
strErrMsg = "<br>" & strSvcName & "'s status is Stop Pending. Please wait for a while and check again.<br>"
else
if (objService.status = cstSvcRunning) then
objService.stop
if err.number <> 0 then
strErrMsg = g_strErrBng & "Err: Unabel to stop service " & strSvcName & g_strErrEnd
err.clear
else
sleep(2)
end if
end if
end if
case "PAUSE_SVC"
if objService.status = cstSvcPausePending then
strErr = "<br>" & strSvcName & "'s status is Pause Pending. Please wait for a while and check again.<br>"
else
if (objService.status = cstSvcRunning) then
objService.pause
if err.number <> 0 then
strErrMsg = g_strErrBng & "Err: Unabel to pause service " & strSvcName & g_strErrEnd
err.clear
else
sleep(2)
end if
end if
end if
case "RESUME_SVC"
if objService.status = cstSvcContinuePending then
strErrMsg = "<br>" & strSvcName & "'s status is Continue Pending. Please wait for a while and check again.<br>"
else
if (objService.status = cstSvcPaused) then
objService.resume
if err.number <> 0 then
strErrMsg = g_strErrBng & "Err: Unabel to resume service " & strSvcName & g_strErrEnd
err.clear
else
sleep(2)
end if
end if
end if
end select
on error goto 0
set objService = nothing
end function
'-------------------------
' Function
'
' Purpose:
'
' Inputs:
'
' Outputs:
'
' Returns:
'-------------------------
Sub sleep(intTimeElapse)
Dim intStart, intEnd
intStart = timer()
do
intEnd = timer()
loop while ((intEnd - intStart) < intTimeElapse)
end Sub
'-------------------------
' Function GetServiceInfo
'
' Purpose: It retrieves the service info and display it in the table
'
' Inputs:
'
' Outputs:
'
' Returns:
'-------------------------
sub GetServiceInfo()
dim objService, objEntry
dim arrSvc
dim strADSIPath
dim intStatus
On error resume next
strADSIPath = "WinNT://" & strServer & "/" & strSvcName & ",service"
'debug statement
'Response.Write strADSIpath & "<BR>"
'end debug
set objService = GetObject(strADSIPath)
if err.number <> 0 then
Response.Write g_strErrBng & "Err: Unable to get service object." & g_strErrEnd
On error goto 0
exit sub
end if
Response.Write "<table border=1 cellpadding=3>"
Response.Write "<TR><TD>Service Name</TD><TD>" & objService.name & "</TD></TR>"
Response.Write "<TR><TD>Display Name</TD><TD>" & objService.DisplayName & "</TD></TR>"
'the error may happen when query its status
'if it happens, we display its status as "unknown"
intStatus = objService.status
if err.number <> 0 then
intstatus = 0
err.Clear
end if
Response.Write "<TR><TD>Status</TD><TD>" & GetSvcStatusText(intStatus
Response.Write "<TR><TD>Start Type</TD><TD>" & GetSvcStartTypeText(objSer
Response.Write "<TR><TD>Service Account</TD><TD>" & objService.ServiceAccountN
Response.Write "<TR><TD>Path</TD><TD>" & objService.path & "</TD></TR>"
Response.Write "<TR><TD>ADsPath</TD><TD>"
if IsArray(objService.Depende
if err.number = 0 then arrSvc = objService.Dependencies
else
if err.number = 0 then arrSvc = Array(objService.Dependenc
end if
if err.number = 0 then
Response.Write "<TR><TD>Dependencies</TD>
for each objEntry in arrSvc
Response.Write "<TR><TD> </TD><TD>" & objEntry & "</TD></TR>"
next
end if
Response.Write "</table>"
err.Clear
on error goto 0
set objService = nothing
end Sub
'-------------------------
' Function GetAllowedServices
'
' Purpose: Filter of allowed services that a user can see
'
' Inputs:
'
' Outputs:
'
' Returns: String Array
'-------------------------
Function GetAllowedServices()
Dim strFetchServices
strFetchServices = cstFetches
GetAllowedServices = Split(strFetchServices, ", ")
End Function
'-------------------------
' Function inArray
'
' Purpose: Checks to see if string exists in an Array
'
' Inputs: arrList = the array being searched
' strCheck = the sting being searched for
'
' Outputs:
'
' Returns: boolean
'-------------------------
Function inArray(arrList, strCheck)
Dim i
inArray = False
For i=0 To UBound(arrList)
If StrComp(arrList(i), strCheck, 1) = 0 Then
inArray = True
Exit For
End if
Next
End Function
'-------------------------
' Function HandleSvcSpecificProcess
'
' Purpose: This function handles the additional process associated with a
' process.
'
' Inputs: strSvcName - service name
'
' Outputs:
'
' Returns:
'-------------------------
function HandleSvcSpecificProcess(s
dim strRtn
select case Ucase(strSvcName)
'handle the process of checking TSM service status
case else
strErrMsg = "<br><b>No additional process is associated with service '" & strSvcName & "'.</b><br>"
end select
end function
%>
</BODY>
</HTML>
============== END CODE =============
There are some things in there you won't need, but I figured too much is better than not enough.
Replace this line (near the top) with the list of services you would like: Const cstFetches = "Tomcat_Archiver, Tomcat_Claim_Manager, Tomcat"
best of luck,
harperse
Main Topics
Browse All Topics
by: dnojcdPosted on 2006-03-10 at 02:16:54ID: 16153195
http://www.softwareriver.c
hope that can help you :-)