mxtool.bas

Rs232串口通信专题范例,Vusual Basic,Mscomm,PCOMMPRO

Attribute VB_Name = "Mxtool"
'************************************************************
'    Mxtool.bas
'     -- Process PComm Lib function return value
'
'
''1999/4/2  TOM Modified
'************************************************************
Option Explicit

Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Public Const LANG_NEUTRAL = &H0
Public Const SUBLANG_DEFAULT = &H1

Declare Function GetLastError Lib "kernel32" () As Long
Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _
    (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, ByVal lpBuffer As String, _
    ByVal nSize As Long, Arguments As Long) As Long

Public Sub ShowSysErr(title As String, syserr As Long)
Dim lpMsgBuf As String * 80
Dim lang As Integer
    
    'lang = {MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT) }
    lang = SUBLANG_DEFAULT * 2 ^ 10 + LANG_NEUTRAL
    Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, _
        0, syserr, lang, lpMsgBuf, 80, 0)
    Call MsgBox(lpMsgBuf, vbOKOnly Or vbExclamation, title)
End Sub

Public Sub MxShowError(title As String, errcode As Long, syserr As Long)
Dim buf As String
    
    If errcode <> SIO_WIN32FAIL Then
        Select Case errcode
        Case SIO_BADPORT
            buf = "通讯埠错误或未开启"
        Case SIO_OUTCONTROL:
            buf = "未支援此功能"
        Case SIO_NODATA:
            buf = "未有资料被读取"
        Case SIO_OPENFAIL:
            buf = "开启错误"
        Case SIO_RTS_BY_HW:
            buf = "启动硬体流量控制时不可控制RTS状态"
        Case SIO_BADPARM:
            buf = "参数错误"
        Case SIO_BOARDNOTSUPPORT:
            buf = "介面未支援此函数"
        Case SIO_ABORT_WRITE:
            buf = "使用者中断写出动作"
        Case SIO_WRITETIMEOUT:
            buf = "输出逾时"
        Case Else
            buf = "不可预测的错误:" & errcode
        End Select
        Call MsgBox(buf, vbOKOnly Or vbExclamation, title)
    Else         '系统错误的讯息
        Call ShowSysErr(title, syserr)
    End If
End Sub