Page 1 of 2 12 LastLast
Results 1 to 40 of 62

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

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    [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

  2. #2
    Hyperactive Member
    Join Date
    Jun 2016
    Location
    EspaƱa
    Posts
    506

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

    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

  3. #3

  4. #4
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

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

    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>

  5. #5

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

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

    Quote Originally Posted by wqweto View Post
    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.

  6. #6
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

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

    Quote Originally Posted by The trick View Post
    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>

  7. #7

  8. #8

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

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

    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

  9. #9
    PowerPoster
    Join Date
    Aug 2010
    Location
    Canada
    Posts
    2,412

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

    That's some darn fine work!

  10. #10
    PowerPoster
    Join Date
    Jun 2012
    Posts
    2,373

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

    Quote Originally Posted by The trick View Post
    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

  11. #11
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

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

    Quote Originally Posted by The trick View Post
    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.

  12. #12

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

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

    Quote Originally Posted by SearchingDataOnly View Post
    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

  13. #13
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

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

    Quote Originally Posted by the trick View Post
    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
    how to download the sample zip file?

  14. #14

  15. #15

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

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

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

  16. #16
    Hyperactive Member
    Join Date
    Jun 2016
    Location
    EspaƱa
    Posts
    506

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

    good job The trick

  17. #17
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

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

    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
    Last edited by xiaoyao; Feb 8th, 2021 at 06:30 AM.

  18. #18
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

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

    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

  19. #19

  20. #20
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

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

    Quote Originally Posted by xiaoyao View Post
    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>

  21. #21
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

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

    Quote Originally Posted by The trick View Post
    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
    Very useful information, thank you, The trick.

  22. #22

  23. #23
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

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

    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.
    Last edited by xiaoyao; Mar 13th, 2021 at 06:44 PM.

  24. #24

  25. #25

  26. #26
    Hyperactive Member
    Join Date
    Jun 2016
    Location
    EspaƱa
    Posts
    506

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

    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

  27. #27

  28. #28

  29. #29
    Hyperactive Member
    Join Date
    Jun 2016
    Location
    EspaƱa
    Posts
    506

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

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

    a greeting

  30. #30
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

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

    Quote Originally Posted by The trick View Post
    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
    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.
    Attached Images Attached Images  
    Attached Files Attached Files

  31. #31

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

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

    Quote Originally Posted by SearchingDataOnly View Post
    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_")
    ...

  32. #32
    Frenzied Member
    Join Date
    Aug 2020
    Posts
    1,421

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

    Quote Originally Posted by The trick View Post
    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.

  33. #33
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

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

    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"
    Attached Files Attached Files
    Last edited by xiaoyao; Mar 3rd, 2021 at 06:25 AM.

  34. #34
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

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

    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

  35. #35

  36. #36
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

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

    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
    Last edited by xiaoyao; Mar 3rd, 2021 at 12:39 AM.

  37. #37
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

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

    Quote Originally Posted by xiaoyao View Post
    ",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

  38. #38
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,746

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

    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

  39. #39
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

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

    Quote Originally Posted by xiaoyao View Post
    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>

  40. #40

Page 1 of 2 12 LastLast

Tags for this Thread

Posting Permissions

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



Click Here to Expand Forum to Full Width