I get new Win7 Offline PCs imaged with the wrong Com/Serial ports that I have to set up. Out of the box they are always COM18 and COM19 but they need to be COM3 and COM4. I am honestly so tired of manually changing them that I just want this built into a VB.NET 2.0 EXE WinForm that I run that sets other things up as well. Other message boards tell me Win7 is not supported so they can't help, but I have no control over the OS. Hoping StackOverflow will help.
I think I need to change the DeviceID, Caption, and Name in the Win32_SerialPort(?) but the only thing I can find is a SELECT query not an UPDATE or anything.
Here is what I am working with but changing to an UPDATE doesn't work.
Dim ConnOptions As New ConnectionOptions() With {.EnablePrivileges = True, .Timeout = EnumerationOptions.InfiniteTimeout}
Dim mOptions As New EnumerationOptions() With {.Rewindable = False, .ReturnImmediately = True, .DirectRead = True, .EnumerateDeep = False}
Dim mQuery1 As New SelectQuery("SELECT * FROM Win32_SerialPort WHERE Name LIKE '%COM18%'")
'Sample query I thought might work: UPDATE Win32_SerialPort SET DeviceID = "COM3" WHERE Name LIKE '%COM18%'")
Dim mScope As New ManagementScope($"\\{Environment.MachineName}\root\CIMV2", ConnOptions)
mScope.Connect()
Using moSearcher1 As New ManagementObjectSearcher(mScope, mQuery1, mOptions)
If moSearcher1.Get().Equals("COM18") = True Then
'DO SOMETHING HERE LIKE A POPUP
End If
End Using
Am I stuck doing this manually every time or is there something I am missing (either in my code or I am way off base) to help automate this?
This post isn't a complete answer, but shows how one can read/update the COM port database described below.
According to COM port database:
The system-supplied COM port database arbitrates the use of COM port
numbers by COM ports that are installed on the system.
The following code is based on the functionality of the functions listed here (although the usage may be slightly different).
I've performed minor testing on the code in both Windows 7 and Windows 10. Prior to making any registry modifications it's recommended to backup the registry (ie: create a restore point).
The code requires administrative privileges, because it writes to the HKEY_LOCAL_MACHINE registry hive. This can be implemented by adding an "Application Manifest File" to the project and changing:
<requestedExecutionLevel level="asInvoker" uiAccess="false" />
To:
<requestedExecutionLevel level="requireAdministrator" uiAccess="false" />
Create a class (name: ComDBPortInfo.vb)
Public Class ComDBPortInfo
Public Property IsReserved As Integer
Public Property PortName As String
Public Property PortNumber As Integer
End Class
Create a class (name: MSPortsNetComDBException.vb)
Imports System.Runtime.Serialization
<Serializable>
Public Class MSPortsNetComDBException
Inherits Exception
Public Property Value As Integer = 0
Public Const COULD_NOT_OPEN_HIVE As Integer = 4
Public Const COULD_NOT_OPEN_SUBKEY As Integer = 5
Public Const INVALID_BIT_INDEX As Integer = 6
Public Const INVALID_COMDB_SIZE As Integer = 7
Public Const INVALID_PORT_NUMBER As Integer = 8
Public Const PORT_ALREADY_CLAIMED As Integer = 9
Public Const UNABLE_TO_RESIZE_COMDB As Integer = 10
Protected Sub New()
MyBase.New()
End Sub
Public Sub New(value As Integer)
MyBase.New()
Me.Value = value
End Sub
Public Sub New(value As Integer, message As String)
MyBase.New(message)
Me.Value = value
End Sub
Public Sub New(value As Integer, message As String, innerException As Exception)
MyBase.New(message, innerException)
Me.Value = value
End Sub
Protected Sub New(info As SerializationInfo, context As StreamingContext)
MyBase.New(info, context)
End Sub
End Class
Create a module (name: MSPortsNet.vb)
Imports Microsoft.Win32
Module MSPortsNet
Public Enum ComDBPortType As Integer
All = 0
Available = 1
Reserved = 2
End Enum
'Private Const CDB_REPORT_BITS As Integer = 0
'Private Const CDB_REPORT_BYTES As Integer = 1
'if Windows Kit is installed
'constants can be found in %ProgramFiles(x86)%\Windows Kits\<version>\Include\<version>\um\msports.h
Private Const COMDB_MIN_PORTS_ARBITRATED As Integer = 256 'minimum COM database size in bits
Private Const COMDB_MAX_PORTS_ARBITRATED As Integer = 4096 'maximum COM database size in bits
'if Windows Kit is installed
'constant can be found in %ProgramFiles(x86)%\Windows Kits\<version>\Include\<version>\shared\winerror.h
Private Const ERROR_SUCCESS As Integer = 0 'operation successfully completed
Private Const OPERATION_SUCCESSFUL As Integer = 0 'operation successfully completed
Public Function ComDBClaimNextFreePort(Optional autoShrink As Boolean = False, Optional regView As RegistryView = RegistryView.Registry64) As Integer
'get data from COM database
Dim comDB As Byte() = ComDBGet(regView)
Dim foundFreeComPort As Boolean = False
Dim portNumber As Integer = 0
For i As Integer = 0 To comDB.Length - 1
For j As Integer = 0 To 7
'increment
portNumber += 1
'find the first index that has a value of 0
If GetBitValue(comDB(i), j) = 0 Then
'set value
foundFreeComPort = True
Exit For
End If
Next
If foundFreeComPort Then
Exit For
End If
Next
If portNumber = 0 Then
'increment
portNumber += 1
End If
Return ComDBClaimPort(CInt(portNumber), autoShrink, regView)
End Function
Public Function ComDBClaimPort(portNumber As Integer, Optional autoShrink As Boolean = False, Optional regView As RegistryView = RegistryView.Registry64) As Integer
Return ComDBClaimPort(New List(Of Integer)({portNumber}), autoShrink, regView)
End Function
Public Function ComDBClaimPort(portNumbers As List(Of Integer), Optional autoShrink As Boolean = False, Optional regView As RegistryView = RegistryView.Registry64) As Integer
'get data from COM database
Dim comDB As Byte() = ComDBGet(regView)
For Each portNum In portNumbers
If portNum < 1 Then
Throw New MSPortsNetComDBException(MSPortsNetComDBException.INVALID_PORT_NUMBER, $"Error (ComDBClaimPort) - Invalid port number. Port number must be > 0 (portNum: {portNum}).")
End If
'COM database is stored as REG_BINARY, which is retrieved into a Byte();
'each bit represents one COM port number starting with 1;
'index 0 in the Byte() holds data for COM1 - COM8;
'index 1 in the Byte() holds data for COM9 - COM16; etc...
'since the data is stored in a Byte(), it's necessary to determine
'which byte contains the desired data.
'find which byte contains the appropriate bit; 1 byte = 8 bits
Dim desiredByteIndex As Integer = CType(Math.Truncate((portNum - 1) / 8), Integer)
Dim desiredBitIndex As Integer = CType((portNum - 1) Mod 8, Integer)
'calculate size in bits; 8 bits / 1 byte
Dim currentComDBSizeInBits As Integer = comDB.Length * 8
If portNum > currentComDBSizeInBits AndAlso portNum <= COMDB_MAX_PORTS_ARBITRATED Then
'port number > than what can be stored in the current COMBDB so COMDB needs to be resized
ComDBResizeDatabase(comDB, portNum, regView)
ElseIf portNum > currentComDBSizeInBits AndAlso portNum > COMDB_MAX_PORTS_ARBITRATED Then
Throw New MSPortsNetComDBException(MSPortsNetComDBException.INVALID_PORT_NUMBER, $"Error (ComDBClaimPort) - Invalid port number. The maximum number of ports supported is '{COMDB_MAX_PORTS_ARBITRATED}'. Currently, the COM database holds data for COM ports 1 to {comDB.Length * 8}.")
End If
If GetBitValue(comDB(desiredByteIndex), desiredBitIndex) = 1 Then
Throw New MSPortsNetComDBException(MSPortsNetComDBException.PORT_ALREADY_CLAIMED, $"Error (ComDBClaimPort) - 'COM{portNum}' has already been claimed and is unavailable (portNum: {portNum}). No changes have been made.")
End If
'set appropriate bit to claim port
comDB(desiredByteIndex) = SetBitInByte(comDB(desiredByteIndex), True, desiredBitIndex)
Next
If autoShrink Then
Compact(comDB, regView)
End If
'for testing
'DisplayComPortsByteArray(comDB)
Dim resultComDBSet = ComDBSet(comDB, regView)
Return resultComDBSet
End Function
Private Function ComDBGet(Optional regView As RegistryView = RegistryView.Registry64) As Byte()
'get COM database from registry
Using localKey As RegistryKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, regView)
If localKey IsNot Nothing Then
Dim comNameArbiterSubkey As String = "System\CurrentControlSet\Control\COM Name Arbiter"
'open COM Name Arbiter subkey
Using comNameArbiterKey As RegistryKey = localKey.OpenSubKey(comNameArbiterSubkey, False)
If comNameArbiterKey IsNot Nothing Then
'read binary data from registry
Dim comdb As Byte() = CType(comNameArbiterKey.GetValue("ComDB", Nothing), Byte())
Return comdb
Else
Throw New MSPortsNetComDBException(MSPortsNetComDBException.COULD_NOT_OPEN_SUBKEY, $"Error (ComDBGet) - Could not open '{comNameArbiterSubkey}'")
End If
End Using
Else
Throw New MSPortsNetComDBException(MSPortsNetComDBException.COULD_NOT_OPEN_HIVE, $"Error (ComDBGet) - Could Not open 'HKEY_LOCAL_MACHINE' ")
End If
End Using
End Function
Public Function ComDBGetCurrentPortUsage(Optional regView As RegistryView = RegistryView.Registry64) As List(Of Integer)
'get COM port usage from COM database
'COM database is stored as REG_BINARY, which is retrieved into a Byte();
'each bit represents one COM port number starting with COM1;
'index 0 in the Byte() holds data for COM1 - COM8;
'index 1 in the Byte() holds data for COM9 - COM16; etc...
'below data is converted so that each element of the returned
'list represents a COM port number (bit representation)
'Note: the list uses 0-based indices and the first
'COM port number is 1. Therefore, index 0 = COM1, index 1, = COM2, etc...
Dim ComDBList As List(Of Integer) = New List(Of Integer)
Dim ComDB As Byte() = ComDBGet(regView)
If ComDB IsNot Nothing Then
'convert to bit array
Dim ComDBBitArr As BitArray = New BitArray(ComDB)
For i As Integer = 0 To ComDBBitArr.Length - 1
'add; 0 = COM1, 1 = COM2, 2 = COM3, ...
'value of 0 means the port is available
'value of 1 means the port is unavailable (is reserved)
If Not ComDBBitArr(i) Then
'add; false = 0
ComDBList.Add(0)
Else
'add; true = 1
ComDBList.Add(1)
End If
Next
End If
Return ComDBList
End Function
Public Function ComDBGetCurrentPortUsage(portType As ComDBPortType, Optional regView As RegistryView = RegistryView.Registry64) As List(Of ComDBPortInfo)
Dim ComDBList As List(Of Integer) = ComDBGetCurrentPortUsage(regView)
Dim results As List(Of ComDBPortInfo) = New List(Of ComDBPortInfo)
If ComDBList IsNot Nothing And ComDBList.Count > 0 Then
For i As Integer = 0 To ComDBList.Count - 1
If portType = ComDBPortType.All Then
'add
results.Add(New ComDBPortInfo() With {.IsReserved = ComDBList(i), .PortName = $"COM{i + 1}", .PortNumber = i + 1})
ElseIf portType = ComDBPortType.Available AndAlso ComDBList(i) = 0 Then
'add
results.Add(New ComDBPortInfo() With {.IsReserved = ComDBList(i), .PortName = $"COM{i + 1}", .PortNumber = i + 1})
ElseIf portType = ComDBPortType.Reserved AndAlso ComDBList(i) = 1 Then
'add
results.Add(New ComDBPortInfo() With {.IsReserved = ComDBList(i), .PortName = $"COM{i + 1}", .PortNumber = i + 1})
End If
Next
End If
Return results
End Function
Public Function ComDBReleasePort(portNumber As Integer, Optional autoShrink As Boolean = False, Optional regView As RegistryView = RegistryView.Registry64) As Integer
Return ComDBReleasePort(New List(Of Integer)({portNumber}), autoShrink, regView)
End Function
Public Function ComDBReleasePort(portNumbers As List(Of Integer), Optional autoShrink As Boolean = False, Optional regView As RegistryView = RegistryView.Registry64) As Integer
'get data from COM database
Dim comDB As Byte() = ComDBGet(regView)
For Each portNum In portNumbers
If portNum < 1 Then
Throw New MSPortsNetComDBException(MSPortsNetComDBException.INVALID_PORT_NUMBER, $"Error (ComDBReleasePort) - Invalid port number. Port number must be > 0 (portNumber: {portNum}).")
End If
If portNum > comDB.Length * 8 Then
Throw New MSPortsNetComDBException(MSPortsNetComDBException.INVALID_PORT_NUMBER, $"Error (ComDBReleasePort) - Invalid port number. Port number must be > 0 and < {comDB.Length * 8} which is the last port number currently stored in the database (portNumber: {portNum}).")
End If
'find which byte contains the appropriate bit
'8 bits per 1 byte
Dim desiredByteIndex As Integer = CType(Math.Truncate((portNum - 1) / 8), Integer)
Dim desiredBitIndex As Integer = CType((portNum - 1) Mod 8, Integer)
If GetBitValue(comDB(desiredByteIndex), desiredBitIndex) = 0 Then
Debug.WriteLine($"Info (ComDBReleasePort) - 'COM{portNum}' is currently available. Skipping")
Return OPERATION_SUCCESSFUL
End If
'set appropriate bit to claim port
comDB(desiredByteIndex) = SetBitInByte(comDB(desiredByteIndex), False, desiredBitIndex)
Next
If autoShrink Then
Compact(comDB, regView)
End If
'for testing
'DisplayComPortsByteArray(comDB)
'save COMDB
Dim resultComDBSet = ComDBSet(comDB, regView)
Return resultComDBSet
End Function
Private Function ComDBResizeDatabaseByDesiredIndex(comDB As Byte(), lastByteIndexContainingData As Integer, Optional regView As RegistryView = RegistryView.Registry64) As Byte()
'since a Byte() is being used, it's not necessary to
'determine the actual port number, but rather just the byte index
'that contains the bit which represents the port number;
'8 bits in a byte; to dertermine the first port number represented
'within the byte, multiply the byte index by 8
Return ComDBResizeDatabase(comDB, lastByteIndexContainingData * 8, regView)
End Function
Private Function ComDBResizeDatabase(comDB As Byte(), lastPortNumberNeedingReservation As Integer, Optional regView As RegistryView = RegistryView.Registry64) As Byte()
'new size must be >= COMDB_MIN_PORTS_ARBITRATED and <= COMDB_MAX_PORTS_ARBITRATED
'calculate minimum Byte() size
Dim minArraySize As Integer = CType(COMDB_MIN_PORTS_ARBITRATED / 8, Integer)
'calculate maximum Byte() size
Dim maxArraySize As Integer = CType(COMDB_MAX_PORTS_ARBITRATED / 8, Integer)
'calculate the size
Dim comDBSizeIncrement As Integer = CType(1024 / 8, Integer)
'COMDB is stored as REG_BINARY, which is retrieved into a Byte();
'each bit represents one COM port number starting with 1;
'index 0 in the Byte() holds data for COM1 - COM8;
'index 1 in the Byte() holds data for COM9 - COM16; etc...
'since the data is stored in a Byte(), it's necessary to determine
'which byte contains the desired data.
'find which byte contains the appropriate bit; 1 byte = 8 bits
Dim desiredByteIndex As Integer = CType(Math.Truncate((lastPortNumberNeedingReservation - 1) / 8), Integer)
'set value; size = index + 1
Dim newArraySize As Integer = desiredByteIndex + 1
'to ensure that COMDB is only resized by comDBSizeIncrement
'calculate the appropriate size
While CType(newArraySize * 8, Integer) < lastPortNumberNeedingReservation AndAlso newArraySize <= COMDB_MAX_PORTS_ARBITRATED
'increase size
newArraySize += comDBSizeIncrement
End While
If newArraySize > comDB.Length Then
'resize Byte()
Array.Resize(Of Byte)(comDB, newArraySize)
Else
'ensure that Byte array isn't resized below where data exists
Dim lastByteIndexContainingData As Integer = GetLastByteIndexContainingData(comDB)
'Debug.WriteLine($"lastByteIndexContainingData: {lastByteIndexContainingData}")
If lastByteIndexContainingData > newArraySize Then
Throw New MSPortsNetComDBException(MSPortsNetComDBException.UNABLE_TO_RESIZE_COMDB, "Error (ComDBResizeDatabase) - Resizing the COM database To length '{newArraySize}' would result in a loss of data, so it can't be performed. Releasing reserved COM ports prior to resizing the COM database may allow it to be shrunk. Ensure that the registry has been backed up (ie: create a restore point) before releasing reserved COM ports. (lastByteIndexContainingData: {lastByteIndexContainingData})")
End If
'use a list so it's resized automatically
Dim tempComDBList As List(Of Byte) = New List(Of Byte)
For i As Integer = 0 To lastByteIndexContainingData
'add
tempComDBList.Add(comDB(i))
Next
'set value
comDB = tempComDBList.ToArray()
'resize so the ComDB is an increment of comDBSizeIncrement
Array.Resize(comDB, newArraySize)
End If
Return comDB
End Function
Private Function ComDBSet(comDB As Byte(), Optional regView As RegistryView = RegistryView.Registry64) As Integer
'this method requires administrative privileges because it
'writes to the HKEY_LOCAL_MACHINE registry hive
Using localKey As RegistryKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, regView)
If localKey IsNot Nothing Then
Dim comNameArbiterSubkey As String = "System\CurrentControlSet\Control\COM Name Arbiter"
'open COM Name Arbiter subkey
Using comNameArbiterKey As RegistryKey = localKey.OpenSubKey(comNameArbiterSubkey, True)
If comNameArbiterKey IsNot Nothing Then
'save binary data to registry
comNameArbiterKey.SetValue("ComDB", comDB, RegistryValueKind.Binary)
Else
Throw New MSPortsNetComDBException(MSPortsNetComDBException.COULD_NOT_OPEN_SUBKEY, $"Error (ComDBSet) - Could not open '{comNameArbiterSubkey}'")
End If
End Using
Else
Throw New MSPortsNetComDBException(MSPortsNetComDBException.COULD_NOT_OPEN_HIVE, $"Error (ComDBSet) - Could Not open 'HKEY_LOCAL_MACHINE' ")
End If
End Using
'operation successfully completed
Return OPERATION_SUCCESSFUL
End Function
Private Function Compact(comDB As Byte(), Optional regView As RegistryView = RegistryView.Registry64) As Byte()
'if able, shrinks the size of the COM database ensuring that no bytes with a bit set to 1 are deleted
Dim lastByteIndexContainingData As Integer = GetLastByteIndexContainingData(comDB)
Return ComDBResizeDatabaseByDesiredIndex(comDB, lastByteIndexContainingData, regView)
End Function
Public Sub DisplayComPorts(Optional regView As RegistryView = RegistryView.Registry64)
'this method is used for testing; it outputs COM port usage as stored in the COM database
Dim ports As List(Of Integer) = ComDBGetCurrentPortUsage()
If ports IsNot Nothing Then
For i As Integer = 0 To ports.Count - 1
Dim comPortName As String = $"COM{i + 1}"
Dim isReserved As Integer = ports(i)
Debug.WriteLine($"{comPortName}: {isReserved.ToString()}")
Next
End If
End Sub
Private Sub DisplayComPortsByteArray(comDB As Byte())
'this method is used for testing; it outputs COM port usage as stored in the Byte();
'this information may differ from what's in the COM port database, if the data
'has been modified, but not yet saved
If comDB IsNot Nothing Then
'convert to bit array
Dim ComDBBitArr As BitArray = New BitArray(comDB)
Dim byteArrayIndex As Integer = 0
Debug.WriteLine($"Index: {byteArrayIndex}")
For i As Integer = 0 To ComDBBitArr.Length - 1
Dim isReserved As Integer = 0
If ComDBBitArr(i) Then
'set value
isReserved = 1
End If
Debug.WriteLine($" COM{i + 1}: {isReserved}")
If (i + 1) Mod 8 = 0 Then
'increment
byteArrayIndex += 1
Debug.WriteLine($"Index: {byteArrayIndex}")
End If
Next
End If
End Sub
Private Function GetBitValue(b As Byte, bitIndex As Integer) As Byte
'get bit value from byte
If bitIndex < 0 OrElse bitIndex > 7 Then
Throw New MSPortsNetComDBException(MSPortsNetComDBException.INVALID_BIT_INDEX, $"Error (GetBitValue) - Invalid bit index. Value must be 0 to 7 (bitIndex: {bitIndex})")
End If
'result: The result of shifting the bit pattern. The data type is the same as that of pattern.
'pattern: is bit pattern to be shifted; The data type must be an integral type (SByte, Byte, Short, UShort, Integer, UInteger, Long, or ULong)
'amount: The number of bits to shift the bit pattern. The data type must be Integer or widen to Integer.
'
'for bit shifting: result = pattern >> amount
'after bit-shifting is complete, the desired value is
'found by performing a logical AND with 1 (on the result)
Return CType((b >> bitIndex) And 1, Byte)
End Function
Private Function GetLastByteIndexContainingData(comDB As Byte()) As Integer
'find the last index of the Byte array that has any bit set to 1
Dim lastByteIndexContainingData As Integer = 0
For i As Integer = 0 To comDB.Length - 1
For j As Integer = 0 To 7
'check each bit to see if value is set to 1
If GetBitValue(comDB(i), j) = 1 Then
'if value set to 1, save the index
lastByteIndexContainingData = i
End If
Next
Next
Return lastByteIndexContainingData
End Function
Private Function SetBitInByte(b As Byte, isReserved As Boolean, bitIndex As Integer) As Byte
'use a mask to set the value of the desired bit within a Byte
If bitIndex < 0 OrElse bitIndex > 7 Then
Throw New MSPortsNetComDBException(MSPortsNetComDBException.INVALID_BIT_INDEX, $"Error (SetBitInByte) - Invalid bit index. Value must be 0 to 7 (bitIndex: {bitIndex})")
End If
'get index
Dim bitIndexInByte As Integer = bitIndex Mod 8
'result: The result of shifting the bit pattern. The data type is the same as that of pattern.
'pattern: is bit pattern to be shifted; The data type must be an integral type (SByte, Byte, Short, UShort, Integer, UInteger, Long, or ULong)
'amount: The number of bits to shift the bit pattern. The data type must be Integer or widen to Integer.
'
'for bit shifting: result = pattern << amount
'this value will is used with logical operations below
Dim mask As Byte = CType((1 << bitIndexInByte), Byte)
If isReserved Then
'bit is set by performing a logical OR with mask value
Return b Or mask
Else
'clear the value; C#, ~ instead of Not
'bit is set by performing a logical AND with the complement
'of the mask value. in VB.NET, Not is used to get the complement
'in C#, '~' is used to get the complement instead of 'Not'.
'instead of using the complement, one could
'create another mask that shifts '0' to the left (instead of '1')
Return b And (Not mask)
End If
End Function
End Module
Usage: ComDBClaimNextFreePort
'claim next available COM port
Dim result As Integer = MSPortsNet.ComDBClaimNextFreePort()
'Dim result As Integer = MSPortsNet.ComDBClaimNextFreePort(True)
Usage: ComDBClaimPort
'claim one COM port
Dim resultSinglePort As Integer = MSPortsNet.ComDBClaimPort(4)
'Dim resultSinglePort As Integer = MSPortsNet.ComDBClaimPort(4, True)
Usage: ComDBClaimPort (multiple port numbers)
'claim multiple COM ports
Dim resultMultiplePorts As Integer = MSPorts.ComDBClaimPort(New List(Of Integer)({18, 19}))
'Dim resultMultiplePorts As Integer = MSPorts.ComDBClaimPort(New List(Of Integer)({18, 19}), True)
Usage: ComDBGetCurrentPortUsage
'get all COM ports in database
Dim portsAll As List(Of ComDBPortInfo) = ComDBGetCurrentPortUsage(ComDBPortType.All)
'get all available COM ports in database
Dim portsAvailable As List(Of ComDBPortInfo) = ComDBGetCurrentPortUsage(ComDBPortType.Available)
'get all reserved COM ports in database
Dim portsReserved As List(Of ComDBPortInfo) = ComDBGetCurrentPortUsage(ComDBPortType.Reserved)
Usage: ComDBReleasePort
'release one COM port
Dim resultSinglePort As Integer = MSPortsNet.ComDBReleasePort(18)
'Dim resultSinglePort As Integer = MSPortsNet.ComDBReleasePort(18, True)
Usage: ComDBReleasePort (multiple port numbers)
'release multiple COM ports
Dim resultMultiplePorts As Integer = MSPorts.ComDBReleasePort(New List(Of Integer)({18, 19}))
'Dim resultMultiplePorts As Integer = MSPorts.ComDBReleasePort(New List(Of Integer)({18, 19}), True)
Additional Resources
Change COM port via registry, command line or software?
COM port database
Get a specific bit from byte
Set Specific Bit In Byte Array
Logical and Bitwise Operators in Visual Basic
Bit Shift Operators (Visual Basic)
USB serial driver (Usbser.sys)
comdb.c
The solution I was able to come up with was actually to get an older version of ProcMon (process monitor) and see exactly what was changing in the registry. From there I had to manually write registry edits. Still doesn't feel like the most efficient method, but it worked.
If anyone has this specific question as well, here are the registry edits that I did:
'***** ADD PORT NUMBER ENTRIES
C:\Windows\win.ini
'***** EDIT \Device\SiLabUser to "COM3" or "COM4"
HKLM\HARDWARE\DEVICEMAP\SERIALCOMM\
'***** EDIT sub keys PORTNAME and FRIENDLYNAME
HKLM\System\CurrentControlSet\Enum\USB\VID_10C8&PID_EP69&MI_00\8&6FD00A90&0&0000
I have the following functions to generate md5-hashes for files. The functions work great for small files, but crashes and generate Run-time error 7 - Out of memory when I try to hash files over ~250 MB (I don't actually know at which exact size it breaks, but files below 200 MB work fine).
I don't understand why it breaks at a certain size, so if anyone could shed some light on that I would appreciate it a lot.
Also, is there anything I can do to make the functions handle larger files? I intend to use the functions in a larger tool where I will need to generate hashes for files of unknown sizes. Most will be small enough for the current functions to work, but I will have to be able to handle large files as well.
I got my current functions from the most upvoted answer this post How to get the MD5 hex hash for a file using VBA?
Public Function FileToMD5Hex(ByVal strFileName As String) As String
Dim varEnc As Variant
Dim varBytes As Variant
Dim strOut As String
Dim intPos As Integer
Set varEnc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
'Convert the string to a byte array and hash it
varBytes = GetFileBytes(strFileName)
varBytes = varEnc.ComputeHash_2((varBytes))
'Convert the byte array to a hex string
For intPos = 1 To LenB(varBytes)
strOut = strOut & LCase(Right("0" & Hex(AscB(MidB(varBytes, intPos, 1))), 2))
Next
FileToMD5Hex = strOut
Set varEnc = Nothing
End Function
Private Function GetFileBytes(ByVal strPath As String) As Byte()
Dim lngFileNum As Long
Dim bytRtnVal() As Byte
lngFileNum = FreeFile
'If file exists, get number of bytes
If LenB(Dir(strPath)) Then
Open strPath For Binary Access Read As lngFileNum
ReDim bytRtnVal(LOF(lngFileNum)) As Byte
Get lngFileNum, , bytRtnVal
Close lngFileNum
Else
MsgBox "Filen finns inte" & vbCrLf & "Avbryter", vbCritical, "Filen hittades inte"
Exit Function
End If
GetFileBytes = bytRtnVal
Erase bytRtnVal
End Function
Thank you
It looks like you reached the memory limit.
A better way would be to compute the MD5 of the file by block:
Public Function ComputeMD5(filepath As String) As String
Dim buffer() As Byte, svc As Object, hFile%, blockSize&, i&
blockSize = 2 ^ 16
' open the file '
If Len(Dir(filepath)) Then Else Err.Raise 5, , "file not found" & vbCr & filepath
hFile = FreeFile
Open filepath For Binary Access Read As hFile
' allocate buffer '
If LOF(hFile) < blockSize Then blockSize = ((LOF(hFile) + 1024) \ 1024) * 1024
ReDim buffer(0 To blockSize - 1)
' compute hash '
Set svc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
For i = 1 To LOF(hFile) \ blockSize
Get hFile, , buffer
svc.TransformBlock buffer, 0, blockSize, buffer, 0
Next
Get hFile, , buffer
svc.TransformFinalBlock buffer, 0, LOF(hFile) Mod blockSize
buffer = svc.Hash
' cleanup '
svc.Clear
Close hFile
' convert to an hexa string '
ComputeMD5 = String$(32, "0")
For i = 0 To 15
Mid$(ComputeMD5, i + i + 2 + (buffer(i) > 15)) = Hex(buffer(i))
Next
End Function
This is an extension to FlorentB's answer, which worked brilliantly for me until my files surpassed the 2GB LOF() size limit.
I tried to adapt for getting file length by alternate means as follows:
Public Function ComputeMD5(filepath As String) As String
If Len(Dir(filepath)) Then Else Err.Raise 5, , "File not found." & vbCr & filepath
Dim blockSize As Long: blockSize = 2 ^ 20
Dim blockSize_f As Double
Dim buffer() As Byte
Dim fileLength As Variant
Dim hFile As Integer
Dim n_Reads As Long
Dim i As Long
Dim svc As Object: Set svc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
fileLength = DecGetFileSize(filepath)
If fileLength < blockSize Then blockSize = ((fileLength + 1024) \ 1024) * 1024
ReDim buffer(0 To blockSize - 1)
n_Reads = fileLength / blockSize
blockSize_f = fileLength - (CDbl(blockSize) * n_Reads)
hFile = FreeFile
Open filepath For Binary Access Read As hFile
For i = 1 To n_Reads
Get hFile, i, buffer
svc.TransformBlock buffer, 0, blockSize, buffer, 0
Next i
Get hFile, i, buffer
svc.TransformFinalBlock buffer, 0, blockSize_f
buffer = svc.Hash
svc.Clear
Close hFile
ComputeMD5 = String$(32, "0")
For i = 0 To 15
Mid$(ComputeMD5, i + i + 2 + (buffer(i) > 15)) = Hex(buffer(i))
Next
End Function
Public Function DecGetFileSize(fname As String) As Variant
Dim fso As New FileSystemObject
Dim f: Set f = fso.GetFile(fname)
DecGetFileSize = CDec(f.Size)
Set f = Nothing
Set fso = Nothing
End Function
This all runs fine, returning a string, however that string does not equal the MD5 calculated using other tools on the same file.
I can't work out where the discrepancy is originating.
I've checked and double checked filelength, n_reads, blockSize and blockSize_f and I'm sure those values are all correct.
I had some trouble with the Get function, where if I didn't explicitly tell it the block number, it dies at block 2048.
Any ideas / pointers would be much appreciated.
I'm trying to figure out how to read a section of bytes (Say 16) starting at a specific address, say 0x2050. I'd like to get the 16 bits output in hex values into a label.
I've been trying to figure out BinaryReader, and FileStreams but I'm not entirely sure what the difference is, or which one I should be using.
*I've seen a lot of threads mentioning file size could be an issue, and I'd like to point out that some files I'll be checking may be up to 4gb in size.
I've tried the following:
Dim bytes() As Byte = New Byte(OpenedFile.Length) {}
ListBox1.Items.Add(Conversion.Hex(OpenedFile.Read(bytes, &H2050, 6)))
But this simply writes 6 bytes to the file, and I'm not sure why. There is no output in the listbox.
How about something like the following?:
Sub Main()
Dim pos As Long = 8272
Dim requiredBytes As Integer = 2
Dim value(0 To requiredBytes - 1) As Byte
Using reader As New BinaryReader(File.Open("File.bin", FileMode.Open))
' Loop through length of file.
Dim fileLength As Long = reader.BaseStream.Length
Dim byteCount As Integer = 0
reader.BaseStream.Seek(pos, SeekOrigin.Begin)
While pos < fileLength And byteCount < requiredBytes
value(byteCount) = reader.ReadByte()
pos += 1
byteCount += 1
End While
End Using
Dim displayValue As String
displayValue = BitConverter.ToString(value)
End Sub
I have been trying my hand at handling packets and bytes for the first time, and I have not been able to obtain the packet length correctly so far after many different techniques.
Code:
Public Shared Sub Client(packet As Packet)
Console.WriteLine( _
"Client -> " & _
packet.Timestamp.ToString("yyyy-MM-dd hh:mm:ss.fff") & _
" length:" & Convert.ToString(packet.Length))
'Define Byte Array
Dim clientPacket As Byte() = packet.Buffer
' Open a Binary Reader
Dim memStream As MemoryStream = New MemoryStream(clientPacket)
Dim bReader As BinaryReader = New BinaryReader(memStream)
' Remove the Ethernet Header
Dim ethBytes As Byte() = bReader.ReadBytes(14)
' Remove the IPv4 Header
Dim IPv4Bytes As Byte() = bReader.ReadBytes(20)
' Remove the TCP Header
Dim TCPBytes As Byte() = bReader.ReadBytes(20)
' Get the packet length
If clientPacket.Length > 54 Then
Dim len As UInt32 = bReader.ReadUInt32
Console.WriteLine(len)
End If
End Sub
So far, all of my attempts at having the console write the data length have resulted in failure. I validated the endianness and actually wrote out the bytes to verify that I was handling the correct data.
Example bytes:
00 00 00 24 -> UINT32 is 36 bytes, but I am getting an array of Integers like 3808493568
How can I fix this?
I agree with Hans, endianness is your problem. Also, I'd recommend you use the BitConverter class on the clientPacket array, easier than using streams.
Dim len As UInt32
Dim arr() As Byte
arr = {0, 0, 0, 24}
len = BitConverter.ToUInt32(arr, 0)
Console.Write(len.ToString) 'returns 402653184
arr = {24, 0, 0, 0}
len = BitConverter.ToUInt32(arr, 0)
Console.Write(len.ToString) 'returns 24
For your code, I think this might work (untested):
If clientPacket.Length > 54 Then
Dim lenBytes As Byte() = bReader.ReadBytes(4)
Array.Reverse(lenBytes, 0, 4)
Dim len As UInt32 = BitConverter.ToUInt32(lenBytes, 0)
Here is the code I used to store an image in my database (SQL Server 2008 R2) using VB 2010.
The images get stored but the problem is the clarity of the image is lost when retrieved and seen in a picture box.
Public Function InsertUpdateImage(ByRef _SqlConnection As System.Data.SqlClient.SqlConnection, ByVal _Image As System.Drawing.Image, ByVal _ImageFormat As System.Drawing.Imaging.ImageFormat) As Integer
Dim _SqlRetVal As Integer = 0
'System.IO.Path.GetFullPath(files(ListView1.SelectedIndices(0))) Give the path for the 'image from listview
Dim str As String = System.IO.Path.GetFullPath(files(ListView1.SelectedIndices(0)))
Dim i As Integer = Len(str)
Dim j As Integer = 0
Dim locstr(i + 10) As Char
i = 0
While i < Len(str)
If str(i) = "\" Then
locstr(j) = "\"
j = j + 1
Else
locstr(j) = str(i)
j = j + 1
End If
i = i + 1
End While
Dim loc As New String(locstr)
MsgBox(loc)
' lets add this record to database
Dim _SqlCommand As New System.Data.SqlClient.SqlCommand("insert into maindb(photo,name,location) values(#image,'" + System.IO.Path.GetFileName(files(ListView1.SelectedIndices(0))) + "','" + loc + "')", _SqlConnection)
' Convert image to memory stream
Dim _MemoryStream As New System.IO.MemoryStream()
_Image.Save(_MemoryStream, _ImageFormat)
' Add image as SQL parameter
Dim _SqlParameter As New System.Data.SqlClient.SqlParameter("#image", SqlDbType.Image)
_SqlParameter.Value = _MemoryStream.ToArray()
_SqlCommand.Parameters.Add(_SqlParameter)
' Executes a Transact-SQL statement against the connection
' and returns the number of rows affected.
_SqlRetVal = _SqlCommand.ExecuteNonQuery()
Console.Write(_SqlRetVal)
' Dispose command
_SqlCommand.Dispose()
_SqlCommand = Nothing
' Error occurred while trying to execute reader
' send error message to console (change below line to customize error handling)
Return _SqlRetVal
End Function
Your image.save() reduces the quality of the image (if saved as Jpeg) to the default compression level of aabout 75%.
Please see this MSDN article on increasing this quality level, when you call Save by passing in myEncoderParameters, containing a quality level at a much higher level (say 90%)
http://msdn.microsoft.com/en-us/library/system.drawing.imaging.encoder.quality.aspx
Or see the (untested) code below, that should do the trick
' Create a a single encoder parameter envelope
Dim EncoderParameters As New EncoderParameters(1)
' Create and add a single quality parameter to this envelope, specifying 95%
Dim QualityParam As New EncoderParameter(Encoder.Quality, CType(95L, Int32))
EncoderParameters.Param(0) = QualityParam
' Save the image with the encoder param specifying 95% quality
_image.Save(_MemoryStream, _ImageFormat, EncoderParameters)