bilgisayarınıza uzaktan erişen var mı

04/05/2012, 13:59

accessman

Kod:
'=====================[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..."
    end select
end function
Kod:
'======================[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]=============================
11/04/2020, 18:15

accessman

Buda mutlaka işe yarar