У меня есть проект winforms в VB.Net 2017. У меня есть подпрограмма под названием LogDataFiles, которая использует API CreateFile и WriteFile для записи небольшого файла данных на диск.При запуске из исходного кода я могу успешно записать файлы, вызвав процедуру LogDataFiles непосредственно через командную кнопку или отправив сообщение в очередь сообщений, которая, в свою очередь, вызывает функцию LogDataFiles.
Однако после компиляциии запуск из исполняемого файла, поведение меняется.Я по-прежнему могу записывать файлы, вызывая подпрограмму напрямую через командную кнопку, но CreateFile завершается ошибкой с кодом ошибки 998, если я отправляю сообщение в очередь сообщений, а затем вызываю функцию LogDataFiles.Функция пытается записать 5 файлов.С первой попытки будет записан первый файл, но все остальные файлы не будут работать в CreateFile с ошибкой 998. Последующие попытки через очередь сообщений завершатся неудачно, даже для первого файла.
Мне нужна помощь, чтобы выяснить, почему логикапроисходит сбой в исполняемом режиме, когда он работает из исходного кода.
Это соответствующий код.Сначала объявления API, затем подпрограммы ведения журнала, а затем логика очереди.
Private Structure SECURITY_ATTRIBUTES
Dim nLength As Integer
Dim lpSecurityDescriptor As Integer
Dim bInheritHandle As Boolean
End Structure
Private Declare Auto Function CreateFile Lib "kernel32.dll" (ByVal lpFileName As String,
ByVal dwDesiredAccess As Int32, ByVal dwShareMode As Int32, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES,
ByVal dwCreationDisposition As Int32, ByVal dwFlagsAndAttributes As Int32, ByVal hTemplateFile As IntPtr) As Integer
Private Declare Auto Function CreateFile Lib "kernel32.dll" (ByVal lpFileName As String,
ByVal dwDesiredAccess As Int32, ByVal dwShareMode As Int32, ByRef lpSecurityAttributes As IntPtr,
ByVal dwCreationDisposition As Int32, ByVal dwFlagsAndAttributes As Int32, ByVal hTemplateFile As IntPtr) As Integer
Private Declare Auto Function SetFilePointer Lib "kernel32" (ByVal hFile As Integer, _
ByVal lDistanceToMove As Integer, ByRef lpDistanceToMoveHigh As Integer, _
ByVal dwMoveMethod As Integer) As Long
Private Declare Auto Function ReadFile Lib "Kernel32.dll" ( _
ByVal hndRef As Integer, ByVal lpBuffer As Byte(), _
ByVal numberOfBytesToRead As Integer, ByRef numberOfBytesRead As Integer, ByVal flag As Integer) As Boolean
Private Declare Auto Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Integer) As Boolean
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, ByRef lpFreeBytesAvailableToCaller As Long, ByRef lpTotalNumberOfBytes As Long, ByRef lpTotalNumberOfFreeBytes As Long) As Long
Private Declare Auto Function GetLastError Lib "kernel32" () As Long
Private Declare Function WriteFile Lib "kernel32" (
ByVal hTemplateFile As Integer, lpBuffer() As Byte,
ByVal nNumberOfBytesToWrite As Int32,
ByRef lpNumberOfBytesWritten As Int32, ByVal lpOverlapped As Int32) As Integer
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, ByRef lpSectorsPerCluster As UInt32, ByRef lpBytesPerSector As UInt32, ByRef lpNumberOfFreeClusters As UInt32, ByRef lpTtoalNumberOfClusters As UInt32) As Integer
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Integer) As Integer
Private Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Integer
Private Const GENERIC_WRITE As Long = &H40000000
Private Const GENERIC_READ As Long = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const CREATE_ALWAYS As Long = 2
Private Const OPEN_EXISTING As Long = 3
Private Const OPEN_ALWAYS As Long = 4
Private Const INVALID_HANDLE_VALUE As Long = -1
' CreateFile dwShareMode
Private Const FILE_SHARE_READ As Integer = &H1
Private Const FILE_SHARE_WRITE As Integer = &H2
' Windows file cache related attributes
Private Const WRITE_THROUGH As Long = &H80000000
Private Const NO_BUFFERING As Long = &H20000000
Friend Structure STORAGE_DEVICE_NUMBER
Friend DeviceType As Integer
Friend DeviceNumber As Integer
Friend PartitionNumber As Integer
End Structure
Private Enum EFileAccess As System.Int32
''
'' The following are masks for the predefined standard access types
''
DELETE = &H10000
READ_CONTROL = &H20000
WRITE_DAC = &H40000
WRITE_OWNER = &H80000
SYNCHRONIZE = &H100000
STANDARD_RIGHTS_REQUIRED = &HF0000
STANDARD_RIGHTS_READ = READ_CONTROL
STANDARD_RIGHTS_WRITE = READ_CONTROL
STANDARD_RIGHTS_EXECUTE = READ_CONTROL
STANDARD_RIGHTS_ALL = &H1F0000
SPECIFIC_RIGHTS_ALL = &HFFFF
''
'' AccessSystemAcl access type
''
ACCESS_SYSTEM_SECURITY = &H1000000
''
'' MaximumAllowed access type
''
MAXIMUM_ALLOWED = &H2000000
''
'' These are the generic rights.
''
GENERIC_READ = &H80000000
GENERIC_WRITE = &H40000000
GENERIC_EXECUTE = &H20000000
GENERIC_ALL = &H10000000
End Enum
Private Enum EFileShare
FILE_SHARE_NONE = &H0
FILE_SHARE_READ = &H1
FILE_SHARE_WRITE = &H2
FILE_SHARE_DELETE = &H4
End Enum
Private Enum ECreationDisposition
''' <summary>
''' Creates a new file, only if it does not already exist.
''' If the specified file exists, the function fails and the last-error code is set to ERROR_FILE_EXISTS (80).
''' If the specified file does not exist and is a valid path to a writable location, a new file is created.
''' </summary>
CREATE_NEW = 1
''' <summary>
''' Creates a new file, always.
''' If the specified file exists and is writable, the function overwrites the file, the function succeeds, and last-error code is set to ERROR_ALREADY_EXISTS (183).
''' If the specified file does not exist and is a valid path, a new file is created, the function succeeds, and the last-error code is set to zero.
''' For more information, see the Remarks section of this topic.
''' </summary>
CREATE_ALWAYS = 2
''' <summary>
''' Opens a file or device, only if it exists.
''' If the specified file or device does not exist, the function fails and the last-error code is set to ERROR_FILE_NOT_FOUND (2).
''' For more information about devices, see the Remarks section.
''' </summary>
OPEN_EXISTING = 3
''' <summary>
''' Opens a file, always.
''' If the specified file exists, the function succeeds and the last-error code is set to ERROR_ALREADY_EXISTS (183).
''' If the specified file does not exist and is a valid path to a writable location, the function creates a file and the last-error code is set to zero.
''' </summary>
OPEN_ALWAYS = 4
''' <summary>
''' Opens a file and truncates it so that its size is zero bytes, only if it exists.
''' If the specified file does not exist, the function fails and the last-error code is set to ERROR_FILE_NOT_FOUND (2).
''' The calling process must open the file with the GENERIC_WRITE bit set as part of the dwDesiredAccess parameter.
''' </summary>
TRUNCATE_EXISTING = 5
End Enum
Private Enum EFileAttributes
FILE_ATTRIBUTE_READONLY = &H1
FILE_ATTRIBUTE_HIDDEN = &H2
FILE_ATTRIBUTE_SYSTEM = &H4
FILE_ATTRIBUTE_DIRECTORY = &H10
FILE_ATTRIBUTE_ARCHIVE = &H20
FILE_ATTRIBUTE_DEVICE = &H40
FILE_ATTRIBUTE_NORMAL = &H80
FILE_ATTRIBUTE_TEMPORARY = &H100
FILE_ATTRIBUTE_SPARSE_FILE = &H200
FILE_ATTRIBUTE_REPARSE_POINT = &H400
FILE_ATTRIBUTE_COMPRESSED = &H800
FILE_ATTRIBUTE_OFFLINE = &H1000
FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000
FILE_ATTRIBUTE_ENCRYPTED = &H4000
FILE_ATTRIBUTE_VIRTUAL = &H10000
'This parameter can also contain combinations of flags (FILE_FLAG_*)
FILE_FLAG_BACKUP_SEMANTICS = &H2000000
FILE_FLAG_DELETE_ON_CLOSE = &H4000000
FILE_FLAG_NO_BUFFERING = &H20000000
FILE_FLAG_OPEN_NO_RECALL = &H100000
FILE_FLAG_OPEN_REPARSE_POINT = &H200000
FILE_FLAG_OVERLAPPED = &H40000000
FILE_FLAG_POSIX_SEMANTICS = &H1000000
FILE_FLAG_RANDOM_ACCESS = &H10000000
FILE_FLAG_SEQUENTIAL_SCAN = &H8000000
FILE_FLAG_WRITE_THROUGH = &H80000000
End
Enum
Sub LogDataFiles()
Dim i As Integer
For i = 0 To 5
Call WriteFileData(i)
Next
End Sub
Sub WriteFileData(ByVal indexNo As Integer)
Dim strFileName As String
Dim bf As New BinaryFormatter
Dim tmpStream As New MemoryStream
Dim bytArray() As Byte
'data inside defaults to all FF's
Dim tmpStorage As New clsDataStorage
Dim blnResult As Boolean
Dim strTemp As String
Try
strFileName = dataPath & "File_" & indexNo.ToString & ".dat"
'In real app, tmpStorage would be a more complex class so data is serialized
'to allow it to be put into byte array
'Must serialize the data first
bf.Serialize(tmpStream, tmpStorage)
bytArray = tmpStream.ToArray
tmpStream.Close()
Call testIO.Write_Serialized_Data_To_File(bytArray, strFileName)
blnResult = testIO.Check_File_Contents_By_CRC(strFileName)
If blnResult = True Then
strTemp = strFileName & vbTab & vbTab & "CRC Okay"
Else
strTemp = strFileName & vbTab & vbTab & "** CRC ERROR **"
End If
Call AddToList(strTemp)
'error handling
Catch ex As Exception
Call LogError(ex)
Finally
tmpStream = Nothing
bf = Nothing
bytArray = Nothing
tmpStorage = Nothing
End Try
End
Sub
Sub Write_Serialized_Data_To_File(ByVal bytSerializedData() As Byte, ByVal strFileName As String)
Dim lHandle As Integer
Dim i As Integer
Dim iBytesWritten As Integer
Dim iResult As Integer
Dim bytArray() As Byte
Dim bytCRC() As Byte
Dim intUBound As Integer
Dim arrLogged() As Byte
Dim bytTemp As Byte
Dim blnExistsAlready As Boolean = False
Dim intLoopCounter As Integer = 0
Dim lngError As Long
Dim lpSA As SECURITY_ATTRIBUTES
Try
intUBound = bytSerializedData.GetUpperBound(0)
ReDim bytArray(intUBound)
For i = 0 To intUBound
bytTemp = bytSerializedData(i)
bytArray(i) = bytTemp
Next
'check to see if file exists first
Dim strFileExists As String = " "
strFileExists = Dir(strFileName)
strFileExists = Trim$(strFileExists)
If Len(strFileExists) = 0 Then
'file does not exist
blnExistsAlready = False
ElseIf (Len(strFileExists) > 0) Then
blnExistsAlready = True
End If
''open the file
lpSA.nLength = Len(lpSA)
If blnExistsAlready = True Then
'open but do not create file
lHandle = CreateFile(strFileName, GENERIC_WRITE, 0,
lpSA, OPEN_EXISTING, NO_BUFFERING, IntPtr.Zero)
Debug.WriteLine("Write handle exists is = " & lHandle.ToString)
ElseIf blnExistsAlready = False Then
'create new file
lHandle = CreateFile(strFileName, GENERIC_WRITE, 0,
lpSA, CREATE_ALWAYS, NO_BUFFERING, IntPtr.Zero)
Debug.WriteLine("Write handle create is = " & lHandle.ToString)
End If
Debug.WriteLine("Write handle create is = " & lHandle.ToString)
lngError = GetLastError()
If lngError > 0 Then
Debug.WriteLine("B after write last error is " & lngError.ToString)
MsgBox("CreateFile Failure for " & strFileName & " -Error Code: " & lngError.ToString)
Else
'add CRC bytes to bytArray before logging to disk
intUBound = bytArray.GetUpperBound(0)
'get crc bytes
bytCRC = CRC_CalcCRC(bytArray)
'add crc bytes to array
ReDim Preserve bytArray(intUBound + 2) 'for 2 crc bytes
bytArray(intUBound + 1) = bytCRC(1)
bytArray(intUBound + 2) = bytCRC(0)
ReDim arrLogged(intUBound + 2 + 4)
For i = (intUBound + 2 + 4) To 4 Step -1
arrLogged(i) = bytArray(i - 4)
Next i
'add upper bound of data array including CRC bytes to front of log before passing
arrLogged = Convert_Long_To_Binary_Array_LSB_First((intUBound + 2), 0, 4, arrLogged)
iResult = CInt(WriteFile(lHandle, arrLogged, Convert.ToInt32(Math.Ceiling(arrLogged.Length / SRAM_Drive_SectorSize) * SRAM_Drive_SectorSize), iBytesWritten, 0))
'Call CloseHandle(lHandle)
End If
'error handling
Catch ex As Exception
Call LogError(ex)
Finally
If lHandle <> INVALID_HANDLE_VALUE Then
Call CloseHandle(lHandle)
'MsgBox("close handle " & lHandle.ToString)
End If
End Try
End Sub
Ниже приведена логика, связанная с очередью:
Private Sub RxQueue_ReceiveCompleted(sender As Object, e As ReceiveCompletedEventArgs) Handles RxQueue.ReceiveCompleted
Try
Dim qMessage As Message = RxQueue.EndReceive(e.AsyncResult)
Dim qBody As structEvent
qBody = CType(qMessage.Body, structEvent)
Call UpdateUI(qBody)
RxQueue.BeginReceive()
Return
Catch ex As Exception
Call LogError(ex)
End Try
End Sub
Public Sub Load_RxQueue()
Try
With RxQueue
.Path = nameOfQueue
.Formatter = New XmlMessageFormatter(New Type() {GetType(structEvent)})
'.EnableConnectionCache = True
'purge any existing messages currently in queue
.Purge()
'.BeginReceive()
End With
Catch ex As Exception
Call LogError(ex)
End Try
End Sub
Public Sub Start_RxQueue()
Call Load_RxQueue()
Me.RxQueue.BeginReceive()
End Sub
Delegate Sub UpdateUIHandler(ByVal objQueueDataFields As structEvent)
Sub UpdateUI(ByVal objQueueDataFields As structEvent)
Try
'check to see if thread switch is required
If Me.InvokeRequired = True Then
'switch control over to the primary UI thread
Dim handler As New UpdateUIHandler(AddressOf UpdateUI_Impl)
Dim args() As Object = {objQueueDataFields}
'call begin invoke method of form object
Me.BeginInvoke(handler, args)
Else
Call UpdateUI_Impl(objQueueDataFields)
End If
Catch ex As Exception
Call LogError(ex)
End Try
End Sub
Sub UpdateUI_Impl(ByVal qData As structEvent)
Try
Call DecodeUI(qData)
Catch ex As Exception
Call LogError(ex)
End Try
End Sub
Sub DecodeUI(ByVal qDecodeData As structEvent)
Try
Select Case qDecodeData.inputNo
Case 0
'list files to screen
Call List_Files()
Case 1
Call AddToList("confirm pressed")
Call LogDataFiles()
'list files to screen with CRC checked
'Call List_Files()
Call AddToList("Finished")
Case 2
'delete existing files
Call Delete_Files()
Case 100
'initial read of existing files
Me.lstData.Items.Clear()
Call List_Files()
End Select
Catch ex As Exception
Call LogError(ex)
End Try
End Sub