Session Watcher - See Who's Connected to Your PC and What Files Are Being Accessed

Category:

System/API

Type:

Classes

Difficulty:

Advanced

Author: Anonymous

Version Compatibility: Visual Basic 6

More information:

The included application monitors sessions that have been established with the local computer by remote machines/users, and then lists the files open by the remote user(s). 1. Create a new project with a new Form 2. Add a new Class Module to the project 3. Add two ListView controls, three Command Buttons, and a Timer. 4. Copy following code into the form and the class module 5. Run the project and test it

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
'=====================[CLASS MODULE]=========================== Option Explicit Private Const SESS_GUEST = &H1 Private Const SESS_NOENCRYPTION = &H2 Private Const NERR_SUCCESS As Long = 0& Private Const MAX_PREFERRED_LENGTH As Long = -1 Private Const ERROR_MORE_DATA As Long = 234& Private Const LB_SETTABSTOPS As Long = &H192 Private Const ERROR_ACCESS_DENIED = 5 Private Const ERROR_INVALID_LEVEL = 124& Private Const ERROR_INVALID_PARAMETER = 87 Private Const ERROR_NOT_ENOUGH_MEMORY = 8 Private Const NERR_ClientNameNotFound = 2312 Private Const NERR_InvalidComputer = (2100 + 251) Private Const ERROR_FILE_NOT_FOUND = 2 Private Const NERR_FileIdNotFound = 2314 Private Const PERM_FILE_READ = &H1 Private Const PERM_FILE_WRITE = &H2 Private Const PERM_FILE_CREATE = &H4 'for use on Win NT/2000 only Private Type SESSION_INFO_502 sesi502_cname As Long sesi502_username As Long sesi502_num_opens As Long sesi502_time As Long sesi502_idle_time As Long sesi502_user_flags As Long sesi502_cltype_name As Long sesi502_transport As Long End Type Private Type FILE_INFO_3 fi3_ID As Long fi3_Permissions As Long fi3_Num_Locks As Long fi3_Filename As Long fi3_Username As Long End Type Private Declare Function NetSessionDel Lib "netapi32" _ (ByVal servername As Long, _ ByVal UncClientName As Long, _ ByVal username As Long) As Long Private Declare Function NetSessionEnum Lib "netapi32" _ (ByVal servername As Long, _ ByVal UncClientName As Long, _ ByVal username As Long, _ ByVal level As Long, _ bufptr As Long, _ ByVal prefmaxlen As Long, _ entriesread As Long, _ totalentries As Long, _ resume_handle As Long) As Long Private Declare Function NetFileClose Lib "netapi32" _ (ByVal servername As Long, _ ByVal fileid As Long) As Long Private Declare Function NetFileEnum Lib "netapi32" _ (ByVal servername As Long, _ ByVal basepath As Long, _ ByVal username As Long, _ ByVal level As Long, _ bufptr As Long, _ ByVal prefmaxlen As Long, _ entriesread As Long, _ totalentries As Long, _ resume_handle As Long) As Long Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long) Private m_sError As String Public Property Get ErrorMsg() As String ErrorMsg = m_sError End Property Public Function GetSessions(ByVal sComputer As String) As Collection Dim lBuffer As Long Dim dwServer As Long Dim dwEntriesRead As Long Dim dwTotalEntries As Long Dim dwResumeHandle As Long Dim lSuccess As Long Dim nStructSize As Long Dim ii As Long Dim sUserID As String Dim si As SESSION_INFO_502 Dim colSessions As New Collection If Len(sComputer) = 0 Then sComputer = vbNullString Else sComputer = "\\" & sComputer & vbNullString End If dwServer = StrPtr(sComputer) lSuccess = NetSessionEnum(dwServer, _ 0&, _ 0&, _ 502, _ lBuffer, _ MAX_PREFERRED_LENGTH, _ dwEntriesRead, _ dwTotalEntries, _ dwResumeHandle) Select Case lSuccess Case NERR_SUCCESS m_sError = "" Case ERROR_ACCESS_DENIED m_sError = "Access is denied - insufficient right to access the requested info." Case ERROR_INVALID_LEVEL m_sError = "The value specified for the level parameter is invalid." Case ERROR_INVALID_PARAMETER m_sError = "Th...

Code:

'======================[FORM CODE]=============================

Option Explicit

Private Sub Form_Load()
   Timer1.Interval = 5000  'every 5 seconds
   Timer1.Enabled = True
   Command1_Click          'force a refresh
   ' set button captions
   Command1.Caption = "Refresh"
   Command2.Caption = "Disconnect"
   Command3.Caption = "Close File"
