'***** WorkStationList Begins 'Written by Alan Kaplan, alan@akaplan.com/tools.html 'This script creates a directory containing files with names of 'computers within domain 'last change 2/8/2001 'some of this code has been based on the example files 'in Microsoft Windows Script Host 2.0 Developer Guide, by Gunter Born 'You must have ADSI on PC running this script for it to work Option Explicit Dim DnameObj,objContainer,colPCs,objEnv,objDomain Dim isnew, path, newpath, oFolders,fso,WSfile dim message,dname,mydomain,title, command Dim major,minor,ver,wshshell,key,key2 Set WshShell = WScript.CreateObject("WScript.Shell") 'get resource domain name as default search string within logon domain key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\Currentversion\Winlogon\CachePrimaryDomain" mydomain = WshShell.RegRead (key) 'alternate: get domain logged into 'set objEnv = WshShell.Environment("process") 'mydomain = objEnv("USERDOMAIN") 'Get current domain name on error resume next 'Check adequacy of current config. This can be commented out to speed 'up processing SysTest ' Define dialog box variables. message = "Please Enter Domain Name." title = "List Source" 'get domain name, domain default dname = InputBox(message, title, mydomain) ' Evaluate the user input. If dname = "" Then ' Canceled by the user WScript.quit End If 'Bind to the builtin administrators group to see if you can connect 'This is a kludge, but binding to non-existent domain does not raise error GetObject("WinNT://" & dname &"/administrators") if err.number then message = "Cannot bind to " &dname WshShell.Popup message,0,"Connection or Authority Failure",vbCritical WScript.Quit End If ' Query Destination folder name. Title = "Destination Folder" path = InputBox("Enter folder name (e.g. C:\AllPCs).", _ Title, "C:\AllPCs") If path = "" Then WScript.Quit ' Canceled by the user End If newpath = path ' Save path (for deletion) ' Create FileSystemObject object to access file system. Set fso = WScript.CreateObject("Scripting.FileSystemObject") ' Check whether the folder exists. If (Not fso.FolderExists(path)) Then ' Folder doesn't exist; create it. Set oFolders = fso.CreateFolder(path) isnew = True ' Folder is new. Else isnew = False ' Folder already exists. End If If isnew = False Then If (MsgBox("Folder Exists. Rename folder " & path & " ?", _ vbYesNo + vbQuestion, Title) = vbYes) Then ' Yes, the user agrees. Rename folder stuff, incrementing name dim rename rename =0 do rename = rename +1 newpath = path & rename Loop Until (Not fso.FolderExists(newpath)) 'then rename to new name fso.MoveFolder path, newpath MsgBox "Folder renamed " & newpath Set oFolders = fso.CreateFolder(path) Else 'Don't rename, delete fso.DeleteFolder(path) 'Out with the old fso.CreateFolder(path) 'In with empty new, same name End If End If 'This should work with with Win2k Active directory per docs.... DnameObj = "WinNT://" & dname 'Case counts here! WshShell.Popup "Be patient, this may take some time",3,"Ready to Query Domain",64 Set objContainer=GetObject(DnameObj) objContainer.Filter=Array("computer") For Each colPCs in objContainer WSfile = path & "\" & colPCs.Name fso.CreateTextFile(WSfile) Next 'Show done If (MsgBox("Done. All PCs in " & dname & " exported to " & path &_ ". " & vbCrLf & "Open folder " & path & " ?",_ vbYesNo + vbQuestion,"Script Complete") = vbYes) Then WshShell.Run(path) End If Wscript.Quit 'Script ends Sub SysTest() on error resume next ' WSH version tested Major = (ScriptEngineMinorVersion()) Minor = (ScriptEngineMinorVersion())/10 Ver = major + minor 'Need version 5.5 If err.number or ver < 5.5 then message = "You have WScript Version " & ver & ". Please load Version 5.5" End If 'Test for ADSI err.clear key = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Active Setup\Installed Components\{E92B03AB-B707-11d2-9CBD-0000F87A369E}\version" key2 = WshShell.RegRead (key) if err <> 0 then message = message & "ADSI must be installed on local workstation to continue" & vbCrLf WshShell.Popup message,0,"Workstation Setup Error",vbInformation WScript.Quit End if End Sub