VB-創建類模塊DLL文件

最近需要調用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

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