Function CaptureConsole(sCmd) 'returns as-run command, StdOut and StdErr in an array Dim oSh, FSO, fErr, sData, fOut, ErrF, OutF, Cmd Set oSh = createobject("WScript.Shell") Set FSO = createobject("Scripting.FileSystemObject") fOut = FSO.GetTempName fErr = FSO.GetTempName Cmd = "%COMSPEC% /c " & sCmd _ & " 2>" & fErr & " 1>" & fOut oSh.Run Cmd, 0, True If FSO.FileExists(fOut) Then If FSO.GetFile(fOut).Size>0 Then Set OutF = FSO.OpenTextFile(fOut) sOut = OutF.Readall OutF.Close End If FSO.DeleteFile(fOut) End If If FSO.FileExists(fErr) Then If FSO.GetFile(fErr).Size>0 Then Set ErrF = FSO.OpenTextFile(fErr) sErr = ErrF.Readall ErrF.Close End If FSO.DeleteFile(fErr) End If CaptureConsole = Array(Cmd, sOut, sErr) End Function Sub ccSleep(seconds) set oShell = CreateObject("Wscript.Shell") cmd = "%COMSPEC% /c ping -n " & 1 + seconds & " 127.0.0.1>nul" oShell.Run cmd,0,1 End Sub Function Cmd(cmdline) ' Wrapper for getting StdOut from a console command Dim Sh, FSO, fOut, OutF, sCmd Set Sh = createobject("WScript.Shell") Set FSO = createobject("Scripting.FileSystemObject") fOut = FSO.GetTempName sCmd = "%COMSPEC% /c " & cmdline & " >" & fOut Sh.Run sCmd, 0, True If FSO.FileExists(fOut) Then If FSO.GetFile(fOut).Size>0 Then Set OutF = FSO.OpenTextFile(fOut) Cmd = OutF.Readall OutF.Close End If FSO.DeleteFile(fOut) End If End Function Function GetIPAddresses() '===== ' Returns array of IP Addresses as output ' by ipconfig or winipcfg... ' ' Win98/WinNT have ipconfig (Win95 doesn't) ' Win98/Win95 have winipcfg (WinNt doesn't) ' ' Note: The PPP Adapter (Dial Up Adapter) is ' excluded if not connected (IP address will be 0.0.0.0) ' and included if it is connected. '===== set sh = createobject("wscript.shell") set fso = createobject("scripting.filesystemobject") Set Env = sh.Environment("PROCESS") if Env("OS") = "Windows_NT" then workfile = fso.gettempname sh.run "%comspec% /c ipconfig > " & workfile,0,true else 'winipcfg in batch mode sends output to 'filename winipcfg.out workfile = "winipcfg.out" sh.run "winipcfg /batch" ,0,true end if set sh = nothing set ts = fso.opentextfile(workfile) data = split(ts.readall,vbcrlf) ts.close set ts = nothing fso.deletefile workfile set fso = nothing arIPAddress = array() index = -1 for n = 0 to ubound(data) if instr(data(n),"IP Address") then parts = split(data(n),":") if trim(parts(1)) <> "0.0.0.0" then 'if instr(trim(parts(1)), "0.0.0.0") = 0 then index = index + 1 ReDim Preserve arIPAddress(index) arIPAddress(index)= trim(cstr(parts(1))) end if end if next GetIPAddresses = arIPAddress End Function Function IpConfig Dim oShell, Cmd set oShell = CreateObject("WScript.Shell") set Cmd = oShell.Exec("%COMSPEC% /C ipconfig /all 2>1") CmdResults = Cmd.StdOut.ReadAll End Function Function IsConnectable(sHost,iPings,iTO) ' sHost is a hostname or IP ' iPings is number of ping attempts ' iTO is timeout in milliseconds ' if values are set to "", then defaults below used If iPings = "" Then iPings = 2 If iTO = "" Then iTO = 750 Set Sh = CreateObject("WScript.Shell") Set ExCmd = Sh.Exec("ping -n " & iPings _ & " -w " & iTO & " " & sHost) Select Case InStr(ExCmd.StdOut.Readall,"TTL=") Case 0 IsConnectable = False Case Else IsConnectable = True End Select End Function Function IsPortUp(numPort) ' Returns T/F for whether or not port is up ' DEPENDENCY: Procedures Cmd, Chomp Dim PreCmd, PostCmd PreCmd = "netstat -an | find "":" PostCmd = """| find ""LISTENING""&&echo:True" IsPortUp = CBool(Cmd(PreCmd & numPort & PostCmd)) End Function Function IsTS Dim Sh, x Set Sh = WScript.CreateObject("WScript.Shell") x = LCase(Sh.ExpandEnvironmentStrings("%Clientname%")) If (x <> "") Then IsTS = True Else IsTS = False End If End Function Function IsTSSession Dim Sh, x Set Sh = WScript.CreateObject("WScript.Shell") x = LCase(Sh.ExpandEnvironmentStrings("%Clientname%")) If (x <> "") And (x <> "console") Then IsTSSession = True Else IsTSSession = False End If End Function Function ListeningPorts ' DEPENDENCY: Procedure Cmd Dim netstat, Ports, Port, i netstat = "netstat -an | find ""LISTENING""" Ports = Split(Cmd(netstat), vbCrLf) For i = 0 To UBound(Ports) Ports(i) = Trim(Mid(Ports(i),10,22)) Next ListeningPorts = Ports End Function function MacAddress(sIpAddr) Set net = CreateObject("wscript.network") Set sh = CreateObject("wscript.shell") sh.run "%comspec% /c nbtstat -A " & sIpAddr _ & " > c:\" & sIpAddr & ".txt",0,true Set sh = nothing Set fso = createobject("scripting.filesystemobject") Set ts = fso.opentextfile("c:\" & sIpAddr & ".txt") MacAddress = null Do While Not ts.AtEndOfStream data = ucase(trim(ts.readline)) wscript.echo data if instr(data,"MAC ADDRESS") Then MacAddress = trim(split(data,"=")(1)) Exit Do End if loop ts.close Set ts = nothing fso.deletefile "c:\" & sIpAddr & ".txt" Set fso = nothing End function Sub MakeMail(sTo, sSubject, sMsg) dim tmp, oShell 'create mailto target tmp = "mailto:" & sTo ' escape subject and add it tmp = tmp & "?&subject=" & escape(sSubject) 'escape body and add it tmp = tmp & "&body=" & escape(sMsg) tmp = Replace(tmp,"%20%20","%20") tmp = Replace(tmp,"%20.","") tmp = Replace(tmp,"%0D%0D%0A","%0D%0A") set oShell = CreateObject("WScript.Shell") oShell.Run tmp End Sub Function MySid Dim tmp ' Returns SID of logged on user ' depends on whoami tmp = Split(CreateObject("WScript.Shell")._ Exec("whoami /sid /user").StdOut.ReadAll) MySid = tmp(UBound(tmp)) End Function Function NameFromPing(sIP) Set Cmd = CreateObject("WScript.Shell")._ Exec("ping -a -n 1 -w 1 " & sIP) NameFromPing = Split(Cmd.StdOut.ReadAll," ")(1) End Function Function NameFromTrace(sIP) Set Cmd = CreateObject("WScript.Shell")._ Exec("tracert -h 1 -w 1 " & sIP) NameFromTrace = Split(Cmd.StdOut.ReadAll," ")(3) End Function Function nslook(sTargetDomain) cmdline = "cmd /c nslookup -type=mx " & sTargetDomain Set Cmd = CreateObject("WScript.Shell").Exec(cmdline) nslook = Cmd.StdOut.ReadAll End Function Function psSID(sHost) psSID = split(CreateObject("WScript.Shell").Exec( _ "%COMSPEC% /C psgetsid " & sHost).StdOut.ReadAll, vbCrLf)(6) If Instr(psSID,"No mapping") Then psSID = "" End Function Function QBasic(filarg) ' Wrapper for running QuickBasic programs ' QB File MUST have last line: SYSTEM Dim Sh, FSO, fOut, OutF, Cmd Set Sh = createobject("WScript.Shell") Set FSO = createobject("Scripting.FileSystemObject") fOut = FSO.GetTempName Cmd = "%COMSPEC% /c qb /run " & filarg _ & " 2>NUL 1>" & fOut wscript.echo Cmd Wscript.Quit Sh.Run Cmd, 0, True If FSO.FileExists(fOut) Then If FSO.GetFile(fOut).Size>0 Then Set OutF = FSO.OpenTextFile(fOut) QBasic = OutF.Readall OutF.Close End If FSO.DeleteFile(fOut) End If End Function sub RegisterControl(strControlName) set objShell = CreateObject("WScript.Shell") sCMD = "regsvr32 /s " & strControlName rtn = objShell.run(sCMD, 0, true) wscript.echo strControlName & " " & rtn end sub Sub SetServiceState(Svc, State) ' Uses simple shell commands ' state should be: pause, resume, stop, start CreateObject("WScript.Shell").Run("net " & state & " " & Svc),0,True End Sub Sub SetVar_Volatile(VarName,VarValue) set shell = createobject("wscript.shell") set envVolatile = shell.environment("volatile") envVolatile(VarName) = VarValue End Sub Sub UnRegisterControl(strControlName) Set Sh= CreateObject("WScript.Shell") sCMD = "regsvr32 /s /u" & strControlName rtn = Sh.Run(sCMD, 0, True) End Sub Sub XpOptimize ' http://www.microsoft.com/hwdev/performance/benchmark.htm CreateObject("WScript.Shell").Run("rundll32.exe advapi32.dll,ProcessIdleTasks") End Sub