use FLOCK()

[stefano]

Dear All,

I use flock()… if i find the file already locked I can identify the other user

Grazie
Stefano

[Antonio Linares]

Stefano,

Do you mean tht you want to know the name of the user that has locked a file ?

[stefano]

Yes, I do. I need to know the username or the address IP or other information about the lock of the file

Saluti
Stefano

[nageswaragunupudi]

This is possible only in ADS client-server version.

[James Bott]

Stefano,

Did you mean a file lock, or perhaps a record lock?

There was a discussion of how to determine locking via programming many years ago. I can't find it in my notes, but as I remember it the way was to record the file and user in a DBF when locking and remove the record when unlocking. The problem comes if there is a crash when it is marked locked--it will remain marked as locked when the app is restarted. By "marked locked" I mean there is a record for it. There was a failsafe method to prevent this, but I can't remember how right now.

You might try searching the forum for locking keywords. If you can't find it, let me know and I will search my notes some more because I am quite sure I saved it somewhere.

[hmpaquito]

My generic system lock / shared lock (files, users, counters, programas, etc..) its seems:

Code: Select all  Expand view

FUNCTION SemaphoreOn(cId)
Local cInfo

cInfo:= "User: xxx  date: / /"
nHandle:= FCreate("File_"+ cId)
FWrite(nHandle, cInfo)

RETURN nHandle

FUNCTION SemaphoreOff(nHandle)
FClose(nHandle)
RETURN

FUNCTION IsSemaphoreOn(cId)
Local lOn

lOn:= File("File_"+ cId)
IF lOn
    nHandle:= FOpen("File_"+ cId, FO_EXCLUSIVE)
    IF nHandle > 0
       FClose(nHandle)
    ELSE
        lOn:= .f.
    ENDIF
ENDIF
....
RETURN lOn

Sample:

Code: Select all  Expand view

IF IsSemaphoreOn("Filebase_FLock")
   msginfo("Filebase yet flock !")
   return
ENDIF
nHandle:= SemaPhoreOn("Filebase_FLock")
USE FileBase
flock()
...
SemaphoreOff(nHandle)

This system prevents hangout or systems crashesh

Regards.

[hebert_j_vargas]

Hi, i was Interested in this subject, searching on google I found this app used on Visual Fox Pro (VFP), maybe you can use this:

WinApiSupport.prg

Code: Select all  Expand view

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)

FUNCTION RtlS2PL(tnDest, tcSrc, tnLen)
        DECLARE RtlMoveMemory IN WIN32API AS RtlS2PL Long @Dest, String Source, Long Length
RETURN  RtlS2PL(@tnDest, @tcSrc, tnLen)

FUNCTION RtlP2PL(tnDest, tnSrc, tnLen)
        DECLARE RtlMoveMemory IN WIN32API AS RtlP2PL Long @Dest, Long Source, Long Length
RETURN  RtlP2PL(@tnDest, tnSrc, tnLen)

FUNCTION RtlP2PS(tcDest, tnSrc, tnLen)
        DECLARE RtlMoveMemory IN WIN32API AS RtlP2PS STRING @Dest, Long Source, Long Length
RETURN  RtlP2PS(@tcDest, tnSrc, tnLen)

FUNCTION lstrcpy (tcDest, tnSrc)
        DECLARE lstrcpy IN WIN32API STRING @lpstring1, INTEGER lpstring2
RETURN  lstrcpy (@tcDest, tnSrc)

FUNCTION lstrlenW(tnSrc)
        DECLARE Long lstrlenW IN WIN32API Long src
RETURN  lstrlenW(tnSrc)

-----------------------------------------------------------------------------------------------------------------------------
WhoHasFileOpen.prg

Code: Select all  Expand view

*-- 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.

