Как посмотреть все сетевые соединения

Автор: Randy Birch

Компилятор: Visual Basic

Пример демонстрирует подключения и открытые файлы на расшаренном C$ локального компьютера. В NT или 2000 для получения нужной нам информации используется струтктура CONNECTION_INFO_1. В то время как на машинах Windows 9x для этого необходимо воспользоваться CONNECTION_INFO_50. Ко всему прочему в 9x для структуры CONNECTION_INFO_50 необходимо выделять и освобождать буфер до и после вызова API функции.

Добавьте на форму кнопку (Command1), список (List1), два лейбла (Label1, Label2) и следующий код:

Option Explicit

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 STYPE_DISKTREE = 0
Private Const STYPE_PRINTQ = 1
Private Const STYPE_DEVICE = 2
Private Const STYPE_IPC = 3

'используется только в Win NT/2000
Private Type CONNECTION_INFO_1
  coni1_id As Long
  coni1_type As Long
  coni1_num_opens As Long
  coni1_num_users As Long
  coni1_time As Long
  coni1_username As Long
  coni1_netname As Long
End Type

Private Declare Function NetConnectionEnum Lib "netapi32" _
  (ByVal servername As Long, _
   ByVal qualifier 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 Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (pTo As Any, uFrom As Any, _
   ByVal lSize As Long)
   
Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long


Private Sub Form_Load()

   ReDim TabArray(0 To 5) As Long
   
   TabArray(0) = 59
   TabArray(1) = 128
   TabArray(2) = 159
   TabArray(3) = 185
   TabArray(4) = 212
   TabArray(5) = 243
   
  'очищаем и устанавливаем столбцы
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&)
   Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 6&, TabArray(0))
   List1.Refresh
   
   Command1.Caption = "NetConnectionEnum"
   Label1.Caption = "call success (0) or error :"
   Label2.Caption = ""
   
End Sub


Private Sub Command1_Click()

   Dim bufptr          As Long  'output
   Dim dwServer        As Long  'указатель на сервер 
   Dim dwShare         As Long  'указатель на расшаренный ресурс 
   Dim dwEntriesread   As Long  'out
   Dim dwTotalentries  As Long  'out
   Dim dwResumehandle  As Long  'out
   Dim success         As Long  
   Dim nStructSize     As Long
   Dim cnt             As Long
   Dim bServer         As String
   Dim bShare          As String   
   Dim ci1             As CONNECTION_INFO_1
     
  'для тестирования используем локальный компьютер. Этот параметр может 
  'указывать либо на локальный компьютер, либо на другой. в данном 
  'случае COMPUTERNAME, это переменная окружения NT/2000.
   bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString
   dwServer = StrPtr(bServer)
   
   bShare = "C$"
   dwShare = StrPtr(bShare)
   
  'так объявляется в NT/2000! 
   success = NetConnectionEnum(dwServer, _
                               dwShare, _
                               1, _
                               bufptr, _
                               MAX_PREFERRED_LENGTH, _
                               dwEntriesread, _
                               dwTotalentries, _
                               dwResumehandle)

   List1.Clear
   Label2.Caption = success
   
   If success = NERR_SUCCESS And _
      success <> ERROR_MORE_DATA Then
      
      nStructSize = LenB(ci1)
      
      For cnt = 0 To dwEntriesread - 1
         
        'получаем часть данных и копируем их
        'в CONNECTION_INFO_1, а затем добавляем
        'данные в список
         CopyMemory ci1, ByVal bufptr + (nStructSize * cnt), nStructSize
         
        'ci1.coni1_time возвращает количество секунд; 
        'переводим их в минуты
         List1.AddItem GetPointerToByteStringW(ci1.coni1_username) & vbTab & _
                       GetPointerToByteStringW(ci1.coni1_netname) & vbTab & _
                       ci1.coni1_time \ 60 & vbTab & _
                       ci1.coni1_num_opens & vbTab & _
                       ci1.coni1_num_users & vbTab & _
                       ci1.coni1_id & vbTab & _
                       GetConnectionType(ci1.coni1_type)

      Next
   End If
   
   Call NetApiBufferFree(bufptr)

End Sub


Private Function GetPointerToByteStringW(ByVal dwData As Long) As String
  
   Dim tmp() As Byte
   Dim tmplen As Long
   
   If dwData <> 0 Then
   
      tmplen = lstrlenW(dwData) * 2
      
      If tmplen <> 0 Then
      
         ReDim tmp(0 To (tmplen - 1)) As Byte
         CopyMemory tmp(0), ByVal dwData, tmplen
         GetPointerToByteStringW = tmp
         
     End If
     
   End If
    
End Function


Private Function GetConnectionType(ByVal dwSessionType As Long) As String

   Select Case dwSessionType
      Case STYPE_DISKTREE: GetConnectionType = "Disk drive"
      Case STYPE_PRINTQ:   GetConnectionType = " Print queue"
      Case STYPE_DEVICE:   GetConnectionType = "Communication device"
      Case STYPE_IPC:      GetConnectionType = "(IPC)"
      Case Else:           GetConnectionType = ""
   End Select
   
End Function