[VB6] VBCDeclFix - The Add-in allows you to use Cdecl functions in VB6 IDE.-VBForums

link管理

链接快照平台

输入网页链接，自动生成快照
标签化管理网页链接

相关文章推荐

温柔的豆浆 · JS Plugin not ...· 1 月前 ·

焦虑的煎饼 · SendMessage doesn't ...· 1 月前 ·

重感情的手术刀 · 变更 | Vue Apollo· 1 月前 ·

刀枪不入的开心果 · Unity 2020.1 ...· 3 月前 ·

刚分手的人字拖 · Browser to Unity ...· 5 月前 ·

发呆的石榴 · csol女角色鉴赏 ...· 1 月前 ·

逆袭的凉面 · 致高考考生之诚信考试· 4 月前 ·

活泼的生姜 · 圣经书有多厚_头条· 11 月前 ·

听话的牛肉面 · 琅寰书院�% - 搜狗图片搜索· 1 年前 ·

活泼的水煮肉 · 操作日志追踪记录之MDC入门-腾讯云开发者社 ...· 1 年前 ·

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. The Add-in allows you to use Cdecl functions in VB6 both declared in type libraries and using the CDecl keyword.
If you have ever tried to use CDECL -functions declared in a TLB then you know that debugging (in IDE) is impossible. The project just has crashed and doesn't even start although compilation to native code works without any issues. A similar problem occurs when using the CDecl keyword - VB6 always generates the code with the 0x31 error ( Bad Dll Calling Convention ) so you can use such functions neither IDE nor compiled executable. This Add-in fixes this behavior and you can debug your code in IDE and compile the code to an executable file.
https://github.com/thetrik/VBCDeclFix

very good job.
cannot open project CDeclFix closes ide.
if I compile it with the explorer context menu it works perfectly.
I don't have time to test it with more time but the test project works fine.
i use vb6 version 8176 i dont have sp6
a greeting

Sorry, my mistake (again with .gitattribute file). I've fixed now.

Btw, you can add *.dca to .gitignore (and safely remove them from the repo) as these are temporaray ActiveX Designers cache files the way .oca files are temporary cache for ActiveX Controls OCX files.
Edit: Nice explanation in the README and very informative.
Edit 2: I usually hammer .gitattributes/.gitignore/README.md until looking good with "amend" commits (i.e. modifying the last commit) which I then force push to origin to directly observe the results on github. The idea is not to litter repo's history with multiple vexing "Update README" commits.
cheers,
VbAsyncSocket - Simple and thin WinSock API wrappers for VB6 | ZipArchive - A single-class pure VB6 library for zip with ASM speed | VbRtcc - Runtime Tiny C Compiler for VB6
[VB6] Simple AES 256-bit password protected encryption | [VB6] Blur effect on GDI+ bitmaps | Fast O(N) median filter for GDI+ bitmaps impl w/ SSE2 thunks

Thank you! I use github desktop i haven't yet figured out how to work with it correctly.

No, there is no amend option in Github Desktop for no apparent reason. They probably expect "advanced" users to use git from the command prompt to amend last commit.
SourceTree does have implemented it though.
cheers,
VbAsyncSocket - Simple and thin WinSock API wrappers for VB6 | ZipArchive - A single-class pure VB6 library for zip with ASM speed | VbRtcc - Runtime Tiny C Compiler for VB6
[VB6] Simple AES 256-bit password protected encryption | [VB6] Blur effect on GDI+ bitmaps | Fast O(N) median filter for GDI+ bitmaps impl w/ SSE2 thunks

Update.
Added support for CDecl keyword. Now you can use it in the Declare statement like:

Code:

Option Explicit
Private Declare Function snwprintf1 CDecl Lib "msvcrt" _
                         Alias "_snwprintf" ( _
                         ByVal pszBuffer As Long, _
                         ByVal lCount As Long, _
                         ByVal pszFormat As Long, _
                         ByRef pArg1 As Any) As Long
Private Declare Function snwprintf2 CDecl Lib "msvcrt" _
                         Alias "_snwprintf" ( _
                         ByVal pszBuffer As Long, _
                         ByVal lCount As Long, _
                         ByVal pszFormat As Long, _
                         ByRef pArg1 As Any, _
                         ByRef pArg2 As Any) As Long
Private Declare Function wtoi64 CDecl Lib "msvcrt" _
                         Alias "_wtoi64" ( _
                         ByVal psz As Long) As Currency
