Solved

vbs to HTA script Modification

Posted on 2011-03-08
19
1,269 Views
Last Modified: 2012-05-11
Hi Team,

We do around 1000 Server patching in a day.  As part of patching activity we run a script before patching to get the snapshot of the services and we run the script again after patching to see if there is any problem in any services.

I have a vbs file (enclosed) which will Check:
a)  Ping Status
b)  RDC Status
c)  Last Bootup Time
d)  Services with type as Auto and in Stopped state.

Now I have multiple domains and I need to run the VBScript on each and every domain.

Requirement:

My requirement is:
a)  To run the script for all domains from One Single domain.
b)  Need to modify the vbs script to HTA script which will read the text file and run against all the domains from one domain and result on screen and then option button to export to Excel or CSV.  I am OK if it has option where it prompts for username and password with which it will run against all other domains.
c)  Script should continue to next server if it has struck at any server.
d)  Also can the output have conditional Formatting or you can say treshold, if any server where the ping is failed or RDC is failed or Services are stopped with type Automatic, it should highlight in Red so that we can take quick actions
e)  Script already has option to send e-mail and which needs to stay and should send e-mail after the script has completed its job.

I hope I have specified the requirement properly.

If anyone needs any infomation please let me know.

Many Thanks
Praveen checks.txt
0
Comment
Question by:praveendusi
  • 11
  • 6
  • 2
19 Comments
 
LVL 15

Expert Comment

by:markdmac
Comment Utility
As you are dumping to a CSV file, formatting isn't an option to make text red.  

It sounds like this script does all you need however you have the issue of multiple domains.  Can't you get a trust setup so your user ID has rights to each of the domains?
0
 

Author Comment

by:praveendusi
Comment Utility
Hi Mark,

Thank you for the response.

Active directory management is not in our scope and as this is a huge environment there is lot of process involved to do that. So we still have to run from each domain.  As the time limit to do the checks is less, we wanted to have a script that can run against all the domains from server.

Can output be transferred to HTML and then set threshold?  

Praveen
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Hi, this is a very large ask.  Considering it currently does not do anything with multiple domains, that's going to be a big change.

All I have done here is convert the current script to a HTA, but it still took me an hour....

I have only done CSV output.  The XLS isn't coded yet.

Regards,

Rob.
<html><head><title>Check Servers</title>
<HTA:APPLICATION
ID = "Check Servers"
APPLICATIONNAME="Check Servers"
>
<head>
<script language='vbscript'>
Const ForReading = 1
Const ForAppending = 8
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const CONVERT_TO_LOCAL_TIME = True

Sub GetInformation
	strInput = Trim(txt_input.value)
	strOutput = Trim(txt_output.value)
	If strInput = "" Then
		MsgBox "Please enter an input file name."
	ElseIf strOutput = "" Then
		MsgBox "Please enter an output file name."
	' CSV
	ElseIf optOutput(0).checked = True Then
		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objTextFile = objFSO.OpenTextFile(strInput, ForReading, False)

		txt_results.Value = "Host Name,Ping Status,RDC Status,OS,OS-Type,Service Pack,Last BootUp Time,Stopped Services" & VbCrLf

		Do Until objTextFile.AtEndOfStream
			strcomputer = Trim(objTextFile.Readline)
			hostno = hostno + 1
			txt_results.Value = txt_results.Value & strcomputer & ","
			'	Check server Ping Status
			Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
			For Each objStatus in objPing
				If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
					txt_results.Value = txt_results.Value & "NotPingable" & VbCrLf
					PingStatus = 0
				Else
					txt_results.Value = txt_results.Value & "Pingable,"
					PingStatus = 1
				End If
			Next
			If pingstatus = 1 Then
				'==================================================== 
				'check RDP( Including Logon disabled ) 
				'=====================================================
				On Error Resume Next  
				Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
				If Err.Number <> 0 Then
					txt_results.Value = txt_results.Value & "RDC failed,"
				Else
					strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\WinLogon"
					strValueName = "WinstationsDisabled"
					oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
					rdc=strValue
					If rdc=0 Then
						txt_results.Value = txt_results.Value & "RDC OK,"
					Else 
						txt_results.Value = txt_results.Value & "Remote logins are disabled,"
					End If
				End If
				Err.Clear
				On Error GoTo 0
				
				'==================================================== 
				'check Operating System , Service Pack
				'=====================================================
				On Error Resume Next
				Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
				If Err.Number = 0 Then
					Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
					For Each objItem in colItems
						txt_results.Value = txt_results.Value & objItem.Caption & ","
						txt_results.Value = txt_results.Value & objItem.CSDVersion & ","
					Next
				Else
					txt_results.Value = txt_results.Value & ",,"
				End If
				Err.Clear
				On Error GoTo 0
				
				'=====================================================
				'check Last boot Time
				'=====================================================
				Set objWMIDateTime = CreateObject("WbemScripting.SWbemDateTime")
				Set objWMIcurrenttime = CreateObject("WbemScripting.SWbemDateTime")
				On Error Resume Next
				Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
				If Err.Number = 0 Then
					Set colServer = objWMIService.InstancesOf("Win32_OperatingSystem")
					For Each objServer In colServer
						objWMIDateTime.Value = objServer.LastBootUpTime
						objWMIcurrenttime.Value=objServer.LocalDateTime
						txt_results.Value = txt_results.Value & objWMIDateTime.GetVarDate & ","
					Next
				Else
					txt_results.Value = txt_results.Value & ","
				End If
				
				'==============================================================================
				'	check for Service(s) where Startup Type is Auto but service is Stopped
				'=============================================================================
				On Error Resume Next
				Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
				If Err.Number = 0 Then
					Set colListOfServices = objWMIService.ExecQuery("Select * from Win32_Service")
					For Each objService in colListOfServices
						If objService.StartMode = "Auto" and objService.State = "Stopped" Then
							txt_results.Value = txt_results.Value & objService.DisplayName & " -- "
						End If
					Next
				Else
					'txt_results.Value = txt_results.Value
				End If
				txt_results.Value = txt_results.Value & VbCrLf
			End If
		Loop
		Set objLogFile = objFSO.OpenTextFile(strOutput, ForAppending, True)
		objLogFile.WriteLine txt_results.Value
		objLogFile.Close
	' XLS
	ElseIf optOutput(1).Checked = True Then
	End If
	MsgBox "Information retrieved."
