Announcement

**Robert DeBolt** · 12 Dec 2007, 08:02 PM

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

**Mike Doty** · 12 Dec 2007, 08:21 PM

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

**Mike Doty** · 12 Dec 2007, 08:21 PM

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

**Robert DeBolt** · 12 Dec 2007, 11:04 PM

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

**Knuth Konrad** · 13 Dec 2007, 04:14 AM

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

**Michael Mattias** · 13 Dec 2007, 08:52 AM

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.

**John Petty** · 13 Dec 2007, 10:25 AM

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

**Knuth Konrad** · 14 Dec 2007, 03:46 AM

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?

Announcement

Sort string array in VB from PB DLL

Sort string array in VB from PB DLL

Comment

Comment

Comment

Comment

Comment

Comment

Comment

Comment