Page 2 of 2 FirstFirst 12
Results 41 to 62 of 62

Thread: C++ DLL to VB6

  1. #41
    Lively Member
    Join Date
    Feb 2006
    Posts
    73

    Re: C++ DLL to VB6

    Quote Originally Posted by _Wim_ View Post
    ... but open for any remarks of course!
    look here:
    http://bbs.vbstreets.ru/viewtopic.php?f=1&t=50509

  2. #42
    Member
    Join Date
    Oct 2009
    Location
    Nijmegen, Netherlands
    Posts
    59

    Re: C++ DLL to VB6

    @cliv Indeed the same Chinese relay card..!
    Issue with your code is that it doesn't work in VB6 IDE. So debugging is only possible by making an .exe, since that executes fine.
    One interesting point is that any function without parameters, like the enumerate function, only returning a long as result, does work in VB6 IDE.
    So I'll stick with the solution that Olaf has provided, using a 'cdecl' wrapper.
    _Wim_
    Last edited by _Wim_; Jan 12th, 2021 at 01:11 PM.

  3. #43
    New Member
    Join Date
    Jan 2021
    Posts
    4

    Re: C++ DLL to VB6

    Using the code from your posts, I was able to create a working program for my USB Relay. I'm attaching it for anyone who would like to see.

    Thanks for the help!

    P.S. This is my first post here, so I might be doing it wrong.

    Code includes:
    UsbRelay.VBP
    UsbRelay.vbw
    Form1.frm (Has 2 buttons, RelayOnBtn RelayOffBtn)
    UsbRelay.bas
    CdeclCall.bas
    usb_relay_device.dll (Looks like I can not attach this file)


    UsbRelay.VBP
    Code:
    Type=Exe
    Form=Form1.frm
    Module=CdeclCall; CdeclCall.bas
    Module=UsbRelay; UsbRelay.bas
    IconForm="Form1"
    Startup="Form1"
    HelpFile=""
    Title="UsbRelay"
    ExeName32="UsbRelay.exe"
    Command32=""
    Name="UsbRelayVB6"
    HelpContextID="0"
    CompatibleMode="0"
    MajorVer=1
    MinorVer=0
    RevisionVer=0
    AutoIncrementVer=0
    ServerSupportFiles=0
    CompilationType=0
    OptimizationType=0
    FavorPentiumPro(tm)=0
    CodeViewDebugInfo=0
    NoAliasing=0
    BoundsCheck=0
    OverflowCheck=0
    FlPointCheck=0
    FDIVCheck=0
    UnroundedFP=0
    StartMode=0
    Unattended=0
    Retained=0
    ThreadPerObject=0
    MaxNumberOfThreads=1
    DebugStartupOption=0

    UsbRelay.vbw
    Code:
    Form1 = 64, 46, 799, 913, , 32, 32, 433, 295, C
    CdeclCall = 558, 18, 1317, 1017, 
    UsbRelay = 878, 16, 1616, 1048,

    Form1.frm
    Code:
    VERSION 5.00
    Begin VB.Form Form1 
       Caption         =   "USB Relay Board"
       ClientHeight    =   1536
       ClientLeft      =   60
       ClientTop       =   420
       ClientWidth     =   4068
       LinkTopic       =   "Form1"
       ScaleHeight     =   1536
       ScaleWidth      =   4068
       StartUpPosition =   3  'Windows Default
       Begin VB.CommandButton RelayOffBtn 
          Caption         =   "Relay 1 OFF"
          Height          =   495
          Left            =   2100
          TabIndex        =   1
          Top             =   240
          Width           =   1575
       End
       Begin VB.CommandButton RelayOnBtn 
          Caption         =   "Relay 1 ON"
          Height          =   495
          Left            =   240
          TabIndex        =   0
          Top             =   240
          Width           =   1575
       End
    End
    Attribute VB_Name = "Form1"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    
    Option Explicit
    
       Dim RlyHnd&
       Dim RlySN$ ' 5 chars
       Dim DeviceInfo As USB_Relay_Device_Info
       
       
    '========================================================
    Private Sub Form_Load()
    
       Dim stat&
       Dim bstr(4) As Byte ' for 5 charater RlySN$
       
       ' Initialize the DLL
       stat& = RelayInit
       
       ' Get all devices pluged into pc ??? (may need work)
       ' Get Device Serial_Number  (5 characters)
       DeviceInfo = EnumerateDevice()
       If DeviceInfo.Serial_Number <> 0 Then
          Call CopyMemory(bstr(0), ByVal DeviceInfo.Serial_Number, 5)
          RlySN$ = StrConv(bstr, vbUnicode)
       End If
      
       ' Get Device Handle
       RlyHnd& = OpenDeviceWithSerial(RlySN$)
       
       stat& = RelayOpen(VarPtr(DeviceInfo))
    
    End Sub
    
    '========================================================
    Private Sub Form_Unload(cancel As Integer)
       Dim stat&
       
       Call CloseDevice(RlyHnd&)
       stat& = RelayExit
       stat& = FreeEnumerate(VarPtr(DeviceInfo))
       ''Set DeviceInfo = Nothing   ' Release the object.
    
    End Sub
    
    '========================================================
    Private Sub RelayOnBtn_Click()
       Dim stat&
    
       'stat& = OpenAllChannels(RlyHnd&)
       stat& = OpenOneChannel(RlyHnd&, 1)  ' #1 On
    
    End Sub
    
    '========================================================
    Private Sub RelayOffBtn_Click()
       Dim stat&
    
        'stat& = CloseAllChannels(RlyHnd&)
        stat& = CloseOneChannel(RlyHnd&, 1) ' #1 Off
        
    End Sub
    
    '    Call GetStatus(hnd, Status)
    '    MsgBox Status

    UsbRelay.bas
    Code:
    Attribute VB_Name = "UsbRelay"
    Option Explicit
    
       Public Declare Sub CopyMemory _
          Lib "kernel32" Alias "RtlMoveMemory" ( _
          ByRef Destination As Any, _
          ByRef Source As Any, _
          ByVal length&)
       
       Public Enum USB_Relay_Device_Type
          USB_RELAY_DEVICE_ONE_CHANNEL = 1
          USB_RELAY_DEVICE_TWO_CHANNEL = 2
          USB_RELAY_DEVICE_FOUR_CHANNEL = 4
          USB_RELAY_DEVICE_EIGHT_CHANNEL = 8
       End Enum
       
       Public Type USB_Relay_Device_Info
          Serial_Number As Long ' Pointer to 5 digits serial number
          Device_Path   As Long ' I assume this is not implemented..!?
          Type          As USB_Relay_Device_Type
          Next          As Long ' type is USB_Relay_Device_Info - RECURSIVE!
       End Type
       
       '========================================================
       Public Static Function OpenDeviceWithSerial&(serialNumber$)
          ' returns handle to device!
          ' usage: hnd=OpenDeviceWithSerial("ABCDE")
          OpenDeviceWithSerial = cdeclCallA("usb_relay_device.dll", _
                                 "usb_relay_device_open_with_serial_number", _
                                 vbLong, serialNumber, Len(serialNumber$))
       End Function
       
       '========================================================
       Public Sub CloseDevice(ByVal handle&)
          ' Close entire relay board
          If handle& <> 0 Then
             Call cdeclCallA("usb_relay_device.dll", _
                             "usb_relay_device_close", vbEmpty, handle&)
          End If
       End Sub
       
       '========================================================
       Public Static Function EnumerateDevice() As USB_Relay_Device_Info
          ' TODO add another wrapper on top of EnumerateDevice to collect all
          '      devices in an array, and serial nr translated into string(s)
          ' Get device info, return as "USB_Relay_Device_Info"
          Dim lPtr&
          Dim uRetVal As USB_Relay_Device_Info
          
          lPtr& = cdeclCallA("usb_relay_device.dll", _
                 "usb_relay_device_enumerate", _
                 vbLong)
          If lPtr& <> 0 Then
             Call CopyMemory(uRetVal, ByVal lPtr&, LenB(uRetVal))
             EnumerateDevice = uRetVal
          End If
       End Function
       
       '========================================================
       Public Static Function GetStatus&(ByVal handle&, ByRef status&)
          ' Get open/close status of the relay switches.
          ' Although long is returned, only LSB byte is used
          ' '3' = two switches are open
          If handle& <> 0 Then
             Call cdeclCallA("usb_relay_device.dll", _
                             "usb_relay_device_get_status", _
                             vbLong, handle&, VarPtr(status&))
          End If
       End Function
       
       '========================================================
       Public Static Function RelayInit&()
          ' Supposed to start the application with RelayInit,
          ' but appears not really necessary...!?
          RelayInit& = cdeclCallA("usb_relay_device.dll", "usb_relay_init", vbEmpty)
       End Function
       
       '========================================================
       Public Static Function RelayExit&()
          ' Call on Form_Unload
          Call cdeclCallA("usb_relay_device.dll", "usb_relay_exit", vbEmpty)
       End Function
       
       '========================================================
       Public Static Function RelayOpen&(devInfo&)
          ' Open device using Device_Info obtained via EnumerateDevice
          If devInfo& <> 0 Then
             RelayOpen = cdeclCallA("usb_relay_device.dll", _
             "usb_relay_device_open", vbLong, devInfo&)
          End If
       End Function
       
       '========================================================
       Public Static Function OpenAllChannels(ByVal handle&)
          ' Activates all relay switches..
          ' CLOSE all the relay contacts
          If handle& <> 0 Then
             OpenAllChannels = cdeclCallA("usb_relay_device.dll", _
                               "usb_relay_device_open_all_relay_channel", _
                               vbLong, handle&)
          End If
       End Function
       
       '========================================================
       Public Static Function OpenOneChannel(ByVal handle&, ByVal indx&)
          ' Activates one relay contact, index = 1, 2, etc
          If handle& <> 0 Then
             OpenOneChannel = cdeclCallA("usb_relay_device.dll", _
                              "usb_relay_device_open_one_relay_channel", _
                              vbLong, handle&, indx&)
          End If
       End Function
       
       '========================================================
       Public Static Function CloseOneChannel(ByVal handle&, ByVal indx&)
          ' Deactivate one relay contact, index = 1, 2, etc
          If handle& <> 0 Then
             CloseOneChannel = cdeclCallA("usb_relay_device.dll", _
                               "usb_relay_device_close_one_relay_channel", _
                               vbLong, handle&, indx&)
          End If
       End Function
       
       '========================================================
       Public Static Function CloseAllChannels(ByVal handle&)
          ' Deactivates all relay switches.
          ' OPEN all the relay contacts
          If handle& <> 0 Then
             CloseAllChannels = cdeclCallA("usb_relay_device.dll", _
                                "usb_relay_device_close_all_relay_channel", _
                                vbLong, handle&)
          End If
       End Function
       
       '========================================================
       Public Static Function FreeEnumerate&(ByVal devInfo&)
          If devInfo& <> 0 Then
             FreeEnumerate = cdeclCallA("usb_relay_device.dll", _
                             "usb_relay_device_free_enumerate", _
                             vbLong, devInfo&)
          End If
       End Function

    CdeclCall.bas
    Code:
    Attribute VB_Name = "CdeclCall"
    
    Option Explicit
    
       ' Some DLL's are compiled for C using "cdecl".  These DLL's must be
       ' re-compiled using the "StdCall" convention to be used with VB6.
       ' You can call cdecl-defined functions without re-compiling the DLL
       ' when you use this DispCallFunc-API
       '
       '  Using the drop-in-module below, your code could then look like:
       '
       '  Function OpenDeviceWithSerial(SerialNumber$)&
       '     OpenDeviceWithSerial = CdeclCallA(YourDllFilePath, _
       '                            "usb_relay_device_open_with_serial_number", _
       '                            vbLong, SerialNumber, Len(SerialNumber))
       '  End Function
    
       Private Declare Function DispCallFunc& _
          Lib "oleaut32" ( _
          ByVal pvInstance&, _
          ByVal offsetinVft&, _
          ByVal CallConv&, _
          ByVal retTYP As Integer, _
          ByVal paCNT&, _
          ByRef paTypes As Integer, _
          ByRef paValues&, _
          ByRef retVAR As Variant)
       
       Private Declare Function GetProcAddress& _
          Lib "kernel32" ( _
          ByVal hModule&, _
          ByVal lpProcName$)
       
       Private Declare Function LoadLibrary& _
          Lib "kernel32" Alias "LoadLibraryA" ( _
          ByVal lpLibFileName$)
       
       Private Declare Function FreeLibrary& _
          Lib "kernel32" ( _
          ByVal hLibModule&)
       
       Private Declare Function lstrlenA& _
          Lib "kernel32" ( _
          ByVal lpString&)
       
       Private Declare Function lstrlenW& _
          Lib "kernel32" ( _
          ByVal lpString&)
       
       Private Declare Sub RtlMoveMemory _
          Lib "kernel32" ( _
          ByRef dst As Any, _
          ByRef src As Any, _
          ByVal bLen&)
       
       Private Enum CallingConventionEnum
          CC_FASTCALL
          CC_CDECL
          CC_PASCAL
          CC_MACPASCAL
          CC_STDCALL
          CC_FPFASTCALL
          CC_SYSCALL
          CC_MPWCDECL
          CC_MPWPASCAL
       End Enum
       
       Private LibHdls As New Collection, _
          VType%(0 To 63), _
          VPtr&(0 To 63)
    
    '========================================================
    Public Static Function CdeclCallA(sDll$, sFunc$, _
                           ByVal retType As VbVarType, ParamArray p() As Variant)
       
       Dim i&, pFunc&, v(), hRes&
     
       ' Make a copy of the params, to prevent problems with
       '   VT_Byref-Members in the ParamArray
       v = p
      
       For i& = 0 To UBound(v)
          If VarType(p(i&)) = vbString Then
             p(i&) = StrConv(p(i&), vbFromUnicode)
             v(i&) = StrPtr(p(i))
          End If
          VType(i&) = VarType(v(i&))
          VPtr(i&) = VarPtr(v(i&))
       Next i&
      
       hRes& = DispCallFunc(0, GetFuncPtr(sDll$, sFunc$), CC_CDECL, retType, _
                          i&, VType(0), VPtr(0), CdeclCallA)
      
       For i& = 0 To UBound(p) 'back-conversion of the ANSI-String-Results
          If VarType(p(i&)) = vbString Then p(i&) = StrConv(p(i&), vbUnicode)
       Next i&
      
       If hRes& Then Err.Raise hRes&
      
    End Function
    
    '========================================================
    Public Static Function StdCallA(sDll$, sFunc$, ByVal retType As VbVarType, _
                             ParamArray p() As Variant)
       
       Dim i&, pFunc&, v(), hRes&
     
       ' Make a copy of the params, to prevent problems with
       '   VT_Byref-Members in the ParamArray
       v = p
       
       For i& = 0 To UBound(v)
          If VarType(p(i&)) = vbString Then
             p(i&) = StrConv(p(i&), vbFromUnicode)
             v(i&) = StrPtr(p(i&))
          End If
          VType(i&) = VarType(v(i&))
          VPtr(i&) = VarPtr(v(i&))
       Next i&
      
       hRes& = DispCallFunc(0, GetFuncPtr(sDll$, sFunc$), CC_STDCALL, retType, _
                          i&, VType(0), VPtr(0), StdCallA)
      
       For i& = 0 To UBound(p) 'back-conversion of the ANSI-String-Results
          If VarType(p(i&)) = vbString Then p(i&) = StrConv(p(i&), vbUnicode)
       Next i&
      
      If hRes& Then Err.Raise hRes&
      
    End Function
          
    '========================================================
    Public Static Function StdCallW(sDll$, sFunc$, ByVal retType As VbVarType, _
                             ParamArray p() As Variant)
       
       Dim i&, v(), hRes&
     
       ' Make a copy of the params, to prevent problems with
       '   VT_Byref-Members in the ParamArray
       v = p
       
       For i& = 0 To UBound(v)
          If VarType(p(i&)) = vbString Then v(i&) = StrPtr(p(i&))
          VType(i&) = VarType(v(i&))
          VPtr(i&) = VarPtr(v(i&))
       Next i&
      
       hRes& = DispCallFunc(0, GetFuncPtr(sDll$, sFunc$), CC_STDCALL, _
                           retType, i&, VType(0), VPtr(0), StdCallW)
       If hRes& Then Err.Raise hRes&
       
    End Function
    
    '========================================================
    Public Static Function CdeclCallW(sDll$, sFunc$, ByVal retType As VbVarType, _
                               ParamArray p() As Variant)
       Dim i&, v(), hRes&
     
       ' Make a copy of the params, to prevent problems with
       '   VT_Byref-Members in the ParamArray
       v = p
       
       For i& = 0 To UBound(v)
          If VarType(p(i&)) = vbString Then v(i&) = StrPtr(p(i&))
          VType(i&) = VarType(v(i&))
          VPtr(i&) = VarPtr(v(i&))
       Next i&
      
       hRes& = DispCallFunc(0, GetFuncPtr(sDll$, sFunc$), CC_CDECL, retType, _
                           i&, VType(0), VPtr(0), CdeclCallW)
       If hRes& Then Err.Raise hRes&
       
    End Function
    
    '========================================================
    Public Static Function VtblCall(pUnk&, ByVal vtblIdx&, _
                                    ParamArray p() As Variant)
       
       Dim i&, v(), hRes&
       
       If pUnk = 0 Then Exit Function
       
       ' Make a copy of the params, to prevent problems with
       '   VT_Byref-Members in the ParamArray
       v = p
       
       For i& = 0 To UBound(v)
          VType(i&) = VarType(v(i&))
          VPtr(i&) = VarPtr(v(i&))
       Next i&
      
       hRes& = DispCallFunc(pUnk&, vtblIdx& * 4, CC_STDCALL, vbLong, _
                            i&, VType(0), VPtr(0), VtblCall)
       If hRes& Then Err.Raise hRes&
       
    End Function
    
    '========================================================
    Public Static Function GetFuncPtr&(sDll$, sFunc$)
       
       Dim hLib&, sLib$
       
       If sLib$ <> sDll$ Then ' Caching, to make resolving libHdls faster
          sLib$ = sDll$
          
          On Error Resume Next
          hLib& = 0
          hLib& = LibHdls(sLib$)
          On Error GoTo 0
        
          If hLib& = 0 Then
             hLib& = LoadLibrary(sLib$)
             If hLib& = 0 Then
                Err.Raise vbObjectError, , "Dll not found (or loadable): " & sLib$
             End If
             LibHdls.Add hLib&, sLib$ '<- cache under the dll-name for the next call
          End If
       End If
       
       GetFuncPtr& = GetProcAddress(hLib&, sFunc$)
       If GetFuncPtr& = 0 Then
          Err.Raise 453, , "EntryPoint not found: " & sFunc$ & " in: " & sLib
       End If
       
    End Function
    
    '========================================================
    Public Static Function GetBStrFromPtr$(lpSrc&, _
                                           Optional ByVal ANSI As Boolean)
       Dim sLen&
       
       If lpSrc& = 0 Then Exit Function
       If ANSI Then
          sLen& = lstrlenA(lpSrc&)
       Else
          sLen = lstrlenW(lpSrc&)
       End If
       
       If sLen Then
          GetBStrFromPtr = Space$(sLen&)
       Else
          Exit Function
       End If
          
       Select Case ANSI
          Case True: RtlMoveMemory ByVal GetBStrFromPtr, ByVal lpSrc&, sLen&
          Case Else: RtlMoveMemory ByVal StrPtr(GetBStrFromPtr), _
                                   ByVal lpSrc&, sLen& * 2
       End Select
       
    End Function
    
    '========================================================
    Public Static Sub CleanupLibHandles()
       ' Not really needed - but callable (usually at process-shutdown) to
       '   clear things up
       Dim libHdl
       
       For Each libHdl In LibHdls
          FreeLibrary libHdl
       Next
       Set LibHdls = Nothing
       
    End Sub

  4. #44
    Member
    Join Date
    Oct 2009
    Location
    Nijmegen, Netherlands
    Posts
    59

    Re: C++ DLL to VB6

    Glad to see that the efforts of the experts here, and my humble efforts helped you (and me) to use these Chinese relays..!
    Note only the .bas and .frm are needed.
    Given time, I want to enhance the enumerate function, since the .dll supports multiple relay cards. Also I would like to return the actual serial number as (array of) strings, instead of a pointer. But bottomline it works!
    And thanks to Olaf Schmidt...
    _Wim_
    Last edited by _Wim_; Jan 20th, 2021 at 01:17 PM.

  5. #45
    New Member
    Join Date
    Jan 2021
    Posts
    4

    Re: C++ DLL to VB6

    Here is another way to get the String from a cdecl string pointer.

    Code:
    Private Declare Function SysAllocStringByteLen$ _
          Lib "oleaut32.dll" ( _
          Optional ByVal pszStrPtr&, _
          Optional ByVal strLength&)
      
    '========================================================
    Private Sub Form_Load()
    
       Dim stat&
       
       ' Initialize the DLL
       stat& = RelayInit
       
       ' Enumerate all devices
       DeviceInfo = EnumerateDevice()
    
       ' Get Device Serial_Number  (5 characters)
       If DeviceInfo.Serial_Number <> 0 Then
         ' Got pointer to string, now get string
          RlySN$ = SysAllocStringByteLen$(DeviceInfo.Serial_Number, 5)
          Label1 = "Serial Number  " & RlySN$
       End If
      
       ' Get Device Handle
       RlyHnd& = OpenDeviceWithSerial(RlySN$)
       
       stat& = RelayOpen(VarPtr(DeviceInfo))
    
    End Sub

  6. #46
    PowerPoster
    Join Date
    Jun 2013
    Posts
    5,244

    Re: C++ DLL to VB6

    Quote Originally Posted by GaryBullard View Post
    Here is another way to get the String from a cdecl string pointer...
    Not sure whether you noticed... but I've already included a nice helper-function in the cdecl-call-module:

    GetBStrFromPtr(lpSrc&, Optional ByVal ANSI As Boolean) As String

    In the concrete case of this relais-device-dll, you'll probably need to specify the Optional param as True..

    HTH

    Olaf

  7. #47
    New Member
    Join Date
    Jan 2021
    Posts
    4

    Re: C++ DLL to VB6

    Yea,
    I'm using your GetBStrFromPtr because it can handle both single and dual byte characters. (ANSI and Unicode)
    Thanks again!

  8. #48
    Fanatic Member
    Join Date
    Jan 2020
    Posts
    639

    Re: C++ DLL to VB6

    vb6 call by cdecl dll api:

    how to Fast Call cdecl api like sqlite3.dll? - Page 2-VBForums
    https://www.vbforums.com/showthread....ighlight=CDECL

    Code:
    Option Explicit
    
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
    
    Public Function CallCdecl(ByVal Pfn As Long, Optional ByVal Spacer As Long) As Long
        pvPatchTrampoline AddressOf Module1.CallCdecl, 0
        CallCdecl = CallCdecl(Pfn)
    End Function
    
    Public Function CallCdecl1(ByVal Pfn As Long, ByVal Arg1 As Long, Optional ByVal Spacer As Long) As Long
        pvPatchTrampoline AddressOf Module1.CallCdecl1, 1
        CallCdecl1 = CallCdecl1(Pfn, Arg1)
    End Function
    
    Public Function CallCdecl2(ByVal Pfn As Long, ByVal Arg1 As Long, ByVal Arg2 As Long, Optional ByVal Spacer As Long) As Long
        pvPatchTrampoline AddressOf Module1.CallCdecl2, 2
        CallCdecl2 = CallCdecl2(Pfn, Arg1, Arg2)
    End Function
    
    Public Function CallCdecl3(ByVal Pfn As Long, ByVal Arg1 As Long, ByVal Arg2 As Long, ByVal Arg3 As Long, Optional ByVal Spacer As Long) As Long
        pvPatchTrampoline AddressOf Module1.CallCdecl3, 3
        CallCdecl3 = CallCdecl3(Pfn, Arg1, Arg2, Arg3)
    End Function
    
    Public Function CallCdecl4(ByVal Pfn As Long, ByVal Arg1 As Long, ByVal Arg2 As Long, ByVal Arg3 As Long, ByVal Arg4 As Long, Optional ByVal Spacer As Long) As Long
        pvPatchTrampoline AddressOf Module1.CallCdecl4, 4
        CallCdecl4 = CallCdecl4(Pfn, Arg1, Arg2, Arg3, Arg4)
    End Function
    
    Private Function pvPatchTrampoline(ByVal Pfn As Long, ByVal lNumParams As Long) As Boolean
        Const PAGE_EXECUTE_READWRITE As Long = &H40
        Const THUNK_SIZE    As Long = 21
        Dim bInIDE          As Boolean
        Dim aThunk(0 To 5)  As Long
     
        Debug.Assert pvSetTrue(bInIDE)
        If bInIDE Then
            Call CopyMemory(Pfn, ByVal Pfn + &H16, 4)
        Else
            Call VirtualProtect(Pfn, THUNK_SIZE, PAGE_EXECUTE_READWRITE, 0)
        End If
        '  0: 58                   pop         eax
        '  1: 89 84 24 XX XX XX XX mov         dword ptr [esp+Xh],eax
        '  8: 58                   pop         eax
        '  9: FF D0                call        eax
        ' 11: 90                   nop
        ' 12: 90                   nop
        ' 13: 90                   nop
        ' 14: 81 C4 XX XX XX XX    add         esp,Xh
        ' 20: C3                   ret
        aThunk(0) = &H24848958
        aThunk(1) = lNumParams * 4 + 4
        aThunk(2) = &H90D0FF58
        aThunk(3) = &HC4819090
        aThunk(4) = lNumParams * 4
        aThunk(5) = &HC3
        Call CopyMemory(ByVal Pfn, aThunk(0), THUNK_SIZE)
        '--- success
        pvPatchTrampoline = True
    End Function
    
    Private Function pvSetTrue(bValue As Boolean) As Boolean
        bValue = True
        pvSetTrue = True
    End Function
    call method
    Code:
    pvPatchTrampoline AddressOf Module1.CallCdecl2,0
    
    msgbox CallCdecl2(cdecl_sum,a,b)
    but i think it's best like ,do anyone can do it?
    how to fix like vPatchTrampoline module1.sum,cdecl_sum_address

    Code:
    pvPatchTrampoline module1.sum,cdecl_sum_address
    function sum(a as long ,b as long )
    '***
    end function
    Last edited by xiaoyao; Jan 23rd, 2021 at 04:25 AM.

  9. #49
    Fanatic Member
    Join Date
    Jan 2020
    Posts
    639

    Re: C++ DLL to VB6

    Quote Originally Posted by GaryBullard View Post
    Here is another way to get the String from a cdecl string pointer.

    Code:
    Private Declare Function SysAllocStringByteLen$ _
          Lib "oleaut32.dll" ( _
          Optional ByVal pszStrPtr&, _
          Optional ByVal strLength&)
      
    '========================================================
    Private Sub Form_Load()
    
       Dim stat&
       
       ' Initialize the DLL
       stat& = RelayInit
       
       ' Enumerate all devices
       DeviceInfo = EnumerateDevice()
    
       ' Get Device Serial_Number  (5 characters)
       If DeviceInfo.Serial_Number <> 0 Then
         ' Got pointer to string, now get string
          RlySN$ = SysAllocStringByteLen$(DeviceInfo.Serial_Number, 5)
          Label1 = "Serial Number  " & RlySN$
       End If
      
       ' Get Device Handle
       RlyHnd& = OpenDeviceWithSerial(RlySN$)
       
       stat& = RelayOpen(VarPtr(DeviceInfo))
    
    End Sub


    RlySN$ = SysAllocStringByteLen$(DeviceInfo.Serial_Number, 5)
    maybe it need to clear memory about string pointer?

  10. #50
    Fanatic Member
    Join Date
    Jan 2020
    Posts
    639

    Re: C++ DLL to VB6

    what about this?
    GetMem4 ByVal GetAddr(AddresOf NeedFunc) + &H16, NeedAddr

  11. #51
    Fanatic Member
    Join Date
    Jan 2020
    Posts
    639

    Re: C++ DLL to VB6

    what's this?

    [VBCompiler]
    LinkSwitches= "C:\Program Files\Microsoft Visual Studio\VB98\Projects\TestVB6StaticLink\Release\TestVB6StaticLink.lib" /EXPORT:_StrLen@4
    Конференция VBStreets Просмотр темы Direct3D9 в VB6.
    http://bbs.vbstreets.ru/viewtopic.ph...49733#p6780386
    TestVB6StaticLink.zip
    (44.92 Кб)
    http://bbs.vbstreets.ru/download/file.php?id=10644

    call Declare sub like call function address, it's jmp?
    http://bbs.vbstreets.ru/viewtopic.php?f=28&t=42929
    func_pointers_1.0.4.zip
    http://bbs.vbstreets.ru/download/file.php?id=9542


    Конференция VBStreets Просмотр темы cdecl
    http://bbs.vbstreets.ru/viewtopic.ph...CDECL#p6758145
    Code:
    Function PatchVBA4cdecl(Optional Enable As Boolean = True) As Boolean
    ' для вызовов dll с соглашением cdecl
    '!Support only vba332.dll v.3.0.7019!
    Const PAGE_EXECUTE_READWRITE = &H40
    Const pCRC = &HD8, CRC = &H1928EA, pPatch1 = &H155E26, pPatch2 = &H155E6B
    Const Original = "3B FC 0F 85 BB 6D 00 00", Patch = "8B E7 90 90 90 90 90 
    
    90"
    Dim p&, i&, S$, er&
    p = GetModuleHandle("vba332")
    CopyMemory ByVal VarPtr(i), ByVal (p + pCRC), 4
    If i <> CRC Then PatchVBA4cdecl = True: Exit Function
    If Enable Then S = Hex2Bin(Patch) Else S = Hex2Bin(Original)
    er = VirtualProtect(ByVal p + pPatch1, 77, PAGE_EXECUTE_READWRITE, i)
    CopyMemory ByVal p + pPatch1, ByVal S, 8
    CopyMemory ByVal p + pPatch2, ByVal S, 8
    er = VirtualProtect(ByVal p + pPatch1, 77, ByVal i, i)
    End Function

    VBStreets会议查看主题-cdecl
    http://bbs.vbstreets.ru/viewtopic.ph...45&hilit=CDECL
    Last edited by xiaoyao; Jan 23rd, 2021 at 05:01 AM.

  12. #52
    New Member
    Join Date
    Jan 2021
    Posts
    4

    Re: C++ DLL to VB6

    Quote Originally Posted by xiaoyao View Post
    RlySN$ = SysAllocStringByteLen$(DeviceInfo.Serial_Number, 5)
    maybe it need to clear memory about string pointer?
    Yes; I would need to use SysFreeString to deallocate the string.

  13. #53
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Posts
    2,700

    Re: C++ DLL to VB6

    Quote Originally Posted by xiaoyao View Post
    what's this?
    This patch is not working (now and 15 years ago). You'd better get the whole thread google translated if you think my russian is that rusty :-))

    cheers,
    </wqw>

  14. #54
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Posts
    2,700

    Re: C++ DLL to VB6

    Quote Originally Posted by GaryBullard View Post
    Yes; I would need to use SysFreeString to deallocate the string.
    Yes, you have to deallocate it but your SysAllocStringByteLen API declare does not allow this. It has to be tweaked to return a raw Long pointer so it can be invoked like this

    Dim sText As String
    lPtr = SysAllocStringByteLen(...)
    Call CopyMemory(ByVal VarPtr(sText), lPtr, 4)

    . . . and let VB call SysFreeString when local sText variable gets deallocated.

    Having an API declare to return a String means that its C/C++ prototype is something like char *MyFunction(...), not BSTR MyFunction(...).

    So the compiler emits code that expects a pointer to a null-terminated ANSI string to be returned and this automagically gets converted to a BSTR (String). So in the case of SysAllocStringByteLen the returned BSTR indeeds packs ANSI string which correctly gets converted to Unicode but it ultimately leaks.

    Tweaking the API's return type to be Long switches off the ANSI->Unicode magic so the sText value in above snippet will look weird before being manually "unpacked" to Unicode with StrConv(sText, vbUnicode) or similar.

    cheers,
    </wqw>

  15. #55

  16. #56
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Posts
    2,700

    Re: C++ DLL to VB6

    Quote Originally Posted by The trick View Post
    I seems found out why VB6 crashes when we use cdecl declared APIs in a tlb. There is a bug (seems) in handling conventions and there is no cdecl call p-code. More precisely, the p-code exists but there is no handler (it returns internal error). Just i made a small tests and replace the missing p-code handler and... it works )))
    I'm making the Add-in which fixes the bug in runtime.
    So this will allow using typelib declared cdecl imports in both compiled executable and IDE project?

    That would be the best solution if the compiler can save us the trouble of providing manual trampolines *and* the code works in IDE without modification.

    What about compile to p-code (not native)? Is this already working with typelib declared cdecls?

    cheers,
    </wqw>

  17. #57
    Hyperactive Member
    Join Date
    Aug 2017
    Posts
    374

    Re: C++ DLL to VB6

    Quote Originally Posted by GaryBullard View Post
    ... I'm using your GetBStrFromPtr because it can handle both single and dual byte characters. (ANSI and Unicode)
    You might be interested in these ANSI/Unicode one-liners as well.

    Quote Originally Posted by GaryBullard View Post
    Yes; I would need to use SysFreeString to deallocate the string.
    Typically, you don't need to use that API; simply letting the string go out of scope or setting it to vbNullString is enough to free the string.

    Quote Originally Posted by wqweto View Post
    Yes, you have to deallocate it but your SysAllocStringByteLen API declare does not allow this.
    Actually, it has been confirmed in the discussion here that that declaration doesn't cause any leaks.

  18. #58
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,731

    Re: C++ DLL to VB6

    Quote Originally Posted by wqweto View Post
    So this will allow using typelib declared cdecl imports in both compiled executable and IDE project?

    That would be the best solution if the compiler can save us the trouble of providing manual trampolines *and* the code works in IDE without modification.
    Yes it will work both native (already works) and IDE. Just i'm creating the table where recognize the new undocumented p-codes. I also make new __cdecl handlers for the new p-codes because current stubs just generates 0x33 error.

    What about compile to p-code (not native)? Is this already working with typelib declared cdecls?
    It doesn't work because the bug in VB6 exe. To remove the bug you need only fix one byte and then it will compile successfully (without crashes) but the compiled executable will give 0x33 error because there is NO __cdecl p-code handles. My Add-in removes the bug in VB6.exe and places the new P-code handlers instead empty stubs. So if you want to use __cdecl in a p-code executable you only need to add those handlers (you can just insert Add-in's initialization code).

    I'll plan to add the __cdecl support to Declare statement but i don't know exactly if it's possible because i inject to the codegeneration process which isn't documented.

  19. #59
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Posts
    2,700

    Re: C++ DLL to VB6

    Quote Originally Posted by Victor Bravo VI View Post
    Actually, it has been confirmed in the discussion here that that declaration doesn't cause any leaks.
    Actually, yes. The analysis is correct!

    The assembly emitted does call ANSI-to-Unicode *and* uses __vbaFreeStrList run-time function to cleanup the As String result from the API call which is mind-boggling.

    Same happens for SysAllocString declare but it works correctly only if the ANSI string is double-zero terminated.

    So it seems that for API declares with As String result the returned pointer is always ANSI-to-Unicode converted (which is expected) and SysStringFree'd just in case (which is weird).

    Probably the reasoning is that if it's not a BSTR this does not hurt apparently and oleaut32 implementation bails out without corrupting internal strings allocator.

    cheers,
    </wqw>

  20. #60

  21. #61

  22. #62

Page 2 of 2 FirstFirst 12

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width