Attribute VB_Name = "modFindPortWin32"
Option Explicit

Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" ( _
        ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
        lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, _
        ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = &H3
Private Const OPEN_ALWAYS = &H4
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const INVALID_HANDLE_VALUE = -1
Private Const FirstComPort = 1
Private Const LastComPort = 16

Public Function IsPortInList(lstComPortList As Object, ByVal iComPort As Integer) As Boolean
    Dim idxComPort As Integer
    On Error GoTo GetPortFromListError
    IsPortInList = False
    For idxComPort = 0 To lstComPortList.ListCount - 1
        If (lstComPortList.ItemData(idxComPort) = iComPort) Then
            IsPortInList = True
        End If
    Next
    Exit Function
GetPortFromListError:
    'MsgBox Err.Description, vbCritical, "IsPortInList ComPort Resource List Error"
End Function

Public Function GetPortListIndex(lstComPortList As Object, ByVal iComPort As Integer) As Integer
    Dim idxComPort As Integer
    On Error GoTo GetPortFromListError
    GetPortListIndex = -1
    For idxComPort = 0 To lstComPortList.ListCount - 1
        If (lstComPortList.ItemData(idxComPort) = iComPort) Then
            GetPortListIndex = idxComPort
        End If
    Next
    Exit Function
GetPortFromListError:
    'MsgBox Err.Description, vbCritical, "GetPortListIndex ComPort Resource List Error"
End Function

Public Function isComPortAvailable(ByVal iComPort As Integer) As Boolean
    Dim hComPort As Long
    Dim lpSecAttr As SECURITY_ATTRIBUTES
    Dim lRetVal As Long
    
    On Error GoTo isComPortAvailableError
    
    hComPort = CreateFile("\\.\COM" & iComPort & "", 0, FILE_SHARE_READ + FILE_SHARE_WRITE, lpSecAttr, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    If hComPort = INVALID_HANDLE_VALUE Then
        isComPortAvailable = False
    Else
        isComPortAvailable = True
        lRetVal = CloseHandle(hComPort)
    End If
    
    Exit Function
isComPortAvailableError:
    MsgBox Err.Description, vbCritical, "is ComPort Available Test Error"
End Function

Public Sub CreateComPortResource(lstComPortList As Object)
    Dim idxComPort As Integer

    On Error GoTo CreateComPortResourceError

    lstComPortList.Clear
    For idxComPort = FirstComPort To LastComPort
        If isComPortAvailable(idxComPort) Then
            lstComPortList.AddItem "COM" & idxComPort
            lstComPortList.ItemData(lstComPortList.NewIndex) = idxComPort
        End If
    Next

    Exit Sub
CreateComPortResourceError:
    MsgBox Err.Description, vbCritical, "CreateComPort Resource List Error"
End Sub

Public Function isAnyComPort() As Boolean
    Dim idxComPort As Integer
    Dim bHavePort As Boolean
    On Error GoTo isAnyComPortError

    bHavePort = False
    isAnyComPort = False
    For idxComPort = FirstComPort To LastComPort
        If isComPortAvailable(idxComPort) Then
            bHavePort = True
        End If
    Next
    isAnyComPort = bHavePort
    Exit Function
isAnyComPortError:
    MsgBox Err.Description, vbCritical, "isAnyComPort Resource Error"
End Function

Public Function GetFirstComPort() As Integer
    Dim idxComPort As Integer
    On Error GoTo GetFirstComPortError

    GetFirstComPort = 0
    For idxComPort = FirstComPort To LastComPort
        If isComPortAvailable(idxComPort) Then
            GetFirstComPort = idxComPort
            Exit Function
        End If
    Next
    Exit Function
GetFirstComPortError:
    MsgBox Err.Description, vbCritical, "GetFirstComPort Resource Error"
End Function

Public Function GetBaudRate(strSettings As String) As String
    Dim lPos As Long
    
    lPos = InStr(1, strSettings, ",")
    If (lPos > 0) Then
        GetBaudRate = Left(strSettings, lPos - 1)
    Else
        GetBaudRate = ""
    End If
End Function

Public Function ToggleBaudRate(strSettings As String) As String
    Dim lPos As Long
    Dim strNewSettings As String
    Dim strBaudRate As String
    
    On Error GoTo ToggleBaudRateError
    
    lPos = InStr(1, strSettings, ",")
    If (lPos > 0) Then
        strBaudRate = Left(strSettings, lPos - 1)
        If (strBaudRate = "115200") Then
            strBaudRate = "57600"
        ElseIf (strBaudRate = "57600") Then
            strBaudRate = "115200"
        Else
            strBaudRate = ""
        End If
        If (Len(strBaudRate) > 0) Then
            ToggleBaudRate = strBaudRate & Mid(strSettings, lPos)
        Else
            ToggleBaudRate = strSettings
        End If
    Else
        ToggleBaudRate = strSettings
    End If
    
    Exit Function
ToggleBaudRateError:
    MsgBox Err.Description, vbCritical, "Toggle Baud Rate Error"
End Function