封装com组件dll

概述

vb6 封装的 dll 不是标准 dll 而是 com 组件类型的

实现方法

反例

通过下面方法制作封装的 ActivX dll 在应用到其他项目（同时更换开发电脑）时在调用函数 Connect 时会提示类型不匹配，大概是该函数接受了 Object 后面又通过 set 强制隐式转换类型导致的错误。

Public WithEvents Winsock1 As Winsock
Public Event onDataArrival(ByVal resHexString As String)

Public Function Connect(ByRef oWinsock As Object, ByVal vIP As String, ByVal vPort As String) As Boolean
    IP = vIP
    Port = vPort
    
    Set Winsock1 = oWinsock
    Winsock1.RemoteHost = IP
    Winsock1.RemotePort = Port
    Winsock1.Connect
    
    Do
        DoEvents
    Loop Until Winsock1.State = sckConnected Or Winsock1.State = sckError
     
    Connect = True
    If Winsock1.State = sckError Then
        Winsock1.Close
        Connect = False
    End If
End Function

正例

为避免上面的问题可以在封装 Active dll 的项目中添加 Form 窗体，在其中拖拽控件 Winsock 然后在类中通过实例化该窗体再使用该控件
这样使用方可以不用拖拽 Winsock 组件，而是调用封装好的 dll，注意要在 Class_Terminate 中卸载窗体实例。

Public WithEvents Winsock1 As Winsock
Public Event onDataArrival(ByVal resHexString As String)
Private frm1 As New Form1

Public Function Connect(ByVal vIP As String, ByVal vPort As String) As Boolean
    IP = vIP
    Port = vPort
    Set Winsock1 = frm1.Winsock1
    Winsock1.RemoteHost = IP
    Winsock1.RemotePort = Port
    Winsock1.Connect
    
    Do
        DoEvents
    Loop Until Winsock1.State = sckConnected Or Winsock1.State = sckError
     
    Connect = True
    If Winsock1.State = sckError Then
        Winsock1.Close
        Connect = False
    End If
End Function

Private Sub Class_Terminate()
    Set frm1 = Nothing
End Sub

Public Sub SendInstruct(ByVal strInstruct As String)
    Dim byteInstruct() As Byte
    Dim i As Integer
    Dim instruct As String

    'instruct = "01030000001445C5"
    instruct = strInstruct
    byteInstruct = String2ByteArray(instruct)
    Winsock1.SendData byteInstruct
End Sub

Public Sub CloseSock()
    Winsock1.Close
End Sub

'将使用字符串表示的数值转换为字节数组
Private Function String2ByteArray(ByVal vData As String) As Byte()
    Dim byteInstruction() As Byte
    Dim i As Long
    If Len(vData) Mod 2 = 0 And Len(vData) <> 0 Then '检验16进制字符串长
        ReDim byteInstruction(Len(vData) / 2 - 1)
        For i = 0 To Len(vData) - 1 Step 2
           byteInstruction(i / 2) = Val("&H" & Mid(vData, i + 1, 2))
        Next
    End If
    
    String2ByteArray = byteInstruction
End Function

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Dim i As Integer
    Dim j As Integer
    Dim RecNum As Integer
    Dim TempString As String
    
    Dim Received_Byte() As Byte
    Dim Received_String
    Dim receivedByteLength As Integer
    Dim hexData As String

    Winsock1.GetData Received_String

    receivedByteLength = LenB(Received_String)
    hexData = ""
    ReDim Received_Bytes(0 To receivedByteLength) As Byte
    
    For i = 0 To (receivedByteLength - 1)
        Received_Bytes(i) = Received_String(i)
                        
        If Received_Bytes(i) < 16 Then
            TempString = "0" + Hex(Received_Bytes(i))
        End If
 
        If Received_Bytes(i) > 15 Then
            TempString = Hex(Received_Bytes(i))
        End If
        hexData = hexData + TempString
    Next i
    
    RaiseEvent onDataArrival(hexData)
End Sub