Quickest way to determine if a remote PC is online - vba

I tend to run a lot of commands against remote PCs, but I always check to make sure they are online first. I currently use this code:
If objFSO.FolderExists("\\" & strHost & "\c$") Then
'The PC is online so do your thing
However, when the remote PC is not online, it takes my laptop ~45 seconds before it times out and resolves to FALSE.
Is there a way to hasten the timeout? Or is there another easily implementable solution to determine if a PC is online?

You could use WMI to ping it.
Function IsOnline(strHost As String) As Boolean
Dim strQuery As String
strQuery = "select * from Win32_PingStatus where Address = '" & strHost & "'"
Dim colItems As Object
Set colItems = GetObject("winmgmts://./root/cimv2").ExecQuery(strQuery)
Dim objItem As Object
For Each objItem In colItems
If IsObject(objItem) Then
If objItem.StatusCode = 0 Then
IsOnline = True
Exit Function
End If
End If
Next
End Function

You can use the return code from a ping request:
Function HostIsOnline(hostname)
Set oShell = WScript.CreateObject("WScript.Shell")
Set oShellExec = oShell.Exec("ping -n 1 " & hostname)
While oShellExec.Status = 0
WScript.Sleep(100)
Wend
HostIsOnline = (oShellExec.ExitCode = 0)
End Function

Related

objProcess.Terminate not Found

