'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