End Sub
</script>
</head>
<body>
	<table border="0">
		<tr>
			<td>
				<br>Select input file:
			</td>
			<td>
				<input type="file" name="txt_input" id="txt_input" size="60">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br>Select output format:
			</td>
		</tr>
		<tr>
			<td>
				<input type="radio" id="optOutput" name="optOutput" value="csv" checked> CSV
			</td>
			<td>
				<input type="radio" id="optOutput" name="optOutput" value="xls"> XLS
			</td>
		</tr>
		<tr>
			<td>
				<br>Output file name:
			</td>
			<td>
				<input type="text" name="txt_output" id="txt_output" size="60">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br><button name="btnGetInfo" id="btnGetInfo" value="Get Information" onclick="GetInformation">Get Information</button>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br><textarea name='txt_results' rows='15' cols='120' readonly></textarea>
			</td>
		</tr>
	</table>
</body>

Open in new window

0
 
LVL 15

Expert Comment

by:markdmac
Comment Utility
I wonder if you can use PowerShell instead? That has native support to create HTML output, and can run remotely.
0
 

Author Comment

by:praveendusi
Comment Utility
Hi Rob,

I know it takes lot of efforts to write a script.  You have devoted time for scripting in my other post as well.  I appreciate your efforts.

I have run the above script on my laptop and it works fine for me.  Will test the same on my servers when I am in the office.

In the meanwhile, I got a Disk Space HTA script in Experts Exchange itself, which ask to put alternate credentials.  I am attaching the script for your reference.  Can you check if we can use the Alternate Credentials code in the above script please?

Many Thanks
Praveen
disk.txt
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
That can certainly be done.  I'll add that tomorrow.

Rob.
0
 

Author Comment

by:praveendusi
Comment Utility
No Problem.  Thank you Rob.
0
 

Author Comment

by:praveendusi
Comment Utility
And also Rob.  Can you see if I get the output "Format" (the fields will remain same as my original script its  only the format and the export method that needs to be used same as the disk space)  same as in the Disk Space script?

The script has option to export to HTML, CSV, TXT and XLS.

Many Thanks
Praveen
0
 

Author Comment

by:praveendusi
Comment Utility
Hi Rob,

I ran the script and it works.  Ouput might have to be fine tuned little bit.  Need your help is fine tuning.  I need in the same format as the Disk Space Script.

I have tested the Disk Space script and it does work fine when I try to run against different domain.  Offcourse I need to run the script once against other domain.  But it eliminates me login to server of each domain and run the script.  It is manageable now.  If it is easy to modify the script to run against all the domains at the same time and give the output it good else I have to create multiple copies of the script and run the script for each domain  (I know I am aksing too much.... :)) ... But just seeing the possibilities).

