vb6 – 串口编程

Option Explicit
'******************************************************************************
' Description: Scans machine using the WIN32 API for all available comm hardware
' Usage:    main program calls the 'CommSettings' sub,passing the
'           name of the communications control and a combobox name.
'******************************************************************************

Dim CommCntrl             As Control                                  ' the communications control
Dim cmboPort              As Control                                  ' combobox to populate
Dim bNoComm               As Boolean

Private Const MAX_COMM = 16                                           ' 32 max port # to check

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_OVERLAPPED = &H40000000
Private Const INVALID_HANDLE_VALUE = -1

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

Private Declare Function CloseHandle Lib "kernel32" ( _
                                     ByVal hObject As Long) As Long


Public Sub GetPorts(serialCntrl As Control,comboBox As Control)
    '******************************************************************************
    ' Usage:    Pass the name of the communications control,a combo box,and the
    '           current com port setting in the calling routine.
    '******************************************************************************

    Dim iCntr             As Integer                                  ' loop counter
    Dim hRet              As Long                                     ' api return value
    Dim sCom              As String                                   ' comm port name

    On Error Resume Next

    Set cmboPort = comboBox

    Set CommCntrl = serialCntrl
    Err = 0

    cmboPort.Clear

    ' Close the port if it's open
    If CommCntrl.PortOpen = True Then
        CommCntrl.PortOpen = False
        DoEvents
    Else
        bNoComm = True
    End If

    ' Scan for all possible hardware so we can display all available ports
    ' in the combo box. Dynamically adjusts for PC's with addin cards
    For iCntr = 1 To MAX_COMM
        ' try to open the port.
        ' . required for ports > 9,works for all ports
        sCom = ".Com" & CStr(iCntr) & vbNullChar
        hRet = CreateFile(sCom,GENERIC_READ Or _
                                GENERIC_WRITE,vbNullString,OPEN_EXISTING,_
                          FILE_FLAG_OVERLAPPED,vbNullString)

        If hRet <> INVALID_HANDLE_VALUE Then
            hRet = CloseHandle(hRet)
            cmboPort.AddItem Format$(iCntr)
            Debug.Print iCntr
        Else
            ' dll error 5 = already open
            ' dll error 2 = no harware
            If Err.LastDllError = 5 Then
                cmboPort.AddItem Format$(iCntr) & " - Busy"
            End If
        End If
    Next

End Sub