PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  

Author Topic: Please help with passing arrays  (Read 367 times)

Jim Dunn

  • Junior Member
  • **
  • Posts: 118
  • Jim Dunn
Please help with passing arrays
« on: February 26, 2021, 09:10:28 AM »

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]
' 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 )
' =============================================================================
Logged
3.14159265358979323846264338327950
"Ok, yes... I like pie... um, I meant, pi."

Johan Klassen

  • Junior Member
  • **
  • Posts: 112
  • FF3 User
Re: Please help with passing arrays
« Reply #1 on: February 26, 2021, 06:50:56 PM »

hello Jim
with some minor changes it compiles without complaint

Code: [Select]
type ws as WSTRING * MAX_PATH

ReDim Shared rgwszPaths(0) AS ws 'WSTRING * MAX_PATH
changed the Function splitString a bit
Code: [Select]
Function splitString(Byref source As ws, destination(Any) As ws, ByVal delimiter As String) as Long
Logged

Jim Dunn

  • Junior Member
  • **
  • Posts: 118
  • Jim Dunn
Re: Please help with passing arrays
« Reply #2 on: February 26, 2021, 06:58:08 PM »

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

Much appreciated!!!
Logged
3.14159265358979323846264338327950
"Ok, yes... I like pie... um, I meant, pi."

Johan Klassen

  • Junior Member
  • **
  • Posts: 112
  • FF3 User
Re: Please help with passing arrays
« Reply #3 on: February 26, 2021, 07:05:29 PM »

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
Logged

Johan Klassen

  • Junior Member
  • **
  • Posts: 112
  • FF3 User
Re: Please help with passing arrays
« Reply #4 on: February 26, 2021, 07:16:26 PM »

@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]
'' 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
Logged

Johan Klassen

  • Junior Member
  • **
  • Posts: 112
  • FF3 User
Re: Please help with passing arrays
« Reply #5 on: February 26, 2021, 07:27:01 PM »

however this works
Code: [Select]
'' 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
Logged

Johan Klassen

  • Junior Member
  • **
  • Posts: 112
  • FF3 User
Re: Please help with passing arrays
« Reply #6 on: February 26, 2021, 07:30:54 PM »

your example using CWSTR
Code: [Select]
'#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 )
' =============================================================================
Logged

Jim Dunn

  • Junior Member
  • **
  • Posts: 118
  • Jim Dunn
Re: Please help with passing arrays
« Reply #7 on: February 26, 2021, 08:47:24 PM »

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!
Logged
3.14159265358979323846264338327950
"Ok, yes... I like pie... um, I meant, pi."

Josť Roca

  • Guru Member
  • *****
  • Posts: 3325
Re: Please help with passing arrays
« Reply #8 on: February 26, 2021, 09:40:23 PM »

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]
'#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.
« Last Edit: February 26, 2021, 09:50:02 PM by Josť Roca »
Logged

Jim Dunn

  • Junior Member
  • **
  • Posts: 118
  • Jim Dunn
Re: Please help with passing arrays
« Reply #9 on: February 28, 2021, 09:56:57 PM »

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

Code: [Select]
'#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...
« Last Edit: February 28, 2021, 10:09:21 PM by Jim Dunn »
Logged
3.14159265358979323846264338327950
"Ok, yes... I like pie... um, I meant, pi."

Josť Roca

  • Guru Member
  • *****
  • Posts: 3325
Re: Please help with passing arrays
« Reply #10 on: February 28, 2021, 10:27:42 PM »

In this particular case, you can do:

Code: [Select]
'#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