dccom.bas

一份串口通信的好资料,对初学串口者很有用滴

Attribute VB_Name = "DCCOM"
Option Explicit
  Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  Private Const HKEY_LOCAL_MACHINE = &H80000002
  Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
  Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As String, lpcbData As Long) As Long
    
  Public Function testcom()
          Const ERROR_NO_MORE_ITEMS = 259&
          Const BUFFER_SIZE     As Long = 255
          Dim hKey     As Long, Cnt       As Long, sName       As String, sData       As String, Ret       As Long, RetData       As Long
          Ret = BUFFER_SIZE
          Cnt = 0
          If RegOpenKey(HKEY_LOCAL_MACHINE, "HardWare\DeviceMap\SerialComm", hKey) = 0 Then
                  sName = Space(BUFFER_SIZE)
                  sData = Space(BUFFER_SIZE)
                  Ret = BUFFER_SIZE
                  RetData = BUFFER_SIZE
                  While RegEnumValue(hKey, Cnt, sName, Ret, 0, ByVal 0&, ByVal sData, RetData) <> ERROR_NO_MORE_ITEMS
                          If RetData > 0 Then
                                  CHO.list.AddItem Left$(sData, RetData - 1)
                          End If
                          Cnt = Cnt + 1
                          sName = Space(BUFFER_SIZE)
                          sData = Space(BUFFER_SIZE)
                          Ret = BUFFER_SIZE
                          RetData = BUFFER_SIZE
                  Wend
                  RegCloseKey hKey
          Else
                  MsgBox "     错误"
          End If
  End Function

Public Function Setcom()

    With Fmain.MSComm
        .CommPort = CInt(Right(TCOM.COMPORT, 1))
        .InputMode = TCOM.COMMODE
        .InBufferSize = TCOM.COMIBUFFER
        .OutBufferSize = TCOM.COMOBUFFER
        .RThreshold = TCOM.COMR
        .SThreshold = TCOM.COMS
        .Settings = TCOM.COMSITTINGS
        .PortOpen = True
        .OutBufferCount = 0
        .InBufferCount = 0
    End With
    
End Function

Public Function Closecom()

            Fmain.MSComm.PortOpen = False
            is_cominuse = False
            Fmain.StatusBar.Panels(1).Text = TCOM.COMPORT & "断开连接"
            Fmain.Caption = "网络通讯实验程序(BY:c0der)"
            
End Function


Public Function ChangeViewMode(VIEWMODE As Integer)

    Select Case VIEWMODE
        Case 0
        
            Fmain.NOTE.Height = 5055
            Fmain.Tsend.Visible = True
            
        
        Case 1
        
            Fmain.NOTE.Height = 5295
            Fmain.Tsend.Visible = False
    End Select
    
End Function


Public Sub Delay(PauseTime As Single)
    
    Dim Start
    Start = Timer
    '设定开始时间
    Do While Timer < Start + PauseTime
        DoEvents
    Loop
End Sub