Visual Basic Programming Code Examples

Locking and unlocking files If your ever editing files or records within files, and hence want to prevent other users/processes from accessing these files, then you can lock the files or records within a file. The following demostrates how to lock and unlock files. 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