Sub Main()
    Dim sBuf    As String
    sBuf = Space$(255)
    Debug.Print Left$(sBuf, snwprintf1(StrPtr(sBuf), Len(sBuf), StrPtr("Test %ld"), ByVal 123&))
    Debug.Print Left$(sBuf, snwprintf2(StrPtr(sBuf), Len(sBuf), StrPtr("Test %ld, %s"), ByVal 123&, ByVal StrPtr("Hello")))
    Debug.Print wtoi64(StrPtr("1234567"))
End Sub

So from now on, the community can use C libraries

Update.
Added support for CDecl keyword. Now you can use it in the Declare statement like:

Code:

Option Explicit
Private Declare Function snwprintf1 CDecl Lib "msvcrt" _
                         Alias "_snwprintf" ( _
                         ByVal pszBuffer As Long, _
                         ByVal lCount As Long, _
                         ByVal pszFormat As Long, _
                         ByRef pArg1 As Any) As Long
Private Declare Function snwprintf2 CDecl Lib "msvcrt" _
                         Alias "_snwprintf" ( _
                         ByVal pszBuffer As Long, _
                         ByVal lCount As Long, _
                         ByVal pszFormat As Long, _
                         ByRef pArg1 As Any, _
                         ByRef pArg2 As Any) As Long
Private Declare Function wtoi64 CDecl Lib "msvcrt" _
                         Alias "_wtoi64" ( _
                         ByVal psz As Long) As Currency
Sub Main()
    Dim sBuf    As String
    sBuf = Space$(255)
    Debug.Print Left$(sBuf, snwprintf1(StrPtr(sBuf), Len(sBuf), StrPtr("Test %ld"), ByVal 123&))
    Debug.Print Left$(sBuf, snwprintf2(StrPtr(sBuf), Len(sBuf), StrPtr("Test %ld, %s"), ByVal 123&, ByVal StrPtr("Hello")))
    Debug.Print wtoi64(StrPtr("1234567"))
End Sub

So from now on, the community can use C libraries

Thats very comfortable. :-) nice

Update.
Added support for CDecl keyword. Now you can use it in the Declare statement like:

Code:

Option Explicit
Private Declare Function snwprintf1 CDecl Lib "msvcrt" _
                         Alias "_snwprintf" ( _
                         ByVal pszBuffer As Long, _
                         ByVal lCount As Long, _
                         ByVal pszFormat As Long, _
                         ByRef pArg1 As Any) As Long
Private Declare Function snwprintf2 CDecl Lib "msvcrt" _
                         Alias "_snwprintf" ( _
                         ByVal pszBuffer As Long, _
                         ByVal lCount As Long, _
                         ByVal pszFormat As Long, _
                         ByRef pArg1 As Any, _
                         ByRef pArg2 As Any) As Long
Private Declare Function wtoi64 CDecl Lib "msvcrt" _
                         Alias "_wtoi64" ( _
                         ByVal psz As Long) As Currency
Sub Main()
    Dim sBuf    As String
    sBuf = Space$(255)
    Debug.Print Left$(sBuf, snwprintf1(StrPtr(sBuf), Len(sBuf), StrPtr("Test %ld"), ByVal 123&))
    Debug.Print Left$(sBuf, snwprintf2(StrPtr(sBuf), Len(sBuf), StrPtr("Test %ld, %s"), ByVal 123&, ByVal StrPtr("Hello")))
    Debug.Print wtoi64(StrPtr("1234567"))
End Sub

So from now on, the community can use C libraries

Hi The trick,
I'd like to know if this means that we can directly call the original latest Scintilla.dll (without the COM wrapper) to make our own CodeEditor? Thanks. You can use any CDecl functions.
You can use a SciLexer.dll without any tricks if you want to use syntax highlighting. For example:

Code:

Option Explicit
Private m_hScintillaLib As Long
Private m_hWnd          As Long
Public Property Get Text() As String
    Dim lSize   As Long
    lSize = SendMessage(m_hWnd, SCI_GETLENGTH, 0, ByVal 0&)
    If lSize Then
        Text = StrConv(Space$(lSize), vbFromUnicode)
        SendMessage m_hWnd, SCI_GETTEXT, lSize + 1, ByVal Text
        Text = StrConv(Text, vbUnicode)
    End If
End Property
Public Property Let Text( _
                    ByRef sValue As String)
    SendMessage m_hWnd, SCI_SETTEXT, 0, ByVal CStr(StrConv(sValue, vbFromUnicode))
End Property
Private Sub UserControl_GotFocus()
    SetFocusAPI m_hWnd
