www.FiveTechSoft.com
https://fivetechsupport.com/forums/
Code: Select all | Expand
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 lOnCode: Select all | Expand
IF IsSemaphoreOn("Filebase_FLock")
msginfo("Filebase yet flock !")
return
ENDIF
nHandle:= SemaPhoreOn("Filebase_FLock")
USE FileBase
flock()
...
SemaphoreOff(nHandle)Code: Select all | Expand
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)Code: Select all | Expand
*-- 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)Code: Select all | Expand
* 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")Code: Select all | Expand
Function MyFlock( cAlias, cUser )
local lReply:=.f.
if (cAlias)->(flock())
lReply:=.t.
// record cUser here...
endif
return lReply
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.
Code: Select all | Expand
// 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)James Bott wrote: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
Code: Select all | Expand
// 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