Artículo original: Who has files open on the network
http://www.berezniker.com/content/pages/visual-foxpro/who-has-files-open-network
Autor: Sergey Berezniker
Traducido por: Luis María Guayán
La utilidad WhoHasFileOpen muestra la lista de usuarios que tienen abiertos los archivos específicos en la red. Trabaja en plataforma Windows NT (Windows NT 4.0, Windows 2000, etc.) Este código sólo detecta los archivos abiertos usando una ruta compartida en la red. No retorna los archivos abiertos por un usuario en el equipo local y utilizando una ruta local. El usuario que ejecuta este programa debe ser un miembro del grupo Administradores o del grupo Operadores de Cuentas Locales.
El código está basado en el de Ramon F. Jaquez (UT FAQ # 7896) y modificado para usar exclusivamente código VFP.
El código se usa una clase que soporta la API de Windows (también incluida en la descarga en http://www.berezniker.com/files/WhoHasFileOpen.zip)
Gracias Kevin Delaney por la limpieza del código para que pueda ser publicado en línea para su descarga.
Ejemplos:
PROCEDURE WhoHasFileOpen(tcFileName)
*-- For Windows NT Platform (NT 4, NT 2000, e.t.c)
*
* Based of Ramon F. Jaquez UT FAQ # 7896
* Who opened what files on the network? (modified to use only VFP code)
*
*--
* The following program displays the open files, the users that
* opened these files and other related information.
*
* This code detects only the files opened using a net shared
* path. It does not return the files opened by a user on the
* local computer using a local path (i.e. the computer where
* the user is logged on). This is normal, because, otherwise,
* the number of returned files would be huge.
*
* The user running this program must be a member of the
* Administrators or Account Operators local group.
*
* In order to keep the code simple, the error handling only
* displays the error code. You should integrate it in your
* error handling mechanism.
*
*-- This function returns information about open files.
* It returns the open files only if they were
* opened using a share on that computer.
*
*-- It uses:
* - The NetFileEnum Win32 API function to retrieve the wanted information from the OS.
*
*-- Parameters:
* 1. The full file name including path. An extension can be ommited.
LOCAL lcDriveLetter, lcFileMask, llMask, lcRestName
#DEFINE PERM_FILE_READ 0x1 && user has read access
#DEFINE PERM_FILE_WRITE 0x2 && user has write access
#DEFINE PERM_FILE_CREATE 0x4 && user has create access
#DEFINE ACCESS_READ 0x01
#DEFINE ACCESS_WRITE 0x02
#DEFINE ACCESS_CREATE 0x04
#DEFINE ACCESS_EXEC 0x08
#DEFINE ACCESS_DELETE 0x10
#DEFINE ACCESS_ATRIB 0x20
#DEFINE ACCESS_PERM 0x40
#DEFINE ACCESS_GROUP 0x8000
#DEFINE ACCESS_ALL ( ACCESS_READ + ACCESS_WRITE + ACCESS_CREATE + ;
ACCESS_EXEC + ACCESS_DELETE + ACCESS_ATRIB + ACCESS_PERM )
LOCAL lcServerName, lcBasePath, lcUserName, lnBufferPointer
LOCAL lnPreferedMaxLength, lnEntriesRead, lnTotalEntries
LOCAL lnResumeHandle, lnError, loPointersObject
LOCAL lnI, lcDll, lnPermissions, lnID
LOCAL llContinue, lnpFileInfo, lcFileName
LOCAL lnLocks, loRec, lcPermissions
IF ("?" $ tcFileName) OR ("*" $ tcFileName)
_msgbox("File Mask is not supported.")
RETURN
ENDIF
IF EMPTY(SYS(2000, DEFAULTEXT(tcFileName,"*")))
_msgbox("File Name '" + tcFileName + "' not found")
RETURN
ENDIF
IF LEFT(tcFileName,2) = "\\"
lcNetName = LEFT(tcFileName, AT("\", tcFileName, 4)-1)
lcRestName = SUBSTR(tcFileName, AT("\", tcFileName, 4)+1)
lcDriveLetter = lcNetName
ELSE
lcDriveLetter = UPPER(JUSTDRIVE(tcFileName))
IF EMPTY(lcDriveLetter)
_msgbox("Incorrect File Name '" + tcFileName + "'")
RETURN
ENDIF
* Convert a driver letter to the UNC path
lcNetName = _LocalName2UNC(lcDriveLetter)
IF EMPTY(lcNetName)
_msgbox(lcDriveLetter + " isn't a network drive - '" + tcFileName + "'")
RETURN
ENDIF
lcRestName = SUBSTR(JUSTPATH(tcFileName),4)
ENDIF
* Convert share UNC path to the server local path
lcServerName = "\\" + STREXTRACT(lcNetName, "\\", "\")
lcLocalPath = _Share2LocalPath(lcNetName)
IF ISNULL(lcLocalPath)
RETURN
ENDIF
lcBasePath = ADDBS(lcLocalPath) + lcRestName
lcUserName = ""
lcFileMask = JUSTFNAME(tcFileName)
DECLARE INTEGER NetFileEnum IN NETAPI32 ;
STRING @ServerName, STRING @BasePath, ;
STRING @UserName, INTEGER nLevel, ;
INTEGER @BufferPointer, INTEGER PreferedMaxLength, ;
INTEGER @EntriesRead, INTEGER @TotalEntries, ;
INTEGER @ResumeHandle
*-- This is the structure used by NetFileEnum to retrieve the information.
*typedef struct _FILE_INFO_3 {
* DWORD fi3_id;
* DWORD fi3_permissions;
* DWORD fi3_num_locks;
* LPWSTR fi3_pathname;
* LPWSTR fi3_username;} FILE_INFO_3
loWas = NEWOBJECT("WinApiSupport", "WinApiSupport.fxp")
CREATE CURSOR crsWhoHas ( ;
UserName C(10), ;
Locks I, ;
FileID I, ;
Permissions C(24), ;
FileName C(254), ;
ServerFileName C(254))
SCATTER MEMO NAME loRec
*-- The server name, the base path and the user name must be in Unicode format.
lcServerName = StrConv(StrConv(lcServerName + Chr(0), 1), 5)
lcBasePath = StrConv(StrConv(lcBasePath + Chr(0), 1), 5)
lcUserName = StrConv(StrConv(lcUserName + Chr(0), 1), 5)
*-- Allow for a very large buffer.
* If this length is not enough, the info
* will be retrieved in more than one step.
lnPreferedMaxLength = 100000000
lnResumeHandle = 0
lnEntriesRead = 0
lnTotalEntries = 0
lnBufferPointer = 0
llContinue = .t.
DO WHILE llContinue
lnError = NetFileEnum( lcServerName, lcBasePath, lcUserName, 3, ;
@lnBufferPointer, lnPreferedMaxLength, @lnEntriesRead, ;
@lnTotalEntries, @lnResumeHandle)
IF lnEntriesRead = 0
*-- There are no (more) open files.
llContinue = .f.
ENDIF
IF lnError = 0
FOR lnI = 1 TO lnEntriesRead
lnpFileInfo = lnBufferPointer + (lnI - 1) * 20
lcFileName = loWas.StrZFromBufferW(lnpFileInfo + 12)
IF UPPER(JUSTFNAME(lcFileName)) <> UPPER(lcFileMask)
LOOP
ENDIF
lnpFileInfo = lnBufferPointer + (lnI - 1) * 20
*-- Extract the file name
loRec.FileName = lcDriveLetter + "\" + STREXTRACT(lcFileName, lcLocalPath, "",1,1)
loRec.ServerFileName = lcFileName
*-- Extract the number of locks on this file
lnLocks = loWas.Long2NumFromBuffer(lnpFileInfo + 8)
loRec.Locks = lnLocks
*-- Extract the user name that opened the file
lcUserName = loWas.StrZFromBufferW(lnpFileInfo + 16)
loRec.UserName = lcUserName
*-- Extract the permissions on this file
lnPermissions = loWas.Long2NumFromBuffer( lnpFileInfo + 4)
lcPermissions = ""
IF BITAND(lnPermissions, PERM_FILE_READ) > 0
lcPermissions = lcPermissions + "Read+"
ENDIF
IF BITAND(lnPermissions, PERM_FILE_WRITE) > 0
lcPermissions = lcPermissions + "Write+"
ENDIF
IF BITAND(lnPermissions, PERM_FILE_CREATE) > 0
lcPermissions = lcPermissions + "Create+"
ENDIF
loRec.Permissions = LEFT(lcPermissions, LEN(lcPermissions)-1)
*-- Extract the ID for this file.
* This ID is generated when the file is opened and
* can be used as parameter for the NetFileGetInfo
* Win32 API function.
lnID = loWas.Long2NumFromBuffer(lnpFileInfo)
loRec.FileID = lnID
INSERT INTO crsWhoHas FROM NAME loRec
ENDFOR
*-- Free the memory allocated by NetFileEnum
IF lnBufferPointer <> 0
DeAllocNetAPIBuffer(lnBufferPointer)
ENDIF
ELSE
_msgbox("Error No. "+alltrim(str(lnError)),64,'Unable To Continue')
llContinue = .f.
ENDIF
ENDDO
IF RECCOUNT("crsWhoHas") = 0
_msgbox("No open files found for '" + tcFileName + "'")
RETURN
ENDIF
SELECT crsWhoHas
INDEX ON UserName TAG UserName
LOCATE
BROWSE LAST NOWAIT NAME oBr
oBr.ReadOnly = .T.
oBr.Columns(1).Header1.Caption = "User Name"
oBr.Columns(3).Header1.Caption = "File ID"
oBr.Columns(5).Header1.Caption = "File Name"
oBr.Columns(6).Header1.Caption = "Server File Name"
oBr.AutoFit()
RETURN
ENDPROC
*----------------------------------------------------------------------------------
PROCEDURE _apierror
LPARAMETERS tnErrorCode
LOCAL lcErrBuffer, lcErrorMess, lnNewErr
DECLARE Long FormatMessage In kernel32.dll ;
Long dwFlags, String @lpSource, ;
Long dwMessageId, Long dwLanguageId, ;
String @lpBuffer, Long nSize, Long Arguments
lcErrBuffer = REPL(CHR(0),1000)
lnNewErr = FormatMessage(0x1000,.NULL., tnErrorCode, 0, @lcErrBuffer,500,0)
lcErrorMess = TRANSFORM(tnErrorCode) + " " + LEFT(lcErrBuffer, AT(CHR(0),lcErrBuffer)- 1 )
RETURN lcErrorMess
ENDPROC
*----------------------------------------------------------------------------------
PROCEDURE _msgbox
LPARAMETERS tcMessage
=MESSAGEBOX(tcMessage,16)
RETURN "OK"
ENDPROC
*----------------------------------------------------------------------------------
PROCEDURE _share2localpath
LPARAMETERS tcNetName
LOCAL loWas, lnBufferPointer, lcServer, lcShare, lnRC, lcPathRest, loWas, lcLocalPath
IF EMPTY(tcNetName) OR TYPE("tcNetName") <> "C"
ERROR 11
ENDIF
DECLARE Long NetShareGetInfo IN Netapi32.dll ;
String servername, String netname, Long level, Long @bufptr
lcServer = STREXTRACT(tcNetName, "\\", "\")
IF EMPTY(lcServer)
RETURN ""
ENDIF
lcShare = STREXTRACT(tcNetName, "\\" + lcServer + "\", "\",1,1+2)
lcPathRest = STREXTRACT(tcNetName, "\\" + lcServer + "\" + lcShare + "\", "",1,1)
IF EMPTY(lcShare)
RETURN ""
ENDIF
lnBufferPointer = 0
lnRC = NetShareGetInfo(STRCONV(lcServer+CHR(0),5), ;
STRCONV(lcShare+CHR(0),5), 2, @lnBufferPointer)
IF lnRC = 0
loWas = NEWOBJECT("WinApiSupport", "WinApiSupport.fxp")
lcLocalPath = ADDBS(loWas.strzfrombufferw(lnBufferPointer + 24)) + lcPathRest
ELSE
lcLocalPath = Null
_msgbox("Error accessing server '" + lcServer + "', share '" + lcShare + "'" + CHR(13) + _apierror(lnRC))
ENDIF
*!* typedef struct _SHARE_INFO_2 {
*!* 0 LPWSTR shi2_netname;
*!* 4 DWORD shi2_type;
*!* 8 LPWSTR shi2_remark;
*!* 12 DWORD shi2_permissions;
*!* 16 DWORD shi2_max_uses;
*!* 20 DWORD shi2_current_uses;
*!* 24 LPWSTR shi2_path;
*!* 28 LPWSTR shi2_passwd;
*!* } SHARE_INFO_2
RETURN lcLocalPath
ENDPROC
*----------------------------------------------------------------------------------
PROCEDURE _LocalName2UNC
PARAMETERS tcLocalName
LOCAL lcUNCBuffer, lnLength, lcLocalName
DECLARE INTEGER WNetGetConnection IN WIN32API ;
STRING @ lpLocalName, ;
STRING @ lpRemoteName, ;
INTEGER @ lplnLength
IF EMPTY(tcLocalName) OR TYPE("tcLocalName") <> "C"
ERROR 11
ENDIF
lcLocalName = ALLTRIM(tcLocalName)
IF LEN(lcLocalName) = 1
lcLocalName = lcLocalName + ":"
ENDIF
lcUNCBuffer = REPL(CHR(0),261)
lnLength = LEN(lcUNCBuffer)
IF WNetGetConnection(lcLocalName, @lcUNCBuffer, @lnLength) = 0
lcRemoteName = LEFT(lcUNCBuffer,AT(CHR(0),lcUNCBuffer)-1)
ELSE
lcRemoteName = ""
ENDIF
RETURN lcRemoteName
ENDPROC
*----------------------------------------------------------------------------------
FUNCTION DeAllocNetAPIBuffer
*
* Frees the NetAPIBuffer allocated at the address specified by nPtr.
* The API call is not supported under Win9x
LPARAMETER tnBufferPointer
DECLARE INTEGER NetApiBufferFree IN NETAPI32.DLL ;
INTEGER lpBuffer
RETURN (NetApiBufferFree(INT(tnBufferPointer)) = 0)
ENDFUNC
*----------------------------------------------------------------------------------
DEFINE CLASS WinApiSupport AS Custom
* Converts VFP number to the Long integer
FUNCTION Num2Long(tnNum)
LOCAL lcStringl
lcString = SPACE(4)
=RtlPL2PS(@lcString, BITOR(tnNum,0), 4)
RETURN lcString
ENDFUNC
* Convert Long integer into VFP numeric variable
FUNCTION Long2Num(tcLong)
LOCAL lnNum
lnNum = 0
= RtlS2PL(@lnNum, tcLong, 4)
RETURN lnNum
ENDFUNC
* Return Number from a pointer to DWORD
FUNCTION Long2NumFromBuffer(tnPointer)
LOCAL lnNum
lnNum = 0
= RtlP2PL(@lnNum, tnPointer, 4)
RETURN lnNum
ENDFUNC
* Convert Short integer into VFP numeric variable
FUNCTION Short2Num(tcLong)
LOCAL lnNum
lnNum = 0
= RtlS2PL(@lnNum, tcLong, 2)
RETURN lnNum
ENDFUNC
* Retrieve zero-terminated string from a buffer into VFP variable
FUNCTION StrZFromBuffer(tnPointer)
LOCAL lcStr, lnStrPointer
lcStr = SPACE(4096)
lnStrPointer = 0
= RtlP2PL(@lnStrPointer, tnPointer, 4)
lstrcpy(@lcStr, lnStrPointer)
RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1)
ENDFUNC
* Return a string from a pointer to LPWString (Unicode string)
FUNCTION StrZFromBufferW(tnPointer)
Local lcResult, lnStrPointer, lnSen
lnStrPointer = This.Long2NumFromBuffer(tnPointer)
lnSen = lstrlenW(lnStrPointer) * 2
lcResult = Replicate(chr(0), lnSen)
= RtlP2PS(@lcResult, lnStrPointer, lnSen)
lcResult = StrConv(StrConv(lcResult, 6), 2)
RETURN lcResult
ENDFUNC
* Retrieve zero-terminated string
FUNCTION StrZCopy(tnPointer)
LOCAL lcStr, lnStrPointer
lcStr = SPACE(4096)
lstrcpy(@lcStr, tnPointer)
RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1)
ENDFUNC
ENDDEFINE
*------------------------------------------------------------------------
FUNCTION RtlPL2PS(tcDest, tnSrc, tnLen)
DECLARE RtlMoveMemory IN WIN32API AS RtlPL2PS STRING @Dest, Long @Source, Long Length
RETURN RtlPL2PS(@tcDest, tnSrc, tnLen)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION RtlS2PL(tnDest, tcSrc, tnLen)
DECLARE RtlMoveMemory IN WIN32API AS RtlS2PL Long @Dest, String Source, Long Length
RETURN RtlS2PL(@tnDest, @tcSrc, tnLen)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION RtlP2PL(tnDest, tnSrc, tnLen)
DECLARE RtlMoveMemory IN WIN32API AS RtlP2PL Long @Dest, Long Source, Long Length
RETURN RtlP2PL(@tnDest, tnSrc, tnLen)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION RtlP2PS(tcDest, tnSrc, tnLen)
DECLARE RtlMoveMemory IN WIN32API AS RtlP2PS STRING @Dest, Long Source, Long Length
RETURN RtlP2PS(@tcDest, tnSrc, tnLen)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION lstrcpy (tcDest, tnSrc)
DECLARE lstrcpy IN WIN32API STRING @lpstring1, INTEGER lpstring2
RETURN lstrcpy (@tcDest, tnSrc)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION lstrlenW(tnSrc)
DECLARE Long lstrlenW IN WIN32API Long src
RETURN lstrlenW(tnSrc)
ENDFUNC
*------------------------------------------------------------------------
No hay comentarios. :
Publicar un comentario
Los comentarios son moderados, por lo que pueden demorar varias horas para su publicación.