VB-创建类模块DLL文件

Posted 2021-01-23 ricoo

最近需要调用MSCOMM32.OCX控件，但是ABAP调用过程中发现无法同时发送多条记录，则需调整实现方式：

　　a.创建DLL文件封装MSCOMM控件相关属性及方法

　　b.系统注册DLL文件

　　c.ABAP调用DLL文件相关属性及方法

这一部分内容主要是将VB类模块的创建过程记录下：

1.打开VB，创建ActiveX DLL文件

　

2.修改工程名为MSCommPrj

　

3.修改类模块名称为msCommCls

　

4.引用MSCOMM32.OCX组件

　菜单：工程->引用->浏览

　

　查找MSCOMM32.OCX文件（C:WindowsSystem32 或者 C:WindowsSysWOW64）

　

　

　控件引用完成

5.类模块创建Function

‘********************************
‘串口通信集成
‘1.初始参数
‘2.打开串口
‘3.关闭串口
‘4.发送数据
‘5.接收数据
‘*********************************

‘类定义
Dim msComm As New MSCommLib.msComm
‘声明
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

‘初始参数
Public Function frm_initial_parameters(ByVal commport As Integer, ByVal setting As String, ByVal inputmode As Integer) As String
On Error GoTo Err
    ‘串口
    msComm.commport = commport
    
    ‘参数：波特率 校验 数据位 停止位
    msComm.Settings = setting
    
    ‘设置接收数据类型：二进制comInputModeBinary-0 字符串comInputModeText-1
    msComm.inputmode = inputmode

    ‘一次从接收缓冲区读取所有数据（8字节一组）
    msComm.InputLen = 0
    
    ‘接收缓冲区大小
    msComm.InBufferSize = 1024
    
    ‘发送缓冲区大小
    msComm.OutBufferSize = 1024
    
    ‘一次发送所有数据,发送数据时不产生onComm()事件
    msComm.SThreshold = 0
    
    ‘接收1个字节长度触发OnComm()事件
    msComm.RThreshold = 1
    
    ‘清空接收缓冲区
    msComm.InBufferCount = 0
    
    ‘清空发送缓冲区
    msComm.OutBufferCount = 0
    
    ‘返回执行成功标识
    frm_initial_parameters = "[email protected]串口初始化成功"
    
Err:
    If Err.Number > 0 Then
        ‘返回错误消息
        frm_initial_parameters = "[email protected]" + "错误编号:" & Err.Number & " 错误描述:" & Err.Description
        Exit Function
        Resume Next
    End If
End Function

‘打开串口
Public Function frm_open_serialport() As String
On Error GoTo Err
    ‘串口打开
    msComm.PortOpen = True
    
    ‘返回执行成功标识
    frm_open_serialport = "[email protected]串口打开成功"
Err:
    If Err.Number > 0 Then
        frm_open_serialport = "[email protected]" + "错误编号:" & Err.Number & " 错误描述:" & Err.Description
        Exit Function
        Resume Next
    End If
End Function

‘关闭串口
Public Function frm_close_serialport() As String
On Error GoTo Err
    ‘清空接收缓冲区
    msComm.InBufferCount = 0
    
    ‘清空发送缓冲区
    msComm.OutBufferCount = 0
    
    ‘串口关闭
    msComm.PortOpen = False
    
    ‘返回执行成功标识
    frm_close_serialport = "[email protected]串口关闭成功"
Err:
    If Err.Number > 0 Then
        frm_close_serialport = "[email protected]" + "错误编号:" & Err.Number & " 错误描述:" & Err.Description
        Exit Function
        Resume Next
    End If
End Function

