Sub Main()
'IDE_UseCallWindowProcA=false,need run by Ctrl+F5
'IDE中运行,值为False,需要全编绎一次才能正常运行.把cdecl api函数绑定到VB6的函数,并写入汇编代码,修改代码后就又不能运行了,否则可能崩溃
IDE_UseCallWindowProcA = True 'IDE中直接用 CallWindowProcA方式调用CDECL
Debug.Assert pvSetTrue(bInIDE)
BindCdeclToVbFunction
DoTest
RestoreFunctionMemoryList
FreeLibrary DllModule
End Sub
Sub DoTest()
Dim pDB As Long
Dim pStmt As Long
Dim lResult As Long
Dim sBstrRes As String
Dim pzTail As Long
'lResult = VB_sqlite3_open(":memory:", pDB)
lResult = VB_sqlite3_open(StrToBytePtr(":memory:"), VarPtr(pDB))
MsgBox "pDB=" & pDB
If lResult <> SQLITE_OK Or pDB = 0 Then
MsgBox "Cannot open database", vbCritical
GoTo CleanUp
End If
lResult = VB_sqlite3_prepare_v2(pDB, StrToBytePtr("SELECT SQLITE_VERSION()"), ByVal -1&, VarPtr(pStmt), VarPtr(pzTail), 0&)
If lResult <> SQLITE_OK Then
MsgBox "Cannot open database-2", vbCritical
GoTo CleanUp
End If
lResult = VB_sqlite3_step(pStmt)
If lResult = SQLITE_ROW Then
PutMem4 ByVal VarPtr(sBstrRes), SysAllocString(ByVal VB_sqlite3_column_text16(pStmt, 0))
Debug.Print sBstrRes
MsgBox "SQLITE Version版本是:" & sBstrRes
End If
CleanUp:
If pStmt Then VB_sqlite3_finalize pStmt
If pDB Then VB_sqlite3_close pDB
MsgBox "ok"
End Sub
Sub BindCdeclToVbFunction()
'要用到的CDECL API在这里包装成VB的函数过程就可以直接调用了
'fix all cdecl api
DllModule = LoadLibrary(App.Path & "\sqlite3.dll")
CdeclApi(0) = GetProcAddress(DllModule, "sqlite3_open")
FixCdecl GetAddress(GetAddress(AddressOf VB_sqlite3_open)), CdeclApi(0), 2
'Exit Sub
CdeclApi(1) = GetProcAddress(DllModule, "sqlite3_prepare_v2")
FixCdecl GetAddress(GetAddress(AddressOf VB_sqlite3_prepare_v2)), CdeclApi(1), 5
CdeclApi(2) = GetProcAddress(DllModule, "sqlite3_step")
FixCdecl GetAddress(AddressOf VB_sqlite3_step), CdeclApi(2), 1
CdeclApi(3) = GetProcAddress(DllModule, "sqlite3_finalize")
FixCdecl GetAddress(AddressOf VB_sqlite3_finalize), CdeclApi(3), 1
CdeclApi(4) = GetProcAddress(DllModule, "sqlite3_close")
FixCdecl GetAddress(AddressOf VB_sqlite3_close), CdeclApi(4), 1
CdeclApi(5) = GetProcAddress(DllModule, "sqlite3_column_text16")
FixCdecl GetAddress(AddressOf VB_sqlite3_column_text16), CdeclApi(5), 2
End Sub
'ALL CDECL API LIST:
Function VB_sqlite3_open(ByVal filename As Long, ByVal ppDB As Long, Optional ByVal NoUsed As Long) As Long
VB_sqlite3_open = CallCdecl(CdeclApi(0), filename, ppDB) 'ONLY RUN IN VB6 IDE
End Function
Function VB_sqlite3_prepare_v2(ByVal db As Long, _
ByVal zSql As Long, _
ByVal nByte As Long, _
ByVal ppStmt As Long, _
ByVal pzTail As Long, Optional ByVal NoUsed As Long) As Long
VB_sqlite3_prepare_v2 = CallCdecl(CdeclApi(1), db, zSql, nByte, ppStmt, pzTail)
End Function
Function VB_sqlite3_step(ByVal pStmt As Long, Optional ByVal NoUsed As Long) As Long
VB_sqlite3_step = CallCdecl(CdeclApi(2), pStmt)
End Function
Function VB_sqlite3_finalize(ByVal pStmt As Long, Optional ByVal NoUsed As Long) As Long
VB_sqlite3_finalize = CallCdecl(CdeclApi(3), pStmt)
End Function
Function VB_sqlite3_close(ByVal ppDB As Long, Optional ByVal NoUsed As Long) As Long
VB_sqlite3_close = CallCdecl(CdeclApi(4), ppDB)
End Function
Function VB_sqlite3_column_text16(ByVal pStmt As Long, ByVal iCol As Long, Optional ByVal NoUsed As Long) As Long
VB_sqlite3_column_text16 = CallCdecl(CdeclApi(5), pStmt, iCol)
End Function
DOWNLOAD Stdcall_FixCdecl.zip Stdcall_FixCdecl.zip
--------------
FixCdecl AddressOf VB_Add, CdeclApi, 2
c = VB_Add(a, b)
Code:
if cdecl sub test()
in vb6:
sub vb_test(optional NOUSE AS LONG )
msgbox 1
end sub
FORM1 CODE:
Code:
Dim h As Long
Dim CdeclApi_Add As Long
Private Sub Command1_Click()
If CdeclApi_Add = 0 Then
h = LoadLibrary("cdecl.dll")
CdeclApi_Add = GetProcAddress(h, "Add")
FixCdecl GetAddress(AddressOf VB_Add), CdeclApi_Add, 2
End If
Dim a As Long, b As Long, c As Long
a = 44
b = 55
c = VB_Add(a, b)
MsgBox "c=" & c
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
RestoreFunctionMemory
FreeLibrary h
End Sub
Module1.bas
Code:
Option Explicit
Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Declare Function WriteProcessMemory2 Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualProtect2 Lib "kernel32" Alias "VirtualProtect" (ByRef lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long '设置内存可读写
Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Dim OldFunctionAsm(18) As Byte, FunctionPtr As Long, THUNK_SIZE As Long
'演示用,最简化代码
Function VB_Add(ByVal a As Long, ByVal b As Long, Optional NoUsed As Long) As Long
MsgBox 1
MsgBox 1
MsgBox 1
End Function
Sub FixCdecl(VbFunction As Long, CdeclApi As Long, Args As Long) 'GOOD
'MsgBox "call-FixCdecl"
Dim Asm(4) As String, Stub() As Byte ', THUNK_SIZE As Long
' 0: 58 pop eax
' 1: 89 84 24 XX XX XX XX mov dword ptr [esp+Xh],eax
Asm(0) = "58 89 84 24 " & LongToHex(Args * 4) '&H24848958
Asm(1) = "B8 " & LongToHex(CdeclApi) 'B8 90807000 MOV EAX,708090
Asm(2) = "FF D0" 'FFD0 CALL EAX
Asm(3) = "83 C4 " & Hex(Args * 4) '83 C4 XX add esp, XX 'cleanup args
Asm(4) = "C3"
Stub() = toBytes(Join(Asm, " "))
THUNK_SIZE = UBound(Stub) + 1
Dim bInIDE As Boolean
Debug.Assert pvSetTrue(bInIDE)
If bInIDE Then
CopyMemory2 VbFunction, ByVal VbFunction + &H16, 4
Else
VirtualProtect2 VbFunction, THUNK_SIZE, PAGE_EXECUTE_READWRITE, 0 '更改函数地址所在页面属性
End If
FunctionPtr = VbFunction
CopyMemory2 ByVal VarPtr(OldFunctionAsm(0)), ByVal VbFunction, THUNK_SIZE '保存函数旧数据
WriteProcessMemory2 -1, VbFunction, VarPtr(Stub(0)), THUNK_SIZE, 0
End Sub
Sub RestoreFunctionMemory() '恢复原来函数的部分汇编代码,必不可少,否则会崩
If THUNK_SIZE > 0 Then
WriteProcessMemory2 -1, FunctionPtr, VarPtr(OldFunctionAsm(0)), THUNK_SIZE, 0
End If
End Sub
Function toBytes(x As String) As Byte()
Dim tmp() As String
Dim fx() As Byte
Dim i As Long
tmp = Split(x, " ")
ReDim fx(UBound(tmp))
For i = 0 To UBound(tmp)
fx(i) = CInt("&h" & tmp(i))
Next
toBytes = fx()
End Function
Function LongToHex(x As Long) As String
Dim b(1 To 4) As Byte
CopyMemory2 b(1), x, 4
LongToHex = Hex(b(1)) & " " & Hex(b(2)) & " " & Hex(b(3)) & " " & Hex(b(4))
End Function
Function pvSetTrue(bValue As Boolean) As Boolean
bValue = True
pvSetTrue = True
End Function
Function GetAddress(ByVal V As Long) As Long
GetAddress = V
End Function
Last edited by xiaoyao; Mar 9th, 2021 at 06:29 AM.
cdecl anycall(apiptr,array1(0) as long,args count)
The CDECL call written in assembly code supports any number of parameters, supports return values, and is very fast
like
Code:
dim array1() as long ,Result as long
redim array1(1)
array1(0)=11
array1(1)=22
Result = dy(add_address,array1(0),2)
redim array1(2)
array1(0)=11
array1(1)=22
array1(2)=22
Result = dy(add2_address,array1(0),3)
if it's a sub,no args
call dy(sub1_ptr,0,0)
Code:
.386
.model flat, stdcall
option casemap :none
include windows.inc
include user32.inc
include kernel32.inc
includelib user32.lib
includelib kernel32.lib
.data
lpszByDll db "Welcome",0
.data?
hInstance dd ?
.CODE
LibMain proc hInstDLL:DWORD, reason:DWORD, unused:DWORD
.if reason == DLL_PROCESS_ATTACH ;动态库被加载时调用,返回0加载失败!
mov eax,hInstDLL
mov hInstance,eax
mov eax,TRUE
ret
.elseif reason == DLL_PROCESS_DETACH
.elseif reason == DLL_THREAD_ATTACH
.elseif reason == DLL_THREAD_DETACH
;添加处理代码
.endif
ret
LibMain Endp
;C声明:
;int __stdcall dy(void * bdhsdz, int cssz[], int csgs);
dy proc stdcall bdhsdz,cssz,csgs
;第一个参数:被调函数地址,第二个参数:参数数组,第三个参数:参数个数
push ebx
mov ebx,[cssz]
mov eax,[csgs]
dec eax
kaka:
cmp eax,0
jl bq
push dword ptr [ebx + eax * 4]
dec eax
jmp kaka
bq:
call dword ptr [bdhsdz]
mov ebx,eax
mov eax,4
imul dword ptr [csgs]
add esp,eax
mov eax,ebx
pop ebx
ret
dy endp
End LibMain
Last edited by xiaoyao; Mar 7th, 2021 at 09:45 AM.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by xiaoyao
'bind cdecl api to vb6 function
it's support vb6 ide,exe,excel vba
--------------
FixCdecl AddressOf VB_Add, CdeclApi, 2
c = VB_Add(a, b)
FORM1 CODE:
Code:
Dim h As Long
Dim CdeclApi_Add As Long
Private Sub Command1_Click()
If CdeclApi_Add = 0 Then
h = LoadLibrary("cdecl.dll")
CdeclApi_Add = GetProcAddress(h, "Add")
FixCdecl GetAddress(AddressOf VB_Add), CdeclApi_Add, 2
End If
Dim a As Long, b As Long, c As Long
a = 44
b = 55
c = VB_Add(a, b)
MsgBox "c=" & c
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
RestoreFunctionMemory
FreeLibrary h
End Sub
Module1.bas
Code:
Option Explicit
Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Declare Function WriteProcessMemory2 Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualProtect2 Lib "kernel32" Alias "VirtualProtect" (ByRef lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long '设置内存可读写
Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Dim OldFunctionAsm(18) As Byte, FunctionPtr As Long, THUNK_SIZE As Long
'演示用,最简化代码
Function VB_Add(ByVal a As Long, ByVal b As Long, Optional NoUsed As Long) As Long
MsgBox 1
MsgBox 1
MsgBox 1
End Function
Sub FixCdecl(VbFunction As Long, CdeclApi As Long, Args As Long) 'GOOD
'MsgBox "call-FixCdecl"
Dim Asm(4) As String, Stub() As Byte ', THUNK_SIZE As Long
' 0: 58 pop eax
' 1: 89 84 24 XX XX XX XX mov dword ptr [esp+Xh],eax
Asm(0) = "58 89 84 24 " & LongToHex(Args * 4) '&H24848958
Asm(1) = "B8 " & LongToHex(CdeclApi) 'B8 90807000 MOV EAX,708090
Asm(2) = "FF D0" 'FFD0 CALL EAX
Asm(3) = "83 C4 " & Hex(Args * 4) '83 C4 XX add esp, XX 'cleanup args
Asm(4) = "C3"
Stub() = toBytes(Join(Asm, " "))
THUNK_SIZE = UBound(Stub) + 1
Dim bInIDE As Boolean
Debug.Assert pvSetTrue(bInIDE)
If bInIDE Then
CopyMemory2 VbFunction, ByVal VbFunction + &H16, 4
Else
VirtualProtect2 VbFunction, THUNK_SIZE, PAGE_EXECUTE_READWRITE, 0 '更改函数地址所在页面属性
End If
FunctionPtr = VbFunction
CopyMemory2 ByVal VarPtr(OldFunctionAsm(0)), ByVal VbFunction, THUNK_SIZE '保存函数旧数据
WriteProcessMemory2 -1, VbFunction, VarPtr(Stub(0)), THUNK_SIZE, 0
End Sub
Sub RestoreFunctionMemory() '恢复原来函数的部分汇编代码,必不可少,否则会崩
If THUNK_SIZE > 0 Then
WriteProcessMemory2 -1, FunctionPtr, VarPtr(OldFunctionAsm(0)), THUNK_SIZE, 0
End If
End Sub
Function toBytes(x As String) As Byte()
Dim tmp() As String
Dim fx() As Byte
Dim i As Long
tmp = Split(x, " ")
ReDim fx(UBound(tmp))
For i = 0 To UBound(tmp)
fx(i) = CInt("&h" & tmp(i))
Next
toBytes = fx()
End Function
Function LongToHex(x As Long) As String
Dim b(1 To 4) As Byte
CopyMemory2 b(1), x, 4
LongToHex = Hex(b(1)) & " " & Hex(b(2)) & " " & Hex(b(3)) & " " & Hex(b(4))
End Function
Function pvSetTrue(bValue As Boolean) As Boolean
bValue = True
pvSetTrue = True
End Function
Function GetAddress(ByVal V As Long) As Long
GetAddress = V
End Function
Your idea is very interesting and very simple, but my question is as in your example, are several parameters fixed(only need three)?
------------------------------------------------------------------------------------------------------
Function VB_Add(ByVal a As Long, ByVal b As Long, Optional NoUsed As Long) As Long
MsgBox 1
MsgBox 1
MsgBox 1
End Function
------------------------------------------------------------------------------------------------------
If there are multiple parameters, how to balance stacks?
Would you give a few practical and complete examples?
Thank you!
Joh
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
another question is :
how to get return value by your method?
Thanks a lot.
Joh.
Don't use this method. It overwrites behind the buffer of VB-thunks. VB6 linker merges the functions if they are the same. The code doesn't support multiple CDecl functions etc. It's better to use DispCallFunc instead.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by The trick
Don't use this method. It overwrites behind the buffer of VB-thunks. VB6 linker merges the functions if they are the same. The code doesn't support multiple CDecl functions etc. It's better to use DispCallFunc instead.
Thanks for your help.DispCallFunc method is a little more complicated in practice. I saw your post(https://www.vbforums.com/showthread....ons-in-VB6-IDE),it's a great job. But what I am curious about is whether it can control chrome through chromedriver.exe webdriver in vb6. If so, then VBCDeclFix will have a bright future.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
Thanks for your help.DispCallFunc method is a little more complicated in practice.
DispCallFunc is no more complex than the method described here.
Originally Posted by MacroJohn
I saw your post(https://www.vbforums.com/showthread....ons-in-VB6-IDE),it's a great job. But what I am curious about is whether it can control chrome through chromedriver.exe webdriver in vb6. If so, then VBCDeclFix will have a bright future.
This Add-in allows to work with any CDecl functions as well as with native-VB functions. No code injection/modification/etc., compiler does the native call itself.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
another question is :
how to get return value by your method?
Thanks a lot.
Joh.
Function VB_Add(ByVal a As Long, ByVal b As Long, Optional NoUsed As Long) As Long
only add 【, Optional NoUsed As Long】 in every VB api function /sub
In the process of my research, the most difficult thing is how to remove this "essential parameter", and before the end of the program, it is necessary to restore the original memory assembly data of the VB function, and restore the bytes we modified.
i test DispCallFunc is very slowly.
If you don’t care about slow speed, you can use the DispCallFunc method
use fixdecl function ,you can get the result value.
Dim OldFunctionAsm(18) As Byte, FunctionPtr As Long, THUNK_SIZE As Long
Dim OldFunctionAsm2(18) As Byte, FunctionPtr2 As Long
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
RestoreFunctionMemory
if sqlite3.dll have 85 cdecl api.
you can write 85 vb function like :
Code:
Public Declare Function WritePrivateProfileStringA Lib "kernel32"(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
IN MY CODE IS:
Function vb_WritePrivateProfileStringA (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String _
,optional NOUSE AS LONG ) As Long
MSGBOX 1
end function
if cdecl sub test()
in vb6:
sub vb_test(optional NOUSE AS LONG )
msgbox 1
end sub
Code:
Dim h As Long
Dim CdeclApi_Add As Long
Dim CdeclApi_Msg As Long
Private Sub Form_Load()
BindCdeclToVbFunction
End Sub
Sub BindCdeclToVbFunction()
If CdeclApi_Add = 0 Then
h = LoadLibrary("cdecl.dll")
CdeclApi_Add = GetProcAddress(h, "Add")
FixCdecl GetAddress(AddressOf VB_Add), CdeclApi_Add, 2
CdeclApi_Msg = GetProcAddress(h, "Msg")
FixCdecl GetAddress(AddressOf VB_Msg), CdeclApi_Msg, 1
End If
End Sub
Private Sub Command1_Click()
Dim a As Long, b As Long, c As Long
a = 44
b = 55
c = VB_Add(a, b)
MsgBox "c=" & c
Dim S As String, BT() As Byte
S = "中国人abc" & Chr(0)
BT = StrConv(S, vbFromUnicode)
VB_Msg VarPtr(BT(0))
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If CdeclApi_Add > 0 Then
RestoreFunctionMemoryList
FreeLibrary h
End If
End Sub
in bas file:
Code:
Function VB_Add(ByVal a As Long, ByVal b As Long, Optional NoUsed As Long) As Long
MsgBox 1
MsgBox 1
End Function
Sub VB_Msg(ByVal S As Long, Optional NoUsed As Long)
MsgBox 1
MsgBox 1
End Sub
Last edited by xiaoyao; Mar 7th, 2021 at 09:43 AM.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
Thanks for your help.DispCallFunc method is a little more complicated in practice. I saw your post(https://www.vbforums.com/showthread....ons-in-VB6-IDE),it's a great job. But what I am curious about is whether it can control chrome through chromedriver.exe webdriver in vb6. If so, then VBCDeclFix will have a bright future.
chromedriver.exe,VB6 HAVE THIS SAMPLE,IT COM OBJECT(ACTIVEX DLL)
Code:
Dim ChromeObj As ChromeDriver
Dim keys As New Selenium.keys '模拟键盘操作
Private Sub Command1_Click()
Call Vb_ActiveX_ChromeDriver
End Sub
Sub Vb_ActiveX_ChromeDriver() '工具引用Selenium 第一种通过ID
Set ChromeObj = New ChromeDriver
ChromeObj.SetBinary "c:\chrome87.0.4280.20\Chrome\chrome.exe"
ChromeObj.Start
ChromeObj.Get "https://www.baidu.com/"
ChromeObj.Wait 1000
ChromeObj.FindElementById("kw").SendKeys ("游戏") '方法2 分2部 先发送 再按百度按钮
ChromeObj.FindElementById("su").Click '点击按钮
DoEvents
MsgBox ChromeObj.FindElementById("kw").Value '输出结果 有的是text这个自己测试
'ChromeObj.Quit
End Sub
ALSO,YOU CAN USE HTTP tcp/ip TO CALL chrome.EXE
Code:
mPort = 9515
mBaseLocalURL = "http://localhost"
Public Sub Go(strURL As String, Optional ByVal SessionId As String = "")
'访问地址
Dim tmpTxt As String, LocalURL As String
Dim strPostForm As String
If Len(SessionId) = 0 Then SessionId = mNowSessionId
LocalURL = mBaseLocalURL & ":" & mPort & "/session/" & SessionId & "/url"
strPostForm = "{‘url‘:‘$url‘}"
strPostForm = Replace(strPostForm, "‘", Chr(34))
strPostForm = Replace(strPostForm, "$url", strURL)
Debug.Print strPostForm, LocalURL
Call XMLHttpPOST(LocalURL, strPostForm)
'Call mXml.HttpPost(LocalURL, strPostForm)
'Debug.Print mXml.ResponseBodyText
End Sub
Public Sub StartChrome()
'启动浏览器
Dim Webcode As String
Dim strPostForm As String
Dim LocalURL As String
LocalURL = mBaseLocalURL & ":" & mPort & "/session"
strPostForm = "{‘desiredCapabilities‘:{‘browserName‘:‘chrome‘,‘goog:chromeOptions‘:{‘extensions‘: [],‘args‘:[]}}}"
strPostForm = Replace(strPostForm, "‘", Chr(34))
Debug.Print strPostForm
Webcode = XMLHttpPOST(LocalURL, strPostForm)
Webcode = Replace(Webcode, Chr(34), "")
mNowSessionId = GetKeyWordMid(Webcode, "sessionId:", ",")
Call AppendSessionId(mNowSessionId)
Debug.Print mNowSessionId
End Sub
Last edited by xiaoyao; Mar 7th, 2021 at 08:59 AM.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by xiaoyao
Function VB_Add(ByVal a As Long, ByVal b As Long, Optional NoUsed As Long) As Long
only add 【, Optional NoUsed As Long】 in every VB api function /sub
In the process of my research, the most difficult thing is how to remove this "essential parameter", and before the end of the program, it is necessary to restore the original memory assembly data of the VB function, and restore the bytes we modified.
i test DispCallFunc is very slowly.
If you don’t care about slow speed, you can use the DispCallFunc method
use fixdecl function ,you can get the result value.
Dim OldFunctionAsm(18) As Byte, FunctionPtr As Long, THUNK_SIZE As Long
Dim OldFunctionAsm2(18) As Byte, FunctionPtr2 As Long
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
RestoreFunctionMemory
if sqlite3.dll have 85 cdecl api.
you can write 85 vb function like :
Code:
Public Declare Function WritePrivateProfileStringA Lib "kernel32"(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
IN MY CODE IS:
Function vb_WritePrivateProfileStringA (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String _
,optional NOUSE AS LONG ) As Long
MSGBOX 1
end function
if cdecl sub test()
in vb6:
sub vb_test(optional NOUSE AS LONG )
msgbox 1
end sub
Code:
Dim h As Long
Dim CdeclApi_Add As Long
Dim CdeclApi_Msg As Long
Private Sub Form_Load()
BindCdeclToVbFunction
End Sub
Sub BindCdeclToVbFunction()
If CdeclApi_Add = 0 Then
h = LoadLibrary("cdecl.dll")
CdeclApi_Add = GetProcAddress(h, "Add")
FixCdecl GetAddress(AddressOf VB_Add), CdeclApi_Add, 2
CdeclApi_Msg = GetProcAddress(h, "Msg")
FixCdecl GetAddress(AddressOf VB_Msg), CdeclApi_Msg, 1
End If
End Sub
Private Sub Command1_Click()
Dim a As Long, b As Long, c As Long
a = 44
b = 55
c = VB_Add(a, b)
MsgBox "c=" & c
Dim S As String, BT() As Byte
S = "中国人abc" & Chr(0)
BT = StrConv(S, vbFromUnicode)
VB_Msg VarPtr(BT(0))
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If CdeclApi_Add > 0 Then
RestoreFunctionMemoryList
FreeLibrary h
End If
End Sub
in bas file:
Code:
Function VB_Add(ByVal a As Long, ByVal b As Long, Optional NoUsed As Long) As Long
MsgBox 1
MsgBox 1
End Function
Sub VB_Msg(ByVal S As Long, Optional NoUsed As Long)
MsgBox 1
MsgBox 1
End Sub
Thank you for your help.
I tested your example, but it crashed directly in the IDE(win10,vb6). Although this method is portable, it may need to be refined to make it feasible.
Thanks a lot!
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by The trick
DispCallFunc is no more complex than the method described here.
This Add-in allows to work with any CDecl functions as well as with native-VB functions. No code injection/modification/etc., compiler does the native call itself.
thanks for your help!
Although this plug-in has some influence on the IDE, it is very easy to use.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by xiaoyao
chromedriver.exe,VB6 HAVE THIS SAMPLE,IT COM OBJECT(ACTIVEX DLL)
Code:
Dim ChromeObj As ChromeDriver
Dim keys As New Selenium.keys '模拟键盘操作
Private Sub Command1_Click()
Call Vb_ActiveX_ChromeDriver
End Sub
Sub Vb_ActiveX_ChromeDriver() '工具引用Selenium 第一种通过ID
Set ChromeObj = New ChromeDriver
ChromeObj.SetBinary "c:\chrome87.0.4280.20\Chrome\chrome.exe"
ChromeObj.Start
ChromeObj.Get "https://www.baidu.com/"
ChromeObj.Wait 1000
ChromeObj.FindElementById("kw").SendKeys ("游戏") '方法2 分2部 先发送 再按百度按钮
ChromeObj.FindElementById("su").Click '点击按钮
DoEvents
MsgBox ChromeObj.FindElementById("kw").Value '输出结果 有的是text这个自己测试
'ChromeObj.Quit
End Sub
ALSO,YOU CAN USE HTTP tcp/ip TO CALL chrome.EXE
Code:
mPort = 9515
mBaseLocalURL = "http://localhost"
Public Sub Go(strURL As String, Optional ByVal SessionId As String = "")
'访问地址
Dim tmpTxt As String, LocalURL As String
Dim strPostForm As String
If Len(SessionId) = 0 Then SessionId = mNowSessionId
LocalURL = mBaseLocalURL & ":" & mPort & "/session/" & SessionId & "/url"
strPostForm = "{‘url‘:‘$url‘}"
strPostForm = Replace(strPostForm, "‘", Chr(34))
strPostForm = Replace(strPostForm, "$url", strURL)
Debug.Print strPostForm, LocalURL
Call XMLHttpPOST(LocalURL, strPostForm)
'Call mXml.HttpPost(LocalURL, strPostForm)
'Debug.Print mXml.ResponseBodyText
End Sub
Public Sub StartChrome()
'启动浏览器
Dim Webcode As String
Dim strPostForm As String
Dim LocalURL As String
LocalURL = mBaseLocalURL & ":" & mPort & "/session"
strPostForm = "{‘desiredCapabilities‘:{‘browserName‘:‘chrome‘,‘goog:chromeOptions‘:{‘extensions‘: [],‘args‘:[]}}}"
strPostForm = Replace(strPostForm, "‘", Chr(34))
Debug.Print strPostForm
Webcode = XMLHttpPOST(LocalURL, strPostForm)
Webcode = Replace(Webcode, Chr(34), "")
mNowSessionId = GetKeyWordMid(Webcode, "sessionId:", ",")
Call AppendSessionId(mNowSessionId)
Debug.Print mNowSessionId
End Sub
Thanks for your great helps.
Seleniumbasic has not been updated, and the so-called seleniumbaisc3.14 on the Internet is not open source,potential safety hazards would be exist.
The CDeclFix method of The trick gave me an idea: without relying on seleniumbasic, if can I directly use C# or other versions of selenium in vb6 to drive chromedriver.exe? If it can be realized, then the CDeclFix method will be revolutionary in the contribution of vb6 function expansion.
Thanks again.
Last edited by Shaggy Hiker; Apr 19th, 2023 at 08:47 AM.
Reason: Removed personal attack.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
The CDeclFix method of You and The trick gave me an idea. . .
There is no contribution by xiaoyao to CDeclFix -- don't mix things up by giving wrong credit where it's not due, please!
He is our regular spammer here with most posts of his completely out of touch with the topic at hand.
Don't trust *anything* he says because he is using a very low quality auto-translate from chinese while probably even the original thoughts are not very coherent in first place.
@mods: Please clean up the spam by xiaoyao in this thread (and everywhere) as it causes confision so that the original author's work remains mis-credited along with the spammer's unasked junk posts.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by wqweto
There is no contribution by xiaoyao to CDeclFix -- don't mix things up by giving wrong credit where it's not due, please!
I have also discovered that his suggestions seem to have not been self-confirmed,some examples he uploaded are not practical.
Thank you for your kind reminder.
I got it.
Thanks.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
Thank you for your help.
I tested your example, but it crashed directly in the IDE(win10,vb6). Although this method is portable, it may need to be refined to make it feasible.
Thanks a lot!
I test more cdecl api is good for use.
maybe I test sqlite3.dll,cdecl api for opendb,insert,select.
if all test OK,it'S very nice.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
I have also discovered that his suggestions seem to have not been self-confirmed,some examples he uploaded are not practical.
Thank you for your kind reminder.
I got it.
Thanks.
if some cdecl api not support,you can upload ,I will test.
I test if change vb function in vb6 ide ,write asm code.
need restore function memory.
so it'S good,I used many times.
now it'S no problem.
I will test for v8js.dll,sqlite3.dll,theses all need call by cdecl
use v8js for replace vbscript.dll,run js in chrome v8 is very quickly like vc++.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
I have also discovered that his suggestions seem to have not been self-confirmed,some examples he uploaded are not practical.
Thank you for your kind reminder.
I got it.
Thanks.
His "solutions" for cdecl are mostly rehashing an ASM thunk I gave him in this post. There you'll find working trampolines for up to 4 arguments that can be easily extended to any number of arguments.
These trampolines or (even better) the VBCDeclFix add-in solve any cdecl needs -- no need to deal with more BS and non-working code on the topic.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by wqweto
His "solutions" for cdecl are mostly rehashing an ASM thunk I gave him in this post. There you'll find working trampolines for up to 4 arguments that can be easily extended to any number of arguments.
cheers,
</wqw>
do you khnow how to call cdecl without this argument"optional NOUSE AS LONG"
and why cash in vb6 IDE?
If you use a full build, it runs fine(ctrl+f5)
Code:
if cdecl sub test()
in vb6:
sub vb_test(optional NOUSE AS LONG )
msgbox 1
end sub
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by wqweto
His "solutions" for cdecl are mostly rehashing an ASM thunk I gave him in this post. There you'll find working trampolines for up to 4 arguments that can be easily extended to any number of arguments.
These trampolines or (even better) the VBCDeclFix add-in solve any cdecl needs -- no need to deal with more BS and non-working code on the topic.
cheers,
</wqw>
thanks for your advise,i will try.
thanks a lot.
Joh.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by wqweto
Use the VBCDeclFix add-in if something bothers you about the cdecl trampolines.
I would recommend using the add-in even if nothing bothers you about the cdecl trampolines as it is overall a much better solution to the problem.
cheers,
</wqw>
I don't like "cdecl fix add-in",But it can not be denied that this is a very advanced technology. To solve this problem perfectly.
It's just that I personally don't like installing VB6 plugins.(add-in)
if cdecl sub test()
in vb6:
how to use this code call cdecl api "test" without (optional NOUSE AS LONG)
sub vb_test(optional NOUSE AS LONG )
msgbox 1
end sub
Because someone helped me implement this code a year ago, I lost my source code.but now I can't reach him.
I'm in a Hurry. Can you help me? How much does it cost?
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
This code is free and open source, and it doesn't charge you anything.
Some functions are developed by others, in which I have done a lot of optimization and improvement, can be completely correct for normal use. But it's still not perfect.
I want someone to test it, and I can fix it if I find a problem.Maybe there is no problem at all, and you are using the wrong method.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by wqweto
There is no contribution by xiaoyao to CDeclFix -- don't mix things up by giving wrong credit where it's not due, please!
He is our regular spammer here with most posts of his completely out of touch with the topic at hand.
Don't trust *anything* he says because he is using a very low quality auto-translate from chinese while probably even the original thoughts are not very coherent in first place.
@mods: Please clean up the spam by xiaoyao in this thread (and everywhere) as it causes confision so that the original author's work remains mis-credited along with the spammer's unasked junk posts.
cheers,
</wqw>
I have test all code,Run without any problems at all.
Please Don't make personal attacks on me at will.
Everyone just communicates about technology.It's just that everyone likes a different way of doing it.
Just like some people like Android phones, some people like Apple IOS system.It is their own freedom to buy whatever mobile phone they want.
google companies and Apple, they just think that each operating system has its own advantages.I think they're all great.
like support ocx,usercontrol in vb6 Multithreading.
Some people need it and spend days and months researching it.
It doesn't make me feel the need to attack them, These people are not crazy, but they think this technology is also needed.
For example, the VB6 IDE does not support the mouse wheel. But I don't like to install add-ins, so I prefer to use the page up and page down keys.
bind cdecl without addin(fixcdecl),There is another important use for:load dll from memory (load ocx avtive control It's also very good. )
if I want add 5 dll to Resource File,It only needs to send an application to the client, without any DLL files.
You can use this method to encrypt some files and import them into resource files.Prevent others from using them illegally and without authorization, and protect the fruits of their own labor.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by xiaoyao
I have test all code,Run without any problems at all.
Please Don't make personal attacks on me at will.
Everyone just communicates about technology.It's just that everyone likes a different way of doing it.
Just like some people like Android phones, some people like Apple IOS system.It is their own freedom to buy whatever mobile phone they want.
google companies and Apple, they just think that each operating system has its own advantages.I think they're all great.
like support ocx,usercontrol in vb6 Multithreading.
Some people need it and spend days and months researching it.
It doesn't make me feel the need to attack them, These people are not crazy, but they think this technology is also needed.
For example, the VB6 IDE does not support the mouse wheel. But I don't like to install add-ins, so I prefer to use the page up and page down keys.
bind cdecl without addin(fixcdecl),There is another important use for:load dll from memory (load ocx avtive control It's also very good. )
if I want add 5 dll to Resource File,It only needs to send an application to the client, without any DLL files.
You can use this method to encrypt some files and import them into resource files.Prevent others from using them illegally and without authorization, and protect the fruits of their own labor.
On VB6 I don't know ... but on Delphi, you can use the following code to embed the DLL in the Resource DLL and use it from memory without having to export that DLL to finish loading it ...
You can refer to the following link if you know Delphi code
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by wqweto
So you actually understand *some* of the posts/replies here but not the part about stopping spam obviously.
cheers,
</wqw>
You may have misunderstood.Because my translation software shows that you said I was replying to some spam.
Because this problem has not been solved, it has been asked many times repeatedly.
It's like calling that Microsoft's edge browser. You need to add a 6 m rc6. DLL.I was hoping it would be more convenient if there was one that didn't require extra documentation. Is simply called with VB6。
Mainly in some projects, you want the entire installer to be as small as possible.Because some people say that my program has not been tested by myself, so there are a lot of problems.
I'm not happy when people say that.Because I've done a lot of testing on this, and a lot of fixing.
If there is really a problem, they should send this question up. Just like you used to always ask me to send a test to the governor.
Some functions need to run faster, so I made a record of the speed of the test.
My English is not good. Originally, many horses were not written in English.You always ask me to send complete test examples, which also takes a lot of my time.
I think I just need to send up the results of this test.
If some people don't believe it, they can choose one or two ways to make a comparison.
I often use five or ten methods to compare.Originally, it was only a free exchange, so we can write the test project by ourselves.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
by vb6,I focus on multithreading, cdecl calls, edge calls, and so on.
There are some things that are difficult to implement in this language, so it takes a lot of time to study it in depth.
There are five to ten ways to use it.It's just that my requirements are too high, and I always want to do better.So the best way is to use other languages to do a DLL, VB6 call him, so that should be 80% of the problem can be solved.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
Edit New: some friends in this forum told me hould not trust this author(xiaoyao) because of his badness posts actions. They said most of his code examples are useless or fragment, while pay money to him will get the whole code examples.
Just as a point of view.
There's no way I would knowingly charge for the full version. Some people mislead others' opinions.
I didn't charge any fees for this problem.Just have any questions about this code you can communicate.But in the case of you have not been tested to guess the intentions of others, this is very hurtful to others.
about chrome core dll.I also upload the complete code.Because there is a developer, he took the initiative to pay me part of the cost, let me help him do a project.
As a result, some people understand that I intentionally uploaded only an incomplete version and charged another fee for the full version, so the attack of distorted facts is indeed a headache.
It took me more than two weeks to get into this.If you just use cdecl declaratively, the VB6 add-in method is great.
It's just that I also have some other use for having memory to load and run DLLs.
What I uploaded is the latest complete example. Initially, I just used my own cdecl DLL and tested add (11, 22) = 33.This is no problem at all.
Later I tested the SQLite database call and found that calling multiple functions would cause the IDE to crash, but compiled ,run by exe without any problems.
So it took me another two days to fix the question
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by PhuongNam
On VB6 I don't know ... but on Delphi, you can use the following code to embed the DLL in the Resource DLL and use it from memory without having to export that DLL to finish loading it ...
You can refer to the following link if you know Delphi code
Thank you very much for your attention.I know how to run from memory and load some DLLs that do not need to be unzipped to hard disk.
But each call inside the DLL API need to construct a section of our own assembly code, so the running speed is relatively slow.
I always want to be able to run it as fast as possible.So I invented a way to make it VB6's own function. So the running speed is increased by more than ten times.But there will be some instability and bugs to fix.It took me a couple of months.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Originally Posted by MacroJohn
Thank you for your help.
I tested your example, but it crashed directly in the IDE(win10,vb6). Although this method is portable, it may need to be refined to make it feasible.
Thanks a lot!
It should not be possible to crash. If you have time, send me the engineering source code to try.
Using this method, it supports any number of CDECL API transfers, and the number of parameters also supports 0-100.
Just add one more parameter than the original one.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
Perhaps some code runs differently under the Chinese and English versions of VB6. In English VB6, the code may crash, but in my Chinese VB6, it was only the first time the address was not successfully bound. Clicking the button to run the second time was completely normal.
Previously, I also gained inspiration from a project by someone else, which required running twice (equivalent to compiling twice).
There is no problem with CTRL+F5 or compiling it into EXE.
At the beginning, someone helped me write a way to call the CDECL API by writing assembly code, which never crashed. Unfortunately, I lost that source code.
I have never intentionally uploaded only a portion of the code, and in fact, my code was only copied from other people's posts with minor improvements. Perhaps it has become better, perhaps more new problems have arisen.
I have been researching this problem for several years and have not found a perfect solution.
Re: Bind Cdecl Api To vb6 Function(stdcall),support run in IDE
when i call function add on Module1.bas,it will call cdecl api:cadd(a,b)
need WriteProcessMemory asm code to :
Code:
function add(a as long,b as long)
msgbox 1
msgbox 1
msgbox 1
end function
if unload exe,need restore ProcessMemory,Otherwise, it could collapse
By operating in this way, stability is improved, but it may not necessarily guarantee that there is no problem at all.
Code:
Sub FixCdecl(ByVal VbFunction As Long, ByVal CdeclApi As Long, Args As Long) 'GOOD
'If bInIDE Then Exit Sub
'MsgBox "call-FixCdecl"
Dim asm(4) As String, stub() As Byte
' 0: 58 pop eax
' 1: 89 84 24 XX XX XX XX mov dword ptr [esp+Xh],eax
asm(0) = "58 89 84 24 " & LongToHex(Args * 4) '&H24848958
asm(1) = "B8 " & LongToHex(CdeclApi) 'B8 90807000 MOV EAX,708090
asm(2) = "FF D0" 'FFD0 CALL EAX
asm(3) = "83 C4 " & Hex(Args * 4) '83 C4 XX add esp, XX 'cleanup args
asm(4) = "C3"
stub() = toBytes(Join(asm, " "))
' MsgBox bInIDE
If bInIDE Then
CopyMemory2 VbFunction, ByVal VbFunction + &H16, 4 'ide下必须用这个,编绎后不可行
Else
VirtualProtect2 VbFunction, THUNK_SIZE, PAGE_EXECUTE_READWRITE, 0 '更改函数地址所在页面属性
'ide下不可用,编绎后只能用这个
End If
ReDim Preserve OldInfoArr(ApiCount)
'OldInfoArr(ApiCount).MemPtr = VirtualAlloc(ByVal 0&, 4096, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
OldInfoArr(ApiCount).VbFunction2 = VbFunction
CopyMemory2 ByVal VarPtr(OldInfoArr(ApiCount).Oldbt(0)), ByVal VbFunction, ByVal THUNK_SIZE '保存函数旧数据
ApiCount = ApiCount + 1
If bInIDE Then
' CopyMemory2 ByVal VbFunction, ByVal VarPtr(stub(0)), THUNK_SIZE 'only support ide
WriteProcessMemory2 -1, VbFunction, VarPtr(stub(0)), THUNK_SIZE, 0
'WriteProcessMemory -1, ByVal VbFunction, stub(0), THUNK_SIZE, 0
Else
WriteProcessMemory2 -1, VbFunction, VarPtr(stub(0)), THUNK_SIZE, 0
End If
End Sub
Sub RestoreFunctionMemoryList() '必不可少,否则会崩
'If bInIDE Then Exit Sub
Dim I As Long
For I = 0 To ApiCount - 1
' If bInIDE Then 'CopyMemory2 ByVal OldInfoArr(I).VbFunction2, ByVal VarPtr(OldInfoArr(I).Oldbt(0)), ByVal THUNK_SIZE 'only support ide
WriteProcessMemory2 -1, OldInfoArr(I).VbFunction2, VarPtr(OldInfoArr(I).Oldbt(0)), THUNK_SIZE, 0
Next
End Sub