Link to home
Start Free TrialLog in
Avatar of beda79
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
Avatar of Manish Chhetia
Manish Chhetia
Flag of India image

'To run this program, you must set the startup object to 'Sub Main'
'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("\\" & strComputername, vbUnicode), 102, pWrkInfo)
   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_langroup, ByVal 255
      Debug.Print "Domain: " & StripTerminator(StrConv(cname, vbFromUnicode))
      Debug.Print "Operating System: ";
      Select Case WrkInfo(0).wki100_platform_id
         Case PLATFORM_ID_DOS: Debug.Print "DOS"
         Case PLATFORM_ID_OS2:
                     If WrkInfo(0).wki100_ver_major = "4" Then
                        Debug.Print "Win9x"
                     Else
                        Debug.Print "OS2"
                     End If
         Case PLATFORM_ID_NT:
                     If WrkInfo(0).wki100_ver_major = "5" Then
                        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_major; "."; WrkInfo(0).wki100_ver_minor
      Debug.Print "Lan Root: ";
      cname = String$(255, 0)
      CopyMemory ByVal cname, ByVal WrkInfo(0).pwki102_lanroot, ByVal 255
      Debug.Print StripTerminator(StrConv(cname, vbFromUnicode))
      Debug.Print "Logged User: "; Str$(WrkInfo(0).wki102_logged_on_users), vbBlack
      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
Avatar of beda79
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
Avatar of EDDYKT
EDDYKT
Flag of Canada image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of beda79

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?
Avatar of GrahamSkan
What is the error and what is the type of your currIP variable?
Avatar of beda79

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
For those wanting a just simple and small bit of "Yes/No" code, the following function by MMete works very well.  Very elegant.

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

Open in new window