VB and VBA Users Source Code: Returning information on open files on a remote machine
[
Home
|
Contents
|
Search
|
Reply
| Previous |
Next
]
VB/VBA Source Code
Returning information on open files on a remote machine
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, October 25, 2006
Hits:
3539
Category:
Files/Directories/IO
Article:
NetFileEnum returns information about some (or all) open files on a machine or server, depending on the parameters specified in making the call. Below is an example demostrating how to use this API. Option Explicit Private Const MAX_PREFERRED_LENGTH As Long = -1 Private Type FILE_INFO_3 fi3_id As Long fi3_permissions As Long fi3_num_locks As Long fi3_pathname As Long fi3_username As Long End Type Private Const PERM_FILE_READ = &H1 'user has read access Private Const PERM_FILE_WRITE = &H2 'user has write access Private Const PERM_FILE_CREATE = &H4 'user has create access 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.dll" (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 Sub Test() Dim sResults As String Dim sServer As String Dim lFilesRead As Long 'change to your remote machine name, or leave blank for the local machine sServer = "" sResults = GetFileConnections(sServer, lFilesRead) Debug.Print "Server: " & sServer & vbNewLine & "FilesRead: " & lFilesRead & vbNewLine & "Results: " & sResults End Sub Public Function GetFileConnections(sServer As String, ByRef lFilesRead As Long) As String Dim bufptr As Long Dim dwServer As Long Dim dwEntriesread As Long Dim dwTotalentries As Long Dim dwResumehandle As Long Dim dwDomain As Long Dim fi3 As FILE_INFO_3 Dim success As Long Dim nStructSize As Long Dim cnt As Long Dim tmp As String Const NERR_SUCCESS As Long = 0& Const ERROR_MORE_DATA As Long = 234& If Len(sServer) = 0 Then sServer = vbNullString Else sServer = "\\" & sServer & vbNullString End If dwServer = StrPtr(sServer) nStructSize = LenB(fi3) success = NetFileEnum(dwServer, 0&, 0&, 3, bufptr, MAX_PREFERRED_LENGTH, dwEntriesread, dwTotalentries, dwResumehandle) If success = NERR_SUCCESS And _ success <> ERROR_MORE_DATA Then For cnt = 0 To dwEntriesread - 1 CopyMemory fi3, ByVal bufptr + (nStructSize * cnt), nStructSize GetFileConnections = GetFileConnections & zGetPointerToByteStringW(fi3.fi3_username) & vbTab & zGetPermissionType(fi3.fi3_permissions) & vbTab & zGetPointerToByteStringW(fi3.fi3_pathname) & vbNewLine Next lFilesRead = dwEntriesread End If Call NetApiBufferFree(bufptr) End Function Private Function zGetPointerToByteStringW(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 zGetPointerToByteStringW = tmp End If End If End Function Private Function zGetPermissionType(ByVal dwPermissions As Long) As String Dim tmp As String If dwPermissions And PERM_FILE_READ Then tmp = "read " If dwPermissions And PERM_FILE_WRITE Then tmp = tmp & "write " If dwPermissions And PERM_FILE_CREATE Then tmp = tmp & "create " zGetPermissionType = tmp & "access" End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
