frmcom.frm

远程访问sql server 的源码

         Caption         =   "发送数据："
         Height          =   255
         Left            =   -74640
         TabIndex        =   39
         Top             =   5760
         Width           =   975
      End
      Begin VB.Label Label15 
         AutoSize        =   -1  'True
         Caption         =   "串口名："
         Height          =   180
         Left            =   5640
         TabIndex        =   31
         Top             =   1080
         Width           =   720
      End
      Begin VB.Label Label14 
         AutoSize        =   -1  'True
         Caption         =   "波特率："
         Height          =   180
         Left            =   5640
         TabIndex        =   30
         Top             =   1680
         Width           =   720
      End
      Begin VB.Label Label13 
         AutoSize        =   -1  'True
         Caption         =   "数据位："
         Height          =   180
         Left            =   5640
         TabIndex        =   29
         Top             =   2280
         Width           =   720
      End
      Begin VB.Label Label12 
         AutoSize        =   -1  'True
         Caption         =   "停止位："
         Height          =   180
         Left            =   5640
         TabIndex        =   28
         Top             =   2880
         Width           =   720
      End
      Begin VB.Label Label11 
         AutoSize        =   -1  'True
         Caption         =   "奇偶校验位："
         Height          =   180
         Left            =   5520
         TabIndex        =   27
         Top             =   3600
         Width           =   1080
      End
      Begin VB.Label Label10 
         Caption         =   "奇偶校验位："
         Height          =   255
         Left            =   -69480
         TabIndex        =   13
         Top             =   3480
         Width           =   1095
      End
      Begin VB.Label Label9 
         Caption         =   "停    止    位："
         Height          =   255
         Left            =   -69480
         TabIndex        =   12
         Top             =   2760
         Width           =   1095
      End
      Begin VB.Label Label8 
         Caption         =   "数    据    位："
         Height          =   255
         Left            =   -69480
         TabIndex        =   11
         Top             =   2160
         Width           =   1095
      End
      Begin VB.Label Label7 
         Caption         =   "波    特    率："
         Height          =   255
         Left            =   -69480
         TabIndex        =   10
         Top             =   1560
         Width           =   1095
      End
      Begin VB.Label Label6 
         Caption         =   "串    口    名："
         Height          =   255
         Left            =   -69480
         TabIndex        =   9
         Top             =   960
         Width           =   1215
      End
      Begin VB.Label Label5 
         Caption         =   "奇偶校验位："
         Height          =   255
         Left            =   -69480
         TabIndex        =   8
         Top             =   3480
         Width           =   1095
      End
      Begin VB.Label Label4 
         Caption         =   "停    止    位："
         Height          =   255
         Left            =   -69480
         TabIndex        =   7
         Top             =   2760
         Width           =   1095
      End
      Begin VB.Label Label3 
         Caption         =   "数    据    位："
         Height          =   255
         Left            =   -69480
         TabIndex        =   6
         Top             =   2160
         Width           =   1095
      End
      Begin VB.Label Label2 
         Caption         =   "波    特    率："
         Height          =   255
         Left            =   -69480
         TabIndex        =   4
         Top             =   1560
         Width           =   1095
      End
      Begin VB.Label Label1 
         Caption         =   "串    口    名："
         Height          =   255
         Left            =   -69480
         TabIndex        =   2
         Top             =   960
         Width           =   1215
      End
   End
End
Attribute VB_Name = "frmCom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim nSendHand As Long '打开的发送端端口的句柄
Dim nRecvHand As Long '打开的接收端端口的句柄

Private Sub cmdClose_Click()
    '关闭串口
    Comm.PortOpen = False
    staCtl.Panels(1).Text = txtName.Text & " 端口被关闭！"
End Sub

Private Sub cmdCLoseRecv_Click()
    nRecvHand = CloseHandle(nRecvHand)
    staRApi.Panels(1).Text = "接收端口已经关闭！"
End Sub

Private Sub cmdCloseSend_Click()
     nSendHand = CloseHandle(nSendHand)
     staSApi.Panels(1).Text = "发送端口已经关闭！"
End Sub

Private Sub cmdCtlRecv_Click()
    Dim inBuff As String
    Dim nLen As Long
    
    '接收数据
    inBuff = Comm.Input
    nLen = Len(Trim$(inBuff))
    
    txtCtl.Text = "已接收" & nLen & "个字节的数据！" & vbCrLf
    txtCtl.Text = txtCtl.Text & Trim$(inBuff)
End Sub

Private Sub cmdCtlSend_Click()
    Dim sSend As String
    Dim nLen As Long
        
    On Error GoTo err
    sSend = Trim$(txtCtlInput.Text)
    nLen = Len(sSend)
        
    '发送数据
    Comm.Output = sSend
    
    txtCtl.Text = txtCtl.Text & "已发送" & nLen & "个字节的数据！" & vbCrLf
    Exit Sub
err:
    MsgBox err.Description
