modpubfun.bas

此程序为标准的ＴＣＰＩＰ网络编程

Attribute VB_Name = "ModPubFun"
Public leadOn As Boolean '指示灯是否亮
Public recvLen As Long '收到的字符长度
Public sendLen As Long '发送的字符长度
Public udpEnabled As Boolean '是否允许进行UDP通信
Public codeM As Integer '编码方式
Public Const codeGB = 0 'GB编码方式，默认方式
Public Const codeUnicode = 1 'Unicode编码方式，是一种双字节编码方式


Public Function ByteLen(Str As String) As Integer
Dim strByte() As Byte
Dim strLen, i, bLen As Integer
bLen = 0
strByte = Str
strLen = LenB(Str)

Select Case codeM
    Case codeGB
        For i = 0 To strLen - 1
            If Not strByte(i) = 0 Or (i Mod 2) = 0 Then
                bLen = bLen + 1
            End If
        Next i
    Case codeUnicode
        bLen = strLen
End Select

ByteLen = bLen

End Function


'10进制转化为16进制
Public Function DeciToHex(ByVal deciNum As Integer) As String
    Dim hex(1) As Integer
    Dim hexBase(1) As Integer
    Dim i As Single
    Dim tempHex(3) As Byte
    
    For i = 0 To 3
        tempHex(i) = 0
    Next i

    hex(0) = Int(deciNum / 16)
    hex(1) = deciNum Mod 16
    For i = 0 To 1
        If hex(i) < 10 Then
            hexBase(i) = 48
        Else
            hexBase(i) = 55
        End If
    Next i
    tempHex(0) = hex(0) + hexBase(0)
    tempHex(2) = hex(1) + hexBase(1)
    DeciToHex = tempHex
End Function

'16进制转化为10进制
Public Function HexToDeci(hexNum As String) As Integer
    Dim tempBase1 As Integer
    Dim tempBase2 As Integer
    Dim tempAsc1 As Integer
    Dim tempAsc2 As Integer
    hexNum = UCase(hexNum)
    If (Len(hexNum) > 2 Or Len(hexNum) < 0) Then
        HexToDeci = 9999
    End If
    tempAsc1 = Asc(Mid(hexNum, 1, 1))
    tempAsc2 = Asc(Mid(hexNum, 2, 1))
    If tempAsc1 >= 48 And tempAsc1 <= 57 Then
        tempBase1 = 48
    ElseIf tempAsc1 >= 65 And tempAsc1 <= 70 Then
        tempBase1 = 55
    End If
    If tempAsc2 >= 48 And tempAsc2 <= 57 Then
        tempBase2 = 48
    ElseIf tempAsc2 >= 65 And tempAsc2 <= 70 Then
        tempBase2 = 55
    End If
    HexToDeci = (tempAsc1 - tempBase1) * 16 + (tempAsc2 - tempBase2)
End Function

'16进制String转化为Byte流
Public Function StrToBytes(hexStr As String, byteLength As Integer) As Byte()
    On Error Resume Next
    Dim i, j, k As Integer
    Dim byteData
    Dim hexData As String
    Dim hexLen As Integer
    Dim bytes() As Byte
    Dim bytesReturn() As Byte
    j = 0
    k = 0
    hexStr = UCase(hexStr)
    hexLen = Len(hexStr)
    ReDim bytes(hexLen) As Byte
    If hexLen < 2 Then
        MsgBox "输入的十六进制字符串太短，请正确输入！"
        Exit Function
    End If
    For i = 0 To hexLen - 1
        byteData = Asc(Mid(hexStr, i + 1, 1))
        If (byteData >= Asc("0") And byteData <= Asc("9")) Or (byteData >= Asc("A") And byteData <= Asc("F")) Then
            j = j + 1
        Else
            If j = 1 Or Not byteData = Asc(" ") Then
                MsgBox "输入的十六进制字符串有错误，请仔细检查！"
                Exit Function
            End If
        End If
        If j = 2 Then
            hexData = Mid(hexStr, i, 2)
            bytes(k) = HexToDeci(hexData)
            k = k + 1
            j = 0
        End If
    Next i
    ReDim bytesReturn(k - 1)
    For i = 0 To k - 1
        bytesReturn(i) = bytes(i)
    Next i
    byteLength = i
    StrToBytes = bytesReturn
End Function