End Sub
Private Sub UserControl_Initialize()
    Dim sKeywords   As String
    Dim bIsInIDE    As Boolean
    sKeywords = "and as boolean byref byval call case class const " & _
                "dim do each else elseif empty end " & _
                "endif eqv exit false for function get goto " & _
                "if imp in is let like loop " & _
                "lset me mod new next not nothing null on " & _
                "optional or paramarray preserve private public redim rem resume " & _
                "rset select set static stop sub then to " & _
                "true typeof until variant wend while with xor " & _
                "cbool cbyte ccur cdate cdbl cdec cint clng csng cstr " & _
                "cvar cvdate cverr " & _
                "message scripte scriptd isscript enablelist disablelist islist " & _
                "base64tobytearray filetobytearray global_l global_s global_b gotolabel gotoindex " & _
                "getindex getlabel getbase64"
    Debug.Assert MakeTrue(bIsInIDE)
    If bIsInIDE Then
        m_hScintillaLib = LoadLibrary(App.Path & "\Release\Scintilla\SciLexer.dll")
        m_hScintillaLib = LoadLibrary(App.Path & "\Scintilla\SciLexer.dll")
    End If
    If m_hScintillaLib = 0 Then
        Err.Raise 7, "ctlScintilla::ctlScintilla"
    End If
    m_hWnd = CreateWindowEx(WS_EX_CLIENTEDGE, "Scintilla", "TEST", WS_CHILD Or WS_VISIBLE, _
                            0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, UserControl.hwnd, 0, App.hInstance, 0)
    If m_hWnd = 0 Then
        Err.Raise 7, "ctlScintilla::ctlScintilla"
    End If
    SendMessage m_hWnd, SCI_SETLEXER, SCLEX_VB, ByVal 0&
    SendMessage m_hWnd, SCI_SETKEYWORDS, 0, ByVal CStr(StrConv(sKeywords, vbFromUnicode))
    SendMessage m_hWnd, SCI_STYLESETFONT, STYLE_DEFAULT, ByVal CStr(StrConv("Courier New", vbFromUnicode))
    SendMessage m_hWnd, SCI_STYLECLEARALL, 0, ByVal 0&
    SendMessage m_hWnd, SCI_STYLESETFORE, SCE_B_KEYWORD, ByVal &HF00000
    SendMessage m_hWnd, SCI_STYLESETFORE, SCE_B_COMMENT, ByVal &HA000&
    SendMessage m_hWnd, SCI_STYLESETFORE, SCE_B_STRING, ByVal &H80
    SendMessage m_hWnd, SCI_SETMARGINWIDTHN, 0, ByVal SendMessage(m_hWnd, SCI_TEXTWIDTH, STYLE_LINENUMBER, _
                                                ByVal CStr(StrConv("_999999_", vbFromUnicode)))
End Sub
Private Sub UserControl_Resize()
    MoveWindow m_hWnd, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, 0
End Sub
Private Sub UserControl_Terminate()
    If m_hWnd Then
        DestroyWindow m_hWnd
        m_hWnd = 0
    End If
    If m_hScintillaLib Then
        FreeLibrary m_hScintillaLib
        m_hScintillaLib = 0
    End If
End Sub

you can use any cdecl functions.
You can use a scilexer.dll without any tricks if you want to use syntax highlighting. For example:

Code:

option explicit
private m_hscintillalib as long
private m_hwnd          as long
public property get text() as string
    dim lsize   as long
    lsize = sendmessage(m_hwnd, sci_getlength, 0, byval 0&)
    if lsize then
        text = strconv(space$(lsize), vbfromunicode)
        sendmessage m_hwnd, sci_gettext, lsize + 1, byval text
        text = strconv(text, vbunicode)
    end if
end property
public property let text( _
                    byref svalue as string)
    sendmessage m_hwnd, sci_settext, 0, byval cstr(strconv(svalue, vbfromunicode))
end property
private sub usercontrol_gotfocus()
    setfocusapi m_hwnd