End Sub

Private Sub cmdOpen_Click()
    Dim sSetting As String
    Dim portName As String
    On Error GoTo err
    
    portName = Trim$(txtName.Text)
    '取得COM的端口号
    Comm.CommPort = CLng(Mid$(portName, 4))
    
    '下面4条语句用来设置MSComm控件的Settings属性，注意顺序不能改变
    sSetting = sSetting & CLng(Trim$(txtBaud.Text)) & ","
    '这里只要一个字符，不能为整个字符串
    sSetting = sSetting & Left$(Trim$(cboOdd.Text), 1) & ","
    sSetting = sSetting & CLng(Trim$(cboData.Text)) & ","
    sSetting = sSetting & CLng(Trim$(cboEnd.Text))
    
    Comm.Settings = sSetting
    '当接收缓存中有数据的时候就开始接收数据
    Comm.RThreshold = 1
    '打开串口
    Comm.PortOpen = True
    
    staCtl.Panels(1).Text = txtName.Text & " 端口被打开"
    Exit Sub
err:
    MsgBox err.Description
End Sub

Private Sub cmdOpenSend_Click()
    Dim nHand As Long '定义打开的串口设备的句柄
    Dim dcbConfig As DCB
    Dim blnErr As Long
    Dim strDCB As String

    nHand = CreateFile(Trim$(txtSender.Text), GENERIC_WRITE Or GENERIC_READ, 0&, _
        ByVal 0&, OPEN_EXISTING, 0&, 0&)
    
    If nHand = -1 Then
        MsgBox "串口打开失败！"
        '关闭当前被占用的串口
        nHand = CloseHandle(nHand)
        Exit Sub
    Else
        '初始化串口设备的相关参数，输入缓存和输出缓存初始大小为1024
        SetupComm nHand, 1024, 1024
        '用当前设备的通信属性信息填充缓存区
        GetCommState nHand, dcbConfig
        
        dcbConfig.BaudRate = CLng(Trim$(txtSBaud.Text))
        dcbConfig.ByteSize = CLng(Trim$(cboSData.Text))
        dcbConfig.StopBits = cboSEnd.ListIndex
        '奇偶校验位，用对应的索引号即可。这也正好是对应常量的值
        dcbConfig.Parity = cboSOdd.ListIndex
        '用上面的通信设备的通信信息对通信设备进行设置
        blnErr = SetCommState(nHand, dcbConfig)
        If blnErr <= 0 Then
            MsgBox "串行端口配置错误！"
            Exit Sub
        End If
        nSendHand = nHand
        staSApi.Panels(1).Text = "发送端口已经打开！"
    End If
End Sub

Private Sub cmdRecv_Click()
    Dim sRecv As String
    Dim recComState As COMSTAT
    Dim ErrorFlag As Long
    Dim lResult As Long
    
    Dim NumToRead As Long
    Dim NumhaveRead As Long
    
    '通过下面的操作，得到了串口的当前状态
    If ClearCommError(nRecvHand, ErrorFlag, recComState) <= 0 Then
        PurgeComm nRecvHand, PURGE_RXABORT Or PURGE_RXCLEAR
    End If
    
    '为接收区缓存开辟空间
    sRecv = Space$(1024)
    
    If recComState.cbInQue > 0 Then
        '取得接收缓存区内没有被读取的字节数
        NumToRead = recComState.cbInQue
        
        '参数sRecv的传递需要加上关键字ByVal
        '对于ByRef的参数传递，如果实参为字符串变量的时候，需要加上ByVal，因为
        '字符串变量本身已经指针，如果不用ByVal的话，将传递指针的指针，就出现错误了。
        lResult = ReadFile(nRecvHand, ByVal sRecv, NumToRead, _
            NumhaveRead, ByVal 0&)
    End If
    
    '注意：被注释掉的下面的语句是读取数据的另一种方法，即利用Byte数组的方法。
    '紧随上面的读取串口操作放在一起说明是为了进行比较。
    '一般而言，利用Byte数组具有更大的通用性。下面的代码经过测试，能够正确运行。
    
    'Dim binRecv() As Byte
    '为接收缓存区开辟空间
    'ReDim binRecv(0 To 1023)
    'lResult = ReadFile(nRecvHand, binRecv(0), NumToRead, _
            NumhaveRead, ByVal 0&)
    'sRecv = StrConv(binRecv, vbUnicode)
    'sRecv = Left$(sRecv, InStr(sRecv, Chr(0)) - 1)
    
    txtRecv.Text = "接收到" & NumhaveRead & "个字节的数据。" & vbCrLf
    txtRecv.Text = txtRecv.Text & Trim$(sRecv)
    PurgeComm nRecvHand, PURGE_RXABORT Or PURGE_RXCLEAR
End Sub

