-
Jan 12th, 2021, 01:09 AM
#41
Lively Member
Re: C++ DLL to VB6
Originally Posted by _Wim_
... but open for any remarks of course!
look here:
http://bbs.vbstreets.ru/viewtopic.php?f=1&t=50509
-
Jan 12th, 2021, 01:08 PM
#42
Lively Member
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.
-
Jan 17th, 2021, 11:57 AM
#43
New Member
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
-
Jan 20th, 2021, 01:14 PM
#44
Lively Member
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.
-
Jan 21st, 2021, 11:34 AM
#45
New Member
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
-
Jan 22nd, 2021, 06:22 AM
#46
Re: C++ DLL to VB6
Originally Posted by GaryBullard
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
-
Jan 22nd, 2021, 10:36 AM
#47
New Member
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!
-
Jan 23rd, 2021, 04:17 AM
#48
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.
-
Jan 23rd, 2021, 04:18 AM
#49
Re: C++ DLL to VB6
Originally Posted by GaryBullard
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?
-
Jan 23rd, 2021, 04:30 AM
#50
Re: C++ DLL to VB6
what about this?
GetMem4 ByVal GetAddr(AddresOf NeedFunc) + &H16, NeedAddr
-
Jan 23rd, 2021, 04:37 AM
#51
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.
-
Jan 23rd, 2021, 12:01 PM
#52
New Member
Re: C++ DLL to VB6
Originally Posted by xiaoyao
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.
-
Jan 23rd, 2021, 12:24 PM
#53
Re: C++ DLL to VB6
Originally Posted by xiaoyao
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>
-
Jan 23rd, 2021, 12:41 PM
#54
Re: C++ DLL to VB6
Originally Posted by GaryBullard
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>
-
Jan 23rd, 2021, 09:03 PM
#55
Re: C++ DLL to VB6
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.
-
Jan 24th, 2021, 04:48 AM
#56
Re: C++ DLL to VB6
Originally Posted by The trick
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>
-
Jan 24th, 2021, 05:03 AM
#57
Re: C++ DLL to VB6
Originally Posted by GaryBullard
... 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.
Originally Posted by GaryBullard
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.
Originally Posted by wqweto
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.
-
Jan 24th, 2021, 05:41 AM
#58
Re: C++ DLL to VB6
Originally Posted by wqweto
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.
-
Jan 24th, 2021, 05:57 AM
#59
Re: C++ DLL to VB6
Originally Posted by Victor Bravo VI
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>
Last edited by wqweto; Jan 24th, 2021 at 06:09 AM.
-
Feb 1st, 2021, 07:02 PM
#60
-
Feb 2nd, 2021, 02:03 AM
#61
Re: C++ DLL to VB6
Originally Posted by The trick
Direct ZIP download from github garbles line endings, it looks like * text eol=crlf missing in .gitattributes but this still works:
cheers,
</wqw>
-
Feb 2nd, 2021, 08:15 AM
#62
Re: C++ DLL to VB6
Originally Posted by wqweto
Direct ZIP download from github garbles line endings, it looks like * text eol=crlf missing in .gitattributes but this still works:
cheers,
</wqw>
Thank you! I always forget to update .gitignore/.gitattributes files. I've fixed it now.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|