end sub
private sub usercontrol_initialize()
    dim skeywords   as string
    dim bisinide    as boolean
    skeywords = "and as boolean byref byval call case class const " & _
                "dim do each else elseif empty end " & _
                "endif eqv exit false for function get goto " & _
                "if imp in is let like loop " & _
                "lset me mod new next not nothing null on " & _
                "optional or paramarray preserve private public redim rem resume " & _
                "rset select set static stop sub then to " & _
                "true typeof until variant wend while with xor " & _
                "cbool cbyte ccur cdate cdbl cdec cint clng csng cstr " & _
                "cvar cvdate cverr " & _
                "message scripte scriptd isscript enablelist disablelist islist " & _
                "base64tobytearray filetobytearray global_l global_s global_b gotolabel gotoindex " & _
                "getindex getlabel getbase64"
    debug.assert maketrue(bisinide)
    if bisinide then
        m_hscintillalib = loadlibrary(app.path & "\release\scintilla\scilexer.dll")
        m_hscintillalib = loadlibrary(app.path & "\scintilla\scilexer.dll")
    end if
    if m_hscintillalib = 0 then
        err.raise 7, "ctlscintilla::ctlscintilla"
    end if
    m_hwnd = createwindowex(ws_ex_clientedge, "scintilla", "test", ws_child or ws_visible, _
                            0, 0, usercontrol.scalewidth, usercontrol.scaleheight, usercontrol.hwnd, 0, app.hinstance, 0)
    if m_hwnd = 0 then
        err.raise 7, "ctlscintilla::ctlscintilla"
    end if
    sendmessage m_hwnd, sci_setlexer, sclex_vb, byval 0&
    sendmessage m_hwnd, sci_setkeywords, 0, byval cstr(strconv(skeywords, vbfromunicode))
    sendmessage m_hwnd, sci_stylesetfont, style_default, byval cstr(strconv("courier new", vbfromunicode))
    sendmessage m_hwnd, sci_styleclearall, 0, byval 0&
    sendmessage m_hwnd, sci_stylesetfore, sce_b_keyword, byval &hf00000
    sendmessage m_hwnd, sci_stylesetfore, sce_b_comment, byval &ha000&
    sendmessage m_hwnd, sci_stylesetfore, sce_b_string, byval &h80
    sendmessage m_hwnd, sci_setmarginwidthn, 0, byval sendmessage(m_hwnd, sci_textwidth, style_linenumber, _
                                                byval cstr(strconv("_999999_", vbfromunicode)))
end sub
private sub usercontrol_resize()
    movewindow m_hwnd, 0, 0, usercontrol.scalewidth, usercontrol.scaleheight, 0
end sub
private sub usercontrol_terminate()
    if m_hwnd then
        destroywindow m_hwnd
        m_hwnd = 0
    end if
    if m_hscintillalib then
        freelibrary m_hscintillalib
        m_hscintillalib = 0
    end if
end sub

Some progress in development. I'm trying to implement user CDECL functions which are useful for callback functions which should have the CDECL calling convention.
I've found out how to modify the parsing process to accept the CDecl keyword. I've found out how to modify the display procedure to show the correct text (if you just modify the parsing process it'll be a CDecl function but it won't be showed as the CDecl one). The compiler accepts all and compiles the correct result. The only problem with the P-code builder which can't do CDecl functions out-of-box. I need to modify the build process to make all the CDecl function as if it accepts 0 parameters. Just the some playing around CDecl:
As you can see the CDecl keyword is correctly recognized by parser.
Using qsort function:

Code:

Option Explicit
Private Declare Sub qsort CDecl Lib "msvcrt" ( _
                         ByRef pFirst As Any, _
                         ByVal lNumber As Long, _
                         ByVal lSize As Long, _
                         ByVal pfnComparator As Long)
Sub Main()
    Dim z() As Long
    Dim i As Long
    Dim s As String
    ReDim z(10)
    For i = 0 To UBound(z)
        z(i) = Int(Rnd * 1000)
    qsort z(0), UBound(z) + 1, LenB(z(0)), AddressOf Comparator
    For i = 0 To UBound(z)
        s = s & CStr(z(i)) & vbNewLine
    MsgBox s
End Sub
Private Function Comparator CDecl( _
                 ByRef a As Long, _
                 ByRef b As Long) As Long
    Comparator = a - b
End Function

cdeclFix without addin：
writeprocessmemory by asm code:for fix esp,Stack balancing.
dll api：cdecl function:sum(a,b),result=a+b
vb code:

Code:

sub cdeclFix(cdeclApi,myFunCctionAddress,ArgumentCount)
'put asm code to cdeclapi address
end sub
cdeclFix( Cdeclsum_Addres,addressof Mysum,2)
function mYsum(A as long,B as long) as long
msgbox 99999 '
END FUNCTION

it'S run in vb6 IDE good

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 Call_ultow(ByVal Pfn As Long, ByVal Value As Long, ByVal Str As Long, ByVal Radix As Long, Optional ByVal Spacer As Long) As Long
    pvPatchTrampoline AddressOf Module1.Call_ultow, 3
    Call_ultow = Call_ultow(Pfn, Value, Str, Radix)
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)
        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