Trying to kill InternetExplorer:
Sub IE_kill()
Dim objWMI As Object, objProcess As Object, objProcesses As Object
Set objWMI = GetObject("winmgmts://.")
Set objProcesses = objWMI.ExecQuery( _
"SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
For Each objProcess In objProcesses
If Not objProcess Is Nothing Then
hh = objProcesses.Count ' 1
objProcess.Terminate ' Here is Error Not Found
If Err.Number <> 0 Then
Else
'DisplayErrorInfo
Exit For
End If
End If
Next
Set objProcesses = Nothing: Set objWMI = Nothing
End Sub
but get sometimes error on objProcess.Terminate Not Found
how to solve problem? Error catch do not help. On error resume next not work as error raise instead.
I have tried this modification of your code (for MS Edge) and it worked about 3 times so far:
Option Explicit
Sub KillIE()
Dim objWMI As Object, objProcess As Object, objProcesses As Object
Set objWMI = GetObject("winmgmts://.")
Set objProcesses = objWMI.ExecQuery("SELECT * FROM Win32_Process")
For Each objProcess In objProcesses
If Not objProcess Is Nothing Then
If InStr(1, UCase(objProcess.Name), "EDGE") > 0 Then
Debug.Print objProcess.Name
objProcess.Terminate
If Not Err.Number <> 0 Then
Exit For
End If
End If
End If
Next
End Sub
You can give it a try and check the objProcess.Name, before it gives an error. Consider replacing "EDGE" with INTERNETEXPLORER or IEXPLORER.
As mentioned in one of the comments, you can use the taskkill command as shown below:
Sub IE_kill
Dim objShell, strCommand
strCommand = "taskkill /f /im iexplore.exe"
Set objShell = CreateObject("wscript.shell")
objShell.Run strCommand
Set objShell = Nothing
End Sub
Check this answer out to know more about the taskkill
OR, if you want to stick to the wmi, you can try the following "workaround"(it will not throw the error you are currently getting-see further explanation in comments):
Dim objw, strComputer, arrPID(), intIndex
strComputer = "."
intIndex=-1
Set objw = GetObject("winmgmts://"&strComputer&"/root/cimv2")
Set objps = objw.ExecQuery("Select * from win32_process where name = 'iexplore.exe'")
for each instance in objps
intIndex = intIndex + 1
redim preserve arrPID(intIndex)
arrPID(intIndex) = instance.processID 'storing all the process IDs of the processes having name = iexplore.exe
next
for each pid in arrPID
Set objps = objw.ExecQuery("Select * from win32_process where processID = "&pid) 'getting the process with the process IDs
for each instance in objps
instance.terminate 'As soon as this line gets executed for the first process ID in the array, It will terminate ALL the iexplore processes. This means, for the remaining process IDs in the array, this line would not even get executed because when we try to find the process with that process ID, it wouldn't be found and hence we would not be able to enter the for-loop and tus no error is generated.
next
next

Run queries on remote PostgreSQL from LibreOffice Calc

My goal is to run simple queries from LibreOffice Calc and get the results from a remote PostgreSQL database.
I tried to do something similar to this answer but I get an error.
Here is what I have:
Sub GetQuery
Dim oParms(1) as new com.sun.star.beans.PropertyValue
Dim oStatement As Object
Dim oResult As Object
Dim oConnection As Object
oParms(0).Name = "user"
oParms(0).Value = "serveruser"
oParms(1).Name = "password"
oParms(1).Value = "serverpwd"
oManager = CreateUnoService("com.sun.star.sdbc.DriverManager")
sURL = "dbname=mydatabase hostaddr=X.X.X.X port=5432 user=postgresuser password=postgrespwd"
oConnection = oManager.getConnectionWithInfo(sURL, oParms())
oStatement = oConnection.createStatement()
oResult = oStatement.executeQuery("select count(*) from mytable")
MsgBox "Result: " & oResult
oStatement.close()
End Sub
When I try to run this I get "Object variable not set" on line oStatement = oConnection.createStatement().
As you can see I have very limited experience on remote database connection.

ActiveX calling URL page

I'm using the following code inside an ActiveX Script job on SQl Server to call an URL every X minutes.
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "iexplore.exe http://www.google.com.br"
Set WsShell = Nothing
it is working but the processes created keep running:
Any way of changin that code to call the URL and kill the recent called process or call it with a "time-to-live". I think it is more secure, I wouldn't want to kill the wrong process.
Following up on the suggestion by #Ted, you can also fetch a URL using native Microsoft capabilities in an in-process fashion. You can do this via a component known as WinHTTP (the latest appears to be WinHTTP 5.1).
See my script below which includes a function to simply obtain the status of a URL. When I run this script I get the following output:
http://www.google.com => 200 [OK]
http://www.google.com/does_not_exist => 404 [Not Found]
http://does_not_exist.google.com => -2147012889
[The server name or address could not be resolved]
If you want the actual content behind a URL, try oHttp.ResponseText. Here's the WinHTTP reference if you are interested in other capabilities as well.
Option Explicit
Dim aUrlList
aUrlList = Array( _
"http://www.google.com", _
"http://www.google.com/does_not_exist", _
"http://does_not_exist.google.com" _
)
Dim i
For i = 0 To UBound(aUrlList)
WScript.Echo aUrlList(i) & " => " & GetUrlStatus(aUrlList(i))
Next
Function GetUrlStatus(sUrl)
Dim oHttp : Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error Resume Next
With oHttp
.Open "GET", SUrl, False
.Send
End With
If Err Then
GetUrlStatus = Err.Number & " [" & Err.Description & "]"
Else
GetUrlStatus = oHttp.Status & " [" & oHttp.StatusText & "]"
End If
Set oHttp = Nothing
End Function
The way you start IE is external, you have little control over the process once it is started.
A better interactive way is like this
Function GetData(strUrl) 'As String
Set web = CreateObject("InternetExplorer.Application")
web.Navigate strUrl
Do While web.Busy
wscript.sleep 100
Loop
Set doc = Nothing
Do Until Not doc Is Nothing
Set doc = web.Document
Loop
strWebPage = doc.all(1).innerHTML 'This does return the head sections
web.Quit
GetData = strWebPage
End Function
wscript.echo GetData("www.google.com")
UPDATE: As it stands now, it looks like this is not a viable solution. After multiple invocations, IE processes begin to accumulate with this approach as well. It appears this behavior has something to do with IE's session management. IE doesn't like to be abruptly terminated.
I found some very useful information about managing processes via WMI here. Using that as a basis, I came up with the code I show below. One of the nice aspects of the WMI approach is that you are given access to the unique ID for the process. I consider my code a starting point as I'm sure further improvements are possible (including the addition of exception handling).
Perhaps others with deeper knowledge of WMI can offer additional advice.
PS: Hope you like that I wrapped this functionality inside a VBScript class called Process.
Option Explicit
' Const PROG = "notepad.exe"
Const TARGET = "http://www.google.com"
Dim PROG : PROG = "C:\Program Files\Internet Explorer\iexplore.exe " & TARGET
Const ABOVE_NORMAL = 32768 ' what are the other priority constants?
Dim oProc : Set oProc = New Process
oProc.Name = PROG
' oProc.Priority = ABOVE_NORMAL
oProc.Launch
WScript.Echo "Launched '" & PROG & "' with process ID '" & oProc.ID & "'"
WScript.Sleep 5000
oProc.Terminate
WScript.Echo "Process " & oProc.ID & " killed."
Set oProc = Nothing
' ----------------------------------------------------------------------
Class Process
Public Computer
Public Name
Public Priority
Public ID
Public IsRunning
Private mHandle
Private Sub Class_Initialize()
Me.Computer = "."
Me.Name = Null
Me.ID = -1
Me.Priority = Null
Me.IsRunning = False
Set mHandle = Nothing
End Sub
Private Sub Class_Terminate()
Set mHandle = Nothing
End Sub
Public Sub Launch()
Dim oWmi, oStartup, oConfig
Dim nPid
Set oWmi = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& Me.Computer & "\root\cimv2")
Set oStartup = oWmi.Get("Win32_ProcessStartup")
If Not IsNull(Me.Priority) Then
Set oConfig = oStartup.SpawnInstance_
oConfig.PriorityClass = Me.Priority
End If
Set mHandle = GetObject("winmgmts:root\cimv2:Win32_Process")
mHandle.Create Me.Name, Null, oConfig, nPid
' WScript.Echo "TypeName Is [" & TypeName(mHandle) & "]"
Me.ID = nPid
Me.IsRunning = True
End Sub
Public Sub Terminate()
' mHandle.Terminate ' hmmm, doesn't work...
Dim oWmi
Dim colProcessList, oProc
Set oWmi = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& Me.Computer & "\root\cimv2")
Set colProcessList = oWmi.ExecQuery _
("Select * from Win32_Process Where ProcessId = '" & Me.ID & "'")
For Each oProc In colProcessList ' should be only one process
' WScript.Echo "TypeName Is [" & TypeName(oProc) & "]"
oProc.Terminate
Next
Me.IsRunning = False
End Sub
End Class
Could you consider using a lightweight command line URL retrieval program, like CURL ( http://curl.haxx.se/docs/manpage.html ) or WGET ( http://www.gnu.org/software/wget/ )? These programs can be executed from the command line quite simply:
wget http://www.google.com
curl http://www.google.com
You can execute them from VBScript like this:
sub shell(cmd)
' Run a command as if you were running from the command line
dim objShell
Set objShell = WScript.CreateObject( "WScript.Shell" )
objShell.Run(cmd)
Set objShell = Nothing
end sub
shell "wget http://www.google.com"
The only downside to this is that WGET and CURL won't execute javascript, download affiliated images, or render the HTML; they will simply download the web page. In my experience, I use CURL and WGET regularly as long as I only have to retrieve a single HTML page; but if I have to render something or trigger AJAX functions I use an automatable web browser toolkit like Selenium, WATIN, or IMacros.

VBScript Kill Process Using Parameter

I am attempting to create a VBscript that will kill a Windows process that is passed in as a parameter (argument). I have the following code and believe the problem to be at either line 8, 18, or 24 but am not sure what the problem is. When I replace that code with notepad.exe instead of the variable, it works. Any help would be great. Thanks.
Dim prcid
Dim check
Dim Inp
Set Inp = WScript.Arguments
check=0
Set objService = GetObject("winmgmts:")
For Each Process In objService.InstancesOf("Win32_process")
If process.name= "Inp" Then
prcid=process.processid
check=1
Exit For
End If
Next
If check =0 Then
WScript.Quit [ExitCode]
End if
For Each process In objService.InstancesOf("Win32_process")
If process.name= "Inp" Then
If process.processid=prcid Then
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("SELECT * FROM Win32_Process WHERE Name = 'Inp'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
End If
Exit For
End If
Next
You are using a variable as a literal:
1. process.name= "Inp" should be process.name = Inp (twice)
2. "SELECT * FROM Win32_Process WHERE Name = 'Inp'" should be "SELECT * FROM Win32_Process WHERE Name = '" & Inp & "'"
And you are using the WScript.Arguments object incorrect: to get the first argument from the command line, use WScript.Arguments(0)
Disclaimer: I did not test your code with these enhancements, I just spotted these errors on first sight. There could be more lurking inside.
Are you sure there is no extension for Inp because when I ran the script on my windows XP system it worked fine. Also on my system all the process have an extension, except for
System and System Idle Process. If there is an extension you will need to use it.
I found this on the internet it has been tested on a lot of systems
Verified on the following platforms
Server 8 No
Windows Server 2008 R2 Yes
Windows Server 2008 Yes
Windows Server 2003 Yes
Windows 8 No
Windows 7 Yes
Windows Vista Yes
Windows XP Yes
Windows 2000 Yes
Script name: WMI_KillProcess.vbs
Created on: 10/05/2010
Author: Dennis Hemken
Purpose: This function kills a process by name,
which is running on a special pc in the network.
Dim strComputer
strComputer = "."
fct_KillProcess "acrord32", strComputer
' or
' strComputer = "192.168.2.13"
' fct_KillProcess "outlook", strComputer
Public Function fct_KillProcess(strProcessName, strComputer)
Dim objWMI
Dim colServices
Dim objService
Dim strServicename
Dim ret
Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colServices = objWMI.InstancesOf("win32_process")
For Each objService In colServices
strServicename = LCase(Trim(CStr(objService.Name) & ""))
If InStr(1, strServicename, LCase(strProcessName), vbTextCompare) > 0 Then
ret = objService.Terminate
End If
Next
Set colServices = Nothing
Set objWMI = Nothing
End Function

Getting the currently logged-in windows user

I found this via google: http://www.mvps.org/access/api/api0008.htm
'******************** Code Start **************************
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If ( lngX > 0 ) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
'******************** Code End **************************
Is this the best way to do it?
You could also do this:
Set WshNetwork = CreateObject("WScript.Network")
Print WshNetwork.UserName
It also has a UserDomain property and a bunch of other things:
http://msdn.microsoft.com/en-us/library/907chf30(VS.85).aspx
You could also use Environ$ but the method specified by the question is better. Users/Applications can change the environment variables.
I generally use an environ from within VBA as in the following. I haven't had the problems that Ken mentions as possibilities.
Function UserNameWindows() As String
UserNameWindows = VBA.Environ("USERNAME") & "#" & VBA.Environ("USERDOMAIN")
End Function
Lots of alternative methods in other posts, but to answer the question: yes that is the best way to do it. Faster than creating a COM object or WMI if all you want is the username, and available in all versions of Windows from Win95 up.
Alternative way to do that - probably the API you mention is a better way to get username.
For Each strComputer In arrComputers
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
For Each objItem in colItems
Wscript.Echo "UserName: " & objItem.UserName & " is logged in at computer " & strComputer
Next
there are lots of way to get the current logged user name in WMI.
my way is to get it through the username from process of 'explorer.exe'
because when user login into window, the access of this file according to the current user.
WMI script would be look like this:
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strIP & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process")
For Each objprocess In colProcessList
colProperties = objprocess.GetOwner(strNameOfUser, strUserDomain)
If objprocess.Name = "explorer.exe" Then
UsrName = strNameOfUser
DmnName = strUserDomain
End If
Next
for more detailcheck the link on :
http://msdn.microsoft.com/en-us/library/aa394599%28v=vs.85%29.aspx