Many Thanks.
Praveen

0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
Hi, here is the same HTA with the alternate credentials added.

I'll work on changing the output format.

Regards,

Rob.
<html><head><title>Check Servers</title>
<HTA:APPLICATION
ID = "Check Servers"
APPLICATIONNAME="Check Servers"
>
<head>
<script language='vbscript'>
Const ForReading = 1
Const ForAppending = 8
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const CONVERT_TO_LOCAL_TIME = True

Sub GetInformation
	strInput = Trim(txt_input.value)
	strOutput = Trim(txt_output.value)
	If strInput = "" Then
		MsgBox "Please enter an input file name."
	ElseIf strOutput = "" Then
		MsgBox "Please enter an output file name."
	' CSV
	ElseIf optOutput(0).checked = True Then
		Set oLocator = CreateObject("WbemScripting.SWbemLocator")

		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objTextFile = objFSO.OpenTextFile(strInput, ForReading, False)

		txt_results.Value = "Host Name,Ping Status,RDC Status,OS,OS-Type,Service Pack,Last BootUp Time,Stopped Services" & VbCrLf

		Do Until objTextFile.AtEndOfStream
			strcomputer = Trim(objTextFile.Readline)
			hostno = hostno + 1
			txt_results.Value = txt_results.Value & strcomputer & ","
			'	Check server Ping Status
			Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
			For Each objStatus in objPing
				If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
					txt_results.Value = txt_results.Value & "NotPingable" & VbCrLf
					PingStatus = 0
				Else
					txt_results.Value = txt_results.Value & "Pingable,"
					PingStatus = 1
				End If
			Next
			If pingstatus = 1 Then
				On Error Resume Next
				If username.value="" Then 
					'connect with current credentials
					Set oDefault=oLocator.ConnectServer(strComputer, "root\default")
					Set oReg = oDefault.get("StdRegProv")
					Set objWMIService = oLocator.ConnectServer (strComputer,"root\cimv2")
				Else
					'connect with alternate credentials
					Set oDefault=oLocator.ConnectServer(strComputer, "root\default",username.value,password.value)
					Set oReg = oDefault.get("StdRegProv")
					Set objWMIService = oLocator.ConnectServer (strComputer,"root\cimv2",username.value,password.value)
				End If
				oReg.Security_.impersonationlevel = 3
				objWMIService.Security_.impersonationlevel = 3
				If Err.Number <> 0 Then
					txt_results.Value = txt_results.Value & "WMI ERROR" & VbCrLf
					Err.Clear
					On Error GoTo 0
				Else
					'==================================================== 
					'check RDP( Including Logon disabled ) 
					'=====================================================
					strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\WinLogon"
					strValueName = "WinstationsDisabled"
					oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
					rdc=strValue
					If rdc=0 Then
						txt_results.Value = txt_results.Value & "RDC OK,"
					Else 
						txt_results.Value = txt_results.Value & "Remote logins are disabled,"
					End If
					
					'==================================================== 
					'check Operating System , Service Pack
					'=====================================================
					Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
					For Each objItem in colItems
						txt_results.Value = txt_results.Value & objItem.Caption & ","
						txt_results.Value = txt_results.Value & objItem.CSDVersion & ","
					Next
					
					'=====================================================
					'check Last boot Time
					'=====================================================
					Set objWMIDateTime = CreateObject("WbemScripting.SWbemDateTime")
					Set objWMIcurrenttime = CreateObject("WbemScripting.SWbemDateTime")
					Set colServer = objWMIService.InstancesOf("Win32_OperatingSystem")
					For Each objServer In colServer
						objWMIDateTime.Value = objServer.LastBootUpTime
						objWMIcurrenttime.Value=objServer.LocalDateTime
						txt_results.Value = txt_results.Value & objWMIDateTime.GetVarDate & ","
					Next
					
					'==============================================================================
					'	check for Service(s) where Startup Type is Auto but service is Stopped
					'=============================================================================
					Set colListOfServices = objWMIService.ExecQuery("Select * from Win32_Service")
					For Each objService in colListOfServices
						If objService.StartMode = "Auto" and objService.State = "Stopped" Then
							txt_results.Value = txt_results.Value & objService.DisplayName & " -- "
						End If
					Next
	
					txt_results.Value = txt_results.Value & VbCrLf
				End If
			End If
		Loop
		Set objLogFile = objFSO.OpenTextFile(strOutput, ForAppending, True)
		objLogFile.WriteLine txt_results.Value
		objLogFile.Close
	' XLS
	ElseIf optOutput(1).Checked = True Then
	End If
	MsgBox "Information retrieved."
