[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Need help modifying a VB script to scan for local admin to move on after error, and to scan ad

Posted on 2009-04-22
39
Medium Priority
?
602 Views
Last Modified: 2012-05-06
Hi,
Husbi wrote this great script to scan for local group on servers

I need some help fixing it
1. many times when it gets to some servers ( i believe with no permissions, bc other times i get unable to ping) i get an error. I need to add  something so it doesnt stop the script. And just continues on.
This is the errror i get "localadmin.vbs (58, 3) (null) the network path was not found"  
2. Also I need to add an option to scan a server list OR all of the servers in AD

Please help
' ======================================================================================
' servers.txt 			= Enter server name one per line
' localgroupoutput.csv 		= Log files will be created and writing in this file.
' =====================================================================================
 
'Option Explicit
 
Dim strGroup, ObjFSO, ObjTextFile, strText, arrComputers, strComputer, ping, png, status, objGroup, objMember
 
Dim strPath, strCommand, objShell
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
 
Const HostNameFile = "servers.txt"
Const LogFile = "localgroupoutput.csv"
 
 
strGroup = InputBox("Type Server Local Group name you want see members OR type * for all local groups","LOCAL GROUP NAME","Administrators", 100, 100)
 
 
Dim FSO, WriteLog
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WriteLog = FSO.OpenTextFile(LogFile, 8, True)
WriteLog.WriteLine vbNewLine & "Script started @ " & Now()
 
 
Const ForReading = 1
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(HostNameFile, ForReading)
 
strText = objTextFile.ReadAll
objTextFile.Close
 
 
 
If strGroup = "" Then
	WScript.Echo "Script Cancelled"
	WScript.Quit()
elseif strGroup = "*" then
	WScript.Echo "Search All local groups"
 
 
 
arrComputers = Split(strText, vbCrLf)
 
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
 
		
		Set colGroups = GetObject("WinNT://" & strComputer & "")
		colGroups.Filter = Array("group")
		
		For Each objGroup In colGroups
    			Wscript.Echo objGroup.Name
    			WriteLog.WriteLine strComputer & "," & objGroup.Name	 
    			For Each objUser in objGroup.Members
				strMembers = Replace(Replace(objUser.AdsPath, "WinNT://", ""), "/", "\")
        			Wscript.Echo vbTab & objUser.Name
        			WriteLog.WriteLine "," & "," & strMembers
    			Next
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
 
 
 
Else
WScript.Echo "Group Entered: " & strGroup
 
 
arrComputers = Split(strText, vbCrLf)
 
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
 
		Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup)
		WScript.Echo  strComputer & ": Members of " & objGroup.Name & " group:"
 
		For Each objMember in objGroup.Members
 
			Dim strMembers
			strMembers = Replace(Replace(objMember.AdsPath, "WinNT://", ""), "/", "\")
			WScript.Echo strComputer & ": " & strMembers
			WriteLog.WriteLine objGroup.Name & "," & strComputer & "," & strMembers
 
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
End If
 
 
 
 ' ======================================================================================
' servers.txt 			= Enter server name one per line
' localgroupoutput.csv 		= Log files will be created and writing in this file.
' =====================================================================================
 
'Option Explicit
 
Dim strGroup, ObjFSO, ObjTextFile, strText, arrComputers, strComputer, ping, png, status, objGroup, objMember
 
Dim strPath, strCommand, objShell
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
 
Const HostNameFile = "servers.txt"
Const LogFile = "localgroupoutput.csv"
 
 
strGroup = InputBox("Type Server Local Group name you want see members OR type * for all local groups","LOCAL GROUP NAME","Administrators", 100, 100)
 
 
Dim FSO, WriteLog
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WriteLog = FSO.OpenTextFile(LogFile, 8, True)
WriteLog.WriteLine vbNewLine & "Script started @ " & Now()
 
 
Const ForReading = 1
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(HostNameFile, ForReading)
 
strText = objTextFile.ReadAll
objTextFile.Close
 
 
 
If strGroup = "" Then
	WScript.Echo "Script Cancelled"
	WScript.Quit()
elseif strGroup = "*" then
	WScript.Echo "Search All local groups"
 
 
 
arrComputers = Split(strText, vbCrLf)
 
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
 
		
		Set colGroups = GetObject("WinNT://" & strComputer & "")
		colGroups.Filter = Array("group")
		
		For Each objGroup In colGroups
    			Wscript.Echo objGroup.Name
    			WriteLog.WriteLine strComputer & "," & objGroup.Name	 
    			For Each objUser in objGroup.Members
				strMembers = Replace(Replace(objUser.AdsPath, "WinNT://", ""), "/", "\")
        			Wscript.Echo vbTab & objUser.Name
        			WriteLog.WriteLine "," & "," & strMembers
    			Next
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
 
 
 
Else
WScript.Echo "Group Entered: " & strGroup
 
 
arrComputers = Split(strText, vbCrLf)
 
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
 
		Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup)
		WScript.Echo  strComputer & ": Members of " & objGroup.Name & " group:"
 
		For Each objMember in objGroup.Members
 
			Dim strMembers
			strMembers = Replace(Replace(objMember.AdsPath, "WinNT://", ""), "/", "\")
			WScript.Echo strComputer & ": " & strMembers
			WriteLog.WriteLine objGroup.Name & "," & strComputer & "," & strMembers
 
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
End If
 
 
 
 
 
 
 
 
 
 
 
Function isAlive(strComputer)
	isAlive = False
	Set ping = GetObject("winmgmts:").ExecQuery("select * from Win32_PingStatus where Address = '" & strComputer & "'")
	
	For Each png IN ping
		if png.StatusCode = 0 Then isAlive = True
	Next
End Function
 
 
 
 
 
 
 
Function isAlive(strComputer)
	isAlive = False
	Set ping = GetObject("winmgmts:").ExecQuery("select * from Win32_PingStatus where Address = '" & strComputer & "'")
	
	For Each png IN ping
		if png.StatusCode = 0 Then isAlive = True
	Next
End Function

Open in new window

0
Comment
Question by:neoptoent
  • 19
  • 19
39 Comments
 
LVL 38

Expert Comment

by:Rich Rumble
ID: 24206682
A over simplified "fix" is "on error resume next" at the top of the script.
But you should have debugging through out as a best practice, the on error resume next is for hacks like me who don't know anything ;)
-rich
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24212146
hey neoptoent

i think you double paste the script, can you check it and give me exectly the line number
0
 

Author Comment

by:neoptoent
ID: 24216216
I will repaste the script
 
Thanks

' ======================================================================================
' servers.txt 			= Enter server name one per line
' localgroupoutput.csv 		= Log files will be created and writing in this file.
' =====================================================================================
 
'Option Explicit
 
Dim strGroup, ObjFSO, ObjTextFile, strText, arrComputers, strComputer, ping, png, status, objGroup, objMember
 
Dim strPath, strCommand, objShell
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
 
Const HostNameFile = "servers.txt"
Const LogFile = "localgroupoutput.csv"
 
 
strGroup = InputBox("Type Server Local Group name you want see members OR type * for all local groups","LOCAL GROUP NAME","Administrators", 100, 100)
 
 
Dim FSO, WriteLog
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WriteLog = FSO.OpenTextFile(LogFile, 8, True)
WriteLog.WriteLine vbNewLine & "Script started @ " & Now()
 
 
Const ForReading = 1
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(HostNameFile, ForReading)
 
strText = objTextFile.ReadAll
objTextFile.Close
 
 
 
If strGroup = "" Then
	WScript.Echo "Script Cancelled"
	WScript.Quit()
elseif strGroup = "*" then
	WScript.Echo "Search All local groups"
 
 
 
arrComputers = Split(strText, vbCrLf)
 
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
 
		
		Set colGroups = GetObject("WinNT://" & strComputer & "")
		colGroups.Filter = Array("group")
		
		For Each objGroup In colGroups
    			Wscript.Echo objGroup.Name
    			WriteLog.WriteLine strComputer & "," & objGroup.Name	 
    			For Each objUser in objGroup.Members
				strMembers = Replace(Replace(objUser.AdsPath, "WinNT://", ""), "/", "\")
        			Wscript.Echo vbTab & objUser.Name
        			WriteLog.WriteLine "," & "," & strMembers
    			Next
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
 
 
 
Else
WScript.Echo "Group Entered: " & strGroup
 
 
arrComputers = Split(strText, vbCrLf)
 
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
 
		Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup)
		WScript.Echo  strComputer & ": Members of " & objGroup.Name & " group:"
 
		For Each objMember in objGroup.Members
 
			Dim strMembers
			strMembers = Replace(Replace(objMember.AdsPath, "WinNT://", ""), "/", "\")
			WScript.Echo strComputer & ": " & strMembers
			WriteLog.WriteLine objGroup.Name & "," & strComputer & "," & strMembers
 
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
End If
 
 
 
 
 
 
 
 
 
 
 
Function isAlive(strComputer)
	isAlive = False
	Set ping = GetObject("winmgmts:").ExecQuery("select * from Win32_PingStatus where Address = '" & strComputer & "'")
	
	For Each png IN ping
		if png.StatusCode = 0 Then isAlive = True
	Next
End Function

Open in new window

0
Veeam and MySQL: How to Perform Backup & Recovery

MySQL and the MariaDB variant are among the most used databases in Linux environments, and many critical applications support their data on them. Watch this recorded webinar to find out how Veeam Backup & Replication allows you to get consistent backups of MySQL databases.

 
LVL 14

Expert Comment

by:yehudaha
ID: 24216228
still error on line 58 ?
0
 

Author Comment

by:neoptoent
ID: 24216520
Line 96,3
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24217159
hey

about the second request you have the option to scan txt file, still want AD ?

any way this will continune and let you know if there error
' ======================================================================================
' servers.txt 			= Enter server name one per line
' localgroupoutput.csv 		= Log files will be created and writing in this file.
' =====================================================================================
 
'Option Explicit
 
Dim strGroup, ObjFSO, ObjTextFile, strText, arrComputers, strComputer, ping, png, status, objGroup, objMember
 
Dim strPath, strCommand, objShell
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
 
Const HostNameFile = "servers.txt"
Const LogFile = "localgroupoutput.csv"
 
 
strGroup = InputBox("Type Server Local Group name you want see members OR type * for all local groups","LOCAL GROUP NAME","Administrators", 100, 100)
 
 
Dim FSO, WriteLog
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WriteLog = FSO.OpenTextFile(LogFile, 8, True)
WriteLog.WriteLine vbNewLine & "Script started @ " & Now()
 
 
Const ForReading = 1
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(HostNameFile, ForReading)
 
strText = objTextFile.ReadAll
objTextFile.Close
 
 
 
If strGroup = "" Then
	WScript.Echo "Script Cancelled"
	WScript.Quit()
elseif strGroup = "*" then
	WScript.Echo "Search All local groups"
 
 
 
arrComputers = Split(strText, vbCrLf)
 
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
 
		
		Set colGroups = GetObject("WinNT://" & strComputer & "")
		colGroups.Filter = Array("group")
		
		For Each objGroup In colGroups
    			Wscript.Echo objGroup.Name
    			WriteLog.WriteLine strComputer & "," & objGroup.Name	 
    			For Each objUser in objGroup.Members
				strMembers = Replace(Replace(objUser.AdsPath, "WinNT://", ""), "/", "\")
        			Wscript.Echo vbTab & objUser.Name
        			WriteLog.WriteLine "," & "," & strMembers
    			Next
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
 
 
 
Else
WScript.Echo "Group Entered: " & strGroup
 
 
arrComputers = Split(strText, vbCrLf)
 
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
        On Error Resume Next
		Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup)
		If Err.Number <> 0 Then
		Err.Clear
		WScript.Echo "Error Connect " & strGroup & " On " & strComputer
		End if
		WScript.Echo  strComputer & ": Members of " & objGroup.Name & " group:"
 
		For Each objMember in objGroup.Members
 
			Dim strMembers
			strMembers = Replace(Replace(objMember.AdsPath, "WinNT://", ""), "/", "\")
			WScript.Echo strComputer & ": " & strMembers
			WriteLog.WriteLine objGroup.Name & "," & strComputer & "," & strMembers
 
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
End If
 
 
 
 
 
 
 
 
 
 
 
Function isAlive(strComputer)
	isAlive = False
	Set ping = GetObject("winmgmts:").ExecQuery("select * from Win32_PingStatus where Address = '" & strComputer & "'")
	
	For Each png IN ping
		if png.StatusCode = 0 Then isAlive = True
	Next
End Function

Open in new window

0
 

Author Comment

by:neoptoent
ID: 24218166
hi,
Yeah I would like the option to scan either a txt or AD
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24233529
sorry for the delay ...  a lot of work :-)

every time you want to run the script against ou just run from command line:

yourscript OuName

example:

ListMember.vbs Sales
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24233532
forgot the script :_0
' ======================================================================================
' servers.txt 			= Enter server name one per line
' localgroupoutput.csv 		= Log files will be created and writing in this file.
' =====================================================================================
 
'Option Explicit
intSize = 0 
'Dim strGroup, ObjFSO, ObjTextFile, strText, arrComputers, strComputer, ping, png, status, objGroup, objMember
 
Dim strPath, strCommand, objShell
 
 
If WScript.Arguments.Count = 1 then 
strArgument = WScript.Arguments.Item(0)
End if
 
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName & " " & strArgument
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If
 
 
Const HostNameFile = "c:\servers.txt"
Const LogFile = "c:\localgroupoutput.csv"
 
 
strGroup = InputBox("Type Server Local Group name you want see members OR type * for all local groups","LOCAL GROUP NAME","Administrators", 100, 100)
 
 
Dim FSO, WriteLog
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WriteLog = FSO.OpenTextFile(LogFile, 8, True)
WriteLog.WriteLine vbNewLine & "Script started @ " & Now()
 
 
Const ForReading = 1
 
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile(HostNameFile, ForReading)
 
strText = objTextFile.ReadAll
objTextFile.Close
 
 
 
If strGroup = "" Then
	WScript.Echo "Script Cancelled"
	WScript.Quit()
elseif strGroup = "*" then
	WScript.Echo "Search All local groups"
 
 
 
If WScript.Arguments.Count = 1 then 
strOu = WScript.Arguments.Item(0)
Set objRootDSE = GetObject("LDAP://rootDSE")
Set colItems = GetObject("LDAP://ou=" & strOu & "," & objRootDSE.Get("defaultNamingContext"))
colItems.Filter = Array("Computer")
For Each objItem in colItems
ReDim Preserve arrComputers(intSize)
arrComputers (intSize) = objitem.CN
intSize = intSize + 1
Next 
Else
arrComputers = Split(strText, vbCrLf)
End if
 
     
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
 
		
		Set colGroups = GetObject("WinNT://" & strComputer & "")
		colGroups.Filter = Array("group")
		
		For Each objGroup In colGroups
    			Wscript.Echo objGroup.Name
    			WriteLog.WriteLine strComputer & "," & objGroup.Name	 
    			For Each objUser in objGroup.Members
				strMembers = Replace(Replace(objUser.AdsPath, "WinNT://", ""), "/", "\")
        			Wscript.Echo vbTab & objUser.Name
        			WriteLog.WriteLine "," & "," & strMembers
    			Next
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
 
 
 
Else
WScript.Echo "Group Entered: " & strGroup
If WScript.Arguments.Count = 1 then 
strOu = WScript.Arguments.Item(0)
Set objRootDSE = GetObject("LDAP://rootDSE")
Set colItems = GetObject("LDAP://ou=" & strOu & "," & objRootDSE.Get("defaultNamingContext"))
colItems.Filter = Array("Computer")
For Each objItem in colItems
ReDim Preserve arrComputers(intSize)
arrComputers (intSize) = objitem.CN
intSize = intSize + 1
Next 
Else
arrComputers = Split(strText, vbCrLf)
End if 
 
 
For Each strComputer in arrComputers
 
Status = isAlive(strComputer)
 
	If Status = True Then
        On Error Resume Next
		Set objGroup = GetObject("WinNT://" & strComputer & "/" & strGroup)
		If Err.Number <> 0 Then
		Err.Clear
		WScript.Echo "Error Connect " & strGroup & " On " & strComputer
		End if
		WScript.Echo  strComputer & ": Members of " & objGroup.Name & " group:"
 
		For Each objMember in objGroup.Members
 
			Dim strMembers
			strMembers = Replace(Replace(objMember.AdsPath, "WinNT://", ""), "/", "\")
			WScript.Echo strComputer & ": " & strMembers
			WriteLog.WriteLine objGroup.Name & "," & strComputer & "," & strMembers
 
		Next
 
	Else
		WScript.Echo strComputer & ": Unable to ping "
        	WriteLog.WriteLine "," & strComputer & "," & "Unable to ping"
	End if
	
Next
 
	WriteLog.WriteLine vbNewLine & "Script ended @ " & Now()
End If
 
 
 
 
 
 
 
 
 
 
 
Function isAlive(strComputer)
	isAlive = False
	Set ping = GetObject("winmgmts:").ExecQuery("select * from Win32_PingStatus where Address = '" & strComputer & "'")
	
	For Each png IN ping
		if png.StatusCode = 0 Then isAlive = True
	Next
End Function

Open in new window

0
 

Author Comment

by:neoptoent
ID: 24242053
Hi
When I run the script from a command line and just type an OU name, it just scans the txt file
Any ideas?
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24242482
checking
0
 

Author Comment

by:neoptoent
ID: 24250809
find anything?
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24263972
sorry

it's a big problem to catch a script problem when it's working for you, i tested it and it's working

try again running

cscript scriptname.vbs ouname

be sure that what you have in the ou and the txt file is the same thing and you just thinking the script scanning the txt file and actually it's scanning the ou.
0
 

Author Comment

by:neoptoent
ID: 24273273
Do I need to use a special path to the OU or can I just type the ou name?
This is the error I receive
 
C:\scripts\Local Group Members.vbs(58, 3) (null): The network path was not found
0
 

Author Comment

by:neoptoent
ID: 24296100
Any ideas
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24297263
hey neoptoent
the script works for me but
give me a bit more time to "improve" the script

if you want quick assist press the "request for attention" button for other expert will review the question
0
 

Author Comment

by:neoptoent
ID: 24297692
I will wait
thanks so much
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24298542
one small thing do you know what is hta file ?
it's ok to write something liek this ?
0
 

Author Comment

by:neoptoent
ID: 24298978
never heard of hta
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24299115
hta - HTML Applications

"HTAs enable you to use Internet Explorer to provide a graphical user interface for your scripts"

you can read here:

http://www.microsoft.com/technet/scriptcenter/hubs/htas.mspx

what i'm asking if i can try write your code into hta (graphical user interface) ?

example of hta:
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Computer Info Tool (http://www.wisesoft.co.uk)</title>
<hta:application applicationname="WiseSoft Computer Info Tool" scroll="yes" singleinstance="no"
        windowstate="normal">
<style type="text/css">
body {
	margin:0px;
	background-color:#CBCBCB; /*#F6F6F6;*/
	font-family:Arial, Helvetica, sans-serif;
	font-size:14px;
	color:#595959;
}
h1 {
	font-size:24px;
	font-weight:bold;
	color:#FFFFFF;
	background-color:#2886C8;
	text-align:center;
	border-style:solid;
	border-width:thin;
	border-color:#C9E0F1;
	padding:5px;
}
h2 {
	font-size:18px;
	font-weight:bold;
}
h3 {
	font-size:16px;
	font-weight:bold;
}
a {
	color:#2886C8;
}
 
#Main {
	margin-left:20px;
	margin-right:20px;
}
#DisplayError {
	color:red;
	margin-left:20px;
	margin-right:20px;
}
#Footer {
	margin:20px;
	font-weight:bold;
	font-size:16px;
}
#Header {
	margin-left:20px;
	margin-right:20px;
	text-align:center;
}
#Tools {
	text-align:center;
	border-color:#595959;
	border-style:dotted;
	border-width:1px;
	background-color:#F6F6F6;
	margin-left:20px;
	margin-right:20px;
	margin-top:20px;
	padding:5px;
}
.Button { 
	color: #444444; 
} 
.InfoSectionHeader {
	font-size:20px;
	font-weight:bold;
	background-color:#595959;
	color:#FFFFFF;
	text-align:center;
	padding:5px;
	margin-top:0px;
	cursor:pointer;
}
.InfoSection {
	text-align:center;
	margin-bottom:10px;
	background-color:#FFFFFF;
	border-color:#595959;
	border-style:dotted;
	border-width:1px;
}
.InfoSectionBody {
	padding:10px;
}
.Link {
	text-decoration: underline;
	cursor:pointer;
	color:#2886C8;
}
.HeaderLink {
	text-decoration: underline;
	cursor:pointer;
	color:#FFFFFF;
}
.Table {
	/*width:90%;*/
    border: 2px solid;
	border-collapse: collapse;
	border-color: #696969;
}
.Table th {
	border: 1px dotted #111111;
	border-color: #787878;
	color: #FFFFFF;
	font: bold 12pt arial, sans-serif;
	background-color: #595959; /* #787878;*/
	text-align: left;
 padding=3px;
}
.Table td {
	border: 1px dotted #111111;
	border-color: #787878;
	font: bold 10pt arial, sans-serif;
	color: #787878;
 padding=5px;
}
 
</style>
</head>
<body>
<script language="VBScript">
	Option Explicit
	Const bytesToMB = 1048576
    Const bytesToGB = 1073741824
    Const bytesToTB = 1099511627776
    Const adVarChar = 200
    Const adDate = 7
	Const MaxCharacters = 255
	Const adFldIsNullable = 32
	Const adInteger = 3
	Const adBigInt = 20
    Const blnConfirmKillProcess = true
    
    Private objWMIService
    Private strComputer
    private intProcessTimerID
	
	' ***************************************
	' Open Windows explorer to a given path
	' Used when clicking a link in the "Shares" section
	' ***************************************
	Sub OpenUNC(ByVal strPath)
		
		Dim objShell
			
		Set objShell = CreateObject("Wscript.Shell")
		strPath = "explorer.exe /e," & strPath
		objShell.Run strPath
 
	End Sub
	
	' ***************************************
	' Reboot computer
	' ***************************************
	sub RebootComputer()
		Dim objItem, colItems
		strComputer = CurrentComputer.InnerHTML
		if MsgBox("Are you sure you want to reboot '" & strComputer & "'?",vbYesNo+vbExclamation,"Confirm Reboot") = vbYes then
			Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
			For Each objItem in colItems
				objItem.Reboot()
			Next
			msgbox "Computer '" & strComputer & "' has been rebooted",vbOKOnly+vbInformation
		end if
 
	end sub
	
	' ***************************************
	' Shutdown computer
	' ***************************************
	sub ShutDownComputer()
		Dim objItem, colItems
		strComputer = CurrentComputer.InnerHTML
		if MsgBox("Are you sure you want to shutdown '" & strComputer & "'?",vbYesNo+vbExclamation,"Confirm Shutdown") = vbYes then
			Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
			For Each objItem in colItems
				objItem.Win32Shutdown(1)
			Next
			msgbox "Computer '" & strComputer & "' has been shutdown",vbOKOnly+vbInformation
		end if
 
	end sub
	
	' ***************************************
	' Kills the specified process
	' Called when "Kill Process" link is clicked in the Running Processes section
	' ***************************************
	Sub KillProcess(ByVal intProcessID, ByVal strName)
		Dim objItem, colItems
		strComputer = CurrentComputer.InnerHTML
		if blnConfirmKillProcess = True then
			if msgbox("Are you sure you want to kill the '" & strName & "' process on '" & strComputer & "'?",vbYesNo+vbExclamation,"Confirm Kill Process") = vbNo then
				exit sub
			end if
		end if
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
		Set colItems = objWMIService.ExecQuery("Select * from Win32_Process WHERE ProcessID = '" & _
											 intProcessID & "' AND Name = '" & strName & "'")
 
		For Each objItem In colItems
			objItem.Terminate()
		Next
		RefreshProcesses
	End Sub
	
	' ***************************************
	' Refreshes list of processes in the "Running Processes" section
	' ***************************************
	Sub RefreshProcesses
		strComputer = CurrentComputer.InnerHTML
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
		ProcessesData.InnerHTML = RunningProcesses_HTML
	End Sub
	
	' ***************************************
	' Enables/Disables the auto refresh feature in the "Running Processes" section
	' ***************************************
	sub SetProcessAutoRefresh
		dim intInterval
		' Get the refresh interval
		intInterval = ProcessAutoRefresh.Value
		' Remove the current auto-refresh
		window.clearInterval(intProcessTimerID)
		' Add an auto-refresh if specified
		if intInterval > 0 then
			intProcessTimerID = window.setInterval("RefreshProcesses", intInterval)
		end if
	end sub
	
	' ***************************************
	' Stores the sort value for "Running Processes" section in a hidden div
	' and refreshes the processes list with the new sort value
	' ***************************************
	Sub SortProcesses(byval strSort)
		' If sort link is clicked twice on the same column, sort descending
		if ProcessSort.InnerHTML = strSort then
			ProcessSort.InnerHTML = strSort & " DESC"
		else
			ProcessSort.InnerHTML = strSort
		end if
		RefreshProcesses()
	End Sub
	
	' ***************************************
	' Map as network drive on this computer to a share on another computer
	' Called from the "Shares" section. User is prompted for a drive letter
	' ***************************************
	Sub MapDrive(ByVal strPath)
		Dim objNetwork
		Dim strDrive
		strDrive = InputBox("Enter drive letter:","Drive Letter","Z")
		If strDrive <> "" Then
			strDrive = Left(strDrive,1) & ":"
		
			Set objNetwork = CreateObject("WScript.Network")
			objNetwork.MapNetworkDrive strDrive,strPath
		End If
	End Sub
	
	' ***************************************
	' Stores the sort value for "Running Processes" section in a hidden div
	' ***************************************
	Sub MapPrinter(ByVal strPath)
		Dim objNetwork
		Set objNetwork = createobject("Wscript.Network")
		objNetwork.AddWindowsPrinterConnection(strPath)
		If MsgBox("Make Printer Default?",vbYesNo+vbQuestion,"Default Printer") = vbYes Then
			objNetwork.SetDefaultPrinter strPath
		End If
	End Sub
	
	' ***************************************
	' Replace special HTML characters
	' ***************************************
	Function HTMLEncode(strValue)
		HTMLEncode= REplace(Replace(strValue,"<","<"),">",">")
	End Function
	
	' ***************************************
	' Convert Bytes to MB,GB or TB as appropriate
	' ***************************************
    function ConvertToDiskUnit(ByVal value) 
        IF (value/bytesToTb) > 1 Then
            ConvertToDiskUnit = round(value / bytesToTB,1) & " TB"
        ELSEIF (value/bytesToGb) > 1 Then
            ConvertToDiskUnit = round(value / bytesToGB,1) & " GB"
        Else
            ConvertToDiskUnit = round(value / bytesToMB,1) & " MB"
        END If
    end Function
    
    	' ***************************************
	' Convert integer value to string
	' ***************************************
    Function GetMemoryType(ByVal intType)
       	Dim strType
    	Select case intType
    	Case 0
 			strType = "Unknown"
 		Case 1
 			strType = "Other"
 		Case 2
 			strType = "DRAM"
 		Case 3
 			strType = "Synchronous DRAM"
		Case 4
			strType = "Cache DRAM"
		Case 5
			strType = "EDO" 
		Case 6
		 	strType = "EDRAM" 
		Case 7
		 	strType = "VRAM"
		Case 8
		 	strType = "SRAM"
		Case 9
		  	strType = "RAM"
		Case 10
		 	strType = "ROM"
		Case 11
			strType = " Flash"
		Case 12
			strType = "EEPROM"
		Case 13
 			strType = "FEPROM"
		Case 14
		 	strType = " EPROM"
		Case 15
		 	strType = " CDRAM"
		Case 16
		  	strType = "3DRAM"
		Case 17
		 	strType = " SDRAM"
		Case 18
		 	strType = " SGRAM"
		Case 19
		 	strType = " RDRAM"
		Case 20
		 	strType = " DDR"
		Case 21
		 	strType = " DDR-2"
		Case Else
		 	strType = "Unknown"
		End Select
		GetMemoryType=strType
    End Function
    
    ' ***************************************
	' Convert Integer value to string
	' ***************************************
    Function GetMemoryFormFactor(ByVal intFormFactor)
    	Dim strFormFactor
    	Select Case intFormFactor
    	Case 0
			strFormFactor = "Unknown"
		Case 1
			strFormFactor = "Other"
		Case 2
			strFormFactor = "SIP"
		Case 3
			strFormFactor = "DIP"
		Case 4
			strFormFactor = "ZIP"
		Case 5
			strFormFactor = "SOJ"
		Case 6
			strFormFactor = "Proprietary"
		Case 7
			strFormFactor = "SIMM"
		Case 8
			strFormFactor = "DIMM"
		Case 9
			strFormFactor = "TSOP"
		Case 10
			strFormFactor = "PGA"
		Case 11
			strFormFactor = "RIMM"
		Case 12
			strFormFactor = "SODIMM"
		Case 13
			strFormFactor = "SRIMM"
		Case 14
			strFormFactor = "SMD"
		Case 15
			strFormFactor = "SSMP"
		Case 16
			strFormFactor = "QFP"
		Case 17
			strFormFactor = "TQFP"
		Case 18
			strFormFactor = "SOIC"
		Case 19
			strFormFactor = "LCC"
		Case 20
			strFormFactor = "PLCC"
		Case 21
			strFormFactor = "BGA"
		Case 22
			strFormFactor = "FPBGA"
		Case 23
			strFormFactor = "LGA"
		case Else
			strFormFactor = "Unknown"
		End Select
		GetMemoryFormFactor=strFormFactor
    End Function
    
   	' ***************************************
	' Convert date string to a more readable format
	' ***************************************
    Function FormatDate(ByVal strValue)
    	Dim strDate
    	If ISNULL(strValue) Or strValue = "" Then
    		strDate = ""
    	Else
    		strDate = Left(strValue,4) & "-" & MID(strValue,5,2) & "-" & MID(strValue,7,2) & " " & _
    				Mid(strValue,9,2) & ":" &  Mid(strValue,11,2)
    	End If
    	FormatDate = strDate
    End Function
    
	' ***************************************
	' Clear existing report data
	' ***************************************
	Sub Reset
		ProcessAutoRefresh.Value="0"
		window.clearInterval(intProcessTimerID)
		Main.Style.Display = "none"
		Tools.Style.Display = "none"
		LogicalDisk.InnerHTML=""
		PhysicalDisk.InnerHTML=""
		Processor.InnerHTML =""
		Memory.InnerHTML = ""
		OS.InnerHTML =""
		Shares.InnerHTML=""
		DisplayError.InnerHTML=""
	End Sub
	
	' ***************************************
	' Main procedure used to generate report
	' Calls other procedures that generate the HTML for each section
	' ***************************************
	Sub GenerateReport
		Reset()
		strComputer = txtComputer.Value
		if strComputer = "" Then 
			Dim objNetwork
			set objNetwork = createobject("wscript.network")
			strComputer =  objNetwork.ComputerName
			txtComputer.Value = strComputer
		End If
		CurrentComputer.InnerHTML = strComputer
		
		On Error Resume Next
		Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
		If Err.Number <> 0 Then
			On Error GoTo 0
			DisplayError.InnerHTML = "Error connecting to '" & strComputer & "'"
			Err.Clear
			Exit Sub
		End If
		On Error GoTo 0
		Main.Style.Display = ""
		Tools.Style.Display = ""
	
		ProcessesData.InnerHTML = RunningProcesses_HTML
		LogicalDisk.InnerHTML = LogicalDisk_HTML
		PhysicalDisk.InnerHTML = PhysicalDisk_HTML
		Processor.InnerHTML = Processor_HTML
		Memory.InnerHTML = Memory_HTML
		OS.InnerHTML = OS_HTML
		Shares.InnerHTML = Shares_HTML
	
	End Sub
	
	' ***************************************
	' Gets a list of running processes and returns HTML for the "Running Processes" section
	' ***************************************
	Function RunningProcesses_HTML
		Dim row,strHTML,strFilter
		Dim DataList,colItems,objItem,strUser,strDomain
		Dim strWMIQuery
		strFilter = txtProcessFilter.Value
		
		' Recordset is used to sort data from WMI
		Set DataList = CreateObject("ADOR.Recordset")
		DataList.Fields.Append "Name", adVarChar, MaxCharacters, adFldIsNullable
		DataList.Fields.Append "WorkingSet", adInteger, adFldIsNullable
		DataList.Fields.Append "CreationDate",adVarChar, MaxCharacters, adFldIsNullable
		DataList.Fields.Append "Description",adVarChar,MaxCharacters, adFldIsNullable
		DataList.Fields.Append "ProcessID",adInteger, adFldIsNullable
		DataList.Fields.Append "CPUTime",adInteger, adFldIsNullable
		DataList.Fields.Append "Caption",adVarChar,MaxCharacters, adFldIsNullable
		DataList.Fields.Append "Owner",adVarChar,MaxCharacters, adFldIsNullable
		DataList.Fields.Append "Path",adVarChar,MaxCharacters, adFldIsNullable
		DataList.Open
 
		strWMIQuery = "Select * From Win32_Process"
		' Add filter if required
		if strFilter <> "" then
			strWMIQuery = strWMIQuery & " WHERE Name LIKE '%" & strFilter & "%'"
		end if
		
		Set colItems = objWMIService.ExecQuery(strWMIQuery)
 
		' Load WMI data into recordset
		For Each objItem in colItems
			Dim strOwner
    		DataList.AddNew
    		on error resume next
    		DataList("Name") = HTMLEncode(objItem.Name)
    		DataList("WorkingSet") = objItem.WorkingSetSize
    		DataList("CreationDate") = objItem.CreationDate
    		DataList("Description") = HTMLEncode(objItem.Description)
    		DataList("ProcessID") = objItem.ProcessID
    		DataList("Caption") = objItem.Caption
    		DataList("CPUTime") = (CSng(objItem.KernelModeTime) + CSng(objItem.UserModeTime)) / 10000000
    		If objItem.GetOwner (strUser, strDomain) = 0 Then
				strOwner = strDomain & "\" & strUser
			End If
			DataList("Owner") = strOwner
			on error goto 0
    		DataList.Update
		Next
		' Sort recordset
		DataList.Sort = ProcessSort.InnerHTML
		' Check if recordset is not empty
		If DataList.BOF = FALSE then
			DataList.MoveFirst
			' Generate HTML table report with running processes
			strHTML = strHTML & "<table class=""Table"">"
			strHTML = strHTML &  "<tr><th><span onclick=""SortProcesses('Name')"" class=""HeaderLink"">Name</span></th>" & _
						"<th><span onclick=""SortProcesses('CreationDate')"" class=""HeaderLink"">Creation Date</span></th>" & _
						"<th><span onclick=""SortProcesses('Owner')"" class=""HeaderLink"">Owner</span></th>" & _
						"<th><span onclick=""SortProcesses('WorkingSet')"" class=""HeaderLink"">Working Set</span></th>" & _
						"<th><span onclick=""SortProcesses('CPUTime')"" class=""HeaderLink"">Total CPU Time(s)</span></th>" & _
						"<th> </th></tr>"
						
			Do Until DataList.EOF
				Dim strCaption,strCreationDate,strPath,intProcessID,strDescription
				Dim strWorkingSet
								
				strHTML = strHTML & "<tr>" & _
									"<td><div title=""" & DataList("Path") & """>" & DataList("Name") & "</div></td>" & _
									"<td>" & FormatDate(DataList("CreationDate")) & "</td>" & _
									"<td>" & DataList("Owner") & "</td>" & _
									"<td>" & ConvertToDiskUnit(DataList("WorkingSet")) & "</td>" & _
									"<td>" & DataList("CPUTime")  & "</td>" & _
									"<td><span onclick=""KillProcess '" & DataList("ProcessID") & "','" & DataList("Name") & "'"" class=""Link"">Kill Process</span></td>" & _
									"</tr>"
				DataList.MoveNext
			Loop
			strHTML = strHTML & "</table>"
		end if
		DataList.Close
		strHTML = strHTML & "<br>Last Refresh:" & Now()
		
		RunningProcesses_HTML=strHTML
	End Function
	
	' ***************************************
	' Gets a list of shared folders and shared printers and
	' returns HTML for the "Shares" section
	' *************************************** 
    Function Shares_HTML
    	Dim objItem, colItems
		Dim strHTML
		
		' Query to return shared folders
		Set colItems = objWMIService.ExecQuery("Select * from Win32_Share WHERE Type = 2147483648 OR Type = 0")
 
		strHTML = strHTML & "<table><tr><td style=""vertical-align:top"">"
		strHTML = strHTML & "<table class=""Table""><tr><th colspan=""2"">Folder Shares</th></tr>"
		For Each objItem In colItems
			Dim strShare 
			strShare = HTMLEncode(objItem.Name)
			strHTML = strHTML & "<tr><td><span class=""Link"" onclick=""OpenUNC('\\" & strComputer & "\" & strShare & "')"">" & strShare & "</span></td>"
			strHTML = strHTML &	"<td><input class=""Button"" type=""submit"" onclick=""MapDrive('\\" & strComputer & "\" & strShare & "')"" value=""Map Drive""></input></td></tr>"
		Next
		strHTML = strHTML & "</table></td>"
		
		' Query to return shared printers
		Set colItems = objWMIService.ExecQuery("Select * from Win32_Share WHERE Type = 2147483649 OR Type = 1")
		
		strHTML = strHTML & "<td style=""vertical-align:top"">"
		strHTML = strHTML & "<table class=""Table""><tr><th colspan=""2"">Printer Shares</th></tr>"
		For Each objItem In colItems
			Dim strPrinterShare 
			strPrinterShare = HTMLEncode(objItem.Name)
			strHTML = strHTML & "<tr><td><span class=""Link"" onclick=""OpenUNC('\\" & strComputer & "\" & strPrinterShare & "')"">" & strPrinterShare & "</span></td>"
			strHTML = strHTML &	"<td><input class=""Button"" type=""submit"" onclick=""MapPrinter('\\" & strComputer & "\" & strPrinterShare & "')"" value=""Connect Printer""></input></td></tr>"
		Next
		strHTML = strHTML & "</table></td></table>"
 
		Shares_HTML = strHTML 
    End Function
    
    ' ***************************************
	' Gets computer system info to be included in the "OS / General" section
	' *************************************** 
    Sub GetComputerSystemInfo(BYRef strDNSHostName,ByRef strDomain,ByRef strDomainRole, _
    						ByRef strManufacturer,ByRef strModel,ByRef strUserName)
    	Dim objItem, colItems
		
		Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
		For Each objItem In colItems
			On Error Resume Next 
			strDNSHostName = HTMLEncode(objItem.DNSHostName)
			strDomain = HTMLEncode(objItem.Domain)
			strManufacturer = HTMLEncode(objItem.Manufacturer)
			strModel = HTMLEncode(objItem.Model)
			strUserName = HTMLEncode(objItem.UserName)
			On Error GoTo 0
			If strUserName = "" Then
				strUserName = "{not logged in}"
			End If
			Select Case objItem.DomainRole
				Case 0
				strDomainRole="Standalone Workstation"
				Case 1
				strDomainRole="Member Workstation"
				Case 2
				strDomainRole="Standalone Server"
				Case 3
				strDomainRole="Member Server"
				Case 4
				strDomainRole="Backup Domain Controller"
				Case 5
				strDomainRole="Primary Domain Controller"
				Case Else
				strDomainRole = "Unknown (" & strDomainRole & ")"
			End Select
		Next
    End Sub
    
    ' ***************************************
	' Returns a HTML report for the "Operating System/General" section
	' ***************************************  
    Function OS_HTML()
    
    	Dim objItem, colItems
		Dim strHTML
		Dim strDNSHostName,strDomain,strDomainRole,strManufacturer,strModel,strUserName
		GetComputerSystemInfo strDNSHostName,strDomain,strDomainRole,strManufacturer,strModel,strUserName
		
		Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
		
		strHTML = "<h3>Current User: " & strUserName & "</h3>"
		
		For Each objItem In colItems
			Dim strComputerRole
			Dim strCaption,strBuildNumber,strInstallDate,strBootDate
			Dim intServicePackMajor,intServicePackMinor,intTotalVisibleMemorySize
			Dim intFreePhysicalMemory,intTotalVirtualMemorySize,intFreeVirtualMemory
			On Error Resume Next
			strCaption = HTMLEncode(objItem.Caption)
			strBuildNumber = HTMLEncode(objItem.BuildNumber)
			intServicePackMajor = objItem.ServicePackMajorVersion
			intServicePackMinor = objItem.ServicePackMinorVersion
			intTotalVisibleMemorySize = objItem.TotalVisibleMemorySize
			intFreePhysicalMemory = objItem.FreePhysicalMemory
			intFreeVirtualMemory =  objItem.FreeVirtualMemory
			intTotalVirtualMemorySize = objItem.TotalVirtualMemorySize
			strInstallDate = FormatDate(objItem.InstallDate)
			strBootDate = FormatDate(objItem.LastBootUpTime)
			On Error GoTo 0
						
			strHTML = strHTML & "<table class=""Table"">" & _
					 	"<tr>" & _
					 	"<th>Operating System:</th><td>" & strCaption & "</td>" & _
					 	"<th>Build Number:</th><td>" & strBuildNumber & "</td>" & _
					 	"</tr><tr>" & _
					 	"<th>Service Pack:</th><td>" & intServicePackMajor & "." &  intServicePackMinor & "</td>" & _
					 	"<th>Role:</th><td>" & strDomainRole & "</td>" & _
					 	"</tr><tr>" & _
					 	"<th>DNS Host Name:</th><td>" & strDNSHostName & "</td>" & _
					 	"<th>Domain:</th><td>" & strDomain & "</td>" & _
					 	"</tr><tr>" & _
					 	"<th>Manufacturer:</th><td>" & strManufacturer & "</td>" & _
					 	"<th>Model:</th><td>" & strModel & "</td>" & _
					 	"</tr><tr>" & _
					 	"<th>Total Physical Memory:</th><td>" & intTotalVisibleMemorySize & "KB</td>" & _
					 	"<th>Free Physical Memory:</th><td>" & intFreePhysicalMemory  & "KB</td>" & _
					 	"</tr><tr>" & _
					 	"<th>Total Virtual Memory:</th><td>" & intTotalVirtualMemorySize & "KB</td>" & _
					 	"<th>Free Virtual Memory:</th><td>" & intFreeVirtualMemory & "KB</td>" & _
					 	"</tr><tr>" & _
					 	"<th>Install Date:</th><td>" & strInstallDate & "</td>" & _
					 	"<th>Last BootUp Time:</th><td>" & strBootDate & "</td>" & _
					 	"</tr>" & _
					 	"</table>"
					 	
			Exit For
		Next
		
		OS_HTML = strHTML
		
    End Function
    
	' ***************************************
	' Get the number of memory slots and memory arrays
	' for the memory section
	' ***************************************
    Function GetMemoryArrayInfo(ByRef intSlots,ByRef intArrays)
    	Dim objItem, colItems
		intSlots = 0
		intArrays = 0
    	Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemoryArray WHERE Use=3")
    	
    	For Each objItem In colItems
    		intSlots = intSlots + objItem.MemoryDevices
    		intArrays = intArrays + 1
    	Next
    End Function
    	
	' ***************************************
	' Returns a HTML report for the "Memory" section
	' ***************************************  
	Function Memory_HTML()
    	Dim objItem, colItems
		Dim strHTML
		
		Set colItems = objWMIService.ExecQuery("Select * from Win32_PhysicalMemory")
 
		strHTML = "<table class=""Table"">" & _
				"<tr>" & _
				"<th>BankLabel</th>" & _
				"<th>Capacity</th>" & _
				"<th>Caption</th>" & _
				"<th>Description</th>" & _
				"<th>DeviceLocator </th>" & _
				"<th>Manufacturer</th>" & _
				"<th>Memory Type</th>" & _
				"<th>Form Factor</th>" & _
				"<th>Model</th>" & _
				"<th>Speed</th>" & _
				"</tr>"
 
		For Each objItem In colItems
			Dim strBankLabel,strCaption,strDescription,strDeviceLocator
			Dim strManufacturer,strMemoryType,strFormFactor,strModel
			Dim strCapacity,intSpeed
			On Error Resume Next
			strBankLabel = HTMLEncode(objItem.BankLabel) 
			strCapacity = ConvertToDiskUnit(objItem.Capacity)
			strCaption = HTMLEncode(objItem.Caption)
			strDescription = HTMLEncode(objItem.Description)
			strDeviceLocator = HTMLEncode(objItem.DeviceLocator)
			strManufacturer = HTMLEncode(objItem.Manufacturer)
			strMemoryType = GetMemoryType(objItem.MemoryType)
			strFormFactor = GetMemoryFormFactor(objItem.FormFactor)
			strModel = HTMLEncode(objItem.Model)
			intSpeed = objItem.Speed
			On Error GoTo 0
		
			strHTML = strHTML & "<tr><td>" & strBankLabel & "</td>" & _
								"<td>" & strCapacity & "</td>" & _
								"<td>" & strCaption & "</td>" & _
								"<td>" & strDescription & "</td>" & _
								"<td>" & strDeviceLocator & "</td>" & _
								"<td>" & strManufacturer & "</td>" & _
								"<td>" & strMemoryType & "</td>" & _
								"<td>" & strFormFactor & "</td>" & _
								"<td>" & strModel & "</td>" & _
								"<td>" & intSpeed & "</td>" & _
								"</tr>"
		Next
		strHTML = strHTML & "</table>"
		
		Dim intSlots,intArrays
		GetMemoryArrayInfo intSlots,intArrays
		
		strHTML = strHTML & "Total Memory Slots:" & intSlots & ", Memory Arrays:" & intArrays
		
		Memory_HTML=strHTML
    End Function
    
     ' ***************************************
	' Returns a HTML report for the "Processor" section
	' ***************************************  
    Function Processor_HTML()
    	Dim objItem, colItems
		Dim strHTML
		
		Set colItems = objWMIService.ExecQuery("Select * from Win32_Processor")
 
		strHTML = "<table class=""Table"">" & _
				"<tr>" & _
				"<th>Name</th>" & _
				"<th>Manufacturer</th>" & _
				"<th>Description</th>" & _
				"<th>Address Width</th>" & _
				"<th>Current Clock Speed</th>" & _
				"<th>Data Width</th>" & _
				"<th>Device ID</th>" & _
				"<th>Ext Clock</th>" & _
				"<th>L2 Cache</th>" & _
				"<th>Max Clock Speed</th>" & _
				"<th>#Cores</th>" & _
				"<th>#Logical Processors</th>" & _
				"</tr>"
 
		For Each objItem in colItems
			Dim strName,strManufacturer,strDescription,strDeviceID
			Dim intAddressWidth,intCurrentClockSpeed,intDataWidth,intExtClock
			Dim intL2CacheSize,intMaxClockSpeed, intNumberOfCores,intNumberOfLogicalProcessors
			On Error Resume Next
			strName = HTMLEncode(objItem.Name)
			strManufacturer = HTMLEncode(objItem.Manufacturer)
			strDescription = HTMLEncode(objItem.Description)
			intAddressWidth = objItem.AddressWidth
			intCurrentClockSpeed = objItem.CurrentClockSpeed
			intDataWidth = objItem.DataWidth
			strDeviceID = HTMLEncode(objItem.DeviceID)
			intExtClock = objItem.ExtClock
			intL2CacheSize = objItem.L2CacheSize
			intMaxClockSpeed = objItem.MaxClockSpeed
			intNumberOfCores  = objItem.NumberOfCores
			intNumberOfLogicalProcessors= objItem.NumberOfLogicalProcessors
			On Error GoTo 0
			strHTML = strHTML & "<tr><td>" & strName & "</td>" & _
								"<td>" & strManufacturer & "</td>" & _
								"<td>" & strDescription & "</td>" & _
								"<td>" & intAddressWidth & "</td>" & _
								"<td>" & intCurrentClockSpeed & "</td>" & _
								"<td>" & intDataWidth & "</td>" & _
								"<td>" & strDeviceID  & "</td>" & _
								"<td>" & intExtClock & "</td>" & _
								"<td>" & intL2CacheSize & "</td>" & _
								"<td>" & intMaxClockSpeed & "</td>" & _
								"<td>" & intNumberOfCores & "</td>" & _
								"<td>" & intNumberOfLogicalProcessors & "</td>" & _
								"</tr>"
		Next
		strHTML = strHTML & "</table>"
		
		Processor_HTML=strHTML
    End Function
    
    ' ***************************************
	' Returns a HTML report for the "Physical Disk" section
	' ***************************************  
    Function PhysicalDisk_HTML()
    	Dim objItem, colItems
		Dim strHTML
		
		Set colItems = objWMIService.ExecQuery("Select * from Win32_DiskDrive")
 
		strHTML = "<table class=""Table""><tr><th>Caption</th><th>Manufacturer</th>" & _
				"<th>Model</th><th>Size</th><th>Serial</th><th>Media Type</th><th>#Partitions</th><th>DeviceID</th><th>Firmware</th><th>Interface</th></tr>"
 
		For Each objItem in colItems
			Dim intSize,intPartitions
			Dim strSize,strCaption,strManufacturer,strModel,strMediaType
			Dim strDeviceID,strFirmwareRevision,strInterfaceType, strSerialNumber
			intSize = objItem.Size
			If IsNumeric(intSize) = False Then
				intSize = 0
			End If
			On Error Resume Next
			strCaption= HTMLEncode(objItem.Caption) 
			strSize = ConvertToDiskUnit(intSize)
			strSerialNumber = HTMLEncode(objItem.SerialNumber)
			strMediaType = HTMLEncode(objItem.MediaType)
			intPartitions = HTMLEncode(objItem.Partitions)
			strDeviceID = HTMLEncode(objItem.DeviceID)
			strFirmwareRevision = HTMLEncode(objItem.FirmwareRevision)
			strInterfaceType = HTMLEncode(objItem.InterfaceType)
			strModel = HTMLEncode(objItem.Model)
			strManufacturer = HTMLEncode(objItem.Manufacturer)
			On Error GoTo 0
		
			strHTML = strHTML & "<tr><td>" & strCaption & "</td>" & _
								"<td>" & strManufacturer & "</td>" & _
								"<td>" & strModel & "</td>" & _
								"<td>" & strSize & "</td>" & _
								"<td>" & strSerialNumber & "</td>" & _
								"<td>" & strMediaType & "</td>" & _
								"<td>" & intPartitions & "</td>" & _
								"<td>" & strDeviceID & "</td>" & _
								"<td>" & strFirmwareRevision & "</td>" & _
								"<td>" & strInterfaceType & "</td>" & _
								"</tr>"
		Next
		strHTML = strHTML & "</table>"
		
		PhysicalDisk_HTML=strHTML
    	
    End Function
 
	 ' ***************************************
	' Returns a HTML report for the "Logical Disk" section
	' ***************************************  
	Function LogicalDisk_HTML()
 
		Dim objItem, colItems
		Dim strDriveType, strDiskSize, strHTML
		
		Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType = 3")
 
		strHTML = "<table class=""Table""><tr><th>Drive</th><th>Name</th><th>File System</th><th>Size</th><th>Used</th><th>Free</th><th>Free(%)</th></tr>"
 
		For Each objItem in colItems
	
			Dim pctFreeSpace,strFreeSpace,strusedSpace,strName,strFileSystem,strVolumeName
			Dim intFreeSpace, intSize
			On Error Resume Next
			intFreeSpace = objItem.FreeSpace
			intSize = objItem.Size
			If ISNUMERIC(intFreeSpace) = False Then
				intFreeSpace=0
			End If
			If IsNumeric(intSize) = False Then
				intSize = 0
			End If
			If objItem.FreeSpace > 0 Then
				pctFreeSpace = round(((intFreeSpace / intSize) * 100),0)
			Else
				pctFreeSpace=0
			End If
			strDiskSize = ConvertToDiskUnit(intSize) 
			strFreeSpace = ConvertToDiskUnit(intFreeSpace)
			strUsedSpace = ConvertToDiskUnit(intSize-intFreeSpace)
			strName = HTMLEncode(objItem.Name)
			strVolumeName = HTMLEncode(objItem.VolumeName)
			strFileSystem = HTMLEncode(objItem.FileSystem)
			On Error GoTo 0
 
			dim strChart 
			strChart = "<div width=100%;""><span style=""padding:0px;margin:0px;width=" & 100-pctFreeSpace & _
				"%;background-color:blue;""> </span><span style=""padding:0px;margin:0px;width=" & pctFreeSpace & _
				"%;background-color:#FF00FF;""> </span></div>"
 
			strHTML = strHTML & "<tr><td>" & strName & "</td><td>" & _
					strVolumeName & "</td><td>" & strFileSystem & "</td><td>" & _
					strDiskSize & "</td><td>" & strUsedSpace & "</td><td>" & _
					strFreeSpace & "</td><td>" &  pctFreeSpace & "%</td></tr>" & _
					"<tr><td colspan=""7"">" & strChart & "</td></tr>"
 
		Next
	
		strHTML = strHTML + "</table></br>"
 
		LogicalDisk_HTML = strHTML
	
	End Function
	
</script>
<script type="text/javascript">
	/* Toggle expand/collapse state for specified section */
	function toggleDisplay(obj) {
		var el = document.getElementById(obj);
		if ( el.style.display != 'none' ) {
			el.style.display = 'none';
		}
		else {
			el.style.display = '';
		}
	}
	/* Toggle expand/collapse state for all sections */
	function toggleAll() {
		var el = document.getElementById("OS");
		var display = ''
		if ( el.style.display != 'none' ) {
			display = 'none';
		}
		el.style.display = display;
		el = document.getElementById("Memory");
		el.style.display = display;
		el = document.getElementById("LogicalDisk");
		el.style.display = display;
		el = document.getElementById("PhysicalDisk");
		el.style.display = display;
		el = document.getElementById("Processor");
		el.style.display = display;
		el = document.getElementById("Shares");
		el.style.display = display;
		el = document.getElementById("Processes");
		el.style.display = display;
	}
 
</script>
<h1>Computer Info Tool</h1>
<div id="Header" style="padding-bottom:0px;margin-bottom:0px;">
  <span style="font-weight:bold;">Connect To Computer:<span><input id="txtComputer"></input>
  <input class="Button" style="font-weight:bold;" onClick="GenerateReport()" type="submit" value="Generate Report">
  </input>
 </div>
 <div id="Tools" style="display:none;margin-bottom:0px;">
   <span class="Link" onClick="RebootComputer">Reboot Computer</span> | 
   <span class="Link" onClick="ShutDownComputer">Shutdown Computer</span>
  </div>
 
<div id="Main" style="display:none;">
  <div id="CurrentComputer" style="display:none"></div>
  <div style="text-align:right;">
  <span class="Link" style="font-weight:bold;" onclick="javascript:toggleAll();">Expand/Collapse All</span>
  </div>
  <div class="InfoSection">
    <div onClick="javascript:toggleDisplay('OS');"  class="InfoSectionHeader">Operating System / General</div>
    <div id="OS" class="InfoSectionBody" ></div>
  </div>
  <div class="InfoSection">
    <div onClick="javascript:toggleDisplay('Processes');"  class="InfoSectionHeader">Running Processes</div>
    <div id="Processes" class="InfoSectionBody">
    	Auto Refresh Interval:<select id="ProcessAutoRefresh" onchange="SetProcessAutoRefresh">
		  <option value ="0">None</option>
		  <option value ="1000">1 second</option>
		  <option value ="2000">2 seconds</option>
		  <option value ="3000">3 seconds</option>
		  <option value ="5000">5 seconds</option>
		  <option value ="10000">10 seconds</option>
		  <option value ="20000">20 seconds</option>
		  <option value ="30000">30 seconds</option>
		  <option value ="60000">1 minute</option>
		</select>
		Filter (Optional):<input id="txtProcessFilter"></input>
		<br/><br/>
		<span onclick="RefreshProcesses()" style=""font-weight:bold"" class="Link">Refresh Processes</span>
		<br/><br/>
		
   		<div id="ProcessesData"></div>
    	</div>
    	<div id="ProcessSort" style="display:none">Name</div>
  </div>
  <div class="InfoSection">
    <div onClick="javascript:toggleDisplay('Memory');"  class="InfoSectionHeader">Memory</div>
    <div id="Memory" class="InfoSectionBody"></div>
  </div>
  <div class="InfoSection">
    <div onClick="javascript:toggleDisplay('LogicalDisk');"  class="InfoSectionHeader">Logical Disk</div>
    <div id="LogicalDisk" class="InfoSectionBody"></div>
  </div>
  <div class="InfoSection">
    <div onClick="javascript:toggleDisplay('PhysicalDisk');" class="InfoSectionHeader">Physical Disk</div>
    <div id="PhysicalDisk" class="InfoSectionBody"></div>
  </div>
  <div class="InfoSection">
    <div onClick="javascript:toggleDisplay('Processor');"  class="InfoSectionHeader">Processor</div>
    <div id="Processor" class="InfoSectionBody"></div>
  </div>
  <div class="InfoSection">
    <div onClick="javascript:toggleDisplay('Shares');"  class="InfoSectionHeader">Shares</div>
    <div id="Shares" class="InfoSectionBody"></div>
  </div>
</div>
<div id="DisplayError"></div>
<div id="Footer">
<hr/>
  <div style="float:left;">Version 1.0</div>
  <div style="float:right;">By David Wiseman<br />
   </div>
    <div style="clear:both;"></div>
    <div style="text-align:center;font-size:20px;font-weight:bold"><a href="http://www.wisesoft.co.uk">www.wisesoft.co.uk</a></div>
</div>
</body>
</html>

Open in new window

0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24299119
save as hta file extension  insted of vbs to vbscript
0
 

Author Comment

by:neoptoent
ID: 24299248
As long as I am able to export to a csv of sorts,
 absolutly
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24364138
hey sorry for the delay

save this file as hta (extension)
<html>
<head>
<title>Group Inventory</title>
<HTA:APPLICATION
  APPLICATIONNAME="Group Inventory"
  ID="MyHTMLapplication"
  VERSION="1.0"/>
</head>
 
<script language="VBScript">
 
Sub Window_OnLoad
  'This method will be called when the application loads
  'Add your code here
End Sub
 
Sub OnClickButtonGo
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomain = objRootDSE.Get("defaultNamingContext")
dataarea.innerhtml = ""
toexcel.disabled = true
If input.value = "txt" Then
oupath.value = ""
oupath.disabled = False
group.disabled = False
group.value = "Administrators"
oupath.value = "c:\list.txt"
ElseIf input.value = "ou" Then
oupath.value = ""
oupath.disabled = False
group.disabled = False
group.value = "Administrators"
oupath.value = "LDAP://ou=domain controllers," & strDomain
End if
End Sub
 
Sub choose
If input.value = "txt" Then
enumtxt
ElseIf input.value = "ou" Then
EnumCompsOU
End If
End sub
 
 
Sub enumtxt
toexcel.disabled = false
Set objfso = CreateObject("scripting.filesystemobject")
On Error Resume Next 
Set objlist = objfso.OpenTextFile(oupath.value,1)
If Err.Number <> 0 Then
Err.Clear
MsgBox "Error Reading From File"
On Error Goto 0
Else
On Error Goto 0
Do Until objlist.AtEndOfStream
strComputer = objlist.ReadLine
If isAlive(strComputer) = True Then
EnumGroup(strcomputer)
Else
dataarea.innerhtml = dataarea.innerhtml & "<BR>" & strComputer & " IS Not Reachable !" & "<BR><BR>"
End If
Loop
End if
End Sub
 
 
sub EnumCompsOU
toexcel.disabled = false
Const ADS_SCOPE_SUBTREE = 2
intSize = 0
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
 
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
 
objCommand.CommandText = "SELECT Name, distinguishedName FROM '" & oupath.value & "' WHERE objectCategory='computer'"  
 
Set objRecordSet = objCommand.Execute
 
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
        If isAlive(strComputer) = True Then
        EnumGroup(objRecordSet.Fields("Name").Value)
        Else
        dataarea.innerhtml = dataarea.innerhtml & "<BR>" & strComputer & " IS Not Reachable !" & "<BR><BR>"
        End if
    objRecordSet.MoveNext
Loop
end sub
 
 
Sub EnumGroup(strcomputer)
Set objNetwork = CreateObject("Wscript.Network")
On Error Resume next
Set objGroup = GetObject("WinNT://" & strComputer & "/" & group.value)
If Err.Number <> 0 Then
Err.Clear
MsgBox "Eror Reading From The Group " & group.value & " On " & strComputer
On Error Goto 0
Else
On Error Goto 0
dataarea.innerhtml = dataarea.innerhtml & "Members Of " & group.value & " Group In " & strcomputer & ":" & "<BR>" 
For Each objUser in objGroup.Members
        dataarea.innerhtml = dataarea.innerhtml & "<BR>" & objUser.Name
Next
dataarea.innerhtml = dataarea.innerhtml & "<BR><BR>"
End if
End sub 
 
Sub Buttontoexcel
Set objfso = CreateObject("scripting.filesystemobject")
strLog = InputBox("Enter The Path To Save The Csv File. e.g: c:\test\test.csv")
If strlog = "" Then
MsgBox "Nothing Entered"
else
Set objlog = objfso.CreateTextFile(strLog,True)
strText = Replace(dataarea.innerhtml,"<BR>",vbCrLf)
objlog.WriteLine strText
MsgBox "done, file saved on " & strLog
End if
End sub
  
Function isAlive(strComputer)
	isAlive = False
	Set ping = GetObject("winmgmts:").ExecQuery("select * from Win32_PingStatus where Address = '" & strComputer & "'")
	
	For Each png IN ping
		if png.StatusCode = 0 Then isAlive = True
	Next
End Function
 
</script>
 
 
<body bgcolor="white">
 
 
<select name="input" id="input" onchange="OnClickButtonGo">
  <option value=""></option>
  <option value="txt">txt</option>
  <option value="ou">ou</option>
</select>
<input type="text" name="Group" size="30" id="Group" disabled=true><BR>
<input type="text" name="OUPath" size="50" id="OUPath" disabled=true>
 
<input type="button" name="GO " id="GO " value="Run Forest " onclick="choose"><BR>
 
<BR>
<input type="button" name="toexcel" id="toexcel" value="Save To csv" onclick="Buttontoexcel" disabled =true><br><br>
<span id=DataArea></span>
</body>
</html>

Open in new window

0
 

Author Comment

by:neoptoent
ID: 24364833
Am I able to scan all AD just for windows servers?
0
 

Author Comment

by:neoptoent
ID: 24365200
When I put in an ou I get:
 
An error occured when trying the script
either BOF or EOF is trueor the current record has been deleted requested operation requires a current record
 
LDAP://OU=data warehouse,OU=55 west st,OU=Organization,DC=main,DC=shoes
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24367156
to query only windows servers 2003 change this line:

objCommand.CommandText = "SELECT Name, distinguishedName FROM '" & oupath.value & "' WHERE objectCategory='computer'"

to

objCommand.CommandText = "SELECT Name, distinguishedName FROM '" & oupath.value & "' WHERE objectClass='computer' " & _
        "and operatingSystemVersion = '5.2 (3790)'"  

about the ou it's need to be backwords example:
if i have a root ou name test1 and inside of him test2 the syntax will be :
LDAP://ou=test2,ou=test1,DC=domain,DC=com
0
 

Author Comment

by:neoptoent
ID: 24367437
right
i got this syntax from csvde

LDAP://OU=data warehouse,OU=55 west st,OU=Organization,DC=main,DC=shoes
Data warehouse is in the 55 west str which is in organization which is in the domain main.shoes
is that wrong?
0
 

Author Comment

by:neoptoent
ID: 24367764
ahh i was using user ou no wonder
it worked for a resource ou,
Whe it is unable to bring a resouce it shows a dialogue box.
It is possible to combine all the machines it failed to scan into one box, as opposed one box per machine?
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24368439
double post a bit confuse , does the script run's ok ?
is thsi what you asked for ?
0
 

Author Comment

by:neoptoent
ID: 24369325
The scan is working, I was using a wrong OU
1. if 5 machines in an ou out of 10 are offline, I will receive 5 popup boxes showing systems it could not resolve....Is it possible to just show all the machines in one box at the end?
2. If I close this thread and open another, could you
          A.  add an option with a check  box to scan all servers (2000 & 2003 server) in AD
          B. Add an option with a check box to scan all workstation in AD
          c. Add an option to scan both
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24372662
wich OS installed on your workstation ?
0
 

Author Comment

by:neoptoent
ID: 24374035
xp
 
0
 
LVL 14

Accepted Solution

by:
yehudaha earned 2000 total points
ID: 24374142
try this
<html>
<head>
<title>Group Inventory</title>
<HTA:APPLICATION
  APPLICATIONNAME="Group Inventory"
  ID="MyHTMLapplication"
  VERSION="1.0"/>
</head>
 
<script language="VBScript">
 
Sub Window_OnLoad
  'This method will be called when the application loads
  'Add your code here
End Sub
 
Sub OnClickButtonGo
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomain = objRootDSE.Get("defaultNamingContext")
dataarea.innerhtml = ""
toexcel.disabled = true
If input.value = "txt" Then
oupath.value = ""
UserOption(0).disabled = True
UserOption(1).disabled = True
UserOption(2).Disabled = true
oupath.disabled = False
group.disabled = False
group.value = "Administrators"
oupath.value = "c:\list.txt"
ElseIf input.value = "ou" Then
oupath.value = ""
UserOption(0).disabled = false
UserOption(1).disabled = false
UserOption(2).Disabled = false
oupath.disabled = False
group.disabled = False
group.value = "Administrators"
oupath.value = "LDAP://ou=domain controllers," & strDomain
End if
End Sub
 
Sub choose
If input.value = "txt" Then
enumtxt
ElseIf input.value = "ou" Then
EnumCompsOU
End If
End sub
 
 
Sub enumtxt
toexcel.disabled = false
Set objfso = CreateObject("scripting.filesystemobject")
On Error Resume Next 
Set objlist = objfso.OpenTextFile(oupath.value,1)
If Err.Number <> 0 Then
Err.Clear
MsgBox "Error Reading From File"
On Error Goto 0
Else
On Error Goto 0
Do Until objlist.AtEndOfStream
strComputer = objlist.ReadLine
If isAlive(strComputer) = True Then
EnumGroup(strcomputer)
Else
dataarea.innerhtml = dataarea.innerhtml & "<BR>" & strComputer & " IS Not Reachable !" & "<BR><BR>"
End If
Loop
End if
End Sub
 
 
sub EnumCompsOU
toexcel.disabled = false
Const ADS_SCOPE_SUBTREE = 2
intSize = 0
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
 
Set objCommand.ActiveConnection = objConnection
 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
 
If UserOption(0).Checked Then
objCommand.CommandText = "SELECT Name FROM '" & oupath.value & "' WHERE objectClass='computer' " & _
        "and operatingSystemVersion = '5.2 (3790)'" 
ElseIf UserOption(1).Checked Then
objCommand.CommandText = "SELECT Name FROM '" & oupath.value & "' WHERE objectClass='computer' " & _
        "and operatingSystemVersion = '5.1 (2600)'" 
ElseIf UserOption(2).Checked Then
objCommand.CommandText = "SELECT Name, distinguishedName FROM '" & oupath.value & "' WHERE objectCategory='computer'"  
End If
 
Set objRecordSet = objCommand.Execute
 
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
        strComputer = objRecordSet.Fields("Name").Value
        If isAlive(strComputer) = True Then
        EnumGroup(objRecordSet.Fields("Name").Value)
        Else
        dataarea.innerhtml = dataarea.innerhtml & "<BR>" & strComputer & " IS Not Reachable !" & "<BR><BR>"
        End if
    objRecordSet.MoveNext
Loop
end sub
 
 
Sub EnumGroup(strcomputer)
Set objNetwork = CreateObject("Wscript.Network")
On Error Resume next
Set objGroup = GetObject("WinNT://" & strComputer & "/" & group.value)
If Err.Number <> 0 Then
Err.Clear
MsgBox "Eror Reading From The Group " & group.value & " On " & strComputer
On Error Goto 0
Else
On Error Goto 0
dataarea.innerhtml = dataarea.innerhtml & "Members Of " & group.value & " Group In " & strcomputer & ":" & "<BR>" 
For Each objUser in objGroup.Members
        dataarea.innerhtml = dataarea.innerhtml & "<BR>" & objUser.Name
Next
dataarea.innerhtml = dataarea.innerhtml & "<BR><BR>"
End if
End sub 
 
Sub Buttontoexcel
Set objfso = CreateObject("scripting.filesystemobject")
strLog = InputBox("Enter The Path To Save The Csv File. e.g: c:\test\test.csv")
If strlog = "" Then
MsgBox "Nothing Entered"
else
Set objlog = objfso.CreateTextFile(strLog,True)
strText = Replace(dataarea.innerhtml,"<BR>",vbCrLf)
objlog.WriteLine strText
MsgBox "done, file saved on " & strLog
End if
End sub
  
Function isAlive(strComputer)
	isAlive = False
	Set ping = GetObject("winmgmts:").ExecQuery("select * from Win32_PingStatus where Address = '" & strComputer & "'")
	
	For Each png IN ping
		if png.StatusCode = 0 Then isAlive = True
	Next
End Function
 
</script>
 
 
<body bgcolor="white">
 
 
<select name="input" id="input" onchange="OnClickButtonGo">
  <option value=""></option>
  <option value="txt">txt</option>
  <option value="ou">ou</option>
</select>
<input type="text" name="Group" size="30" id="Group" disabled=true><BR>
<input type="text" name="OUPath" size="50" id="OUPath" disabled=true>
 
<input type="button" name="GO " id="GO " value="Run Forest " onclick="choose"><BR>
<input type="radio" name="UserOption" value="1">Servers<BR>
<input type="radio" name="UserOption" value="2">Workstations<BR>
<input type="radio" name="UserOption" value="3">All<BR>
 
<BR><BR>
<input type="button" name="toexcel" id="toexcel" value="Save To csv" onclick="Buttontoexcel" disabled =true><br><br>
<span id=DataArea></span>
 
</body>
</html>

Open in new window

0
 

Author Comment

by:neoptoent
ID: 24376642
do i still need to specify an ou?
 
 
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24378106
yes of curse, how the script will know what to scan ?

i just fixed what you asked for.
0
 

Author Comment

by:neoptoent
ID: 24378609
So if i wanted to scan my entire AD and not just one OU is that possible?
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24378729
i didn't notice you asked such thing, but i think you can remove the ou part and leave like this:

LDAP://dc=example,dc=com
0
 

Author Closing Comment

by:neoptoent
ID: 31573349
Great
0
 
LVL 14

Expert Comment

by:yehudaha
ID: 24381585
thanks
0

Featured Post

Simplify Active Directory Administration

Administration of Active Directory does not have to be hard.  Too often what should be a simple task is made more difficult than it needs to be.The solution?  Hyena from SystemTools Software.  With ease-of-use as well as powerful importing and bulk updating capabilities.

Question has a verified solution.

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

How to deal with a specific error when using the Enable-RemoteMailbox cmdlet to create a mailbox in the cloud-based service, for an existing user in an on-premises Active Directory.
High user turnover can cause old/redundant user data to consume valuable space. UserResourceCleanup was developed to address this by automatically deleting user folders when the user account is deleted.
This tutorial will walk an individual through the process of configuring their Windows Server 2012 domain controller to synchronize its time with a trusted, external resource. Use Google, Bing, or other preferred search engine to locate trusted NTP …
There are cases when e.g. an IT administrator wants to have full access and view into selected mailboxes on Exchange server, directly from his own email account in Outlook or Outlook Web Access. This proves useful when for example administrator want…

834 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