Please help with passing arrays

[Jim Dunn]

Hey all... I rewrote the "passing.bas" (which I'm able to compile) from the examples\manual\proguide\arrays folder, but I'm getting errors.

Would anyone be willing to tell me what I'm doing wrong?

Code Select Expand

' FreeBasic
' =============================================================================
#Define UNICODE
#Define _WIN32_WINNT &h0602
#Include Once "windows.bi"
#Include Once "file.bi"
#Include Once "vbcompat.bi"
#Include Once "win\shobjidl.bi"
#Include Once "win\TlHelp32.bi"
#Include Once "crt\string.bi"
#Include Once "win\Shlobj.bi"
'#Include Once "Afx\CWindow.inc"
'#Include Once "Afx\AfxFile.inc"
'#Include Once "Afx\AfxStr.inc"
'#Include Once "Afx\AfxTime.inc"
'#Include Once "Afx\AfxGdiplus.inc"
'#Include Once "Afx\AfxMenu.inc"
'#Include Once "Afx\AfxCom.inc"
'#Include Once "Afx\CXpButton.inc"
'#Include Once "Afx\CMaskedEdit.inc"
'#Include Once "Afx\CImageCtx.inc"
'#Include Once "Afx\CAxHost\CWebCtx.inc"
'#Include Once "Afx\CWinHttpRequest.inc"
'Using Afx
' =============================================================================
ReDim Shared rgwszPaths(0) AS WSTRING * MAX_PATH
Dim Shared rgwszPathsTot As Long
' =============================================================================
function repl(byref replSource As String, replTheWhat As String, replTheNew As String, replCount As Long = 9999 ) as string
    Dim As String replDestination = replSource ' must be above the x=instr
    Dim As Long x = Instr(replDestination, replTheWhat) ' must be below dest=src
    Dim As Long y, nWhatLen, nNewLen, lineCounter
    nWhatLen = len(replTheWhat)
    nNewLen = len(replTheNew)
    lineCounter = 0
    do while x
        y = x + nWhatLen
        if y > len(replDestination) then
            replDestination = Left(replDestination, x-1) + replTheNew
        else
            replDestination = Left(replDestination, x-1) + replTheNew + Mid(replDestination, y)
        end if
        lineCounter += 1
        if lineCounter >= replCount then
            exit do
        end if
        x = Instr(x+nNewLen,replDestination, replTheWhat)
    loop
    return replDestination
End Function
' =============================================================================
Function splitString(ByVal source As WString, destination(Any) As WString, ByVal delimiter As WString) as Long
    Do
        Dim As Integer position = InStr(1, source, delimiter)
        ReDim Preserve destination(UBound(destination) + 1)
        If position = 0 Then
            destination(UBound(destination)) = source
            Exit Do
        End If
        destination(UBound(destination)) = Left(source, position - 1)
        source = Mid(source, position + Len(delimiter))
    Loop
    Return UBound(destination)
End Function
' =============================================================================
Function ListFiles(wszFolder as WString) as Long
    Dim hSearch as HANDLE
    Dim WFD AS WIN32_FIND_DATAW

    Dim wszPath AS WSTRING * MAX_PATH
    Dim wszCurPath AS WSTRING * MAX_PATH
    Dim wszFullPath AS WSTRING * MAX_PATH * 2

    if right(wszFolder,1) <> "\" then
        wszFolder += "\"
    end if
    wszPath = wszFolder
    wszCurPath = wszPath + "*.*"

    ' Find the files ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    hSearch = FindFirstFile(wszCurPath, @WFD)
    IF hSearch <> INVALID_HANDLE_VALUE THEN
        DO
            IF (WFD.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY THEN
                ' found a folder
            ELSE
                wszFullPath = wszPath & WFD.cFileName
                ' Store the full path in the array
                rgwszPathsTot += 1
                ReDim Preserve rgwszPaths(rgwszPathsTot) AS WSTRING * MAX_PATH
                rgwszPaths(rgwszPathsTot) = wszFullPath ' zero-based array
            END IF
        LOOP WHILE FindNextFile(hSearch, @WFD)
        FindClose(hSearch)
    END IF
    Return rgwszPathsTot
End Function
' =============================================================================
Function WinMain( _
    ByVal hInstance     As HINSTANCE, _
    ByVal hPrevInstance As HINSTANCE, _
    ByVal szCmdLine     As ZString Ptr, _
    ByVal nCmdShow      As Long _
    ) As Long

    Dim wszFolder AS WSTRING * MAX_PATH
    Dim sArray(Any) As WString * MAX_PATH
    Dim As Long x, y, lineCount, splitCount

    rgwszPathsTot = 0

    wszFolder = "c:\download"
    lineCount = ListFiles(wszFolder)

    for x = 1 to lineCount
        ? rgwszPaths(x)
        splitCount = splitString( rgwszPaths(x), sArray(), " - " )
        if splitCount then
            for y = 1 to splitCount
                ? sArray(y)
            next y
        end if
    next x

    Return 0
End Function
' =============================================================================
End WinMain( GetModuleHandle(Null), Null, Command(), SW_NORMAL )
' =============================================================================

[Johan Klassen]

hello Jim
with some minor changes it compiles without complaint

Code Select Expand


type ws as WSTRING * MAX_PATH

ReDim Shared rgwszPaths(0) AS ws 'WSTRING * MAX_PATH

changed the Function splitString a bit

Code Select Expand


Function splitString(Byref source As ws, destination(Any) As ws, ByVal delimiter As String) as Long


[Jim Dunn]

Johan, thank you *SO SO MUCH*... I would've never figured out that.

Much appreciated!!!

[Johan Klassen]

I am not sure that the splitString declaration is correct, this will also compile
Function splitString(Byref source As ws, destination(Any) As ws, Byref delimiter As ws) as Long

[Johan Klassen]

@Jim
even though it compiles without complaint, I don't think it will work
as a test I modified "passing.bas" in a similar way and it compiles just fine but the output is not what's expected

Code Select Expand


'' examples/manual/proguide/arrays/passing.bas
''
'' NOTICE: This file is part of the FreeBASIC Compiler package and can't
''         be included in other distributions without authorization.
''
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=ProPgPassingArrays
'' --------
#Define UNICODE
#Define _WIN32_WINNT &h0602

type ws as WSTRING * 256

Declare Sub splitString(Byref As ws, (Any) As ws, ByVal As Ushort = Asc(wstr(",")))


Dim As ws s = "Programmer's Guide/Variables and Datatypes/Arrays/Passing Arrays to Procedures"
Dim As ws array(Any)

splitString(s, array(), Asc(wstr("/")))

Print "STRING TO SPLIT:"
Print s
Print
Print "RESULT ARRAY FROM SPLITTING:"
For i As Integer = LBound(array) To UBound(array)
Print i, array(i)
Next i

Sleep


Sub splitString(Byref source As ws, destination(Any) As ws, ByVal delimitor As Ushort)
Do
Dim As Integer position = InStr(1, source, Chr(delimitor))
ReDim Preserve destination(UBound(destination) + 1)
If position = 0 Then
destination(UBound(destination)) = source
Exit Do
End If
destination(UBound(destination)) = Left(source, position - 1)
source = Mid(source, position + 1)
Loop
End Sub


[Johan Klassen]

however this works

Code Select Expand


'' examples/manual/proguide/arrays/passing.bas
''
'' NOTICE: This file is part of the FreeBASIC Compiler package and can't
''         be included in other distributions without authorization.
''
'' See Also: https://www.freebasic.net/wiki/wikka.php?wakka=ProPgPassingArrays
'' --------
#Define UNICODE
#Define _WIN32_WINNT &h0602
#Include Once "Afx\CWstr.inc"

Declare Sub splitString(Byref As CWSTR, (Any) As CWSTR, ByVal As Ubyte = Asc(","))


Dim As CWSTR s = "Programmer's Guide/Variables and Datatypes/Arrays/Passing Arrays to Procedures"
Dim As CWSTR array(Any)

splitString(s, array(), Asc("/"))

Print "STRING TO SPLIT:"
Print s
Print
Print "RESULT ARRAY FROM SPLITTING:"
For i As Integer = LBound(array) To UBound(array)
Print i, array(i)
Next i

Sleep


Sub splitString(Byref source As CWSTR, destination(Any) As CWSTR, ByVal delimitor As Ubyte)
Do
Dim As Integer position = InStr(1, source, Chr(delimitor))
ReDim Preserve destination(UBound(destination) + 1)
If position = 0 Then
destination(UBound(destination)) = source
Exit Do
End If
destination(UBound(destination)) = Left(source, position - 1)
source = Mid(source, position + 1)
Loop
End Sub


[Johan Klassen]

your example using CWSTR

Code Select Expand


'#define Unicode
'#define _WIN32_WINNT &h0602
'#include "crt.bi"

' FreeBasic
' =============================================================================
#Define UNICODE
#Define _WIN32_WINNT &h0602
#Include Once "windows.bi"
#Include Once "file.bi"
#Include Once "vbcompat.bi"
#Include Once "win\shobjidl.bi"
#Include Once "win\TlHelp32.bi"
#Include Once "crt\string.bi"
#Include Once "win\Shlobj.bi"

#Include Once "Afx\CWstr.inc"

'#Include Once "Afx\CWindow.inc"
'#Include Once "Afx\AfxFile.inc"
'#Include Once "Afx\AfxStr.inc"
'#Include Once "Afx\AfxTime.inc"
'#Include Once "Afx\AfxGdiplus.inc"
'#Include Once "Afx\AfxMenu.inc"
'#Include Once "Afx\AfxCom.inc"
'#Include Once "Afx\CXpButton.inc"
'#Include Once "Afx\CMaskedEdit.inc"
'#Include Once "Afx\CImageCtx.inc"
'#Include Once "Afx\CAxHost\CWebCtx.inc"
'#Include Once "Afx\CWinHttpRequest.inc"
'Using Afx
' =============================================================================

ReDim Shared rgwszPaths(0) AS CWSTR
Dim Shared rgwszPathsTot As Long
' =============================================================================
function repl(byref replSource As String, replTheWhat As String, replTheNew As String, replCount As Long = 9999 ) as string
    Dim As String replDestination = replSource ' must be above the x=instr
    Dim As Long x = Instr(replDestination, replTheWhat) ' must be below dest=src
    Dim As Long y, nWhatLen, nNewLen, lineCounter
    nWhatLen = len(replTheWhat)
    nNewLen = len(replTheNew)
    lineCounter = 0
    do while x
        y = x + nWhatLen
        if y > len(replDestination) then
            replDestination = Left(replDestination, x-1) + replTheNew
        else
            replDestination = Left(replDestination, x-1) + replTheNew + Mid(replDestination, y)
        end if
        lineCounter += 1
        if lineCounter >= replCount then
            exit do
        end if
        x = Instr(x+nNewLen,replDestination, replTheWhat)
    loop
    return replDestination
End Function
' =============================================================================
Function splitString(Byref source As CWSTR, destination(Any) As CWSTR, Byref delimiter As CWSTR) as Long
    Do
        Dim As Integer position = InStr(1, source, delimiter)
        ReDim Preserve destination(UBound(destination) + 1)
        If position = 0 Then
            destination(UBound(destination)) = source
            Exit Do
        End If
        destination(UBound(destination)) = Left(source, position - 1)
        source = Mid(source, position + Len(delimiter))
    Loop
    Return UBound(destination)
End Function
' =============================================================================
Function ListFiles(wszFolder as WString) as Long
    Dim hSearch as HANDLE
    Dim WFD AS WIN32_FIND_DATAW

    Dim wszPath AS WSTRING * MAX_PATH
    Dim wszCurPath AS WSTRING * MAX_PATH
    Dim wszFullPath AS WSTRING * MAX_PATH * 2

    if right(wszFolder,1) <> "\" then
        wszFolder += "\"
    end if
    wszPath = wszFolder
    wszCurPath = wszPath + "*.*"

    ' Find the files ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    hSearch = FindFirstFile(wszCurPath, @WFD)
    IF hSearch <> INVALID_HANDLE_VALUE THEN
        DO
            IF (WFD.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY THEN
                ' found a folder
            ELSE
                wszFullPath = wszPath & WFD.cFileName
                ' Store the full path in the array
                rgwszPathsTot += 1
                ReDim Preserve rgwszPaths(rgwszPathsTot) AS WSTRING * MAX_PATH
                rgwszPaths(rgwszPathsTot) = wszFullPath ' zero-based array
            END IF
        LOOP WHILE FindNextFile(hSearch, @WFD)
        FindClose(hSearch)
    END IF
    Return rgwszPathsTot
End Function
' =============================================================================
Function WinMain( _
    ByVal hInstance     As HINSTANCE, _
    ByVal hPrevInstance As HINSTANCE, _
    ByVal szCmdLine     As ZString Ptr, _
    ByVal nCmdShow      As Long _
    ) As Long

    Dim wszFolder AS CWSTR 'WSTRING * MAX_PATH
    Dim sArray(Any) As CWSTR 'WString * MAX_PATH
    Dim As Long x, y, lineCount, splitCount

    rgwszPathsTot = 0

    wszFolder = "c:\download"
    lineCount = ListFiles(wszFolder)

    for x = 1 to lineCount
        ? rgwszPaths(x)
        splitCount = splitString( rgwszPaths(x), sArray(), " - " )
        if splitCount then
            for y = 1 to splitCount
                ? sArray(y)
            next y
        end if
    next x

    Return 0
End Function
' =============================================================================
End WinMain( GetModuleHandle(Null), Null, Command(), SW_NORMAL )
' =============================================================================


[Jim Dunn]

Johan, amazing!  You've saved me COUNTLESS hours... thank you so much!!!

And I'm not surprised CWSTR saved me... that Jose Roca... he's a smart one!!  : )

Thank you again for your kindness... and to Paul for running this site!

[José Roca]

WinFBX offers a simpler way with additional advantages: No need for globals, unicode aware and you can use several delimiters.

See: https://github.com/JoseRoca/WinFBX/blob/master/docs/String%20Management/String%20Procedures.md#AfxStrSplit

Johan's example:

Code Select Expand


'#CONSOLE ON
#INCLUDE ONCE "Afx/CSafeArray.inc"
USING Afx

Dim As CWSTR s = "Programmer's Guide/Variables and Datatypes/Arrays/Passing Arrays to Procedures"

' It also works with ansi strings:
' Dim As STRING s = "Programmer's Guide/Variables and Datatypes/Arrays/Passing Arrays to Procedures"

DIM csa AS CSafeArray = AfxStrSplit(s, "/")
FOR i AS LONG = csa.LBound TO csa.UBound
   print csa.GetStr(i)
NEXT

SLEEP


There are also many other string functions.

[Jim Dunn]

Ok, that does work as advertised, but when I try to "split" using " / " it fails:

Code Select Expand

'#CONSOLE ON
#INCLUDE ONCE "Afx/CSafeArray.inc"
USING Afx

Dim As CWSTR s = "Programmer's Guide / Variables and Datatypes / Arrays / Passing Arrays to Procedures"
' Dim As STRING s = "Programmer's Guide/Variables and Datatypes/Arrays/Passing Arrays to Procedures"

DIM csa AS CSafeArray = AfxStrSplit(s, " / ")

FOR i AS LONG = csa.LBound TO csa.UBound
   print csa.GetStr(i)
NEXT

SLEEP

Apparently the AfxStrSplit doesn't like it when the split is longer than 1 character, so it splits everything instead...

[José Roca]

In this particular case, you can do:

Code Select Expand


'#CONSOLE ON
#INCLUDE ONCE "Afx/CSafeArray.inc"
USING Afx

Dim As STRING s = "Programmer's Guide / Variables and Datatypes / Arrays / Passing Arrays to Procedures"
DIM csa AS CSafeArray = AfxStrSplit(s, "/")
FOR i AS LONG = csa.LBound TO csa.UBound
   print TRIM(csa.GetStr(i))
NEXT

SLEEP


[Jim Dunn]

I don't normally post code... but in the spirit of gratitude and being willing to take some criticism... here's a complete working copy of my script.

Thanks again to Johan and Jose for turning me on to CWSTR... I love it!  : )

Code Select Expand

' FreeBasic
' This program will search multiple folders for filenames with duplicate KEYS
' KEYS are defined as filenames containing a substring of "- AAAAA 99999 -"
' KEYS can be any length; WORDS must be a pair; first alpha; second numeric
' FILENAMES with "Part 9" must be parsed to not allow false duplicate warnings
' FILENAMES ending with ".tmp" must be ignored

#Define UNICODE
#Define _WIN32_WINNT &h0602
#Include Once "Afx\CWindow.inc"
ReDim Shared rgwszPaths(Any) AS CWSTR

' =============================================================================
Function Tally(HayStack As CWSTR, Needle As CWSTR) As Long
    Dim As Long LenP = Len(Needle), count
    Dim As Long position = Instr(HayStack, Needle)
    If position = 0 Then Return 0
    While position
        count += 1
        position = Instr(position+LenP, HayStack, Needle)
    Wend
    Return count
End Function

' =============================================================================
Function splitString(ByRef source As CWSTR, destination(Any) As CWSTR, ByRef delimiter As CWSTR) as Long
    Dim As Integer position = InStr(1, source, delimiter)
    Do While position
        ReDim Preserve destination(UBound(destination) + 1)
        if position > 1 then
            destination(UBound(destination)) = Left(source, position - 1)
        end if
        source = Mid(source, position + Len(delimiter))
        position = InStr(1, source, delimiter)
    Loop
    if Len(source) then
        ReDim Preserve destination(UBound(destination) + 1)
        destination(UBound(destination)) = source
    end if
    Return UBound(destination)
End Function

' =============================================================================
Function ListFiles(wszFolder as CWSTR) as Long
    Dim hSearch as HANDLE
    Dim WFD AS WIN32_FIND_DATAW

    Dim wszPath AS CWSTR
    Dim wszCurPath AS CWSTR
    Dim wszFullPath AS CWSTR

    wszPath = wszFolder
    if right(wszPath,1) <> "\" then
        wszPath += "\"
    end if
    wszCurPath = wszPath + "*.*"

    ' Find the files ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    hSearch = FindFirstFile(wszCurPath, @WFD)
    IF hSearch <> INVALID_HANDLE_VALUE THEN
        DO
            IF (WFD.dwFileAttributes AND FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY THEN
                ' found a folder
            ELSE
                wszFullPath = wszPath & WFD.cFileName
                ' Store the full path in the array
                ReDim Preserve rgwszPaths(UBound(rgwszPaths) + 1) AS CWSTR ' zero-based array
                rgwszPaths(UBound(rgwszPaths)) = wszFullPath ' zero-based array
            END IF
        LOOP WHILE FindNextFile(hSearch, @WFD)
        FindClose(hSearch)
    END IF
    Return UBound(rgwszPaths)
End Function

' =============================================================================
Function WinMain( _
    ByVal hInstance     As HINSTANCE, _
    ByVal hPrevInstance As HINSTANCE, _
    ByVal szCmdLine     As ZString Ptr, _
    ByVal nCmdShow      As Long _
    ) As Long

    Dim As CWSTR wszFolder, sArray(Any)
    Dim As Long x, y, z, lineCount, splitCount, jFlag
    ReDim As String dArray(0)
    Dim As String jFlagString, jTemp

    wszFolder = "c:\KeyFolder01" : lineCount = ListFiles(wszFolder)
    wszFolder = "d:\KeyFolder02" : lineCount = ListFiles(wszFolder)
    wszFolder = "t:\KeyFolder03" : lineCount = ListFiles(wszFolder)

    for x = 0 to UBound(rgwszPaths)
        jTemp = rgwszPaths(x)
        Erase sArray
        jFlag = 0
        if InStr(rgwszPaths(x),"Part 1") then jFlag = 1 : jFlagString = "Part 1"
        if InStr(rgwszPaths(x),"Part 2") then jFlag = 1 : jFlagString = "Part 2"
        if InStr(rgwszPaths(x),"Part 3") then jFlag = 1 : jFlagString = "Part 3"
        if InStr(rgwszPaths(x),"Part 4") then jFlag = 1 : jFlagString = "Part 4"
        if InStr(rgwszPaths(x),"Part 5") then jFlag = 1 : jFlagString = "Part 5"
        if InStr(rgwszPaths(x),"Part 6") then jFlag = 1 : jFlagString = "Part 6"
        if InStr(rgwszPaths(x),"Part 7") then jFlag = 1 : jFlagString = "Part 7"
        if InStr(rgwszPaths(x),"Part 8") then jFlag = 1 : jFlagString = "Part 8"
        if InStr(rgwszPaths(x),"Part 9") then jFlag = 1 : jFlagString = "Part 9"
        if InStr(rgwszPaths(x),".tmp"  ) then jFlag = 2
        splitCount = splitString(rgwszPaths(x), sArray(), " - ")
        if splitCount and jFlag <> 2 then
            for y = 0 to UBound(sArray)
                if Tally(sArray(y)," ") = 1 then
                    z = InStr(sArray(y)," ")
                    if AfxIsNumeric(left(sArray(y),z-1)) = FALSE and AfxIsNumeric(mid(sArray(y),z+1)) = TRUE then
                        if left(sArray(y),z-1) <> "Part" then
                            ReDim Preserve dArray(UBound(dArray) + 1)
                            dArray(UBound(dArray)) = left(sArray(y),z-1) + " " + mid(sArray(y),z+1)
                            if jFlag = 1 then
                                dArray(UBound(dArray)) = dArray(UBound(dArray)) + " " + jFlagString
                            end if
                        end if
                    end if
                end if
            next y
        end if
    next x

    for x = 0 to UBound(dArray)-1
        jFlag = 0
        if len(dArray(x)) then
            for y = x+1 to UBound(dArray)
                if dArray(x) = dArray(y) then
                    jFlag = 1
                    dArray(y) = ""
                end if
            next y
            if jFlag then
                print "Duplicate Found: "; dArray(x)
            end if
        end if
    next x

    Return 0
End Function
' =============================================================================
End WinMain(GetModuleHandle(Null), Null, Command(), SW_NORMAL)
' =============================================================================