Private Sub cmdSend_Click()
    Dim sSend As String
    Dim lenBuf As Long          '存放将要写入串口的数据长度
    Dim NumberWritten As Long   '用来记录写入的字节长度
    
    On Error GoTo err:
    
    NumberWritten = 0
    sSend = Trim$(txtInput.Text)
    lenBuf = Len(sSend)
    
    '清空缓冲区
    PurgeComm nSendHand, PURGE_RXABORT Or PURGE_RXCLEAR
  
    '注意，写入数据也可以使用Byte数组。另外，参数sSend的传递需要加上关键字ByVal
    '对于ByRef的参数传递，如果实参为字符串变量的时候，需要加上ByVal，因为
    '字符串变量本身已经指针，如果不用ByVal的话，将传递指针的指针，就出现错误了。
    If WriteFile(nSendHand, ByVal sSend, lenBuf, NumberWritten, ByVal 0&) <= 0 Then
        MsgBox "向串口写数据发生错误！"
    End If
    
    txtSend.Text = "已经发送" & lenBuf & "个字节的数据。" & vbCrLf
    Exit Sub
err:
    MsgBox err.Description
End Sub

Private Sub cmdOpenRecv_Click()
    Dim nHand As Long '定义打开的串口设备的句柄
    Dim dcbConfig As DCB
    Dim blnErr As Long

    nHand = CreateFile(Trim$(txtAccept.Text), GENERIC_WRITE Or GENERIC_READ, _
        0&, ByVal 0&, OPEN_EXISTING, 0&, 0&)
    
    If nHand = -1 Then
        MsgBox "串口打开失败！"
        '关闭当前被占用的串口
        nHand = CloseHandle(nHand)
        Exit Sub
    Else
        SetupComm nHand, 1024, 1024
        GetCommState nHand, dcbConfig
        
        dcbConfig.BaudRate = CLng(Trim$(txtABaud.Text))
        dcbConfig.ByteSize = CLng(Trim$(cboAData.Text))
        dcbConfig.StopBits = cboAEnd.ListIndex 'CLng(Trim$(cboAEnd.Text))
        dcbConfig.Parity = cboAOdd.ListIndex
        
        blnErr = SetCommState(nHand, dcbConfig)
        If blnErr <= 0 Then
            MsgBox "串行端口配置错误！"
            Exit Sub
        End If
        nRecvHand = nHand
        staRApi.Panels(1).Text = "接收端口已经打开！"
    End If
End Sub

Private Sub Comm_OnComm()
    Dim sGet As String
    '接收缓冲区的字节数
    Dim nLen As Long
    
    Select Case Comm.CommEvent
        '当有数据到达缓冲区，即开始接收数据
        Case comEvReceive
            '延迟3秒，然后开始接收数据，这是为了确保数据能完全的接收
            Sleep 3000
            nLen = Comm.InBufferCount
            sGet = Comm.Input
            txtCtl.Text = "已接收" & nLen & "个字节的数据！" & vbCrLf
            txtCtl.Text = txtCtl.Text & Trim$(sGet)
    End Select
End Sub

Private Sub Form_Load()
    txtSBaud.Text = 9600
    txtABaud.Text = 9600
    txtBaud.Text = 9600
    
    txtSender.Text = "COM1"
    txtAccept.Text = "COM2"
    
    cboSData.AddItem 5
    cboSData.AddItem 6
    cboSData.AddItem 7
    cboSData.AddItem 8
    cboSData.ListIndex = 3
    
    cboAData.AddItem 5
    cboAData.AddItem 6
    cboAData.AddItem 7
    cboAData.AddItem 8
    cboAData.ListIndex = 3
    
    cboData.AddItem 5
    cboData.AddItem 6
    cboData.AddItem 7
    cboData.AddItem 8
    cboData.ListIndex = 3
    
    cboSEnd.AddItem 1
    cboSEnd.AddItem 1.5
    cboSEnd.AddItem 2
    cboSEnd.ListIndex = 0
    
    cboAEnd.AddItem 1
    cboAEnd.AddItem 1.5
    cboAEnd.AddItem 2
    cboAEnd.ListIndex = 0
    
    cboEnd.AddItem 1
    cboEnd.AddItem 1.5
    cboEnd.AddItem 2
    cboEnd.ListIndex = 0
    
    cboSOdd.AddItem "None"
    cboSOdd.AddItem "Odd"
    cboSOdd.AddItem "Even"
    cboSOdd.AddItem "Mark"
    cboSOdd.AddItem "Space"
    cboSOdd.ListIndex = 0
    
    cboAOdd.AddItem "None"
    cboAOdd.AddItem "Odd"
    cboAOdd.AddItem "Even"
    cboAOdd.AddItem "Mark"
    cboAOdd.AddItem "Space"
    cboAOdd.ListIndex = 0
    
    cboOdd.AddItem "None"
    cboOdd.AddItem "Odd"
    cboOdd.AddItem "Even"
    cboOdd.AddItem "Mark"
    cboOdd.AddItem "Space"
    cboOdd.ListIndex = 0
End Sub