End Sub
</script>
</head>
<body>
	<br>
	<fieldset class="Hide" id="alternate_credentials"><legend><Font face="Tahoma" size="2" color="Blue">Alternate Domain Credentials <i>(optional)</i></Font></legend>
	<Font face="Tahoma" size="2" color="Blue">Username <input id="username" type="text" size="20" name="username"> <i>it is recommended you use domain</i>\<i>username format.</i><br>
	<Font face="Tahoma" size="2" color="Blue">Password <input id="password" type="password" size="20"> <i>alternate credentials won't work for the local computer.</Font></i>
	</fieldset>
	<br>
	<table border="0">
		<tr>
			<td>
				<br>Select input file:
			</td>
			<td>
				<input type="file" name="txt_input" id="txt_input" size="60">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br>Select output format:
			</td>
		</tr>
		<tr>
			<td>
				<input type="radio" id="optOutput" name="optOutput" value="csv" checked> CSV
			</td>
			<td>
				<input type="radio" id="optOutput" name="optOutput" value="xls"> XLS
			</td>
		</tr>
		<tr>
			<td>
				<br>Output file name:
			</td>
			<td>
				<input type="text" name="txt_output" id="txt_output" size="60">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br><button name="btnGetInfo" id="btnGetInfo" value="Get Information" onclick="GetInformation">Get Information</button>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br><textarea name='txt_results' rows='15' cols='120' readonly></textarea>
			</td>
		</tr>
	</table>
</body>

Open in new window

0
 

Author Comment

by:praveendusi
Comment Utility
Thanks Rob. Will check and update you

Praveen
0
 

Author Comment

by:praveendusi
Comment Utility
Hi Rob,

We have tested and it works fine.  Yes if the formatting is fine tunes it would look even better....:)

Apart from my script, do you have any better script that would do the same functionality, like doing the health check of servers?

Praveen
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
OK, this now has XLS support as well.

As far as other scripts go, I don't use any, but there should be some around, depending on what you want to report on.

Regards,

Rob.
<html><head><title>Check Servers</title>
<HTA:APPLICATION
ID = "Check Servers"
APPLICATIONNAME="Check Servers"
>
<head>
<script language='vbscript'>
Const ForReading = 1
Const ForAppending = 8
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const CONVERT_TO_LOCAL_TIME = True

