Locking

• http://visualbasic.happycodings.com/files-directories-drives/code48.html

Option Explicit
 
Public Enum eOpenType
    eOpenUpdate         'Open the file to update it
    eOpenRead           'Open the file to read it
    eOpenNone           'The file is already open
End Enum
 
'Example type
Public Type tUserDetails
    ID As Integer
    Name As String * 20
End Type
 
 
'Purpose     :  Locks a file to prevent other users opening or updating it.
'Inputs      :  sFilePathName               The path and name of the file
'               [eUpdateFile]               If True, opens the file for Appending data, else
'                                           will open the file for Input
'               [lRecordLength]             The file of the input/read type
'               [lRecordNumber]             The record to lock in the file. If -1, will lock the whole file
'               [iFreeFile]                 The file handle of the file to lock.
'Outputs     :  Returns the file handle on success, else returns -1

 
Function FileLock(sFilePathName As String, Optional eUpdateFile As eOpenType = eOpenUpdate, Optional lRecordLength As Long = -1, Optional lRecordNumber As Long = -1, Optional iFreeFile As Integer = 0) As Integer
 
    On Error GoTo ErrFailed
    'Lock file
    Select Case eUpdateFile
    Case eOpenUpdate
        iFreeFile = FreeFile
        If lRecordLength = -1 Then
            'Lock whole file
            Open sFilePathName For Random Shared As iFreeFile
        Else
            'Lock a specific record
            Open sFilePathName For Random Shared As iFreeFile Len = lRecordLength
        End If
    Case eOpenRead
        iFreeFile = FreeFile
        If lRecordLength = -1 Then
            'Lock whole file
            Open sFilePathName For Random Shared As iFreeFile
        Else
            'Lock a specific record
            Open sFilePathName For Random Shared As iFreeFile Len = lRecordLength
        End If
    Case eOpenNone
        'The file is already open, don't open it again
    End Select
 
    If lRecordNumber = -1 Then
        'Lock whole file, so only this process can edit it
        Lock #iFreeFile
    Else
        'Lock a specific record, so only this process can edit that record
        Lock #iFreeFile, lRecordNumber
    End If
 
    FileLock = iFreeFile
 
    Exit Function
 
ErrFailed:
    Debug.Print "Error in FileLock: " & Err.Description
    FileLock = -1
End Function
 
 
'Purpose     :  Unlocks a file
'Inputs      :  iFileHandle                 The handle of the file returned from the function "FileLock"
'               [lRecordNumber]             The record to lock in the file. If -1, will lock the whole file
'               [bCloseFile]                If True will close the file handle
'Outputs     :  Returns the False on success, else returns True

 
Function FileUnLock(ByRef iFileHandle As Integer, Optional lRecordNumber As Long = -1, Optional bCloseFile As Boolean = True) As Boolean
    On Error GoTo ErrFailed
    If iFileHandle Then
        If lRecordNumber = -1 Then
            'Unlock a the whole file
            Unlock iFileHandle%
        Else
            'Unlock a record
            Unlock iFileHandle%, lRecordNumber
        End If
        If bCloseFile Then
            Close #iFileHandle
            iFileHandle = 0
        End If
        FileUnLock = True
    End If
    Exit Function
 
ErrFailed:
    Debug.Print "Error in FileUnLock: " & Err.Description
    FileUnLock = -1
End Function
 
'Locks and Unlocks a file. This enables you to update a exclusively update file
'that is shared by more than one process.

Sub Test()
    Dim iFileHandle As Integer, lThisUser As Long
    Dim tUser As tUserDetails, sFileName As String
 
'---Store some example data in a file
    sFileName = "C:\test.txt"
    If Dir$(sFileName) <> "" Then
        'Delete existing file
        VBA.Kill sFileName
    End If
    iFileHandle = FileLock(sFileName, eOpenUpdate, Len(tUser))      'Open the file and lock it
    
    'Add 10 users (all called Red!)
    tUser.Name = "Red"
    For lThisUser = 1 To 20
        'Alter the ID
        tUser.ID = lThisUser
        'Write the type to the file
        Put #iFileHandle, lThisUser, tUser
    Next
    'Unlock the file, but don't close it
    FileUnLock iFileHandle, , False
    MsgBox "This file ' " & sFileName & "' now contains 10 records... ", vbInformation
 
    'Lock record 1 then update it
    Call FileLock(sFileName, eOpenNone, Len(tUser), 1, iFileHandle)
    MsgBox "This record 1 of the file ' " & sFileName & "' is now locked.", vbInformation
    tUser.Name = "Red"
    tUser.ID = 1
    'Write the type to the file
    Put #iFileHandle, 1, tUser
 
    'Retrieve the records
    For lThisUser = 1 To 20
        'Alter the ID
        tUser.ID = lThisUser
        'Write the type to the file
        Get #iFileHandle, lThisUser, tUser
        Debug.Print "Name/ID: " & Trim$(tUser.Name) & "/" & tUser.ID
    Next
 
    'Release the lock on the first record and close the file
    FileUnLock iFileHandle, 1, True
 
End Sub

• http://msdn.microsoft.com/en-us/library/aa165435%28office.10%29.aspx

Sub OpenDBExclusive (strDBPath As String)
   Dim cnnDB As ADODB.Connection
   Dim errCurrent As ADODB.Error
 
   ' Initialize Connection object.
   Set cnnDB = New ADODB.Connection
 
   ' Specify Microsoft Jet 4.0 provider and then try
   ' to open the database specified in the strDBPath
   ' variable in exclusive mode.
   On Error Resume Next
   With cnnDB
      .Provider = "Microsoft.Jet.OLEDB.4.0"
      .Mode = adModeShareExclusive
      .Open strDBPath
   End With
 
   If Err <> 0 Then
      ' If errors occur, display them.
      For Each errCurrent In ADODB.Errors
         Debug.Print "Error " & errCurrent.SQLState _
            & ": " & errCurrent.Description
      Next
   Else
      ' No errors: You have exclusive access.
      Debug.Print "The database is open in exclusive mode."
   End If
 
   ' Close Connection object and destroy object variable.
   cnnDB.close
   Set cnnDB = Nothing
End Sub