detect lan activity

[Pino]

i want to detect if a computer on the LAN is trying to access another computer on the LAN is this possible?

[RobDog888]

Since I know you like Winsock, couldn't you write something that
has ports open on each computer listening and when another
computer connects you could send something to the server app?

[Pino]

what port does the lan work on?

[RobDog888]

I'm not sure but I thought about it again and I don't know if this
is a vaild possible solution. I thought there was an API for
detecting network activity?

[RobDog888]

This example may have some use? The USER_INFO_3 type
has some good stuff in it.

Const NERR_Success = 0
Private Const NERR_BASE = 2100
Private Const NERR_InvalidComputer = (NERR_BASE + 251)
Private Const NERR_UseNotFound = (NERR_BASE + 150)
Const CP_ACP = 0
Private Type USER_INFO_3
    usri3_name As Long
    usri3_password As Long
    usri3_password_age As Long
    usri3_priv As Long
    usri3_home_dir As Long
    usri3_comment As Long
    usri3_flags As Long
    usri3_script_path As Long
    usri3_auth_flags As Long
    usri3_full_name As Long
    usri3_usr_comment As Long
    usri3_parms As Long
    usri3_workstations As Long
    usri3_last_logon As Long
    usri3_last_logoff As Long
    usri3_acct_expires As Long
    usri3_max_storage As Long
    usri3_units_per_week As Long
    usri3_logon_hours As Byte
    usri3_bad_pw_count As Long
    usri3_num_logons As Long
    usri3_logon_server As String
    usri3_country_code As Long
    usri3_code_page As Long
    usri3_user_id As Long
    usri3_primary_group_id As Long
    usri3_profile As Long
    usri3_home_dir_drive As Long
    usri3_password_expired As Long
End Type
Private Declare Function NetUserGetInfo Lib "netapi32" (lpServer As Any, UserName As Byte, ByVal Level As Long, lpBuffer As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function lstrlenW Lib "kernel32" (lpString As Any) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
' Returns an ANSI string from a pointer to a Unicode string.
Public Function GetStrFromPtrW(lpszW As Long) As String
    Dim sRtn As String
    sRtn = String$(lstrlenW(ByVal lpszW) * 2, 0)   ' 2 bytes/char
    ' WideCharToMultiByte also returns Unicode string length
    Call WideCharToMultiByte(CP_ACP, 0, ByVal lpszW, -1, ByVal sRtn, Len(sRtn), 0, 0)
    GetStrFromPtrW = GetStrFromBufferA(sRtn)
End Function
' Returns the string before first null char encountered (if any) from an ANSII string.
Public Function GetStrFromBufferA(sz As String) As String
    If InStr(sz, vbNullChar) Then
        GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
    Else
        ' If sz had no null char, the Left$ function
        ' above would return a zero length string ("").
        GetStrFromBufferA = sz
    End If
End Function
Private Sub Form_Load()
    'KPD-Team 2001
    'URL: [url]http://www.allapi.net/[/url]
    'E-Mail: [email][email protected][/email]
    Dim lpBuf As Long
    Dim ui3 As USER_INFO_3
    ' replace "Administrator" with a valid NT username
    Dim bServer() As Byte, bUsername() As Byte
    bServer = "" & vbNullChar
    bUsername = "Administrator" & vbNullChar
    If (NetUserGetInfo(bServer(0), bUsername(0), 3, lpBuf) = NERR_Success) Then
        Call MoveMemory(ui3, ByVal lpBuf, Len(ui3))
        MsgBox GetStrFromPtrW(ui3.usri3_name)
        MsgBox GetStrFromPtrW(ui3.usri3_comment)
        Call NetApiBufferFree(ByVal lpBuf)
    End If
End Sub

[RobDog888]

The Logged on usertype property looks promissing.

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
   [color=red]wki102_logged_on_users[/color] 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 ([email protected])
   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

[Pino]

ok thanks for your help i'm going to look into it

[RobDog888]

If you get the solution, I would like to know too.