Sub GetInformation
	strInput = Trim(txt_input.value)
	strOutput = Trim(txt_output.value)
	If strInput = "" Then
		MsgBox "Please enter an input file name."
	ElseIf strOutput = "" Then
		MsgBox "Please enter an output file name."
	Else
		Set oLocator = CreateObject("WbemScripting.SWbemLocator")

		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objTextFile = objFSO.OpenTextFile(strInput, ForReading, False)

		txt_results.Value = "Host Name,Ping Status,RDC Status,OS,OSVersion,Service Pack,Last BootUp Time,Stopped Services" & VbCrLf

		Do Until objTextFile.AtEndOfStream
			strcomputer = Trim(objTextFile.Readline)
			hostno = hostno + 1
			txt_results.Value = txt_results.Value & strcomputer & ","
			'	Check server Ping Status
			Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
			For Each objStatus in objPing
				If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
					txt_results.Value = txt_results.Value & "NotPingable" & VbCrLf
					PingStatus = 0
				Else
					txt_results.Value = txt_results.Value & "Pingable,"
					PingStatus = 1
				End If
			Next
			If pingstatus = 1 Then
				On Error Resume Next
				If username.value="" Then 
					'connect with current credentials
					Set oDefault=oLocator.ConnectServer(strComputer, "root\default")
					Set oReg = oDefault.get("StdRegProv")
					Set objWMIService = oLocator.ConnectServer (strComputer,"root\cimv2")
				Else
					'connect with alternate credentials
					Set oDefault=oLocator.ConnectServer(strComputer, "root\default",username.value,password.value)
					Set oReg = oDefault.get("StdRegProv")
					Set objWMIService = oLocator.ConnectServer (strComputer,"root\cimv2",username.value,password.value)
				End If
				oReg.Security_.impersonationlevel = 3
				objWMIService.Security_.impersonationlevel = 3
				If Err.Number <> 0 Then
					txt_results.Value = txt_results.Value & "WMI ERROR" & VbCrLf
					Err.Clear
					On Error GoTo 0
				Else
					'==================================================== 
					'check RDP( Including Logon disabled ) 
					'=====================================================
					strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\WinLogon"
					strValueName = "WinstationsDisabled"
					oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
					rdc=strValue
					If rdc=0 Then
						txt_results.Value = txt_results.Value & "RDC OK,"
					Else 
						txt_results.Value = txt_results.Value & "Remote logins are disabled,"
					End If
					
					'==================================================== 
					'check Operating System , Service Pack
					'=====================================================
					Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
					Err.Clear
					On Error GoTo 0
					strCaption = ""
					strCSDVersion = ""
					For Each objItem in colItems
						strCaption = objItem.Caption
						strCSDVersion = objItem.CSDVersion
					Next
					If InStr(strCaption, ",") > 0 Then
						txt_results.Value = txt_results.Value & strCaption & ","
					Else
						txt_results.Value = txt_results.Value & strCaption & ",,"
					End If
					txt_results.Value = txt_results.Value & strCSDVersion & ","
					
					'=====================================================
					'check Last boot Time
					'=====================================================
					Set objWMIDateTime = CreateObject("WbemScripting.SWbemDateTime")
					Set objWMIcurrenttime = CreateObject("WbemScripting.SWbemDateTime")
					Set colServer = objWMIService.InstancesOf("Win32_OperatingSystem")
					For Each objServer In colServer
						objWMIDateTime.Value = objServer.LastBootUpTime
						objWMIcurrenttime.Value=objServer.LocalDateTime
						txt_results.Value = txt_results.Value & objWMIDateTime.GetVarDate & ","
					Next
					
					'==============================================================================
					'	check for Service(s) where Startup Type is Auto but service is Stopped
					'=============================================================================
					Set colListOfServices = objWMIService.ExecQuery("Select * from Win32_Service")
					For Each objService in colListOfServices
						If objService.StartMode = "Auto" and objService.State = "Stopped" Then
							txt_results.Value = txt_results.Value & objService.DisplayName & " -- "
						End If
					Next
	
					txt_results.Value = txt_results.Value & VbCrLf
				End If
			End If
		Loop
		
		' CSV
		If optOutput(0).checked = True Then
			ExportToCSV strOutput
		' XLS
		ElseIf optOutput(1).Checked = True Then
			ExportToExcel strOutput
		End If
	End If
End Sub

Sub ExportToCSV(strOutput)
	If Right(LCase(strOutput), 4) <> ".csv" Then strOutput = strOutput & ".csv"
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objLogFile = objFSO.CreateTextFile(strOutput, True)
	objLogFile.WriteLine txt_results.Value
	objLogFile.Close
	MsgBox "Information saved as " & strOutput
End Sub

Sub ExportToExcel(strOutput)

	If Right(LCase(strOutput), 4) <> ".xls" Then strOutput = strOutput & ".xls"

	On Error Resume Next
	Set objXL=CreateObject("Excel.Application")
	If Err.Number<>0 Then
		MsgBox "You must have Microsoft Excel installed in order to export to this format.",vbOKOnly+vbCritical,"Export"
		Exit Sub
	End If
	Err.Clear
	On Error GoTo 0
	objXL.Visible=False
	Set objWB = objXL.Workbooks.Add
	Set objSheet = objWB.Sheets(1)
	objSheet.Cells(1,3)="Server Check"
	objSheet.Range("C1").font.bold=True
	objSheet.Range("C1").font.size=14
	
	Row=3
	Col=1
	arrData = Split(txt_results.Value, VbCrLf)
	For Each r In arrData
		tmpArray=Split(r,",")
		For z=0 To UBound(tmpArray)
			'set font color to red if can't connect error message is detected
			If InStr(tmpArray(z),"NotPingable") > 0 Or InStr(tmpArray(z),"WMI ERROR") > 0 Then objSheet.Cells(Row,Col+z).Font.Color=vbRed
			objSheet.Cells(Row,Col+z).Value=tmpArray(z)
		Next
		Row=Row+1
	Next
 
	LastRow=Row-1
 
	objSheet.Range("A3:H3").font.bold=True
 
	objSheet.Cells.EntireColumn.AutoFit
	objXL.DisplayAlerts = False
	objWB.SaveAs strOutput
	objXL.DisplayAlerts = True
	objWB.Close False
	objXL.Quit
 
	MsgBox "Finished exporting To " & strOutput,vbOKOnly+vbInformation,"Export"
 
End Sub

