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 functionKod:
'======================[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]=============================