This way

Man, this is like trying to school the guy who *invented* the cdecl trampoline you are just copy/pasting around. . . Just stop it already!
cheers,
VbAsyncSocket - Simple and thin WinSock API wrappers for VB6 | ZipArchive - A single-class pure VB6 library for zip with ASM speed | VbRtcc - Runtime Tiny C Compiler for VB6
[VB6] Simple AES 256-bit password protected encryption | [VB6] Blur effect on GDI+ bitmaps | Fast O(N) median filter for GDI+ bitmaps impl w/ SSE2 thunks

You can use any CDecl functions.
You can use a SciLexer.dll without any tricks if you want to use syntax highlighting. For example:

Code:

Option Explicit
Private m_hScintillaLib As Long
Private m_hWnd          As Long
Public Property Get Text() As String
    Dim lSize   As Long
    lSize = SendMessage(m_hWnd, SCI_GETLENGTH, 0, ByVal 0&)
    If lSize Then
        Text = StrConv(Space$(lSize), vbFromUnicode)
        SendMessage m_hWnd, SCI_GETTEXT, lSize + 1, ByVal Text
        Text = StrConv(Text, vbUnicode)
    End If
End Property
Public Property Let Text( _
                    ByRef sValue As String)
    SendMessage m_hWnd, SCI_SETTEXT, 0, ByVal CStr(StrConv(sValue, vbFromUnicode))
End Property
Private Sub UserControl_GotFocus()
    SetFocusAPI m_hWnd
End Sub
Private Sub UserControl_Initialize()
    Dim sKeywords   As String
    Dim bIsInIDE    As Boolean
    sKeywords = "and as boolean byref byval call case class const " & _
                "dim do each else elseif empty end " & _
                "endif eqv exit false for function get goto " & _
                "if imp in is let like loop " & _
                "lset me mod new next not nothing null on " & _
                "optional or paramarray preserve private public redim rem resume " & _
                "rset select set static stop sub then to " & _
                "true typeof until variant wend while with xor " & _
                "cbool cbyte ccur cdate cdbl cdec cint clng csng cstr " & _
                "cvar cvdate cverr " & _
                "message scripte scriptd isscript enablelist disablelist islist " & _
                "base64tobytearray filetobytearray global_l global_s global_b gotolabel gotoindex " & _
                "getindex getlabel getbase64"
    Debug.Assert MakeTrue(bIsInIDE)
    If bIsInIDE Then
        m_hScintillaLib = LoadLibrary(App.Path & "\Release\Scintilla\SciLexer.dll")
        m_hScintillaLib = LoadLibrary(App.Path & "\Scintilla\SciLexer.dll")
    End If
    If m_hScintillaLib = 0 Then
        Err.Raise 7, "ctlScintilla::ctlScintilla"
    End If
    m_hWnd = CreateWindowEx(WS_EX_CLIENTEDGE, "Scintilla", "TEST", WS_CHILD Or WS_VISIBLE, _
                            0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, UserControl.hwnd, 0, App.hInstance, 0)
    If m_hWnd = 0 Then
        Err.Raise 7, "ctlScintilla::ctlScintilla"
    End If
    SendMessage m_hWnd, SCI_SETLEXER, SCLEX_VB, ByVal 0&
    SendMessage m_hWnd, SCI_SETKEYWORDS, 0, ByVal CStr(StrConv(sKeywords, vbFromUnicode))
    SendMessage m_hWnd, SCI_STYLESETFONT, STYLE_DEFAULT, ByVal CStr(StrConv("Courier New", vbFromUnicode))
    SendMessage m_hWnd, SCI_STYLECLEARALL, 0, ByVal 0&
    SendMessage m_hWnd, SCI_STYLESETFORE, SCE_B_KEYWORD, ByVal &HF00000
    SendMessage m_hWnd, SCI_STYLESETFORE, SCE_B_COMMENT, ByVal &HA000&
    SendMessage m_hWnd, SCI_STYLESETFORE, SCE_B_STRING, ByVal &H80
    SendMessage m_hWnd, SCI_SETMARGINWIDTHN, 0, ByVal SendMessage(m_hWnd, SCI_TEXTWIDTH, STYLE_LINENUMBER, _
                                                ByVal CStr(StrConv("_999999_", vbFromUnicode)))
End Sub
Private Sub UserControl_Resize()
    MoveWindow m_hWnd, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, 0
