10-11-2024, 12:33 PM
I'm updating my old FileSelect function to use _Files$ instead of SHELLing and making temp files to get file/dir info. Working OK doing that (I think) but have a couple a questions using CHDIR with it.
If there a way to see if a directory is accessible before trying to navigate to it? When I try to navigate to a directory with permissions it errors out. I'd like to not allow user to open those directories.
Also, what is a good way (cross-platform) to see if the user is at the root directory?
Here's the code I'm working on. Thanks.
- Dav
If there a way to see if a directory is accessible before trying to navigate to it? When I try to navigate to a directory with permissions it errors out. I'd like to not allow user to open those directories.
Also, what is a good way (cross-platform) to see if the user is at the root directory?
Here's the code I'm working on. Thanks.
- Dav
Code: (Select All)
'====================
'FILESELECT-FILES.BAS v1.00
'====================
'A simple file selector box function using _FILES$.
'Coded by Dav for QB64-PE, OCT/2024
'Lists files in current directory in a scroll box.
'Use arrows, page up/down, home/end to navigate.
'ENTER selects highlighted filename, ESC cancels.
'Selecting a directory will navigate to that
'directory and list files under it.
'Background screen is preserved and restored.
'Works under windows & Linux (havent tested Mac).
'Works in text and graphical screen modes.
'
'=== DEMO FOLLOWS...
Screen _NewImage(700, 500, 32)
_ScreenMove _Middle
'=== draw a background
Cls , _RGB(32, 32, 32)
For x = 1 To _Width Step 3
For y = 1 To _Height Step 3
PSet (x, y), _RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
Next
Print "Use arrows to navigate to a filename. "
Print "Press ENTER to select highlighted file."
Print "Press ESC to cancel and close file box."
'=== Define filebox colors here...
fsborder& = _RGB(255, 0, 0) 'filebox order color
fsfile& = _RGB(255, 255, 255) 'filename color
fsdir& = _RGB(255, 255, 64) 'directories color
fsback& = _RGB(64, 0, 0) 'Background color
fshigh& = _RGB(255, 255, 128) 'highlighted line color
'=== Ask user to select a file
a$ = FileSelect$(5, 15, 20, 55, "*", fsborder&, fsback&, fsfile&, fsdir&, fshigh&)
'=== Show results...
Print
If a$ <> "" Then
Print "You selected: "; a$
Else
Print "No file selected."
End If
End
Function FileSelect$ (y, x, y2, x2, Filespec$, fsborder&, fsback&, fsfile&, fsdir&, fshigh&)
'FileSelect$ function by Dav, OCT/2024
'This function returns a selected filename.
'Show files in current directory in a scroll box.
'Use arrows, page up/down, home/end to navigate.
'ENTER selects highlighted filename, ESC cancels.
'Selecting a directory will navigate to that dir
'and list files under that directory.
'y,x = top left of box
'y2,x2 = bottom right of box
'Filespec$ = spec of files to list in box
'fsborder& = color of box border
'fsback& = background color of file box.
'fsfile& = color of filenames
'fsdir& = color of directories
'fshigh& = color of highlighted line
'=================================================
'=== save original place of cursor
origy = CsrLin
origx = Pos(1)
'=== save colors
fg& = _DefaultColor
bg& = _BackgroundColor
'=== Save whole screen
Dim scr1 As _MEM, scr2 As _MEM
scr1 = _MemImage(0): scr2 = _MemNew(scr1.SIZE)
_MemCopy scr1, scr1.OFFSET, scr1.SIZE To scr2, scr2.OFFSET
'========
loadagain:
'=======
'=== get total file + dir count
c = 0
x$ = _Files$(Filespec$)
Do
If x$ = "" Then Exit Do
c = c + 1
x$ = _Files$
Loop
'if no files found, at least add 1 for ".."
If c = 0 Then c = 1
'=== make room for names
ReDim FileNames$(0 To c)
'=== first line always go up a directory
FileNames$(0) = ".."
LineCount = 1
'=== get dir names first, add to Filename$ array
x$ = _Files$(Filespec$)
Do
If x$ = "" Then Exit Do
'skip "." and ".." from this list
If x$ = "./" Or x$ = ".\" Then GoTo jump
If x$ = "../" Or x$ = "..\" Then GoTo jump
If Right$(x$, 1) = "/" Or Right$(x$, 1) = "\" Then
FileNames$(LineCount) = "[" + Left$(x$, Len(x$) - 1) + "]"
LineCount = LineCount + 1
End If
jump:
x$ = _Files$
Loop
'=== get file names next, add to Filename$ array
x$ = _Files$(Filespec$)
Do
If x$ = "" Then Exit Do
'skip all dir this time
If Right$(x$, 1) = "/" Or Right$(x$, 1) = "\" Then
' do nothing
Else
FileNames$(LineCount) = x$
LineCount = LineCount + 1
End If
x$ = _Files$
Loop
'=== draw a box
Color fsborder&
For L = 0 To y2 + 1
Locate y + L, x: Print String$(x2 + 4, Chr$(219));
Next
'=== show current working dir at top
Color fsfile&, fsborder&
CurDir$ = _CWD$
'=== Shorten it is too long, for display purposes
If Len(CurDir$) > x2 - x Then
CurDir$ = Mid$(CurDir$, 1, x2 - x - 3) + "..."
End If
Locate y, x + 2: Print CurDir$;
'=== scroll through list...
top = 0: selection = 0
Do
For L = 0 To (y2 - 1)
Locate (y + 1) + L, (x + 2)
topl = top + L: If topl > LineCount Then topl = LineCount
If topl = selection Then
Color fsback&, fshigh& 'selected line
Else
Color fsfile&, fsback& 'regular
'=== directories get a different color...
If Mid$(FileNames$(topl), 1, 1) = "[" Then
Color fsdir&, fsback&
End If
End If
Print Left$(FileNames$(topl) + String$(x2, " "), x2);
Next
'=== Get user input
Do
k$ = InKey$: _Limit 30
Loop Until k$ <> ""
Select Case k$
Case Is = Chr$(0) + Chr$(72) 'Up arrow
If selection > 0 Then selection = selection - 1
If selection < top Then top = selection
Case Is = Chr$(0) + Chr$(80) 'Down Arrow
If selection < (LineCount - 1) Then selection = selection + 1
If selection > (top + (y2 - 2)) Then top = selection - y2 + 1
Case Is = Chr$(0) + Chr$(73) 'Page up
top = top - y2
selection = selection - y2
If top < 0 Then top = 0
If selection < 0 Then selection = 0
Case Is = Chr$(0) + Chr$(81) 'Page Down
top = top + y2
selection = selection + y2
If top >= LineCount - y2 Then top = LineCount - y2
If top < 0 Then top = 0
If selection >= LineCount Then selection = LineCount - 1
Case Is = Chr$(0) + Chr$(71) 'Home
top = 0: selection = 0
Case Is = Chr$(0) + Chr$(79) 'End
selection = LineCount - 1
top = selection - y2 + 1
If top < 0 Then top = 0
Case Is = Chr$(27) ' ESC cancels
FileSelect$ = ""
Exit Do
Case Is = Chr$(13) 'Enter
'=== if .. then go up one dir
If RTrim$(FileNames$(selection)) = ".." Then
cd$ = _CWD$
If InStr(_OS$, "WIN") Then
cd$ = Left$(cd$, _InStrRev(cd$, "\"))
Else
cd$ = Left$(cd$, _InStrRev(cd$, "/"))
End If
ChDir cd$
Erase FileNames$
GoTo loadagain
End If
'see if directory
test$ = RTrim$(FileNames$(selection))
If Left$(test$, 1) = "[" Then
test$ = Mid$(test$, 2, Len(test$) - 2)
ChDir test$
Erase FileNames$
GoTo loadagain
Else
If InStr(_OS$, "WIN") Then
If Right$(_CWD$, 1) = "\" Then
C$ = _CWD$
Else
C$ = _CWD$ + "\"
End If
Else
If Right$(_CWD$, 1) = "/" Then
C$ = _CWD$
Else
C$ = _CWD$ + "/"
End If
End If
FileSelect$ = C$ + RTrim$(FileNames$(selection))
Exit Do
End If
End Select
Loop
_KeyClear
'=== Restore the whole screen
_MemCopy scr2, scr2.OFFSET, scr2.SIZE To scr1, scr1.OFFSET
_MemFree scr1: _MemFree scr2
'=== restore original y,x and color
Locate origy, origx
Color fg&, bg&
End Function
