I am trying to simulate an annoying file lock that occurs sometimes so I can test the affect on a tool I have created.
So far I have been unable to simulate the file lock.
The symptoms I experience with the file lock is the following:
I can move and rename the file without issues.
If I attempt to delete the file, it appears to delete, but when I refresh the folder, it re-appears. After the attempted deletion, I cannot create a new file with the same name in that folder until after I reboot.
Note that the file appears to be locked by a thread in the system process.
All attempts so far to lock a file in a similar way prevent me from being able to move or rename the locked file. I am now on Update #3 (see below).
I have used different Windows APIs such as LockFileEx and .NET libraries, but so far none have reproduced the behaviour.
I appreciate any suggestions that could help determine a way to simulate this, even if not via the system process.
This is one example of the code I have unsuccessfully tried to attempt to simulate this locking behaviour.
Private FileHandle As IntPtr
Private LockAcquired As LockAcquiredEnum
Private ResetEvent As ManualResetEvent = Nothing
Private Overlapped As New System.Threading.NativeOverlapped
Private Enum LockAcquiredEnum
Failed
Pending
Succeeded
End Enum
#Region "Declarations"
Private Const INVALID_HANDLE_VALUE As Short = -1
Private Const ERROR_SUCCESS As Short = 0
Public Const ERROR_IO_PENDING As Integer = &H3E5
<DllImport("kernel32.dll", CharSet:=CharSet.Unicode, SetLastError:=True, EntryPoint:="CreateFileW")>
Private Shared Function CreateFile(<MarshalAs(UnmanagedType.LPWStr)> ByVal filename As String, <MarshalAs(UnmanagedType.U4)> ByVal access As FileAccess, <MarshalAs(UnmanagedType.U4)> ByVal share As FileShare, ByVal securityAttributes As IntPtr, <MarshalAs(UnmanagedType.U4)> ByVal creationDisposition As FileMode, <MarshalAs(UnmanagedType.U4)> ByVal OptionsAndAttributes As UInteger, ByVal templateFile As IntPtr) As IntPtr
End Function
<DllImport("kernel32.dll", SetLastError:=True)>
Private Shared Function LockFileEx(ByVal hFile As IntPtr, ByVal dwFlags As UInteger, ByVal dwReserved As UInteger, ByVal nNumberOfBytesToLockLow As UInteger, ByVal nNumberOfBytesToLockHigh As UInteger, <[In]> ByRef lpOverlapped As System.Threading.NativeOverlapped) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
<DllImport("kernel32.dll")>
Shared Function UnlockFileEx(ByVal hFile As IntPtr, ByVal dwReserved As UInteger, ByVal nNumberOfBytesToUnlockLow As UInteger, ByVal nNumberOfBytesToUnlockHigh As UInteger, <[In]> ByRef lpOverlapped As System.Threading.NativeOverlapped) As Boolean
End Function
<DllImport("kernel32.dll", SetLastError:=True)>
Private Shared Function CloseHandle(ByVal hHandle As IntPtr) As Boolean
End Function
Private Enum FileLockEnum As UInteger
LOCKFILE_FAIL_IMMEDIATELY = 1
LOCKFILE_EXCLUSIVE_LOCK = 2
End Enum
#End Region
Private Sub cmdLockTestFile_Click(sender As Object, e As EventArgs) Handles cmdLockTestFile.Click
LockFile()
End Sub
Private Sub cmdUnlockTestFile_Click(sender As Object, e As EventArgs) Handles cmdUnlockTestFile.Click
UnlockFile()
End Sub
Private Sub LockFile()
' Get the options
Dim dwFileFlags As FileOptions
Dim dwLockFlags As FileLockEnum
dwFileFlags = FileOptions.Asynchronous
' Open the file
lblStatus.Text = $"Opening the file 'TestFile.exe' as {If((dwFileFlags And FileOptions.Asynchronous) <> 0, "asynchronous", "synchronous")}" & vbLf
FileHandle = CreateFile("C:\Program Files (x86)\App\TestFile.exe", FileAccess.Read, FileShare.ReadWrite, Nothing, FileMode.Open, FileAttributes.Normal Or dwFileFlags, Nothing)
If FileHandle = INVALID_HANDLE_VALUE Then
lblStatus.Text = $"Open failed, error = {Marshal.GetLastWin32Error()}" & vbLf
Return
End If
'Optionally set this
'dwLockFlags = FileLockEnum.LOCKFILE_EXCLUSIVE_LOCK
' Set the starting position in the OVERLAPPED structure
Dim o As New System.Threading.NativeOverlapped
o.OffsetLow = 0 ' we lock on byte zero
' Say what kind of lock we want
If (dwLockFlags And FileLockEnum.LOCKFILE_EXCLUSIVE_LOCK) <> 0 Then
lblStatus.Text = "Requesting exclusive lock" & vbLf
Else
lblStatus.Text = "Requesting shared lock" & vbLf
End If
' Say whether we're going to wait to acquire
If (dwLockFlags And FileLockEnum.LOCKFILE_FAIL_IMMEDIATELY) <> 0 Then
lblStatus.Text = "Requesting immediate failure" & vbLf
ElseIf dwFileFlags And FileOptions.Asynchronous Then
lblStatus.Text = "Requesting notification on lock acquisition" & vbLf
' The event that will be signaled when the lock is acquired
' error checking deleted for expository purposes
ResetEvent = New ManualResetEvent(False)
o.EventHandle = ResetEvent.SafeWaitHandle.DangerousGetHandle
Else
lblStatus.Text = "Call will block until lock is acquired" & vbLf
End If
' Okay, here we go.
lblStatus.Text = "Attempting lock" & vbLf
Dim IsLockAcquired As Boolean = LockFileEx(FileHandle, dwLockFlags, 0, 1, 0, o)
' If the lock failed, remember why.
Dim dwError As UInteger = If(IsLockAcquired, ERROR_SUCCESS, Marshal.GetLastWin32Error())
lblStatus.Text = $"Wait {If(IsLockAcquired, "succeeded", "failed")}, error code {dwError}" & vbLf
If IsLockAcquired Then
lblStatus.Text = "Lock acquired immediately" & vbLf
LockAcquired = LockAcquiredEnum.Succeeded
ElseIf dwError = ERROR_IO_PENDING Then
LockAcquired = LockAcquiredEnum.Pending
lblStatus.Text = "Waiting for lock" & vbLf
Else
LockAcquired = LockAcquiredEnum.Failed
End If
End Sub
Private Sub UnlockFile()
If LockAcquired = LockAcquiredEnum.Pending Then
ResetEvent.WaitOne()
LockAcquired = LockAcquiredEnum.Succeeded
End If
' If we got the lock, then hold the lock until the user releases it.
If LockAcquired = LockAcquiredEnum.Succeeded Then
lblStatus.Text = "Unlocking" & vbLf
UnlockFileEx(FileHandle, 0, 1, 0, Overlapped)
End If
' Clean up
If ResetEvent IsNot Nothing Then
ResetEvent.Close()
ResetEvent.Dispose()
End If
CloseHandle(FileHandle)
lblStatus.Text = "Unlocked TestFile.exe" & vbLf
End Sub
I am unable to reproduce the behaviour I have experienced using this code. It seems to be caused by something running under Windows' system process (pid 4)
Update:
Based on Feedback from #HansPassant, I have tried to modify my code to simulate this behaviour, but I still cannot reproduce this.
I first tried removing the code that makes use of the LockFileEx API, and only opening the file with the CreateFile API with the addition of the FileShare.Delete attribute to one parameter.
FileHandle = CreateFile("C:\Program Files (x86)\App\TestFile.exe", FileAccess.Read, FileShare.Read Or FileShare.Delete, Nothing, FileMode.Open, FileAttributes.Normal Or dwFileFlags, Nothing)
I then tried to completely rewrite it using a FileStream object like the other article mentions, but that did not work either.
Public Class Form1
Private TestFileStream As FileStream
Private Sub cmdLockTestFile_Click(sender As Object, e As EventArgs) Handles cmdLockTestFile.Click
LockFile()
End Sub
Private Sub cmdUnlockTestFile_Click(sender As Object, e As EventArgs) Handles cmdUnlockTestFile.Click
UnlockFile()
End Sub
Private Sub LockFile()
' Open the file
lblStatus.Text = $"Opening the file 'TestFile.exe' with FileShare.Delete permissions." & vbLf
Try
TestFileStream = New FileStream("C:\Program Files (x86)\App\TestFile.exe", FileMode.Open, FileAccess.Read, FileShare.Read Or FileShare.Delete)
lblStatus.Text &= "File is opened with FileShare.Delete permissions." & vbLf
FileReadTimer.Enabled = True
Catch ex As Exception
lblStatus.Text &= $"Open failed, error = {ex.Message}" & vbLf
Return
End Try
End Sub
Private Sub UnlockFile()
If TestFileStream IsNot Nothing Then
TestFileStream.Close()
End If
FileReadTimer.Enabled = False
lblStatus.Text &= "Closed TestFile.exe"
End Sub
Private Sub FileReadTimer_Tick(sender As Object, e As EventArgs) Handles FileReadTimer.Tick
Dim Value As Integer
Value = TestFileStream.ReadByte()
If Value = -1 Then
TestFileStream.Position = 0
Value = TestFileStream.ReadByte()
End If
End Sub
End Class
I even tried this, but it didn't help.
TestFileStream = New FileStream("C:\Program Files (x86)\App\TestFile.exe", FileMode.Open, FileAccess.ReadWrite, FileShare.ReadWrite Or FileShare.Delete)
The only thing I did not try was modifying the file. It does not make sense to me that whatever process is locking the file would actually be modifying it, and I do not want to damage the file in any way.
So far, no matter what I have tried, while the file is open in code, I am still able to delete the file from the folder. A refresh of that folder does not make it re-appear, and I am able to create a new file with the same name.
Update #2:
I tried following the example here https://stackoverflow.com/a/19875330/4816919 but I still could not reproduce it. (It is the same stackoverflow post mentioned by #HansPassant)
I changed the lines that create the FileStream object to where the Timer is enabled to this:
TestFileStream = New FileStream("C:\Program Files (x86)\App\TestFile.exe", FileMode.Open, FileAccess.Read, FileShare.Read Or FileShare.Delete, 4096, FileOptions.SequentialScan)
lblStatus.Text &= "File is opened with FileShare.Delete permissions." & vbLf
TestFileStream.Read(New Byte(99){}, 1, 1)
GC.KeepAlive(TestFileStream)
FileReadTimer.Enabled = True
I am at a loss as to how to do this so far.
Update #3
Based on my research, it appears that this is a behaviour of transactional NTFS.
I have therefore modified my project to use the AlphaFS library, which simplifies performing transactional NTFS operations.
This is my latest code.
Public Class Form1
Private sxRuntimeStream As FileStream
Private FileTransaction As Alphaleonis.Win32.Filesystem.KernelTransaction
Private Sub cmdLockSxRuntime_Click(sender As Object, e As EventArgs) Handles cmdLockSxRuntime.Click
LockFile()
End Sub
Private Sub cmdUnlockSxRuntime_Click(sender As Object, e As EventArgs) Handles cmdUnlockSxRuntime.Click
UnlockFile()
End Sub
Private Sub cmdCloseTransaction_Click(sender As Object, e As EventArgs) Handles cmdCloseTransaction.Click
CloseTransaction()
End Sub
Private Sub LockFile()
' Open the file
If FileTransaction IsNot Nothing Then
lblStatus.Text = "The Transaction is still open." & vbLf
ElseIf sxRuntimeStream IsNot Nothing Then
lblStatus.Text = "The file 'sxRuntime.exe' is already open." & vbLf
Else
lblStatus.Text = "Opening the file 'sxRuntime.exe' with FileShare.Delete permissions." & vbLf
Try
FileTransaction = New Alphaleonis.Win32.Filesystem.KernelTransaction()
sxRuntimeStream = Alphaleonis.Win32.Filesystem.File.OpenTransacted(FileTransaction, "C:\Program Files (x86)\ActiveERP\sxRuntime.exe", FileMode.Open, FileAccess.Read, FileShare.ReadWrite Or FileShare.Delete, 4096, Alphaleonis.Win32.Filesystem.PathFormat.FullPath)
lblStatus.Text &= "File is opened with FileShare.Delete permissions." & vbLf
sxRuntimeStream.Read(New Byte(99) {}, 1, 1)
GC.KeepAlive(sxRuntimeStream)
FileReadTimer.Enabled = True
Catch ex As Exception
lblStatus.Text &= $"Open failed, error = {ex.Message}" & vbLf
Return
End Try
End If
End Sub
Private Sub UnlockFile()
FileReadTimer.Enabled = False
If sxRuntimeStream IsNot Nothing Then
sxRuntimeStream.Close()
sxRuntimeStream.Dispose()
sxRuntimeStream = Nothing
lblStatus.Text &= "Closed sxRuntime.exe" & vbLf
End If
End Sub
Private Sub CloseTransaction()
If FileTransaction IsNot Nothing Then
FileTransaction.Commit()
FileTransaction.Dispose()
FileTransaction = Nothing
lblStatus.Text &= "Transaction closed"
End If
End Sub
Private Sub FileReadTimer_Tick(sender As Object, e As EventArgs) Handles FileReadTimer.Tick
Dim Value As Integer
Value = sxRuntimeStream.ReadByte()
If Value = -1 Then
sxRuntimeStream.Position = 0
Value = sxRuntimeStream.ReadByte()
End If
End Sub
End Class
Unfortunately, I am still unable to reproduce this behaviour.
I appreciate any suggestions or insights into this matter.
FYI, as it may have been lost above, the behaviour is that when an affected file is attempted to be deleted via Windows Explorer, it appears to work, but a new file in the same location and name cannot be created. Upon refresh, the file re-appears, but most of the file's properties are now lost. Typically only a reboot will finalize the deletion of the file, although I am not concerned with this part.
Recently I have been attempting to create a chatbot for school, and one of the features I wanted was speech recognition. Unfortunately, due to the deprecated nature of VB6, there are very few tutorials on using SAPI for speech recognition with VB6, and none at all for enabling free diction (simply speaking without a grammar set and converting speech into text).
Automation Interfaces and Objects (SAPI 5.4) has the documentation.
Trivial example:
Option Explicit
'See "Automation Interfaces and Objects (SAPI 5.4)" at MSDN.
Private WithEvents RC As SpeechLib.SpInProcRecoContext
Private RG As SpeechLib.ISpeechRecoGrammar
Private Sub Form_Load()
With New SpeechLib.SpInprocRecognizer
Set RC = .CreateRecoContext()
Set .AudioInput = .GetAudioInputs().Item(0)
End With
With RC
.EventInterests = SRERecognition Or SREFalseRecognition
Set RG = .CreateGrammar()
End With
RG.DictationSetState SGDSActive
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then
Text1.Move 0, 0, ScaleWidth, ScaleHeight
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
RG.DictationSetState SGDSInactive
End Sub
Private Sub RC_FalseRecognition( _
ByVal StreamNumber As Long, _
ByVal StreamPosition As Variant, _
ByVal Result As SpeechLib.ISpeechRecoResult)
With Text1
.SelStart = &H7FFF
.SelText = "False Rec: "
.SelText = Result.PhraseInfo.GetText()
.SelText = vbNewLine
End With
End Sub
Private Sub RC_Recognition( _
ByVal StreamNumber As Long, _
ByVal StreamPosition As Variant, _
ByVal RecognitionType As SpeechLib.SpeechRecognitionType, _
ByVal Result As SpeechLib.ISpeechRecoResult)
With Text1
.SelStart = &H7FFF
.SelText = "Rec: "
.SelText = Result.PhraseInfo.GetText()
.SelText = vbNewLine
End With
End Sub
I've a simple winsock server chat and this is the code:
Private Sub Form_Load()
Winsock1.LocalPort = 5100
Winsock1.Listen
End Sub
Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
Winsock1.Close
Winsock1.Accept requestID
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim sData As String
Winsock1.GetData sData
Text1.Text = Text1.Text & sData
End Sub
I receive the message from an ios app but I can't send message with a "sendData".
How can I send message to all the clients? I need to use a client?
Thanks.
If you want to send messages to more than one client, then the best approach would be instead of closing your listening winsock1, and using it to accept the request, to create a new winsock control that will accept the request. This way you can accept connections from more than one source.
Example:
1st change winsock1's property Index to 0, to create a control array. Now all events's signature change to include the Index parameter.
Dim NumSockets As Integer
Private Sub Form_Load()
Winsock1(0).LocalPort = 5100
Winsock1(0).Listen
End Sub
Private Sub Winsock1_Close(Index As Integer)
Winsock1(Index).Close
End Sub
Private Sub Winsock1_ConnectionRequest(Index As Integer, ByVal requestID As Long)
NumSockets = NumSockets + 1
Load Winsock1(NumSockets) 'create a new winsock control
Winsock1(NumSockets).Accept requestID 'use that one to accept the request
End Sub
Private Sub Winsock1_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim vtData As String
Winsock1(Index).GetData vtData, vbString
Print vtData
End Sub
I have a problem trying to catch the completion of a stored proc execute asynchronously.
Below my code VBA (in a class module named clsAsync):
Option Explicit
Private WithEvents cnn As ADODB.Connection
Private Sub cnn_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
MsgBox "Execution completed"
End Sub
Sub execSPAsync()
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
cnn.ConnectionString = "connection to my database SQLSEREVER"
cnn.Open
cnn.Execute "kp.sp_WaitFor", adExecuteNoRecords, adAsyncExecute
End Sub
This class is PublicNotCreatable.
To call the sub execSPAsync from a module I use the following code:
Sub testASYNC()
Dim a As New clsAsync
Call a.execSPAsync
End Sub
The stored procedure is very simple:
alter PROC kp.sp_WaitFor
AS
WAITFOR DELAY '00:00:05'
My problem is that the event ExecuteComplete is not fired at all, while if I comment the adAsynExecute parameter all is working fine.
Any idea on how to solve my question?
I solved my problem replacing the calling code:
Sub testASYNC()
Dim a As New clsAsync
Call a.execSPAsync
End Sub
with this new code:
Private a As clsAsync
Sub testASYNC()
Set a = New clsAsync
Call a.execSPAsync
End Sub
In the async mode, the object "a" is no longer available at the end of the procedure (scope visibility issue).
I was following this MSDN guide on creating custom events. I feel like I understand the process now, but I cannot figure out why I am getting a Compile Error: Event Not Found for RaiseEvent ItemAdded. The weird thing is, the ItemAdded event is recognized by the IDE (I can type it in all lowercase and it is then automatically formatted properly), so I know that it is recognized by VB.
DataComboBox Class Module Code:
Public Event ItemAdded(sItem As String, fCancel As Boolean)
Private pComboBox As Control
Public Property Set oComboBox(cControl As Control)
Set pComboBox = cControl
End Property
Public Property Get oComboBox() As Control
oComboBox = pComboBox
End Property
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
End Sub
The UserForm contains two controls - a CommandButton named btnAdd and a ComboBox named cboData.
UserForm Code:
Private WithEvents mdcbCombo As DataComboBox
Private Sub UserForm_Initialize()
Set mdcbCombo = New DataComboBox
Set mdcbCombo.oComboBox = Me.cboData
End Sub
Private Sub mdcbCombo_ItemAdded(sItem As String, fCancel As Boolean)
Dim iItem As Long
If LenB(sItem) = 0 Then
fCancel = True
Exit Sub
End If
For iItem = 1 To Me.cboData.ListCount
If Me.cboData.List(iItem) = sItem Then
fCancel = True
Exit Sub
End If
Next iItem
End Sub
Private Sub btnAdd_Click()
Dim sItem As String
sItem = Me.cboData.Text
AddDataItem sItem
End Sub
Private Sub AddDataItem(sItem As String)
Dim fCancel As Boolean
fCancel = False
RaiseEvent ItemAdded(sItem, fCancel)
If Not fCancel Then Me.cboData.AddItem (sItem)
End Sub
You cannot raise an event outside the classes file level.
Add a routine like this inside "DataComboBox1" to allow you to raise the event externally.
Public Sub OnItemAdded(sItem As String, fCancel As Boolean)
RaiseEvent ItemAdded(sItem, fCancel)
End Sub
Then call the OnItemAdded with the current object.
Example...
Private WithEvents mdcbCombo As DataComboBox
...
mdcbCombo.OnItemAdded(sItem, fCancel)