Function SaveAs(strFile)
	Dim objDialog
 
	If InStr(GetOS,"2000") Then
		SaveAs=InputBox("Enter the filename and path.","Export",strFile)
	Else
		'This requires Windows XP/2003
		Set objDialog=CreateObject("SAFRCFileDlg.FileSave")
	
		objDialog.filename=strFile
		objDialog.OpenFileSaveDlg
		SaveAs=objDialog.FileName
	End If
End Function
</script>
</head>
<body>
	<br>
	<fieldset class="Hide" id="alternate_credentials"><legend><Font face="Tahoma" size="2" color="Blue">Alternate Domain Credentials <i>(optional)</i></Font></legend>
	<Font face="Tahoma" size="2" color="Blue">Username <input id="username" type="text" size="20" name="username"> <i>it is recommended you use domain</i>\<i>username format.</i><br>
	<Font face="Tahoma" size="2" color="Blue">Password <input id="password" type="password" size="20"> <i>alternate credentials won't work for the local computer.</Font></i>
	</fieldset>
	<br>
	<table border="0">
		<tr>
			<td>
				<br>Select input file:
			</td>
			<td>
				<input type="file" name="txt_input" id="txt_input" size="60">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br>Select output format:
			</td>
		</tr>
		<tr>
			<td>
				<input type="radio" id="optOutput" name="optOutput" value="csv" checked> CSV
			</td>
			<td>
				<input type="radio" id="optOutput" name="optOutput" value="xls"> XLS
			</td>
		</tr>
		<tr>
			<td>
				<br>Output file name:
			</td>
			<td>
				<input type="text" name="txt_output" id="txt_output" size="60">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br><button name="btnGetInfo" id="btnGetInfo" value="Get Information" onclick="GetInformation">Get Information</button>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br><textarea name='txt_results' rows='15' cols='120' readonly></textarea>
			</td>
		</tr>
	</table>
</body>

Open in new window

0
 

Author Comment

by:praveendusi
Comment Utility
Hi Rob,

I tested the script and it is working fine.

Many Thanks
0
 
LVL 65

Expert Comment

by:RobSampson
Comment Utility
So is there anything else you need?
0
 

Author Comment

by:praveendusi
Comment Utility
One last thing.  Is there a way you can format the output of Services stopped?  

Right now they show the services that are stopped with " --" separation.  i wanted then in one line by another.

ex:
Windows Installer
Smart Card

Also is there a way we can call a text file where we can exclude Services which we don't want to monitor.  Ex: Windows Installer, Performance Logs

Praveen
0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
Comment Utility
>> Is there a way you can format the output of Services stopped?

Yes, for XLS, not for CSV.  I have done that for XLS.

I have included this line:
      strServiceExcludeFile = "C:\Temp\ServiceExcludes.txt"

in which you can put the *Display Name* of the service to exclude, one per line.

Regards,

Rob.
<html><head><title>Check Servers</title>
<HTA:APPLICATION
ID = "Check Servers"
APPLICATIONNAME="Check Servers"
>
<head>
<script language='vbscript'>
Const ForReading = 1
Const ForAppending = 8
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const CONVERT_TO_LOCAL_TIME = True

