10 de marzo de 2016

¿Quién tiene abiertos los archivos en la red?

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