i try to make an Ping script with vbs. I need a Script, that ping (no ping limit, the program will run all the time) a computername in the network every 2 seconds and save the results in a txt file.
For Example:
06/08/2010 - 13:53:22 | The Computer "..." is online
06/08/2010 - 13:53:24 | The Computer "..." is offline
Now i try a little bit:
strComputer = "TestPC"
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
..........
Next
And than i don't know how to make it. (I'm new with vbs :-))
I hope some one can help me.
Greeting,
matthias
Try this
Option Explicit
Dim strHost, strFile
strHost = "www.google.com" '"127.0.0.1"
strFile = "C:\Test.txt"
PingForever strHost, strFile
Sub PingForever(strHost, outputfile)
Dim Output, Shell, strCommand, ReturnCode
Set Output = CreateObject("Scripting.FileSystemObject").OpenTextFile(outputfile, 8, True)
Set Shell = CreateObject("wscript.shell")
strCommand = "ping -n 1 -w 300 " & strHost
While(True)
ReturnCode = Shell.Run(strCommand, 0, True)
If ReturnCode = 0 Then
Output.WriteLine Date() & " - " & Time & " | The Computer " & strHost & " is online"
Else
Output.WriteLine Date() & " - " & Time & " | The Computer " & strHost & " is offline"
End If
Wscript.Sleep 2000
Wend
End Sub
You put your pings inside a loop of some kind and then use Wscript.Sleep 2000 to sleep for 2 seconds.
Then you use the File System Object (FSO) to write to a file. Information can be found here.
Edit: Something like this might work:
Const OpenFileForAppending = 8
Dim fso, ts
Set fso = CreateObject("Scripting. FileSystemObject")
While 1 > 0 ' loop forever
Set ts = fso.OpenTextFile("c:\temp\test.txt", OpenFileForAppending, True)
' do your pinging code
'if ok
ts.WriteLine("OK")
'else
ts.WriteLine("Not OK")
'endif
ts.Close()
Wscript.Sleep 2000
Wend
Related
I write the vbscript code to monitor system starting and ending time but it's not logging in same day 'That means not open and writing the same date file how to solve this
Dim objFS, objFile
Dim crdate,ckdate,fname
Set objFS = CreateObject("Scripting.FileSystemObject")
do
crdate = Day(now) & "-" & Month(now) & "-" & Year(now)
fname = crdate & ".txt"
if (objFS.FileExists(fname)) Then
do
ckdate = Day(now) & "-" & Month(now) & "-" & Year(now)
objFile.WriteLine(Time & "\n")
wscript.sleep 300000
loop until ckdate <> crdate
else
Set objFile = objFS.CreateTextFile(fname)
end if
loop
I found the answer in google that is closing the file with
objFile.Close
Dim objFS, objFile
Dim crdate,ckdate,fname
Set objFS = CreateObject("Scripting.FileSystemObject")
do
crdate = Day(now) & "-" & Month(now) & "-" & Year(now)
fname = crdate & ".txt"
if (objFS.FileExists(fname)) Then
Set objFile = objFS.OpenTextFile(fname, 8, True)
objFile.WriteLine("-------------------------------")
do
ckdate = Day(now) & "-" & Month(now) & "-" & Year(now)
objFile.WriteLine(Time)
wscript.sleep 300000
loop until ckdate <> crdate
objFile.Close
else
Set objFile = objFS.CreateTextFile(fname)
objFile.Close
end if
loop
Windows does this natively... you don't have to reinvent the wheel. You can pull this locally or remotely and more ACCURATELY with the windows events.
PS C:\Users\steve> Get-WinEvent -Log System | where {($_.ID -eq "12" -or $_.ID -eq "13")} | format-table -property Message
Message
-------
The operating system started at system time ?2017?-?01?-?01T00:51:20.610798500Z.
The operating system is shutting down at system time ?2017?-?01?-?01T00:50:53.812034600Z.
I have the followaing run.vbs script
Rexe = "R-Portable\App\R-Portable\bin\Rscript.exe"
Ropts = "--no-save --no-environ --no-init-file --no-restore --no-Rconsole "
RScriptFile = "runShinyApp.R"
Outfile = "ShinyApp.log"
startChrome = "GoogleChromePortable\App\Chrome-bin\chrome.exe --app=http://127.0.0.1:9999"
strCommand = Rexe & " " & Ropts & " " & RScriptFile & " 1> " & Outfile & " 2>&1"
intWindowStyle = 0 ' Hide the window and activate another window.'
bWaitOnReturn = False ' continue running script after launching R '
' the following is a Sub call, so no parentheses around arguments'
CreateObject("Wscript.Shell").Run strCommand, intWindowStyle, bWaitOnReturn
WScript.Sleep 1000
CreateObject("Wscript.Shell").Run startChrome, intWindowStyle, bWaitOnReturn
It works pretty well in most cases except when the user puts the run.vbs script in a folder with spaces in its name: e.g. if run.vbs is in folder "foo bar", the user gets the error : "C:\Users\[user name]\Desktop\foo" not recognized as internal command...
I don't understand why Rscript.exe looks for the absolute path before running even if it's called from its parent directory using relative path.
I heard about the double quote solution using the absolute path but it doesn't seem to work with .exe scripts (it does though with .bat and .cmd)
Thanks for any help!
Below code will help you
Dim oShell As Object
Set oShell = CreateObject("WScript.Shell")
'run command'
Dim oExec As Object
Dim oOutput As Object
Set oExec = oShell.Exec("C:\Program Files\R\R-3.2.3\bin\Rscript.exe C:\subfolder\YourScript.R " & """" & var1 & """")
Set oOutput = oExec.StdOut
handle the results as they are written to and read from the StdOut object
Dim s As String
Dim sLine As String
While Not oOutput.AtEndOfStream
sLine = oOutput.ReadLine
If sLine <> "" Then s = s & sLine & vbCrLf
Wend
I have a script that executes remotely to see if a program is running. It works fine but I need it to check for several programs on several servers and I don't want to re-write it. I'm trying to see if I can call the function within the vbscript via command line so that I can use 1 script and change the arguments at the command line.
Function IsProcessRunning(strComputer, strProcess)
Dim Process, strObject
IsProcessRunning = 0
strObject = "winmgmts://" & strComputer
For Each Process in GetObject( strObject ).InstancesOf( "win32_process" )
If UCase( Process.name ) = UCase( strProcess ) Then
IsProcessRunning = 1
If IsProcessRunning = 1 Then
WScript.echo 1 & ": " & strProcess & " is currently running on " & strComputer
End If
Exit Function
End If
Next
WScript.echo 0 & ": " & strProcess " is NOT running on " & strComputer
End Function
What I'm hoping for is to be able to run this via cmd like:
run.vbs IsprocessRunning Server3 Program2.exe
UPDATE
Why not to use WMIC? E. g. type in command line:
wmic /node:server1 process where name='explorer.exe' get processid
to get all launched explorers process ID on server1.
SOURCE
Use WScript.Arguments property:
IsProcessRunning WScript.Arguments(0), WScript.Arguments(1)
Function IsProcessRunning(strComputer, strProcess)
Dim Process, strObject
IsProcessRunning = 0
strObject = "winmgmts://" & strComputer
For Each Process in GetObject( strObject ).InstancesOf( "win32_process" )
If UCase(Process.name) = UCase(strProcess) Then
IsProcessRunning = 1
WScript.echo 1 & ": " & strProcess & " is currently running on " & strComputer
Exit Function
End If
Next
WScript.echo 0 & ": " & strProcess & " is NOT running on " & strComputer
End Function
Better to add some check if the appropriate command line arguments provided to script.
I have a VB Script that goes out to a string of servers and checks to see if there are any pending Windows updates. It works perfectly. The only issue is to run the script I have to type:
cscript pending.vbs server01 server02 server03 server04 etc.. I have over 300 servers I want to run this against. I need to be able to update a text file with server names instead of manually typing them out. I am posting the script below:
I am not a programmer by far, but I do understand some.
Thanks!
'#
'# ServerPendingUpdates.vbs
'#
'# Usage: cscript ServerPendingUpdates.vbs {servername} {servername} {servername} {servername}
'# If no {servername} specified then 'localhost' assumed
'#
'# To do: Error handling
'#
Option Explicit
Dim strServer : strServer = GetArgValue(0,"localhost")
'#
'# Loop through the input parameters for each server
'#
Dim i
For i = 0 To WScript.Arguments.Count - 1
CheckServerUpdateStatus GetArgValue(i,"localhost") 'strServer
Next
WScript.Quit(0)
Function CheckServerUpdateStatus( ByVal strServer )
WScript.Echo vbCRLF & "Connecting to " & strServer & " to check software update status..."
Dim blnRebootRequired : blnRebootRequired = False
Dim blnRebootPending : blnRebootPending = False
Dim objSession : Set objSession = CreateObject("Microsoft.Update.Session", strServer)
Dim objUpdateSearcher : Set objUpdateSearcher = objSession.CreateUpdateSearcher
Dim objSearchResult : Set objSearchResult = objUpdateSearcher.Search(" IsAssigned=1 and IsHidden=0 and Type='Software'")
'#
'#
'#
Dim i, objUpdate
Dim intPendingInstalls : intPendingInstalls = 0
For i = 0 To objSearchResult.Updates.Count-1
Set objUpdate = objSearchResult.Updates.Item(I)
If objUpdate.IsInstalled Then
If objUpdate.RebootRequired Then
blnRebootPending = True
End If
Else
intPendingInstalls = intPendingInstalls + 1
'If objUpdate.RebootRequired Then '### This property is FALSE before installation and only set to TRUE after installation to indicate that this patch forced a reboot.
If objUpdate.InstallationBehavior.RebootBehavior <> 0 Then
'# http://msdn.microsoft.com/en-us/library/aa386064%28v=VS.85%29.aspx
'# InstallationBehavior.RebootBehavior = 0 Never reboot
'# InstallationBehavior.RebootBehavior = 1 Must reboot
'# InstallationBehavior.RebootBehavior = 2 Can request reboot
blnRebootRequired = True
End If
End If
Next
WScript.Echo strServer & " has " & intPendingInstalls & " updates pending installation"
If blnRebootRequired Then
WScript.Echo strServer & " WILL need to be rebooted to complete the installation of these updates."
Else
WScript.Echo strServer & " WILL NOT require a reboot to install these updates."
End If
'#
'#
'#
If blnRebootPending Then
WScript.Echo strServer & " is waiting for a REBOOT to complete a previous installation."
End If
End Function
'#
'#
'#
Function GetArgValue( intArgItem, strDefault )
If WScript.Arguments.Count > intArgItem Then
GetArgValue = WScript.Arguments.Item(intArgItem)
Else
GetArgValue = strDefault
End If
End Function
You can query all domain using an ASDI object in vbs:
Set DomObj = GetObject("WinNT://" & strDomain )
DomObj.Filter = Array("computer")
Will output an array (DomObj)
or use LDAP:
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strQuery = "<LDAP://" & strDNSDomain & "> (objectCategory=computer);distinguishedName,operatingSystem;subtree"
Source:
http://www.scriptlook.com/list-servers-domain/ &
http://www.scriptlook.com/check-services-every-server-domain/
Just create a text file with the list of servers, one per line.
Open the file (OpenTextFile) and read it line by line. See these links for reference
http://ss64.com/vb/filesystemobject.html
FileSystemObject Object
path = "serverlist.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(path, 1)
Do Until objFile.AtEndOfStream
CheckServerUpdateStatus(objFile.ReadLine)
Loop
i know i asked already the question about the ping script but now i have a new question about it :-) I hope someone can help me again.
strText = "here comes the mail message"
strFile = "test.log"
PingForever strHost, strFile
Sub PingForever(strHost, outputfile)
Dim Output, Shell, strCommand, ReturnCode
Set Output = CreateObject("Scripting.FileSystemObject").OpenTextFile(outputfile, 8, True)
Set Shell = CreateObject("wscript.shell")
strCommand = "ping -n 1 -w 300 " & strHost
While(True)
ReturnCode = Shell.Run(strCommand, 0, True)
If ReturnCode = 0 Then
Output.WriteLine Date() & " - " & Time & " | " & strHost & " - ONLINE"
Else
Output.WriteLine Date() & " - " & Time & " | " & strHost & " - OFFLINE"
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "noreply#test.net"
objEmail.To = "test#test.net"
objEmail.Subject = "Computer" & strHost & " is offline"
objEmail.Textbody = strText
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
"smtpadress"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
End If
Wscript.Sleep 2000
Wend
End Sub
My problem is now, the mail comes all 2 seconds, when the computer are offline. Can someone show me how to make it with flags? So only one mail comes when its offline?
Thanks for your help.
Use a flag and report only when state changes
FLAG0 = "ON"
While(True)
ReturnCode = Shell.Run(strCommand, 0, True)
If ReturnCode = 0 Then
Output.WriteLine Date() & " - " & Time & " | " & strHost & " - ONLINE"
FLAG0 = "ON"
Else
Output.WriteLine Date() & " - " & Time & " | " & strHost & " - OFFLINE"
IF FLAG0 = "ON" THEN
FLAG0 = "OFF"
Set objEmail = CreateObject("CDO.Message")
...... rest of mailing code
END IF
End If