End Sub
Private Sub UserControl_Terminate()
    If m_hWnd Then
        DestroyWindow m_hWnd
        m_hWnd = 0
    End If
    If m_hScintillaLib Then
        FreeLibrary m_hScintillaLib
        m_hScintillaLib = 0
    End If
End Sub

Added examples:

qsort - the C-function usage with a callback function;
cairo - original cairo library usage;
sqlite - original sqlite3.dll usage.

I've tested only on a couple builds of vba6.dll so if something doesn't work please report me i'll update the signatures.

I still can't open your project, ide closes.
I did not run all the examples, but some do work.
i use windows 10 vb6 version 8176 i dont have sp6
a greeting

Thanks for reply. I've tried to run the project in Win10 and i have the crash too. The problem is related to the typelibrary (LoadTypeLibEx crashes). I'll see how to solve the problem. Thanks for the report.

everything works perfectly.
You are very good, keep working that well.
thank you for making vb6 better.
a greeting

You can use any CDecl functions.
You can use a SciLexer.dll without any tricks if you want to use syntax highlighting. For example:

Code:

Option Explicit
Private m_hScintillaLib As Long
Private m_hWnd          As Long
Public Property Get Text() As String
    Dim lSize   As Long
    lSize = SendMessage(m_hWnd, SCI_GETLENGTH, 0, ByVal 0&)
    If lSize Then
        Text = StrConv(Space$(lSize), vbFromUnicode)
        SendMessage m_hWnd, SCI_GETTEXT, lSize + 1, ByVal Text
        Text = StrConv(Text, vbUnicode)
    End If
End Property
Public Property Let Text( _
                    ByRef sValue As String)
    SendMessage m_hWnd, SCI_SETTEXT, 0, ByVal CStr(StrConv(sValue, vbFromUnicode))
End Property
Private Sub UserControl_GotFocus()
    SetFocusAPI m_hWnd
End Sub
Private Sub UserControl_Initialize()
    Dim sKeywords   As String
    Dim bIsInIDE    As Boolean
    sKeywords = "and as boolean byref byval call case class const " & _
                "dim do each else elseif empty end " & _
                "endif eqv exit false for function get goto " & _
                "if imp in is let like loop " & _
                "lset me mod new next not nothing null on " & _
                "optional or paramarray preserve private public redim rem resume " & _
                "rset select set static stop sub then to " & _
                "true typeof until variant wend while with xor " & _
                "cbool cbyte ccur cdate cdbl cdec cint clng csng cstr " & _
                "cvar cvdate cverr " & _
                "message scripte scriptd isscript enablelist disablelist islist " & _
                "base64tobytearray filetobytearray global_l global_s global_b gotolabel gotoindex " & _
                "getindex getlabel getbase64"
    Debug.Assert MakeTrue(bIsInIDE)
    If bIsInIDE Then
        m_hScintillaLib = LoadLibrary(App.Path & "\Release\Scintilla\SciLexer.dll")
        m_hScintillaLib = LoadLibrary(App.Path & "\Scintilla\SciLexer.dll")
    End If
    If m_hScintillaLib = 0 Then
        Err.Raise 7, "ctlScintilla::ctlScintilla"
    End If
    m_hWnd = CreateWindowEx(WS_EX_CLIENTEDGE, "Scintilla", "TEST", WS_CHILD Or WS_VISIBLE, _
                            0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, UserControl.hwnd, 0, App.hInstance, 0)
    If m_hWnd = 0 Then
        Err.Raise 7, "ctlScintilla::ctlScintilla"
    End If
    SendMessage m_hWnd, SCI_SETLEXER, SCLEX_VB, ByVal 0&
    SendMessage m_hWnd, SCI_SETKEYWORDS, 0, ByVal CStr(StrConv(sKeywords, vbFromUnicode))
    SendMessage m_hWnd, SCI_STYLESETFONT, STYLE_DEFAULT, ByVal CStr(StrConv("Courier New", vbFromUnicode))
    SendMessage m_hWnd, SCI_STYLECLEARALL, 0, ByVal 0&
    SendMessage m_hWnd, SCI_STYLESETFORE, SCE_B_KEYWORD, ByVal &HF00000
    SendMessage m_hWnd, SCI_STYLESETFORE, SCE_B_COMMENT, ByVal &HA000&
    SendMessage m_hWnd, SCI_STYLESETFORE, SCE_B_STRING, ByVal &H80
    SendMessage m_hWnd, SCI_SETMARGINWIDTHN, 0, ByVal SendMessage(m_hWnd, SCI_TEXTWIDTH, STYLE_LINENUMBER, _
                                                ByVal CStr(StrConv("_999999_", vbFromUnicode)))
