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

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

Quote:

---

Originally Posted by yokesee

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,
</wqw>

Quote:

---

Originally Posted by wqweto

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,
</wqw>

---

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

Quote:

---

Originally Posted by The trick

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,
</wqw>

An attmept to enable CDecl keyword:

https://www.youtube.com/watch?v=I4pAdnBl1Yk

If everything will work correctly i add this ability to the new version of the Add-in.

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 :)

That's some darn fine work! :D

Quote:

---

Originally Posted by The trick

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

Quote:

---

Originally Posted by The trick

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.

Quote:

---

Originally Posted by SearchingDataOnly

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")
    Else
        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

---

https://www.vbforums.com/images/ieimages/2021/02/16.png

Quote:

---

Originally Posted by the trick

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")
    else
        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

---

https://www.vbforums.com/images/ieimages/2021/02/16.png

---

how to download the sample zip file?

Quote:

---

Originally Posted by xiaoyao

how to download the sample zip file?

---

Create a separate thread.

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:

https://www.vbforums.com/images/ieimages/2021/02/1.gif

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)
    Next
   
    qsort z(0), UBound(z) + 1, LenB(z(0)), AddressOf Comparator
   
    For i = 0 To UBound(z)
        s = s & CStr(z(i)) & vbNewLine
    Next
   
    MsgBox s
   
End Sub

Private Function Comparator CDecl( _
                ByRef a As Long, _
                ByRef b As Long) As Long
    Comparator = a - b
End Function

---

https://www.vbforums.com/images/ieimages/2021/02/17.png

good job The trick

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

like this:

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 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)
    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
This way

---

xiaoyao,
I know about that. The Add-in does native CDECL call without any patch at all.

Quote:

---

Originally Posted by xiaoyao

like this: . . .

---

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,
</wqw>

Quote:

---

Originally Posted by The trick

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")
    Else
        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

---

https://www.vbforums.com/images/ieimages/2021/02/16.png

---

Very useful information, thank you, The trick.

I've fixed the P-code builder so i need to do some tests and collect all together:
https://www.youtube.com/watch?v=3_smHx8pq78

Last time I asked：why can't run in chinese version vb6 sp6?
Your later updated version can now be used normally, thank you very much.

Quote:

---

Originally Posted by xiaoyao

can't run in chinese version vb6?sp6?

---

Do you ask or?

Update.

Added support for the CDecl keyword in user functions.

Added examples:

1. qsort - the C-function usage with a callback function;
2. cairo - original cairo library usage;
3. 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

Quote:

---

Originally Posted by yokesee

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.

Okay. I found the problem (related to the .gitattributes file). I've also updated the signatures because i've found another vba6.dll version and fixed some bugs.

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

a greeting

Quote:

---

Originally Posted by The trick

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")
    Else
        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

---

https://www.vbforums.com/images/ieimages/2021/02/16.png

---

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.

Quote:

---

Originally Posted by SearchingDataOnly

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_")
...

---

Quote:

---

Originally Posted by The trick

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_")
...

---

---

Now it's OK. Much appreciated.

now it's good for use,add 【, Optional NoUsed As Long) As Long】

Call Cdecl by VB Function why Stack was trashed by 4 bytes?
https://www.vbforums.com/showthread....58#post5512658
bas file

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"

---

but it's ok,why?

Code:

---

sub test()
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
    Next
   
    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

---

@xiaoyao,
This Add-in allows to work with CDecl functions and produce CDecl functions without any tricks. Just see examples.

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

---

Quote:

---

Originally Posted by xiaoyao

",it's a little big project"
",link obj to EXE,"
"IT'S HARD"
"USE ONLY"
",it's easy,"
[CODE]

---

AddRandomTextCombination
AddRandomLink
AddRandomCodeBlock

Seems that the xiaoyao-handlers have deceided, to leave the chat-bot free-running again.

Olaf

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

Quote:

---

Originally Posted by xiaoyao

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,
</wqw>

Quote:

---

Originally Posted by xiaoyao

The easiest way is to fix the stack imbalance. It only takes a few dozen lines of code to solve

---

The simplest way is to install the Add-in and use CDecl functions directly. Moreover it includes CDecl for user functions so you can use C-callbacks.