function.bas

自己编写的

Attribute VB_Name = "Function"
'卢旻　 2006/2/16

Global hCommTest As Long
Global Const delay As Integer = 20

Public Function mvComSendHexString(hcom As Long, ByVal hexString _
As String, Optional delay As Integer) As String
  '此函数往hcom发送十六进制的字符串，返回设备返回的数据
  '参数说明：
    'hcom:已经使用 mvComOpen 打开的端口句柄。
    'hexString:确认正确的十六进制字符串，此处不做十六进制字符串 _
    的合法性检验。
    'delay:等待设备返回数据的延迟时间。默认为20毫秒。

  '曾劲松 2005/9/8

  If hcom = 0 Then Exit Function

  '先去掉字符串中的空格
  If InStr(1, hexString, " ") >= 1 Then
    hexString = adjustHexString(hexString)
  End If
  
  Dim length As Long
  length = Len(hexString)
  
  If length = 0 Then Exit Function
  
  Dim i, b As Long
  'Dim b As Byte
  For i = 1 To length Step 2
    b = Val("&H" + Mid(hexString, i, 2))
    mvComSendByte hcom, b, 1  '逐一发送字节
    'Sleep 1  '对于因泰莱，此处不能延时
  Next i
    
  Dim result, s As String
  Sleep delay '延时等待返回数据
  While mvComInputBufferCount(hcom) > 0
       mvComReadByte hcom, b, 1
       s = Hex(b)
       If Len(s) = 1 Then
         s = "0" + s
       End If
       result = result + s + " "
  Wend
  mvComSendHexString = result
End Function

Public Function ToHexString(ByVal words As String, ByVal number _
As Long) As String

  If Len(words) > 0 Then
    number = Val(words)
    words = Hex(number)
  End If
  ToHexString = words

End Function

Public Function Reply(ByVal hCommTest As Long, ByVal s As String, _
ByVal b As String) As Integer

    s = Hex(b)
    If Len(s) = 1 Then
        s = "0" + s
    End If
    If s = "FF" Then
        Reply = 0
        Exit Function
    ElseIf s = "FE" Then
        Reply = 1
        Exit Function
    ElseIf s = "AA" Then
        Reply = 2
        Exit Function
    Else: Reply = 3
    Exit Function
    End If
    
'    If Reply = 0 Then
'        mvComSendHexString hCommTest, "FE"
'    ElseIf Reply = 1 Then
'        Label1.Caption = "通信测试成功！"
'    ElseIf Reply = 2 Then
'        Text1.Text = Text1.Text + vbCrLf + "消息发送于:Date&Time" + vbCrLf + words + vbCrLf
'        Label1.Caption = hexString
'        Text2.Text = ""
'    Else: Text1.Text = Text1.Text + vbCrLf + "消息接收于:Date&Time" + vbCrLf + words + vbCrLf
'        mvComSendHexString hCommTest, "AA"
'    End If

End Function

Public Function HexStringToTxt() As String

End Function