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?
' 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 )
' =============================================================================
hello Jim
with some minor changes it compiles without complaint
type ws as WSTRING * MAX_PATH
ReDim Shared rgwszPaths(0) AS ws 'WSTRING * MAX_PATH
changed the Function splitString a bit
Function splitString(Byref source As ws, destination(Any) As ws, ByVal delimiter As String) as Long
Johan, thank you *SO SO MUCH*... I would've never figured out that.
Much appreciated!!!
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
@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
'' 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
however this works
'' 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
your example using CWSTR
'#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 )
' =============================================================================
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!
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:
'#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.
Ok, that does work as advertised, but when I try to "split" using " / " it fails:
'#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...
In this particular case, you can do:
'#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
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! : )
' 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)
' =============================================================================