End Sub
Private Sub UserControl_Resize()
    MoveWindow m_hWnd, 0, 0, UserControl.ScaleWidth, UserControl.ScaleHeight, 0
End Sub
Private Sub UserControl_Terminate()
    If m_hWnd Then
        DestroyWindow m_hWnd
        m_hWnd = 0
    End If
    If m_hScintillaLib Then
        FreeLibrary m_hScintillaLib
        m_hScintillaLib = 0
    End If
End Sub

Hi The trick,
I tested your code. When I copied a piece of VB6 code into the Scintilla control, I found that only the color of the "string" changed. Did I miss anything?
In addition, I would like to know whether there is a way to directly call some classes in .NET's basic library (for example: mscorlib.dll or System.Runtime.dll) in VB6, such as Array, String, Encodeing, Marshal, etc.
Also, can we use the open source and cross-platform .NET Core framework in VB6? Thanks.

Please create a separate thread. You have an error with string handling. My original code uses the apis declared in a TLB so it doesn't perform the UNICODE->ANSI->UNICODE conversion. You should change your calls like:

Code:

SendMessage2 m_hWnd, SCI_SETLEXER, SCLEX_VB, ByVal 0& SendMessage2 m_hWnd, SCI_SETKEYWORDS, 0, ByVal sKeywords SendMessage2 m_hWnd, SCI_STYLESETFONT, STYLE_DEFAULT, ByVal "Courier New" SendMessage2 m_hWnd, SCI_STYLECLEARALL, 0, ByVal 0& SendMessage2 m_hWnd, SCI_STYLESETFORE, SCE_B_KEYWORD, ByVal &HF00000 SendMessage2 m_hWnd, SCI_STYLESETFORE, SCE_B_COMMENT, ByVal &HA000& SendMessage2 m_hWnd, SCI_STYLESETFORE, SCE_B_STRING, ByVal &H80 SendMessage2 m_hWnd, SCI_SETMARGINWIDTHN, 0, ByVal SendMessage2(m_hWnd, SCI_TEXTWIDTH, STYLE_LINENUMBER, _ ByVal "_999999_")

You have an error with string handling. My original code uses the apis declared in a TLB so it doesn't perform the UNICODE->ANSI->UNICODE conversion. You should change your calls like:

Code:

Function VB_CdeclAPI_Sum(ByVal a As Long, ByVal b As Long, Optional NoUsed As Long) As Long MsgBox 1 MsgBox 2 End Function Sub FixCdecl(VbFunction As Long, CdeclApi As Long, args As Long) 'ESP堆栈不平衡 Stack was trashed by 4 bytes Dim asm() As String, stub() As Byte Dim i As Long, argSize As Long argSize = args * 4 ' 0: 58 pop eax ' 1: 89 84 24 XX XX XX XX mov dword ptr [esp+Xh],eax push asm(), "58 89 84 24 " & lng2Hex(argSize + 0) '&H24848958 push asm(), "B8 " & lng2Hex(CdeclApi) 'B8 90807000 MOV EAX,708090 push asm(), "FF D0" 'FFD0 CALL EAX push asm(), "83 C4 " & Hex(argSize + 0) '83 C4 XX add esp, XX 'cleanup args push asm(), "C3" stub() = toBytes(Join(asm, " ")) Dim THUNK_SIZE As Long THUNK_SIZE = UBound(stub) + 1 VirtualProtect2 VbFunction, THUNK_SIZE, PAGE_EXECUTE_READWRITE, 0 '更改函数地址所在页面属性 WriteProcessMemory2 -1, VbFunction, VarPtr(stub(0)), THUNK_SIZE, 0 'Vblegend.VirtualProtect VbFunction, THUNK_SIZE, PAGE_EXECUTE_READWRITE, 0 '更改函数地址所在页面属性 'Vblegend.WriteProcessMemory -1, VbFunction, stub(0), THUNK_SIZE, 0 End Sub

form1 code:

Code:

