beda79
asked on
How to ping with VB6?
Hello, i'd like to write a program in VB6 with a ping function, can anyone tell me how to realize this? Or give me a link to a module? (<-- I'd prefer this solution :)
thank you!
-beda79
thank you!
-beda79
ASKER
Can you give me some more info on how to use this? i copied the declarations into a module and everything from sub_main into the normal code, still didn't work
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
thank you, this module works, the only thing i don't understand is when i pass a variable instead of a direct string (like: IsHostAlive(currIP) instead of IsHostAlive("127.0.0.1") i get an errormessage, do you have any idea why?
What is the error and what is the type of your currIP variable?
ASKER
i found the problem, i declared the variable not in the right way, thanks
Hi,
I have a question about this code. I think there is a standard timeout value something around 600 - 650 msec. Is it possible to increase this value, for example to 2000msec ?
I have to check slow lines and they are giving to much time-outs. This because te RTT are going sometimes above 1000msec
In a dos box you can get ping replys until 5000 msec
thanks
I have a question about this code. I think there is a standard timeout value something around 600 - 650 msec. Is it possible to increase this value, for example to 2000msec ?
I have to check slow lines and they are giving to much time-outs. This because te RTT are going sometimes above 1000msec
In a dos box you can get ping replys until 5000 msec
thanks
For those wanting a just simple and small bit of "Yes/No" code, the following function by MMete works very well. Very elegant.
Maarten
Maarten
Function PingSilent(strComputer)
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
PingSilent = 0 ' strComputer is Not reachable
Else
PingSilent = 1 ' strComputer is Live
End If
Next
End Function
'You can do this by going to Project->Project Properties->Startup Object
'In a module
Private Const PLATFORM_ID_DOS = 300
Private Const PLATFORM_ID_OS2 = 400
Private Const PLATFORM_ID_NT = 500
Private Const PLATFORM_ID_OSF = 600
Private Const PLATFORM_ID_VMS = 700
Private Type WKSTA_INFO_102
wki100_platform_id As Long
pwki100_computername As Long
pwki100_langroup As Long
wki100_ver_major As Long
wki100_ver_minor As Long
pwki102_lanroot As Long
wki102_logged_on_users As Long
End Type
Declare Function NetWkstaGetInfo Lib "netapi32" (ByVal servername As String, ByVal level As Long, lpBuf As Any) As Long
Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Sub Main()
'code submitted by Andreas Linnemann (ALinnemann@gmx.de)
Dim pWrkInfo As Long, WrkInfo(0) As WKSTA_INFO_102, lResult As Long
'make sure you replace the value of the following constant
'with a valid computer name from your LAN
Const strComputername = "YourComputerName"
lResult = NetWkstaGetInfo(StrConv("\
If lResult = 0 Then
Dim cname As String
cname = String$(255, 0)
CopyMemory WrkInfo(0), ByVal pWrkInfo, ByVal Len(WrkInfo(0))
CopyMemory ByVal cname, ByVal WrkInfo(0).pwki100_langrou
Debug.Print "Domain: " & StripTerminator(StrConv(cn
Debug.Print "Operating System: ";
Select Case WrkInfo(0).wki100_platform
Case PLATFORM_ID_DOS: Debug.Print "DOS"
Case PLATFORM_ID_OS2:
If WrkInfo(0).wki100_ver_majo
Debug.Print "Win9x"
Else
Debug.Print "OS2"
End If
Case PLATFORM_ID_NT:
If WrkInfo(0).wki100_ver_majo
Debug.Print "Win 2000"
Else
Debug.Print "Win NT"
End If
Case PLATFORM_ID_OSF: Debug.Print "OSF"
Case PLATFORM_ID_VMS: Debug.Print "VMS"
End Select
Debug.Print " Version "; WrkInfo(0).wki100_ver_majo
Debug.Print "Lan Root: ";
cname = String$(255, 0)
CopyMemory ByVal cname, ByVal WrkInfo(0).pwki102_lanroot
Debug.Print StripTerminator(StrConv(cn
Debug.Print "Logged User: "; Str$(WrkInfo(0).wki102_log
NetApiBufferFree ByVal pWrkInfo
End If
End Sub
'This function is used to stripoff all the unnecessary chr$(0)'s
Private Function StripTerminator(sInput As String) As String
Dim ZeroPos As Integer
'Search the first chr$(0)
ZeroPos = InStr(1, sInput, vbNullChar)
If ZeroPos > 0 Then
StripTerminator = Left$(sInput, ZeroPos - 1)
Else
StripTerminator = sInput
End If
End Function
Try It