End Sub

Private Sub Command1_Click()
   '// SHOW CURRENT SESSIONS AND FILES OPENED
   Dim lCnt1 As Long
   Dim lCnt2 As Long
   lCnt1 = ShowSessions(ListView1)
   lCnt2 = ShowOpenFiles(ListView2)
End Sub

Private Sub Command2_Click()
    On Error Resume Next
   '// DISCONNECT SELECTED SESSION
   Dim oTemp As New Class1
   If Not oTemp.CloseSession(ListView1.SelectedItem.Text) Then
    If Err.Number <> 0 Then
        MsgBox "You have no sessions to disconnect."
    Else
      MsgBox oTemp.ErrorMsg
    End If
   End If
End Sub

Private Sub Command3_Click()
    On Error Resume Next
    
   '// CLOSE SELECTED OPEN FILE
   Dim oTemp As New Class1
   If Not oTemp.CloseFile(ListView2.SelectedItem.Tag) Then
    If Err.Number <> 0 Then
        MsgBox "You have no files open to be closed."
    Else
      MsgBox oTemp.ErrorMsg
    End If
   End If
End Sub

Private Sub Timer1_Timer()
   '// REFRESH THE LISTS EVERY 5 SECONDS
   Command1_Click
End Sub

Private Function ShowSessions(oListView As ListView) As Long

Dim oWatch As New Class1
   Dim coSess As New Collection
   Dim oItm   As ListItem
   Dim oCol   As ColumnHeader
   Dim ii     As Long
   Dim xx     As Variant
   
   Set coSess = oWatch.GetSessions("")    'zero-length means the local machine
   
   With oListView
      .LabelEdit = lvwManual
      .View = lvwReport
      ' Clear previous results
      .ColumnHeaders.Clear
      .ListItems.Clear
      ' Now add column headers
      Set oCol = .ColumnHeaders.Add(, , "Computer")
      Set oCol = .ColumnHeaders.Add(, , "Username")
      Set oCol = .ColumnHeaders.Add(, , "Client Type")
      Set oCol = .ColumnHeaders.Add(, , "#Open Files", , lvwColumnCenter)
      Set oCol = .ColumnHeaders.Add(, , "Active Time", , lvwColumnCenter)
      Set oCol = .ColumnHeaders.Add(, , "Idle Time", , lvwColumnCenter)
      Set oCol = .ColumnHeaders.Add(, , "Session Type", , lvwColumnCenter)
      
      For ii = 1 To coSess.Count
         xx = Split(coSess(ii), vbTab)
         Set oItm = .ListItems.Add(, , xx(1))   'sesi502_cname
         oItm.SubItems(1) = xx(0) 'sesi502_username
         oItm.SubItems(2) = xx(2) 'sesi502_cltype_name
         oItm.SubItems(3) = xx(3) 'sesi502_num_opens
         oItm.SubItems(4) = xx(4) 'sesi502_time
         oItm.SubItems(5) = xx(5) 'sesi502_idle_time
         oItm.SubItems(6) = xx(6) 'sesi502_user_flags
      Next
      
   End With
   
   ShowSessions = coSess.Count

End Function

Private Function ShowOpenFiles(oListView As ListView) As Long

Dim oWatch As New Class1
   Dim coFile As New Collection
   Dim oItm   As ListItem
   Dim oCol   As ColumnHeader
   Dim ii     As Long
   Dim xx     As Variant
   
   Set coFile = oWatch.GetOpenFiles("")   'zero-length means local PC
   
   With oListView
      .LabelEdit = lvwManual
      .View = lvwReport
      ' Clear previous results
      .ColumnHeaders.Clear
      .ListItems.Clear
      ' Now add column headers
      Set oCol = .ColumnHeaders.Add(, , "Accessed By")
      Set oCol = .ColumnHeaders.Add(, , "Open Mode")
      Set oCol = .ColumnHeaders.Add(, , "#Locks")
      Set oCol = .ColumnHeaders.Add(, , "Open Filename")
      
      For ii = 1 To coFile.Count
         xx = Split(coFile(ii), vbTab)
         Set oItm = .ListItems.Add(, , xx(2))   'Username
         oItm.Tag = xx(0)                       'File ID
         oItm.SubItems(1) = xx(3)               'Permissions
         oItm.SubItems(2) = xx(4)               'Number of Locks
         oItm.SubItems(3) = xx(1)               'Filename
         DoEvents
      Next
      
   End With
   
   ShowOpenFiles = coFile.Count

End Function

'======================[FORM CODE]=============================