Please login or register.
1 Hour 1 Day 1 Week 1 Month Forever
Login with username, password and session length

I think it was revealed some time ago that 10.04 and 6.04 updates have been lost.

Hey all, another quick question (I hope).

I noticed at the PowerBASIC site, they are selling version 10.03 of PBWin and 6.03 of PBcc... but I see my downloads directory has 10.04 and 6.04 updates (from years ago).

Did they make some announcement about the .04's being bad/buggy/something???

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!

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


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


@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


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, thank you *SO SO MUCH*... I would've never figured out that.

Much appreciated!!!

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


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