Dim startESP As Long, endEsp As Long
startESP = getESP
Dim h As Long, ret As Long
Dim CdeclApi As Long, lpfnAdd As Long, lpfnVoid As Long, lpfnSub As Long
h = LoadLibrary("cdecl.dll")
CdeclApi = GetProcAddress(h, "Add")
Dim a As Long, b As Long, c As Long
a = 44
b = 55
FixCdecl AddressOf VB_CdeclAPI_Sum, CdeclApi, 2
startESP = getESP
c = VB_CdeclAPI_Sum(a, b)
endEsp = getESP
MsgBox "c=" & c
'ESP堆栈不平衡
MsgBox "Stack was trashed by " & (endEsp - startESP) & " bytes"

Dim startESP As Long, endEsp As Long Dim CdeclApi As Long, lpfnAdd As Long, lpfnVoid As Long, lpfnSub As Long, h As Long h = LoadLibrary("cdecl.dll") CdeclApi = GetProcAddress(h, "Add") Dim a As Long, b As Long, c As Long a = 44 b = 55 startESP = getESP c = CallCdecl(CdeclApi, a, b) endEsp = getESP MsgBox "c=" & c & vbCrLf & "Stack was trashed by " & (endEsp - startESP) & " bytes" end sub Function CallCdecl(lpfn As Long, ParamArray args()) As Long Dim asm() As String Dim stub() As Byte Dim i As Long Dim argSize As Byte Dim ret As Long 'we step through args backwards to preserve intutive ordering For i = UBound(args) To 0 Step -1 If Not IsNumeric(args(i)) Then MsgBox "CallCdecl Invalid Parameter #" & i & " TypeName=" & TypeName(args(i)) Exit Function End If push asm(), "68 " & lng2Hex(CLng(args(i))) '68 90807000 PUSH 708090 argSize = argSize + 4 push asm(), "B8 " & lng2Hex(lpfn) 'B8 90807000 MOV EAX,708090 push asm(), "FF D0" 'FFD0 CALL EAX push asm(), "83 C4 " & Hex(argSize) '83 C4 XX add esp, XX 'Cleanup args push asm(), "C2 10 00" 'C2 10 00 retn 10h 'Cleanup our callwindowproc args stub() = toBytes(Join(asm, " ")) CallCdecl = CallAsm(stub(0), 0, 0, 0, 0) End Function

VBCDeclFix add-in use about 3600 lines code,it's a little big project.
LIKE use masm.exe mak asm code ,link obj to EXE,IT'S HARD.
USE ONLY a sub FiXCdecl ,it's easy,The simplest and least code implementation is also an alternative
VB_Add is same like CdeclAPI_Add

Code:

Private Declare Function CdeclAPI_Add Lib "cdecl.dll" Alias "Add" (ByVal a As Long, ByVal b As Long) As Long
Function VB_Add(ByVal a As Long, ByVal b As Long, Optional NoUsed As Long) As Long
    MsgBox 1
End Function

AddRandomCodeBlock
Seems that the xiaoyao-handlers have deceided, to leave the chat-bot free-running again.
We just exchange technical problems, don't attack each other.My reply is related to this topic about :cdecl
can use msam make dll
or use writeprocesdmemorry to fix call cdecl
or use asm code by addin,
or use vc++ obj file。
Usually I seldom use addin plugins.
asm plugin,Middle Mouse Button plug.
code format plugin,In fact, I know very few plug-ins, there may be hundreds.
only for use cdecl call,write a plugin addin,The cost is too great.
The simplest way is probably to write a DLL relay.
The most convenient estimate is vbcdecl fix add in.
The easiest way is to fix the stack imbalance. It only takes a few dozen lines of code to solve

The simplest way is probably to write a DLL relay.
The most convenient estimate is vbcdecl fix add in.
The easiest way is to fix the stack imbalance. It only takes a few dozen lines of code to solve

On all 3 points the Add-In is simpler, more convenient and easiest and separately it's the fastest solution as it generates correct callsite at compile time so no need to take care to "fix" stack, generate ASM thunk at run-time or other overhead.
You love micro-benchmarking so I leave performace tests to yourself -- test the native cdecl callsite vs *any* of the other solutions.
cheers,
VbAsyncSocket - Simple and thin WinSock API wrappers for VB6 | ZipArchive - A single-class pure VB6 library for zip with ASM speed | VbRtcc - Runtime Tiny C Compiler for VB6
[VB6] Simple AES 256-bit password protected encryption | [VB6] Blur effect on GDI+ bitmaps | Fast O(N) median filter for GDI+ bitmaps impl w/ SSE2 thunks

Advertiser Disclosure: Some of the products that appear on this site are from companies from which TechnologyAdvice receives compensation. This compensation may impact how and where products appear on this site including, for example, the order in which they appear. TechnologyAdvice does not include all companies or all types of products available in the marketplace.