Announcement

Collapse
No announcement yet.

Sort string array in VB from PB DLL

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Sort string array in VB from PB DLL

    I am trying to write a DLL in PB that will sort an array of strings from VB and return the sorted strings back to VB. I have this code in my PB DLL

    SUB SORTSTRING ALIAS "SORTSTRING" (pSA AS DWORD) EXPORT
    LOCAL l AS LONG
    LOCAL u AS LONG
    LOCAL vb AS DWORD

    l = vbArrayLBound(psa, 1)
    u = vbArrayUBound(psa, 1)
    vb = vbArrayFirstElem(psa)

    DIM A(l TO u) AS STRING AT vb
    ARRAY SORT A$()
    END SUB

    and I have this declaration in VB

    Declare Sub SORTSTRING Lib "my.dll" (A$())

    But it is not working, can anyone see what I am doing wrong?

    Thanks

  • #2
    Code:
     
        vbArrayLBound(psa, 1)
        vbArrayUBound(psa, 1)
        vbArrayFirstElem(psa)
    Where do these values come from?
    I suspect that they should come from VB through
    the parameter interface, e.g.,

    Code:
     
    SUB SORTSTRING ALIAS "SORTSTRING" ( _
        l AS LONG,   _                                     
        u AS LONG,   _
        vb AS DWORD, _
        pSA AS DWORD) EXPORT
        DIM A(l TO u) AS STRING AT vb
        ARRAY SORT A$()
    END SUB
    Regards,
    Bob

    Comment


    • #3
      Code:
      '==============================================================================
      '
      '  VBSORT Example - Sort 32-bit Visual Basic arrays
      '  Copyright (c) 1997 by PowerBASIC, Inc.  All Rights Reserved.
      '
      '  Note:  When receiving the Pointer to a Safe Array (PSA) from Visual Basic,
      '         you must receive it as a DWORD by reference.  When passing it to the
      '         OLE API, you pass it BYVAL.
      '
      '==============================================================================
      $COMPILE DLL
      $INCLUDE "VBAPI32.INC"
      
      '------------------------------------------------------------------------------
      ' SortString - Sort a single-dimension VB string array
      '
      SUB SortString ALIAS "SortString" (psa AS DWORD) EXPORT
        LOCAL l  AS LONG
        LOCAL u  AS LONG
        LOCAL vb AS DWORD
        l  = vbArrayLBound(psa, 1)
        u  = vbArrayUBound(psa, 1)
        vb = vbArrayFirstElem(psa)
        DIM vba(l TO u) AS STRING AT vb
        ARRAY SORT vba()
      END SUB
      
      '------------------------------------------------------------------------------
      ' SortInt - Sort a single-dimension VB integer array
      '
      SUB SortInt ALIAS "SortInt" (psa AS DWORD) EXPORT
        LOCAL l  AS LONG
        LOCAL u  AS LONG
        LOCAL vb AS DWORD
        l  = vbArrayLBound(psa, 1)
        u  = vbArrayUBound(psa, 1)
        vb = vbArrayFirstElem(psa)
        DIM vba(l TO u) AS INTEGER AT vb
        ARRAY SORT vba()
      END SUB
      
      '------------------------------------------------------------------------------
      ' SortLong - Sort a single-dimension VB long integer array
      '
      SUB SortLong ALIAS "SortLong" (psa AS DWORD) EXPORT
        LOCAL l  AS LONG
        LOCAL u  AS LONG
        LOCAL vb AS DWORD
        l  = vbArrayLBound(psa, 1)
        u  = vbArrayUBound(psa, 1)
        vb = vbArrayFirstElem(psa)
        DIM vba(l TO u) AS LONG AT vb
        ARRAY SORT vba()
      END SUB
      
      '------------------------------------------------------------------------------
      ' SortSingle - Sort a single-dimension VB single-precision array
      '
      SUB SortSingle ALIAS "SortSingle" (psa AS DWORD) EXPORT
        LOCAL l  AS LONG
        LOCAL u  AS LONG
        LOCAL vb AS DWORD
        l  = vbArrayLBound(psa, 1)
        u  = vbArrayUBound(psa, 1)
        vb = vbArrayFirstElem(psa)
        DIM vba(l TO u) AS SINGLE AT vb
        ARRAY SORT vba()
      END SUB
      
      '------------------------------------------------------------------------------
      ' SortDouble - Sort a single-dimension VB double-precision array
      '
      SUB SortDouble ALIAS "SortDouble" (psa AS DWORD) EXPORT
        LOCAL l  AS LONG
        LOCAL u  AS LONG
        LOCAL vb AS DWORD
        l  = vbArrayLBound(psa, 1)
        u  = vbArrayUBound(psa, 1)
        vb = vbArrayFirstElem(psa)
        DIM vba(l TO u) AS DOUBLE AT vb
        ARRAY SORT vba()
      END SUB
      
      '------------------------------------------------------------------------------
      ' SortCurrency - Sort a single-dimension VB double-precision array
      '
      SUB SortCurrency ALIAS "SortCurrency" (psa AS DWORD) EXPORT
        LOCAL l  AS LONG
        LOCAL u  AS LONG
        LOCAL vb AS DWORD
        l  = vbArrayLBound(psa, 1)
        u  = vbArrayUBound(psa, 1)
        vb = vbArrayFirstElem(psa)
        DIM vba(l TO u) AS CURRENCY AT vb
        ARRAY SORT vba()
      END SUB
      How long is an idea? Write it down.

      Comment


      • #4
        Code:
        '==============================================================================
        '
        '  VBAPI32.INC -- Visual Basic 32-bit API for PowerBASIC Windows compilers
        '
        '  Copyright (C) 1997,1999,2002 PowerBASIC, Inc.
        '  Some portions Copyright (C) 1994 Microsoft Corporation
        '  All Rights Reserved.
        '
        '  This file contains only the Equate, Type, and Declare statements for
        '  SafeArray APIs.
        '
        '  You have a royalty-free right to use, modify, reproduce and distribute
        '  this file (and/or any modified version) in any way you find useful,
        '  provided that you agree that both PowerBASIC and Microsoft have no
        '  warranty, obligation or liability for its contents.
        '
        '  NOTE:  These routines contain minimal error checking.
        '
        '  Last Update: 27 Nov 2002
        '
        '==============================================================================
        '------------------------------------------------------------------------------
        %FADF_AUTO             = &H00001  ' Array is allocated on the stack.
        %FADF_STATIC           = &H00002  ' Array is statically allocated.
        %FADF_EMBEDDED         = &H00004  ' Array is embedded in a structure.
        %FADF_FIXEDSIZE        = &H00010  ' Array may not be resized or reallocated.
        %FADF_RECORD           = &H00020  ' Array containing records.
        %FADF_HAVEIID          = &H00040  ' Array with IID identifying interface.
        %FADF_HAVEVARTYPE      = &H00080  ' Array with VT type.
        %FADF_BSTR             = &H00100  ' An array of BSTRs.
        %FADF_UNKNOWN          = &H00200  ' An array of IUnknown*.
        %FADF_DISPATCH         = &H00400  ' An array of IDispatch*.
        %FADF_VARIANT          = &H00800  ' An array of VARIANTs.
        %FADF_RESERVED         = &H0F0E8  ' Bits reserved for future use.
        %NULL                  = 0
        '------------------------------------------------------------------------------
        TYPE SAFEARRAYBOUND
          cElements AS DWORD             ' number of elements
          cLbound AS LONG                ' LBound of first element
        END TYPE
        TYPE SAFEARRAY
          cDims AS WORD                  ' Count of dimensions in this array.
          fFeatures AS WORD              ' Flags used by the SafeArray
          cbElements AS LONG             ' Size of an element of the array;
                                         ' Does not include size of pointed-to data.
          cLocks AS DWORD                ' Number of times the array has been
                                         ' locked without corresponding unlock.
          pvData AS DWORD                ' Pointer to the data.
          rgsabound(3) AS SAFEARRAYBOUND ' One bound for each dimension.
        END TYPE
        '------------------------------------------------------------------------------
        DECLARE FUNCTION SafeArrayGetDim     LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetDim"     (BYVAL psa AS DWORD) AS DWORD
        DECLARE FUNCTION SafeArrayGetElement LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetElement" (BYVAL psa AS DWORD, rgIndices AS LONG, pData AS ANY) AS LONG
        DECLARE FUNCTION SafeArrayGetLBound  LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetLBound"  (BYVAL psa AS DWORD, BYVAL nDim AS WORD, lbDim AS LONG) AS LONG
        DECLARE FUNCTION SafeArrayGetUBound  LIB "OLEAUT32.DLL" ALIAS "SafeArrayGetUBound"  (BYVAL psa AS DWORD, BYVAL nDim AS WORD, ubDim AS LONG) AS LONG
        DECLARE FUNCTION SafeArrayRedim      LIB "OLEAUT32.DLL" ALIAS "SafeArrayRedim"      (BYVAL psa AS DWORD, BoundNew AS SAFEARRAYBOUND) AS LONG
        DECLARE FUNCTION SafeArrayUnlock     LIB "OLEAUT32.DLL" ALIAS "SafeArrayUnlock"     (BYVAL psa AS DWORD) AS LONG
        DECLARE FUNCTION SafeArrayLock       LIB "OLEAUT32.DLL" ALIAS "SafeArrayLock"       (BYVAL psa AS DWORD) AS LONG
        DECLARE FUNCTION MultiByteToWideChar LIB "KERNEL32.DLL" ALIAS "MultiByteToWideChar" (BYVAL CodePage AS DWORD, BYVAL dwFlags AS DWORD, lpMultiByteStr AS ASCIIZ, BYVAL cchMultiByte AS LONG, lpWideCharStr AS DWORD, BYVAL cchWideChar AS LONG) AS LONG
        DECLARE FUNCTION WideCharToMultiByte LIB "KERNEL32.DLL" ALIAS "WideCharToMultiByte" (BYVAL CodePage AS DWORD, BYVAL dwFlags AS DWORD, lpWideCharStr AS ANY, BYVAL cchWideChar AS LONG, lpMultiByteStr AS ANY, BYVAL cchMultiByte AS LONG, _
                         lpDefaultChar AS ASCIIZ, lpUsedDefaultChar AS LONG) AS LONG
        
        '------------------------------------------------------------------------------
        ' vbArrayRedim - Redimension the upper bound of a single dimension VB array.
        '                The array will retain any existing data.
        '
        FUNCTION vbArrayRedim(BYVAL psa AS DWORD, BYVAL Elems AS LONG) AS LONG
          LOCAL Result AS LONG
          LOCAL b      AS SAFEARRAYBOUND
          ' Must be a single dimension array.
          IF SafeArrayGetDim(psa) <> 1 THEN
            EXIT FUNCTION
          END IF
          ' Get the LBOUND of the array.
          SafeArrayGetlBound psa, 1, b.cLbound
          ' Resize it.
          b.cElements = Elems
          ' Redimension the array to the new size.
          Result = SafeArrayRedim(psa, b)
          ' Return TRUE for success, or FALSE for failure.
          FUNCTION = (Result = 0)
        END FUNCTION
        '------------------------------------------------------------------------------
        ' vbArrayLBound - Return the LBOUND of a Visual Basic array
        '
        FUNCTION vbArrayLBound(BYVAL psa AS DWORD, BYVAL nDim AS INTEGER) AS LONG
          LOCAL bound AS LONG
          SafeArrayGetlBound psa, nDim, bound
          FUNCTION = bound
        END FUNCTION
        '------------------------------------------------------------------------------
        ' vbArrayUBound - Return the UBOUND of a Visual Basic array
        '
        FUNCTION vbArrayUBound(BYVAL psa AS DWORD, BYVAL nDim AS INTEGER) AS LONG
          LOCAL bound AS LONG
          SafeArrayGetUBound psa, nDim, bound
          FUNCTION = bound
        END FUNCTION
        '------------------------------------------------------------------------------
        ' vbArrayFirstElem - Return the address of the first element in a VB array.
        '
        FUNCTION vbArrayFirstElem(BYVAL psa AS DWORD) AS DWORD
          LOCAL sa AS SAFEARRAY PTR
          sa = psa
          FUNCTION = @sa.pvData
        END FUNCTION
        '------------------------------------------------------------------------------
        ' VbStringToPb - Convert a Visual Basic string handle to PowerBASIC
        '
        ' Note:  This is included only for compatibility with 16-bit PB/DLL.
        '        PowerBASIC and Visual Basic strings are compatible in 32-bit.
        '
        FUNCTION VbStringToPb(BYVAL hndle AS DWORD) AS STRING
          LOCAL Temp AS STRING
          ! mov EAX, hndle         ; get handle off the stack
          ! mov Temp, EAX          ; put it in a PowerBASIC string
          FUNCTION = Temp
        END FUNCTION
        '------------------------------------------------------------------------------
        ' PbStringToVb - Convert a PowerBASIC string to a Visual Basic String handle
        '
        ' Note:  This is included only for compatibility with 16-bit PB/DLL.
        '        PowerBASIC and Visual Basic strings are compatible in 32-bit.
        '
        FUNCTION PbStringToVb(BYVAL s AS STRING) AS DWORD
          LOCAL Temp AS DWORD
          ! mov EAX, s              ; get the string handle from the stack
          ! mov Temp, EAX           ; put it in a temporary variable
          ! mov Dword s, 0          ; don't let it get erased
          FUNCTION = Temp
        END FUNCTION
        '------------------------------------------------------------------------------
        ' Convert a dynamic string from ASCII/ANSI to Unicode
        '
        ' Note:  When VB passes a dynamic string to a DLL, it automatically converts
        '        the string from Unicode to ANSI.  However, strings inside of
        '        user-defined types are not converted by VB.
        '
        FUNCTION StrToUnicode(BYVAL x AS STRING) AS STRING
          LOCAL Buffer AS STRING
          Buffer = SPACE$(LEN(x) * 2)
          MultiByteToWideChar 0, _                     ' code page
                              %NULL, _                 ' performance and mapping flags
                              BYVAL STRPTR(x), _       ' ANSI string to convert
                              LEN(x), _                ' len of ANSI string
                              BYVAL STRPTR(Buffer), _  ' buffer for Unicode string
                              LEN(Buffer)              ' len of Unicode buffer
          FUNCTION = Buffer & CHR$(0,0)
          ' With PB/CC 3 or PB/Win 7, you can replace all that with this:
          '
          ' FUNCTION = UCODE$(x) + $NUL + $NUL
        END FUNCTION
        '------------------------------------------------------------------------------
        ' Convert a unicode buffer to an ANSI string
        '
        FUNCTION UnicodeToStr(BYVAL dw AS DWORD, BYVAL length AS LONG) AS STRING
          LOCAL Buffer AS STRING
          Buffer = SPACE$(length \ 2)
          WideCharToMultiByte 0, _                     ' code page
                              %NULL, _                 ' performance and mapping flags
                              BYVAL dw, _              ' Unicode string to convert
                              length, _                ' len of Unicode string
                              BYVAL STRPTR(Buffer), _  ' buffer for ANSI string
                              LEN(Buffer), _           ' len of ANSI buffer
                              BYVAL %NULL, _           ' unmappable chars buffer
                              BYVAL %NULL              ' unmappable chars flag
          FUNCTION = Buffer
          ' With PB/CC 3 or PB/Win 7, you can replace all that with this:
          '
          ' FUNCTION = RTRIM$(ACODE$(PEEK$(dw,length)), $NUL)
        END FUNCTION
        '------------------------------------------------------------------------------
        ' vb2DArrayRedim - Redimension the upper bound of a dual-dimension VB array.
        '                The array will retain any existing data.
        '
        FUNCTION vb2DArrayRedim(BYVAL psa AS DWORD, BYVAL Elems AS LONG) AS LONG
          LOCAL Result AS LONG
          LOCAL b      AS SAFEARRAYBOUND
          ' Must be a dual-dimension array.
          IF SafeArrayGetDim(psa) <> 2 THEN
            EXIT FUNCTION
          END IF
          ' Get the LBOUND of the array.
          SafeArrayGetlBound psa, 2, b.cLbound
          ' Resize it.
          b.cElements = Elems
          ' Redimension the array to the new size.
          Result = SafeArrayRedim(psa, b)
          ' Return TRUE for success, or FALSE for failure.
          FUNCTION = Result'(Result = 0)
        END FUNCTION
        How long is an idea? Write it down.

        Comment


        • #5
          Thanks, Mike, for the info.
          As usual, I learned something new.

          Regards,
          Bob

          Comment


          • #6
            Robert, those are the examples that come along with your compiler. Have a look at the SAMPLES folder.

            Comment


            • #7
              If you are still having trouble making this work, you should probably post your Visual Basic DECLARE and the relevant code lines for the call to your PB-written function.

              I'm not one of them but there are plenty of VB refugees here who can help.
              Michael Mattias
              Tal Systems Inc. (retired)
              Racine WI USA
              [email protected]
              http://www.talsystems.com

              Comment


              • #8
                Michael he actually did post the VB declare!
                Robert
                Been a long while since I have done it and you will find a number of quite old comments in the faq forum but as I remember in your VB declare you need to
                Declare Sub SORTSTRING Lib "my.dll" (byval A$())
                This causes VB to convert the array from unicode to ansi and then pass the array, not actually byval it is a VB fudge
                John

                Comment


                • #9
                  You can't pass an array ByVal in VB. And the VB ByVal magic doesn't convert unicode strings to ANSI, but to ASCIIZ.

                  The PB example, along with its declaration given in the accompanying txt file does work, I use it on regular basis from within my VB apps.

                  I guess Robert needs to be a bit more explicit on the "does not work" part. Any error messages?

                  And just to make sure: We're speaking of VB(A) here, not VB.NET, right?

                  Could you post your VB code that calls the sorting routine?
                  Last edited by Knuth Konrad; 14 Dec 2007, 03:50 AM.

                  Comment

                  Working...
                  X