vb 串口调试软件 源代码

现需要vb 串口调试软件 源代码，那位仁兄，大姐有，能否传个给我！

解决方案 »

  1.   

    http://www.mndsoft.com/blog/blogview.asp?logID=357&cateID=6
      

  2.   

    直接给你贴这吧：SerialPort.basAttribute VB_Name = "SerialPort"
    '****************************************************************************
    '人人为我，我为人人
    '枕善居汉化收藏整理
    '发布日期：05/05/29
    '描  述：API串口读写模块
    '网  站：http://www.mndsoft.com/
    'e-mail：[email protected]
    'OICQ  : 88382850
    '****************************************************************************
    Option ExplicitGlobal ComNum As Long
    Global bRead(255) As ByteType COMSTAT
            fCtsHold As Long
            fDsrHold As Long
            fRlsdHold As Long
            fXoffHold As Long
            fXoffSent As Long
            fEof As Long
            fTxim As Long
            fReserved As Long
            cbInQue As Long
            cbOutQue As Long
    End TypeType COMMTIMEOUTS
            ReadIntervalTimeout As Long
            ReadTotalTimeoutMultiplier As Long
            ReadTotalTimeoutConstant As Long
            WriteTotalTimeoutMultiplier As Long
            WriteTotalTimeoutConstant As Long
    End TypeType DCB
            DCBlength As Long
            BaudRate As Long
            fBinary As Long
            fParity As Long
            fOutxCtsFlow As Long
            fOutxDsrFlow As Long
            fDtrControl As Long
            fDsrSensitivity As Long
            fTXContinueOnXoff As Long
            fOutX As Long
            fInX As Long
            fErrorChar As Long
            fNull As Long
            fRtsControl As Long
            fAbortOnError As Long
            fDummy2 As Long
            wReserved As Integer
            XonLim As Integer
            XoffLim As Integer
            ByteSize As Byte
            Parity As Byte
            StopBits As Byte
            XonChar As Byte
            XoffChar As Byte
            ErrorChar As Byte
            EofChar As Byte
            EvtChar As Byte
    End TypeType OVERLAPPED
            Internal As Long
            InternalHigh As Long
            offset As Long
            OffsetHigh As Long
            hEvent As Long
    End Type
    Type SECURITY_ATTRIBUTES
            nLength As Long
            lpSecurityDescriptor As Long
            bInheritHandle As Long
    End TypeDeclare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Declare Function GetLastError Lib "kernel32" () As Long
    Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
    Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
    Declare Function SetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
    Declare Function GetCommTimeouts Lib "kernel32" (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long
    Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCB) As Long
    Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCB) As Long
    Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
    Function fin_com()
        fin_com = CloseHandle(ComNum)
    End Function'关闭端口
    Function FlushComm()
        FlushFileBuffers (ComNum)
    End Function'初始化端口
    Function Init_Com(ComNumber As String, Comsettings As String) As Boolean
    On Error GoTo handelinitcom
        Dim ComSetup As DCB, Answer, Stat As COMSTAT, RetBytes As Long
        Dim retval As Long
        Dim CtimeOut As COMMTIMEOUTS, BarDCB As DCB
        ' 打开通讯口读/写(&HC0000000).
        ' 必须指定存在的文件 (3).
        ComNum = CreateFile(ComNumber, &HC0000000, 0, 0&, &H3, 0, 0)
        If ComNum = -1 Then
            MsgBox "端口 " & ComNumber & "无效. 请设置正确.", 48
            Init_Com = False
            Exit Function
        End If
        '超时
        CtimeOut.ReadIntervalTimeout = 20
        CtimeOut.ReadTotalTimeoutConstant = 1
        CtimeOut.ReadTotalTimeoutMultiplier = 1
        CtimeOut.WriteTotalTimeoutConstant = 10
        CtimeOut.WriteTotalTimeoutMultiplier = 1
        retval = SetCommTimeouts(ComNum, CtimeOut)
        If retval = -1 Then
            retval = GetLastError()
            MsgBox "端口超时设定无效 " & ComNumber & " 错误: " & retval
            retval = CloseHandle(ComNum)
            Init_Com = False
            Exit Function
        End If
        retval = BuildCommDCB(Comsettings, BarDCB)
        If retval = -1 Then
            retval = GetLastError()
            MsgBox "无效设备 DCB 块 " & Comsettings & " 错误: " & retval
            retval = CloseHandle(ComNum)
            Init_Com = False
            Exit Function
        End If
        retval = SetCommState(ComNum, BarDCB)
        If retval = -1 Then
            retval = GetLastError()
            MsgBox "无效设备 DCB 块 " & Comsettings & " 错误: " & retval
            retval = CloseHandle(ComNum)
            Init_Com = False
            Exit Function
        End If
        
        Init_Com = True
    handelinitcom:
        Exit Function
    End Function'从串口读取数据
    Function ReadCommPure() As String
    On Error GoTo handelpurecom
        Dim RetBytes As Long, i As Integer, ReadStr As String, retval As Long
        Dim CheckTotal As Integer, CheckDigitLC As Integer
        retval = ReadFile(ComNum, bRead(0), 255, RetBytes, 0)
        ReadStr = ""
        If (RetBytes > 0) Then
            For i = 0 To RetBytes - 1
                ReadStr = ReadStr & Chr(bRead(i))
            Next i
           Else
            FlushComm
        End If
        ReadCommPure = ReadStr
    handelpurecom:
        Exit Function
    End Function'向串口写数据
    Function WriteCOM32(COMString As String) As Integer
    On Error GoTo handelwritelpt
        Dim RetBytes As Long, LenVal As Long
        Dim retval As Long
        
        If Len(COMString) > 255 Then
            WriteCOM32 Left$(COMString, 255)
            WriteCOM32 Right$(COMString, Len(COMString) - 255)
            Exit Function
        End If
        
        For LenVal = 0 To Len(COMString) - 1
            bRead(LenVal) = Asc(Mid$(COMString, LenVal + 1, 1))
        Next LenVal
    '    bRead(LenVal) = 0
        retval = WriteFile(ComNum, bRead(0), Len(COMString), RetBytes, 0)
    '    FlushComm
        WriteCOM32 = RetBytes
        
    handelwritelpt:
        Exit Function
    End Function
      

  3.   

    SerialComms.frm***********************VERSION 5.00
    Begin VB.Form frmSerial 
       BorderStyle     =   1  'Fixed Single
       Caption         =   "API串口通讯模块 枕善居 http://www.mndsoft.com"
       ClientHeight    =   4680
       ClientLeft      =   45
       ClientTop       =   330
       ClientWidth     =   6540
       LinkTopic       =   "Form1"
       MaxButton       =   0   'False
       MinButton       =   0   'False
       ScaleHeight     =   4680
       ScaleWidth      =   6540
       StartUpPosition =   3  '窗口缺省
       Begin VB.Timer TMRComm 
          Enabled         =   0   'False
          Interval        =   1000
          Left            =   5430
          Top             =   4230
       End
       Begin VB.Frame Frame1 
          ForeColor       =   &H00C00000&
          Height          =   3015
          Left            =   90
          TabIndex        =   7
          Top             =   1440
          Width           =   6390
          Begin VB.TextBox txtRec 
             Enabled         =   0   'False
             Height          =   1395
             Left            =   105
             MultiLine       =   -1  'True
             ScrollBars      =   2  'Vertical
             TabIndex        =   10
             Tag             =   "NC"
             Top             =   1500
             Width           =   6150
          End
          Begin VB.CommandButton BTNSend 
             Caption         =   "发送数据(&S)"
             Default         =   -1  'True
             Enabled         =   0   'False
             Height          =   375
             Left            =   4815
             TabIndex        =   9
             Tag             =   "NC"
             Top             =   990
             Width           =   1455
          End
          Begin VB.TextBox txt 
             Enabled         =   0   'False
             Height          =   315
             Index           =   2
             Left            =   120
             TabIndex        =   8
             Tag             =   "NC"
             Top             =   540
             Width           =   6135
          End
          Begin VB.Label Label1 
             Caption         =   "接收数据:"
             Height          =   255
             Index           =   3
             Left            =   120
             TabIndex        =   12
             Top             =   1260
             Width           =   1215
          End
          Begin VB.Label Label1 
             Caption         =   "发送到串口的字符:"
             Height          =   255
             Index           =   2
             Left            =   120
             TabIndex        =   11
             Top             =   270
             Width           =   3075
          End
          Begin VB.Shape Pic 
             BorderStyle     =   0  'Transparent
             FillColor       =   &H0000FFFF&
             FillStyle       =   0  'Solid
             Height          =   255
             Left            =   6045
             Shape           =   3  'Circle
             Top             =   180
             Width           =   195
          End
       End
       Begin VB.Frame Frame2 
          Caption         =   "串口设置"
          ForeColor       =   &H00C00000&
          Height          =   1215
          Left            =   105
          TabIndex        =   0
          Top             =   135
          Width           =   6330
          Begin VB.CommandButton BTNCloseCom 
             Cancel          =   -1  'True
             Caption         =   "关闭串口"
             Enabled         =   0   'False
             Height          =   435
             Left            =   4380
             TabIndex        =   4
             Tag             =   "NC"
             Top             =   660
             Width           =   1035
          End
          Begin VB.CommandButton BTNOpenCom 
             Caption         =   "打开串口"
             Height          =   435
             Left            =   4380
             TabIndex        =   3
             Tag             =   "NO"
             Top             =   180
             Width           =   1035
          End
          Begin VB.TextBox txt 
             Height          =   315
             Index           =   1
             Left            =   1980
             TabIndex        =   2
             Tag             =   "NO"
             Text            =   "9600,n,8,1"
             Top             =   570
             Width           =   1455
          End
          Begin VB.TextBox txt 
             Height          =   315
             Index           =   0
             Left            =   1020
             TabIndex        =   1
             Tag             =   "NO"
             Text            =   "COM1:"
             Top             =   570
             Width           =   855
          End
          Begin VB.Label Label1 
             Caption         =   "参数设置:"
             Height          =   255
             Index           =   1
             Left            =   1980
             TabIndex        =   6
             Top             =   330
             Width           =   1335
          End
          Begin VB.Label Label1 
             Caption         =   "串口:"
             Height          =   255
             Index           =   0
             Left            =   1020
             TabIndex        =   5
             Top             =   330
             Width           =   915
          End
       End
    End
    Attribute VB_Name = "frmSerial"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    '****************************************************************************
    '人人为我，我为人人
    '枕善居汉化收藏整理
    '发布日期：05/05/29
    '描  述：API串口读写测试
    '网  站：http://www.mndsoft.com/
    'e-mail：[email protected]
    'OICQ  : 88382850
    '****************************************************************************
    Private Sub BTNCloseCom_Click()
        TMRComm.Enabled = False
        Call fin_com
        SwitchTags
    End SubPrivate Sub BTNOpenCom_Click()
        If Not Init_Com(txt(0).Text, txt(1).Text) Then
            MsgBox txt(0).Text & " 无效!"
            Exit Sub
        End If
        SwitchTags
        TMRComm.Enabled = True
    End SubPrivate Sub BTNSend_Click()
        If WriteCOM32(txt(2)) & vbCr <> Len(txt(2)) Then
            MsgBox "写入错误"
            Exit Sub
        End If
        txtRec.Text = ""
        Pic.FillColor = &HFF0000
    End SubPrivate Sub TMRComm_Timer()
        Dim Ans As String, i As Integer, RtnStr As String
        Ans = ReadCommPure()
        If Pic.FillColor = &HFFFFFF Then
            Pic.FillColor = &H808080
           Else
            Pic.FillColor = &HFFFFFF
        End If
        If Ans = "" Then Exit Sub
        Pic.FillColor = &HFF
        For i = 1 To Len(Ans)
            RtnStr = RtnStr & Hex(Asc(Mid$(Ans, i, 1))) & " "
        Next
        RtnStr = RtnStr & vbCrLf & vbCrLf & CleanStr(Ans)
        txtRec.Text = RtnStr
        FlushComm
    End SubFunction CleanStr(TextLine As String) As String
        Dim i As Integer, RtnStr As String
        RtnStr = ""
        For i = 1 To Len(TextLine)
            Select Case Asc(Mid$(TextLine, i, 1))
                Case &H5D
                    RtnStr = RtnStr & "<ACK>"
                Case &H5B
                    RtnStr = RtnStr & "<NAK>"
                Case Is >= &H30
                    RtnStr = RtnStr & Mid$(TextLine, i, 1)
                Case 13
                    RtnStr = RtnStr & "<CR>"
                Case 10
                    RtnStr = RtnStr & "<LF>"
                Case Else
                    RtnStr = RtnStr & "@"
            End Select
        Next i
        CleanStr = RtnStr
    End FunctionSub SwitchTags()
        Dim xs As Control
        For Each xs In Me
            If xs.Tag <> "" Then
                xs.Enabled = Not xs.Enabled
            End If
        Next
    End Sub
      

  4.   

    谢谢你啊！你还有利用MSComm控件做的吗？
      

  5.   

    那代码不是我做的，是 mndsoft 做的。
    我是以前下载了，帮你贴一下。:-)对这个我没研究过，只是收藏了他的代码。