Tweet
Code:
'-------------------------------
'###############################
'-------------------------------
' This demo show a way of packing and unpacking ASCIIZ buffer strings.
' One practical use is with single or multiple file selections.
' There are other ways of "getting there". Others can argue the merits.
' The ParseASCIIZ function was modified from an old posting,
' but I can't seem to find the original reference.
' Released to the Public Domain by Ian Cairns. Enjoy.
'-------------------------------
'###############################
'-------------------------------
#COMPILE EXE "ASCIIZ_Packing_Demo.exe"
#DIM ALL
#INCLUDE "WIN32API.INC"
#INCLUDE "COMDLG32.INC"
DECLARE FUNCTION DlgFileOpen(hWnd AS DWORD, Caption AS STRING, szFileSpec AS ASCIIZ, xSize AS LONG, _
shortFile AS STRING, InitialDir AS STRING, szFilter AS ASCIIZ, _
DefaultExt AS STRING, multipleFileFlag AS LONG) AS LONG
DECLARE FUNCTION Asciiz_String_Packer(inString AS STRING, CharItem AS STRING, _
szBuffer AS ASCIIZ, BYVAL xSize AS LONG) AS LONG
DECLARE FUNCTION ParseASCIIZ(szString AS ASCIIZ, itemArray() AS STRING) AS LONG
'-------------------------------
'###############################
'-------------------------------
FUNCTION PBMAIN () AS LONG
LOCAL hWnd AS DWORD, _
Caption AS STRING, _
szFileSpec AS ASCIIZ * 2000, _
shortFile AS STRING, _
InitialDir AS STRING, _
szFilter AS ASCIIZ * 1000, _
DefaultExt AS STRING
LOCAL inString AS STRING, _
charItem AS STRING, _
retVal AS LONG, _
i AS LONG, _
noItems AS LONG
DIM f_Items(1:1) AS LOCAL STRING
'Part One: Select single file
hWnd = %NULL
Caption = "PB Win Test FilePicker: One file"
charItem = "|"
InitialDir = DIR$
DefaultExt = ""
inString = "Basic Files (*.bas,*.bi,*.inc)|*.bas;*.bi;*.inc|"_
+ "Text Files (*.txt, *.csv)|*.txt;*.csv|All files (*.*)|*.*||"
retVal = Asciiz_String_Packer(inString, charItem, szFilter, SIZEOF(szFilter))
IF retVal <> 0 THEN
MSGBOX "Error in Packing String to ASCIIZ filter: " + FORMAT$(retVal), %MB_OK, _
"File Selection Demo."
FUNCTION = 0
EXIT FUNCTION
END IF
retVal = DlgFileOpen(hWnd, Caption, szFileSpec, SIZEOF(szFileSpec), shortFile, _
InitialDir, szFilter, DefaultExt, 0)
IF retVal = 0 THEN
MSGBOX "No file selected", %MB_OK, "Single File Selection Demo."
ELSE
MSGBOX "File selected: " + shortfile + CHR$(13) + "With path: " + szFileSpec, _
%MB_OK, "Single File Selection Demo."
END IF
'Part Two: Select multiple files
LOCAL xList AS STRING
Caption = "PB Win Test FilePicker: Multiple files"
retVal = DlgFileOpen(hWnd, Caption, szFileSpec, SIZEOF(szFileSpec), shortFile, _
InitialDir, szFilter, DefaultExt, 1)
IF retVal = 0 THEN
MSGBOX "No file(s) selected", %MB_OK, "Multiple File Selection Demo."
ELSE
' Extract filenames to the list
noItems = ParseASCIIZ(szFileSpec, f_Items())
' Selecting a single file returns the path in szFileSpec, but not the shortFile name.
IF noItems = 1 THEN ' single file picked!
noItems = 2
REDIM f_Items(0:1)
retVal = INSTR(-1, szFileSpec, "\")
f_Items(0) = LEFT$(szFileSpec, retVal-1)
f_Items(1) = MID$(szFileSpec, retVal+1)
xList = CHR$(13) + f_Items(1)
ELSE
FOR i = 1 TO noItems
xList = xList + CHR$(13) + f_Items(i)
NEXT i
END IF
MSGBOX "You selected " + FORMAT$(noItems-1) + " Files" + _
CHR$(13) + "File path: " + f_Items(0) + _
CHR$(13) + "File list:" + xList, %MB_OK, "Multiple File Selection Demo."
END IF
FUNCTION = 0
END FUNCTION
'-------------------------------
'###############################
'-------------------------------
FUNCTION Asciiz_String_Packer(inString AS STRING, CharItem AS STRING, _
szBuffer AS ASCIIZ, BYVAL xSize AS LONG) AS LONG
' inString contains the information, separated by CharItem strings, which will be replaced
' with CHR$(0)'s
' szBuffer is an ASCIIZ string with sufficient space to hold the information being packed
' xSize is the size of the ASCIIZ buffer, which cannot be determined within the function.
'
' This function allows you to pack Strings inside an ASCIIZ structure
' and gets around the limitation of CHR$(0) terminating ASCIIZ buffer construction using strings.
' Possible Use: Filters used in Open/Save file dialogs.
' returns 0 for success,
' 1 for exceeded length of szBuffer (xSize)
' 2 for CharItem not a single character
' 3 for input string is a NULL string
LOCAL szNdx AS LONG, _
szPTR AS ASCIIZ PTR, _
strNdx AS LONG, _
strLen AS LONG, _
tString AS STRING
strLen = LEN(inString)
IF LEN(inString) < 1 THEN FUNCTION = 3 : EXIT FUNCTION
IF LEN(CharItem) > 1 OR LEN(CharItem) < 1 THEN FUNCTION = 2 : EXIT FUNCTION
IF xSize < 2 THEN FUNCTION = 1 : EXIT FUNCTION
szPTR = VARPTR(szBuffer)
szNdx = 0
strNdx = 1
DO
tString = MID$(inString, strNdx, 1)
INCR strNdx
IF tString = CharItem THEN
tString = CHR$(0)
END IF
@szPTR = tString
INCR szPTR
INCR szNdx
IF szNdx > xSize OR strNdx > strLen THEN EXIT LOOP
IF strNdx > strLen THEN EXIT LOOP
LOOP
FUNCTION = 0
END FUNCTION
'------------------------
'########################
'------------------------
FUNCTION ParseASCIIZ(szString AS ASCIIZ, itemArray() AS STRING) AS LONG
' Parses a multiple ASCIIZ string and writes the strings to the itemArray()
' returns number of items copied.
' individual elements may not exceed 255 characters
LOCAL noItems AS LONG, _
oData AS ASCIIZ * 256, _
iPTR AS ASCIIZ PTR,_
oPTR AS ASCIIZ PTR,_
bPTR AS BYTE PTR
' Step 1: Enumerate the Items
oPTR = VARPTR(oData)
iPTR = VARPTR(szString)
noItems = 0
DO
@oPTR = @iPTR
INCR noItems
bPTR = iPTR + LEN(RTRIM$(oData)) + 1
IF @bPTR = 0 THEN 'End of collection of strings
EXIT LOOP
ELSE
iPTR = bPTR
END IF
LOOP
' Step 2: Extract the data.
REDIM ItemArray(0:noItems)
oPTR = VARPTR(oData)
iPTR = VARPTR(szString)
noItems = 0
DO
@oPTR = @iPTR
itemArray(noItems) = oData
INCR noItems
bPTR = iPTR + LEN(RTRIM$(oData)) + 1
IF @bPTR = 0 THEN 'End of collection of strings
EXIT LOOP
ELSE
iPTR = bPTR
END IF
LOOP
FUNCTION = noItems
END FUNCTION
'------------------------
'########################
'------------------------
FUNCTION DlgFileOpen(hWnd AS DWORD, Caption AS STRING, szFileSpec AS ASCIIZ, xSize AS LONG, _
shortFile AS STRING, _
InitialDir AS STRING, szFilter AS ASCIIZ, DefaultExt AS STRING, _
multipleFileFlag AS LONG) AS LONG
' If multipleFileFlag = 1 then allow multiple file selection, otherwise not.
LOCAL ofn AS OPENFILENAME, _
szFileTitle AS ASCIIZ * 256, _
szInitialDir AS ASCIIZ * 256, _
szTitle AS ASCIIZ * 256, _
szDefExt AS ASCIIZ * 10
IF LEN(InitialDir) = 0 THEN
InitialDir = CURDIR$
END IF
szInitialDir = InitialDir + CHR$(0)
IF LEFT$(DefaultExt,1) = "." THEN DefaultExt = MID$(DefaultExt,2)
szDefExt = DefaultExt + CHR$(0)
szTitle = Caption + CHR$(0)
ofn.lStructSize = SIZEOF(ofn)
ofn.hWndOwner = hWnd
ofn.hInstance = %NULL
ofn.lpstrFilter = VARPTR(szFilter) ' pairs of string filters
ofn.nFilterIndex = 0
ofn.lpstrCustomFilter = %NULL
ofn.nMaxCustFilter = 0
ofn.lpstrFile = VARPTR(szFileSpec)
ofn.nMaxFile = xSize
ofn.lpstrFileTitle = VARPTR(szFileTitle)
ofn.nMaxFileTitle = SIZEOF(szFileTitle)
ofn.lpstrInitialDir = VARPTR(szInitialDir)
IF LEN(szTitle) THEN
ofn.lpstrTitle = VARPTR(szTitle)
ELSE
ofn.lpstrTitle = %NULL
END IF
ofn.Flags = %OFN_HIDEREADONLY OR %OFN_FILEMUSTEXIST _
OR %OFN_PATHMUSTEXIST OR %OFN_EXPLORER
IF multipleFileFlag = 1 THEN
ofn.Flags = ofn.Flags OR %OFN_ALLOWMULTISELECT
END IF
ofn.nFileOffset = 0
ofn.nFileExtension = 0
ofn.lpstrDefExt = VARPTR(szDefExt)
ofn.lCustData = 0
ofn.lpfnHook = %NULL
ofn.lpTemplateName = %NULL
FUNCTION = GetOpenFileName(ofn)
shortFile = szFileTitle
END FUNCTION
'------------------------
'########################
'------------------------