Sub GetInformation
	strInput = Trim(txt_input.value)
	strOutput = Trim(txt_output.value)
	strServiceExcludeFile = "C:\Temp\ServiceExcludes.txt"
	If strInput = "" Then
		MsgBox "Please enter an input file name."
	ElseIf strOutput = "" Then
		MsgBox "Please enter an output file name."
	Else
		Set oLocator = CreateObject("WbemScripting.SWbemLocator")

		Set objFSO = CreateObject("Scripting.FileSystemObject")
		Set objTextFile = objFSO.OpenTextFile(strInput, ForReading, False)

		txt_results.Value = "Host Name,Ping Status,RDC Status,OS,OSVersion,Service Pack,Last BootUp Time,Stopped Services" & VbCrLf

		Do Until objTextFile.AtEndOfStream
			strcomputer = Trim(objTextFile.Readline)
			hostno = hostno + 1
			txt_results.Value = txt_results.Value & strcomputer & ","
			'	Check server Ping Status
			Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strComputer & "'")
			For Each objStatus in objPing
				If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
					txt_results.Value = txt_results.Value & "NotPingable" & VbCrLf
					PingStatus = 0
				Else
					txt_results.Value = txt_results.Value & "Pingable,"
					PingStatus = 1
				End If
			Next
			If pingstatus = 1 Then
				On Error Resume Next
				If username.value="" Then 
					'connect with current credentials
					Set oDefault=oLocator.ConnectServer(strComputer, "root\default")
					Set oReg = oDefault.get("StdRegProv")
					Set objWMIService = oLocator.ConnectServer (strComputer,"root\cimv2")
				Else
					'connect with alternate credentials
					Set oDefault=oLocator.ConnectServer(strComputer, "root\default",username.value,password.value)
					Set oReg = oDefault.get("StdRegProv")
					Set objWMIService = oLocator.ConnectServer (strComputer,"root\cimv2",username.value,password.value)
				End If
				oReg.Security_.impersonationlevel = 3
				objWMIService.Security_.impersonationlevel = 3
				If Err.Number <> 0 Then
					txt_results.Value = txt_results.Value & "WMI ERROR" & VbCrLf
					Err.Clear
					On Error GoTo 0
				Else
					'==================================================== 
					'check RDP( Including Logon disabled ) 
					'=====================================================
					strKeyPath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\WinLogon"
					strValueName = "WinstationsDisabled"
					oReg.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
					rdc=strValue
					If rdc=0 Then
						txt_results.Value = txt_results.Value & "RDC OK,"
					Else 
						txt_results.Value = txt_results.Value & "Remote logins are disabled,"
					End If
					
					'==================================================== 
					'check Operating System , Service Pack
					'=====================================================
					Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
					Err.Clear
					On Error GoTo 0
					strCaption = ""
					strCSDVersion = ""
					For Each objItem in colItems
						strCaption = objItem.Caption
						strCSDVersion = objItem.CSDVersion
					Next
					If InStr(strCaption, ",") > 0 Then
						txt_results.Value = txt_results.Value & strCaption & ","
					Else
						txt_results.Value = txt_results.Value & strCaption & ",,"
					End If
					txt_results.Value = txt_results.Value & strCSDVersion & ","
					
					'=====================================================
					'check Last boot Time
					'=====================================================
					Set objWMIDateTime = CreateObject("WbemScripting.SWbemDateTime")
					Set objWMIcurrenttime = CreateObject("WbemScripting.SWbemDateTime")
					Set colServer = objWMIService.InstancesOf("Win32_OperatingSystem")
					For Each objServer In colServer
						objWMIDateTime.Value = objServer.LastBootUpTime
						objWMIcurrenttime.Value=objServer.LocalDateTime
						txt_results.Value = txt_results.Value & objWMIDateTime.GetVarDate & ","
					Next
					
					'==============================================================================
					'	check for Service(s) where Startup Type is Auto but service is Stopped
					'=============================================================================
					strFilter = ""
					If objFSO.FileExists(strServiceExcludeFile) = True Then
						Set objServiceExcludes = objFSO.OpenTextFile(strServiceExcludeFile, 1, False)
						While Not objServiceExcludes.AtEndOfStream
							strLine = Trim(objServiceExcludes.ReadLine)
							If strLine <> "" Then
								If strFilter = "" Then
									strFilter = " WHERE DisplayName<>'" & strLine & "'"
								Else
									strFilter = strFilter & " AND DisplayName<>'" & strLine & "'"
								End If
							End If
						Wend
						objServiceExcludes.Close
					End If
					Set colListOfServices = objWMIService.ExecQuery("Select * from Win32_Service" & strFilter)
					strServices = ""
					For Each objService in colListOfServices
						If objService.StartMode = "Auto" and objService.State = "Stopped" Then
							If strServices = "" Then
								strServices = Trim(objService.DisplayName)
							Else
								strServices = strServices & " -- " & Trim(objService.DisplayName)
							End If
						End If
					Next
					txt_results.Value = txt_results.Value & strServices & VbCrLf
				End If
			End If
		Loop
		
		' CSV
		If optOutput(0).checked = True Then
			ExportToCSV strOutput
		' XLS
		ElseIf optOutput(1).Checked = True Then
			ExportToExcel strOutput
		End If
	End If
End Sub

Sub ExportToCSV(strOutput)
	If Right(LCase(strOutput), 4) <> ".csv" Then strOutput = strOutput & ".csv"
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objLogFile = objFSO.CreateTextFile(strOutput, True)
	objLogFile.WriteLine txt_results.Value
	objLogFile.Close
	MsgBox "Information saved as " & strOutput
End Sub