‘发送数据
Public Function frm_send_data(ByVal inputmode As Integer, ByVal inputtime As Integer, ByVal inputdata As String) As String
Dim rst As String
On Error GoTo Err
    ‘发送数据检查
    If inputdata = "" Then
        Err.Number = 10
        Err.Description = "发送数据为空"
        GoTo Err
    End If
    
    ‘数据类型 0-16进制 1-字符串
    If inputmode = 0 Then
        Dim ztm   As Integer
        Dim spt() As String
        Dim slz() As String
        Dim byt() As Byte
        
        ‘根据符号 & 拆解字符串
        spt = Split(inputdata, "&")
        
        ‘发送数据条目数
        ztm = UBound(spt)
        
        ‘循环条目分批发送数据
        For i = 0 To ztm
            ‘字符串前后空格
            spt(i) = LTrim(spt(i))
            spt(i) = RTrim(spt(i))
            
            ‘16进制按照空格拆解为Byte[]数组
            slz = Split(spt(i), " ")
            
            ‘重定义数组大小Byte[]
            ReDim byt(UBound(slz))
            
            For j = 0 To UBound(slz)
                byt(j) = Val("&H" & slz(j))
            Next j
            
            ‘发送数据
            msComm.Output = byt
            
            Sleep (inputtime)

            Erase byt
            Erase slz
        Next i
        
    ElseIf iniputmode = 1 Then
        msComm.Output = inputdata
        Sleep (inputtime)
    End If
    
    ‘返回执行成功标识
    frm_send_data = "[email protected]数据发送成功"
Err:
    If Err.Number > 0 Then
        frm_send_data = "[email protected]" + "错误编号:" & Err.Number & " 错误描述:" & Err.Description
        Exit Function
        Resume Next
    End If
End Function

‘接收数据
Public Function frm_receive_data(ByVal inputmode As Integer) As String
On Error GoTo Err
    Dim strRest As String
    Dim strBuff As String
    Dim strdata As String
    Dim str()   As Byte

    If (inputmode = 0) Then
        ‘16进制数据接收
        Select Case msComm.CommEvent
            Case comEvReceive
                ‘接收16进制数据
                strBuff = msComm.Input
                str() = strBuff
            
                For k = 0 To UBound(str)
                    If Len(Hex(str(k))) = 1 Then
                        strdata = strdata & "0" & Hex(str(k))
                    Else
                        strdata = strdata & Hex(str(k))
                    End If
                Next
        End Select
        
        If rst = "" Then
            strRest = strdata
        Else
            strRest = strRest & " " & strdata
        End If
    ElseIf (inputmode = 1) Then
        ‘文本数据接收
        strRest = msComm.Input
    End If
    
    If (strRest = "") Then
        Err.Number = 11
        Err.Description = "接收数据为空值"
        GoTo Err
    End If
    
    ‘返回执行成功标识
    frm_receive_data = "[email protected]" & strRest
Err:
    If Err.Number > 0 Then
        frm_receive_data = "[email protected]" + "错误编号:" & Err.Number & " 错误描述:" & Err.Description
        Exit Function
        Resume Next
    End If
End Function

View Code

6.工程保存并编译成DLL文件

　文件保存 　　菜单：文件->保存工程

　文件编译 　　菜单：文件->生成MSCommPrj.dll

7.DLL类测试

　注册DLL文件：运行CMD->Regsvr32 DLL文件路径

　打开VB，创建标准EXE

　

　窗体元素布局

　

　调用DLL类方法

Dim mscls As New MSCommProject.MSCommCls
Dim rst As String

Private Sub close_Click()
    ‘关闭串口
    rst = mscls.frm_close_serialport
    RText.Text = rst + vbCrLf + RText.Text
End Sub

Private Sub Form_Load()
    ‘初始参数
    rst = mscls.frm_initial_parameters(commport.Text, setting.Text, inputmode.Text)
    RText.Text = rst + vbCrLf + RText.Text
    
End Sub

Private Sub open_Click()
    ‘打开串口
    rst = mscls.frm_open_serialport
    RText.Text = rst + vbCrLf + RText.Text
End Sub

Private Sub send_Click()
    ‘发送数据
    rst = mscls.frm_send_data(inputmode.Text, SText.Text)
    RText.Text = rst + vbCrLf + RText.Text
End Sub