LPARAMETERS tcFileName
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, lcServerNameUC, lcBasePathUC, lcUserNameUC

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.
lcServerNameUC = StrConv(StrConv(lcServerName + Chr(0), 1), 5)
lcBasePathUC   = StrConv(StrConv(lcBasePath + Chr(0), 1), 5)
lcUserNameUC   = 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( lcServerNameUC, lcBasePathUC, lcUserNameUC, 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("NetFileEnum: Error " + _apierror(lnError))
        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
*----------------------------------------------------------------------------------

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

PROCEDURE _msgbox
    LPARAMETERS tcMessage
    =MESSAGEBOX(tcMessage,16)
RETURN "OK"

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("NetShareGetInfo: 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

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

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)

Good Luck!!

[hebert_j_vargas]

I Forgot to write you how to use.

Sample Code:

Code: Select all  Expand view

* Mapped drive, specific file 'Sometable.dbf'
WhoHasFileOpen("X:\Somefolder\SumSubfolder\Sometable.dbf")
 
* Mapped drive, all extensions for specific file name 'Sometable'
WhoHasFileOpen("X:\Somefolder\SomeSubfolder\Sometable")
 
* UNC path, specific file 'Sometable.dbf'
WhoHasFileOpen("\\SomeServer\SomeShare\Somefolder\SomemSubfolder\Sometable.dbf")

[James Bott]

Herbert,

Looks like lots of good code. Unfortunately, I don't think it answers his question. He wants to know who has the file locked--it could have been opened by someone else. It seems, the functions you provided only can determine who opened the file.

[James Bott]

hmpaquito ,

Your code, like that posted by Herbert, only can only determine who opened the file in exclusive mode. If the file is opened in shared mode, anyone can lock it later.

There needs to be a function that records who locks the file using flock(). Something like this:

Code: Select all  Expand view

Function MyFlock( cAlias, cUser )
    local lReply:=.f.
    if (cAlias)->(flock())
        lReply:=.t.
       // record cUser here...
    endif
return lReply
 

Then he also needs a function to retrieve the user that has the file locked.

James

[hmpaquito]

hmpaquito ,
Your code, like that posted by Herbert, only can only determine who opened the file in exclusive mode. If the file is opened in shared mode, anyone can lock it later.

James,

No. My code blocks all. Or what you want to mark as used. It all depends on how the user uses it.

So maybe the function will be a semaphore (SemaphoreOn(cId) -SemaphoreOff (cId)) and sometimes will establish a brand who is "using" the cId (MarkAsUsedOn(cId) - MarkAsUsedOff (cId))

Everything depends on how the user uses the lock / mark ... if as "inclusive" because it supports more (brand) or blocking does not support more.

In both cases you can collect who is blocking (user) or simply have in use.


Pseudocode:

Code: Select all  Expand view

// 1) Semaphore use (block):

IF IsSemaphoreOn(cId)
    MsgInfo(cId+ " blocked")
    RETURN
ENDIF
SemaPhoreOn(cId)
...
SemaPhoreOff(cId)



// 2) Mark as used use (no block)

MarkAsUsedOn(cId)
...
MarkAsUsedOff(cId)

Regards

[James Bott]

Hmpaquito,

OK, I see, the code you are showing is just a basic concept. I thought it was a completed system and I could not see anyway to track flocks().

I am curious as to how you handle a computer that hangs when a semaphore is locked. Doesn't this leave the semaphore locked?

James

[James Bott]

One issue with adding locking tracking to any existing program is that you are going to have to add code before and after every file lock in the program.

That is, unless, you are using a database class. In this case all you have to do is create a subclass and add locking tracking. Then it gets used anywhere in the program that locking was used.

[hmpaquito]

Hmpaquito,

OK, I see, the code you are showing is just a basic concept. I thought it was a completed system and I could not see anyway to track flocks().

I am curious as to how you handle a computer that hangs when a semaphore is locked. Doesn't this leave the semaphore locked?

James

Operating System does work for us. Since MSDOS times, when application crash, OS close open files.

Code: Select all  Expand view

// Use sample:

aId:= FLockOn()
REPLACE ALL CodePro WITH "XXX"
FLockOff(aId)



// Core functions
FUNCTION FLockOn()
local cId:= "FLock_"+ Alias()+ "_"+ StrZero(Seconds(), 10)
local aId
FLock()
aId:= MarkAsUsedOn(cId)
RETURN aId

FUNCTION FLockOff(aId)
dbUnlock()
MarkAsUsedOff(aId)
RETURN

FUNCTION FLockInfo()
local cId:= "FLock_"
Local aInfo, cInfo:= ""
aInfo:= MarkAsUsedCollect(cId)

MsgInfo(( aeval(aInfo, {|c| cInfo+ = c}), cInfo), "FLock Info")
RETURN NIL

FUNCTION MarkAsUsedOn(cId)
Local cInfo
cInfo:= "User: ??? Date: ???"
nHandle:= FCreate(cId)
FWrite(nHandle, cInfo)
RETURN {cId, nHandle}

FUNCTION MarkAsUsedOff(aId)
FClose(aId[2])
DELETE FILE (aId[1])
RETURN



FUNCTION MarkAsUsedCollect(cId)
Local cMask:= cId
Local a:= Directory(cMask+ "*.*")
Local aItem, aInfo:= {}
Local nHandle
FOR EACH aItem IN a
   IF nHandle:= FOpen(a[1], FO_EXCLUSIVE) <= 0
      // In use. Obtain info: user, time...
      Aadd(aInfo, MemoRead(a[1]) )
   ELSE
       // File not in used: a hangout or crash.
       FClose(nHandle)
       DELETE FILE (a[1])
   ENDIF
NEXT
RETURN aInfo
 

[James Bott]

I was referring to a hang, not a crash. When the computer hangs the file is still locked. It will only be unlocked when the computer is rebooted or turned off. I'm not sure there is anyway to handle a hang.