Sub ExportToExcel(strOutput)

	If Right(LCase(strOutput), 4) <> ".xls" Then strOutput = strOutput & ".xls"

	On Error Resume Next
	Set objXL=CreateObject("Excel.Application")
	If Err.Number<>0 Then
		MsgBox "You must have Microsoft Excel installed in order to export to this format.",vbOKOnly+vbCritical,"Export"
		Exit Sub
	End If
	Err.Clear
	On Error GoTo 0
	objXL.Visible=False
	Set objWB = objXL.Workbooks.Add
	Set objSheet = objWB.Sheets(1)
	objSheet.Cells(1,3)="Server Check"
	objSheet.Range("C1").font.bold=True
	objSheet.Range("C1").font.size=14
	
	Row=3
	Col=1
	arrData = Split(txt_results.Value, VbCrLf)
	For Each r In arrData
		tmpArray=Split(r,",")
		For z=0 To UBound(tmpArray)
			'set font color to red if can't connect error message is detected
			If InStr(tmpArray(z),"NotPingable") > 0 Or InStr(tmpArray(z),"WMI ERROR") > 0 Then objSheet.Cells(Row,Col+z).Font.Color=vbRed
			objSheet.Cells(Row,Col+z).Value=Replace(tmpArray(z), " -- ", vbLf)
		Next
		Row=Row+1
	Next
 
	LastRow=Row-1
 
	objSheet.Range("A3:H3").font.bold=True
 
	objSheet.Cells.EntireColumn.AutoFit
	objXL.DisplayAlerts = False
	objWB.SaveAs strOutput
	objXL.DisplayAlerts = True
	objWB.Close False
	objXL.Quit
 
	MsgBox "Finished exporting To " & strOutput,vbOKOnly+vbInformation,"Export"
 
End Sub

Function SaveAs(strFile)
	Dim objDialog
 
	If InStr(GetOS,"2000") Then
		SaveAs=InputBox("Enter the filename and path.","Export",strFile)
	Else
		'This requires Windows XP/2003
		Set objDialog=CreateObject("SAFRCFileDlg.FileSave")
	
		objDialog.filename=strFile
		objDialog.OpenFileSaveDlg
		SaveAs=objDialog.FileName
	End If
End Function
</script>
</head>
<body>
	<br>
	<fieldset class="Hide" id="alternate_credentials"><legend><Font face="Tahoma" size="2" color="Blue">Alternate Domain Credentials <i>(optional)</i></Font></legend>
	<Font face="Tahoma" size="2" color="Blue">Username <input id="username" type="text" size="20" name="username"> <i>it is recommended you use domain</i>\<i>username format.</i><br>
	<Font face="Tahoma" size="2" color="Blue">Password <input id="password" type="password" size="20"> <i>alternate credentials won't work for the local computer.</Font></i>
	</fieldset>
	<br>
	<table border="0">
		<tr>
			<td>
				<br>Select input file:
			</td>
			<td>
				<input type="file" name="txt_input" id="txt_input" size="60">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br>Select output format:
			</td>
		</tr>
		<tr>
			<td>
				<input type="radio" id="optOutput" name="optOutput" value="csv" checked> CSV
			</td>
			<td>
				<input type="radio" id="optOutput" name="optOutput" value="xls"> XLS
			</td>
		</tr>
		<tr>
			<td>
				<br>Output file name:
			</td>
			<td>
				<input type="text" name="txt_output" id="txt_output" size="60">
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br><button name="btnGetInfo" id="btnGetInfo" value="Get Information" onclick="GetInformation">Get Information</button>
			</td>
		</tr>
		<tr>
			<td colspan="2">
				<br><textarea name='txt_results' rows='15' cols='120' readonly></textarea>
			</td>
		</tr>
	</table>
</body>

Open in new window

0
 

Author Comment

by:praveendusi
Comment Utility
Hi Rob,

Thank you for the script.  Will test and let you know
0
 

Author Closing Comment

by:praveendusi
Comment Utility
Rob,

Apoligize for the delay response.  

Many thanks for your help in helping to modify the script.

You are wonderful.  A++ for the help.

Praveen
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

Introduction You may have a need to setup a group of users to allow local administrative access on workstations.  In a domain environment this can easily be achieved with Restricted Groups and Group Policies. This article will demonstrate how to…
Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
This video Micro Tutorial explains how to clone a hard drive using a commercial software product for Windows systems called Casper from Future Systems Solutions (FSS). Cloning makes an exact, complete copy of one hard disk drive (HDD) onto another d…
With the advent of Windows 10, Microsoft is pushing a Get Windows 10 icon into the notification area (system tray) of qualifying computers. There are many reasons for wanting to remove this icon. This two-part Experts Exchange video Micro Tutorial s…

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

12 Experts available now in Live!

Get 1:1 Help Now