码迷,mamicode.com
首页 > 其他好文 > 详细

VB-创建类模块DLL文件

时间:2018-11-29 19:54:06      阅读:261      评论:0      收藏:0      [点我收藏+]

标签:调用   kernel   else   检查   bin   crlf   sele   seconds   消息   

最近需要调用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:\Windows\System32 或者 C:\Windows\SysWOW64)

 技术分享图片

 技术分享图片

 控件引用完成

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 = "S@串口初始化成功"
    
Err:
    If Err.Number > 0 Then
        返回错误消息
        frm_initial_parameters = "E@" + "错误编号:" & 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 = "S@串口打开成功"
Err:
    If Err.Number > 0 Then
        frm_open_serialport = "E@" + "错误编号:" & 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 = "S@串口关闭成功"
Err:
    If Err.Number > 0 Then
        frm_close_serialport = "E@" + "错误编号:" & 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 = "S@数据发送成功"
Err:
    If Err.Number > 0 Then
        frm_send_data = "E@" + "错误编号:" & 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 = "S@" & strRest
Err:
    If Err.Number > 0 Then
        frm_receive_data = "E@" + "错误编号:" & 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

 

 

 

VB-创建类模块DLL文件

标签:调用   kernel   else   检查   bin   crlf   sele   seconds   消息   

原文地址:https://www.cnblogs.com/ricoo/p/10039981.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!