最近需要调用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
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
'******************************** '串口通信集成 '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
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