Posts: 3,447
Threads: 376
Joined: Apr 2022
Reputation:
345
04-21-2025, 08:26 PM
(This post was last modified: 01-21-2026, 06:06 AM by SMcNeill.)
Code: (Select All)
$Console:Only
ReDim Shared As String FileList(0), DirList(0)
Disk.File.List "", "" 'get a list of all files in the root directory
Disk.Dir.List "C:", "U*" 'get a list of all subdirectories that start with "U" from the root directory
For i = 1 To UBound(FileList)
Print i, FileList(i)
Next
Sleep
_Delay .5
Cls
_KeyClear
For i = 1 To UBound(DirList)
Print i, DirList(i)
Next
Sleep
System
Sub Disk.File.List (SearchDirectory As String, Extension As String)
Dim As Long FileCount
Dim As String Search, File, slash
ReDim _Preserve FileList(1000) As String
If SearchDirectory = "" Then SearchDirectory = _CWD$
$If WIN Then
slash = "\"
$Else
Slash = "/"
$End If
If Right$(SearchDirectory, 1) <> "/" _AndAlso Right$(SearchDirectory, 1) <> "\" Then SearchDirectory = SearchDirectory + slash
If Extension = "" Then Extension = "*"
Search = SearchDirectory + Extension
File = _Files$(Search)
Do While Len(File)
File = SearchDirectory + File
If _FileExists(File) Then
FileCount = FileCount + 1
If FileCount > UBound(FileList) Then ReDim _Preserve FileList(FileCount + 1000) As String
FileList(FileCount) = File
End If
File = _Files$
Loop
ReDim _Preserve FileList(FileCount) As String
End Sub
Sub Disk.Dir.List (SearchDirectory As String, SearchFor As String)
Dim As Long DirCount
Dim As String Search, Dir, Slash
ReDim _Preserve DirList(1000) As String
If SearchDirectory = "" Then SearchDirectory = _CWD$
$If WIN Then
Slash = "\"
$Else
Slash = "/"
$End If
If Right$(SearchDirectory, 1) <> "/" _AndAlso Right$(SearchDirectory, 1) <> "\" Then SearchDirectory = SearchDirectory + Slash
Search = SearchDirectory + SearchFor
Dir = _Files$(Search)
Do While Len(Dir)
Dir = SearchDirectory + Dir
If _DirExists(Dir) Then
DirCount = DirCount + 1
If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 1000) As String
DirList(DirCount) = Dir
End If
Dir = _Files$
Loop
ReDim _Preserve DirList(DirCount) As String
End Sub
Updated to make use of the new _FILES$ command so this doesn't need any external libraries or anything to run.
What it does is give you a quick listing of files or directory into a shared set of arrays called FileList() and DirList().
Usage is rather simple as shown in the demo here. If anyone has questions, feel free to ask. 
EDIT: I'd suggest using the version below for extended flexibility and control over your return data. https://qb64phoenix.com/forum/showthread...2#pid39082
In my personal opinion, the version in post #7 is much better than this version, especially once you start mixing and matching how the flag return values work for you.
Posts: 1,215
Threads: 162
Joined: Apr 2022
Reputation:
34
Thank you! It's nice not having to rely on that header file.
Posts: 3,447
Threads: 376
Joined: Apr 2022
Reputation:
345
04-22-2025, 02:51 AM
(This post was last modified: 04-22-2025, 03:09 AM by SMcNeill.)
Code: (Select All)
$Console:Only
ReDim As String FileList(0)
Disk.File.List "", "", -1, FileList() 'get a list of all files in the root directory
For i = 1 To UBound(FileList)
Print i, FileList(i)
Next
Sub Disk.File.List (SearchDir As String, Extension As String, Flag As Long, ReturnArray() As String)
'flags are binary bits which represent the following
'Note that a quick value of -1 will set all bits and return everything for us
'1 -- file listing
'2 -- directory listing
'4 -- sorted (directory before file, like windows explorer does) -- implies 1 + 2 both are wanted.
'8 -- return full path info
Dim As Long FileCount, pass
Dim As String Search, File, Slash
ReDim ReturnArray(1000) As String
If SearchDir = "" Then SearchDir = _CWD$: If Extension = "" Then Extension = "*"
If InStr(_OS$, "WIN") Then Slash = "\" Else Slash = "/"
If Right$(SearchDir, 1) <> "/" _AndAlso Right$(SearchDir, 1) <> "\" Then SearchDir = SearchDir + Slash
Search = SearchDir + Extension
If Flag And 4 Then 'sorted so we get directory listings then files
For pass = 1 To 2 'two passes, first to get directory listings then files
File = _Files$(Search)
Do While Len(File)
If ((pass = 1) _AndAlso _DirExists(SearchDir + File)) _OrElse ((pass = 2) _AndAlso _FileExists(SearchDir + File)) Then
FileCount = FileCount + 1
If FileCount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(FileCount + 1000) As String
If Flag And 8 Then File = SearchDir + File 'we want the full path info
ReturnArray(FileCount) = File
End If
File = _Files$
Loop
Next
Else 'unsorted so files and directories are simply listed in alphabetical order
File = _Files$(Search) 'one single pass where we just grab all the info at once
Do While Len(File)
If ((Flag And 1) _AndAlso _FileExists(SearchDir + File)) _OrElse ((Flag And 2) _AndAlso _DirExists(SearchDir + File)) Then
FileCount = FileCount + 1
If FileCount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(FileCount + 1000) As String
If Flag And 8 Then File = SearchDir + File 'we want the full path info
ReturnArray(FileCount) = File
End If
File = _Files$
Loop
End If
ReDim _Preserve ReturnArray(FileCount) As String
End Sub
Note: I'd suggest folks make use of this version instead of the above. It's a much more powerful version and can do multiple things for us that the above couldn't do. This will get files, get directories, allow you to choose between full paths or short paths, and will even sort them if you desire. What more could you possibly want from a file listing tool? 
Posts: 73
Threads: 12
Joined: Apr 2022
Reputation:
9
This is 100% awesome. No fillers, no junk, no extra calories...Thank you !!!
Posts: 3,447
Threads: 376
Joined: Apr 2022
Reputation:
345
Expanded to finally add a recursive directory ability into this.
Code: (Select All)
ReDim As String FileList(0) 'be certain to reset your file listing to 0 files like this, before calling the recursive version
Disk.File.List.Recursive "C:\My Stuff\", "", FileList() 'get a list of all files in the directory, plus subdirectories
For i = 1 To UBound(FileList)
Print i, FileList(i)
Next
Sub Disk.File.List.Recursive (SearchDir As String, Extension As String, ReturnArray() As String)
ReDim TempArray(0) As String
Dim As Long i, totalcount
totalcount = UBound(ReturnArray)
Disk.File.List SearchDir, Extension, -1, TempArray() 'get a temp array of data
For i = 1 To UBound(TempArray)
totalcount = totalcount + 1
If totalcount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(totalcount + 10000) As String
ReturnArray(totalcount) = TempArray(i)
Next
ReDim _Preserve ReturnArray(totalcount) As String
For i = 1 To UBound(TempArray)
If _DirExists(TempArray(i)) Then Disk.File.List.Recursive TempArray(i), Extension, ReturnArray() 'get a temp array of data
Next
End Sub
Sub Disk.File.List (SearchDir As String, Extension As String, Flag As Long, ReturnArray() As String)
'flags are binary bits which represent the following
'Note that a quick value of -1 will set all bits and return everything for us
'1 -- file listing
'2 -- directory listing
'4 -- sorted (directory before file, like windows explorer does) -- implies 1 + 2 both are wanted.
'8 -- return full path info
Dim As Long FileCount, pass
Dim As String Search, File, Slash
ReDim ReturnArray(1000) As String
If SearchDir = "" Then SearchDir = _CWD$: If Extension = "" Then Extension = "*"
If InStr(_OS$, "WIN") Then Slash = "\" Else Slash = "/"
If Right$(SearchDir, 1) <> "/" _AndAlso Right$(SearchDir, 1) <> "\" Then SearchDir = SearchDir + Slash
Search = SearchDir + Extension
If Flag And 4 Then 'sorted so we get directory listings then files
For pass = 1 To 2 'two passes, first to get directory listings then files
File = _Files$(Search)
Do While Len(File)
If File = ".\" _OrElse File = "..\" Then
Else
If ((pass = 1) _AndAlso _DirExists(SearchDir + File)) _OrElse ((pass = 2) _AndAlso _FileExists(SearchDir + File)) Then
FileCount = FileCount + 1
If FileCount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(FileCount + 1000) As String
If Flag And 8 Then File = SearchDir + File 'we want the full path info
ReturnArray(FileCount) = File
End If
End If
File = _Files$
Loop
Next
Else 'unsorted so files and directories are simply listed in alphabetical order
File = _Files$(Search) 'one single pass where we just grab all the info at once
Do While Len(File)
If File = ".\" _OrElse File = "..\" Then
Else
If ((Flag And 1) _AndAlso _FileExists(SearchDir + File)) _OrElse ((Flag And 2) _AndAlso _DirExists(SearchDir + File)) Then
FileCount = FileCount + 1
If FileCount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(FileCount + 1000) As String
If Flag And 8 Then File = SearchDir + File 'we want the full path info
ReturnArray(FileCount) = File
End If
End If
File = _Files$
Loop
End If
ReDim _Preserve ReturnArray(FileCount) As String
End Sub
Note that the recursive routine doesn't allow you to set a flag to just get back short names or files or directories. It looks at a folder, grabs all the information from it, and then grabs all the information from the subfolders. If you want to filter out files or directories, that's on you; this doesn't bother to do that for you.
IMPORTANT USE NOTE: Be certain to reset your array to blank before using the recursive routine. It makes several passes and builds upon the previous pass to generate your results. If you send it an array that already has stuff in it, it'll just add to that array, rather than erasing it.
ReDim As String FileList(0) 'be certain to reset your file listing to 0 files like this, before calling the recursive version
THEN call then recursive routine to get the list of files and folders recursively for you.
Posts: 73
Threads: 12
Joined: Apr 2022
Reputation:
9
(01-20-2026, 09:20 AM)SMcNeill Wrote: Expanded to finally add a recursive directory ability into this.
Note that the recursive routine doesn't allow you to set a flag to just get back short names or files or directories. It looks at a folder, grabs all the information from it, and then grabs all the information from the subfolders. If you want to filter out files or directories, that's on you; this doesn't bother to do that for you.
IMPORTANT USE NOTE: Be certain to reset your array to blank before using the recursive routine. It makes several passes and builds upon the previous pass to generate your results. If you send it an array that already has stuff in it, it'll just add to that array, rather than erasing it.
ReDim As String FileList(0) 'be certain to reset your file listing to 0 files like this, before calling the recursive version
THEN call then recursive routine to get the list of files and folders recursively for you.
And when you thought it could not get any better...<BAM>
Thanks again Steve - this is great and I just might replace my ages old SHELL with DIR to a file and then comb through it...
Posts: 3,447
Threads: 376
Joined: Apr 2022
Reputation:
345
Code: (Select All)
Option _Explicit
ReDim As String FileList(0), f ' be certain to reset your file listing to 0 files like this, before calling the recursive version
Dim i As Long
Disk.File.List "Z:\", "", -1, FileList() ' get a list of all files in the directory, plus subdirectories
For i = 0 To UBound(FileList)
Print i, FileList(i)
Next
f = ".png,.gif" ' comma separated extensions
Disk.File.List.FilterForExtension FileList(), f 'get your file list before you try to filter it.
Print "Filtered"
For i = 0 To UBound(FileList)
Print i, FileList(i)
Next
Sub Disk.File.List.FilterForExtension (FileList() As String, filter As String)
'note that I haven't added filers for wild cards and such, this is for set patterns, with a comma delimiter
Dim As String temp, process
ReDim As String filters(1000), tempList(0)
Dim As Long i, j, p, count, listCount
temp = filter
Do
p = InStr(temp, ",")
If p Then
process$ = Left$(temp, p - 1) 'strip off the symbols
temp = Mid$(temp, p + 1)
Else
process$ = temp
End If
count = count + 1 'the number of filters
filters(count) = process$
Loop Until process$ = temp
ReDim tempList(UBound(FileList)) As String
For i = 1 To UBound(FileList)
temp = FileList(i)
For j = 1 To count
If InStr(temp, filters(j)) Then
listCount = listCount + 1
tempList(listCount) = FileList(i)
Exit For 'no need to keep looking, we found an item that matches our search criteria
End If
Next
Next
For i = 1 To listCount: FileList(i) = tempList(i): Next
ReDim _Preserve FileList(listCount) As String
End Sub
Sub Disk.File.List.Recursive (SearchDir As String, Extension As String, ReturnArray() As String)
ReDim TempArray(0) As String
Dim As Long i, totalcount
totalcount = UBound(ReturnArray)
Disk.File.List SearchDir, Extension, -1, TempArray() 'get a temp array of data
For i = 1 To UBound(TempArray)
totalcount = totalcount + 1
If totalcount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(totalcount + 10000) As String
ReturnArray(totalcount) = TempArray(i)
Next
ReDim _Preserve ReturnArray(totalcount) As String
For i = 1 To UBound(TempArray)
If _DirExists(TempArray(i)) Then Disk.File.List.Recursive TempArray(i), Extension, ReturnArray() 'get a temp array of data
Next
End Sub
Sub Disk.File.List (SearchDir As String, Extension As String, Flag As Long, ReturnArray() As String)
'flags are binary bits which represent the following
'Note that a quick value of -1 will set all bits and return everything for us
'1 -- file listing
'2 -- directory listing
'4 -- sorted (directory before file, like windows explorer does) -- implies 1 + 2 both are wanted.
'8 -- return full path info
Dim As Long FileCount, pass
Dim As String Search, File, Slash
ReDim ReturnArray(1000) As String
If SearchDir = "" Then SearchDir = _CWD$: If Extension = "" Then Extension = "*"
If InStr(_OS$, "WIN") Then Slash = "\" Else Slash = "/"
If Right$(SearchDir, 1) <> "/" _AndAlso Right$(SearchDir, 1) <> "\" Then SearchDir = SearchDir + Slash
Search = SearchDir + Extension
If Flag And 4 Then 'sorted so we get directory listings then files
For pass = 1 To 2 'two passes, first to get directory listings then files
File = _Files$(Search)
Do While Len(File)
If File = ".\" _OrElse File = "..\" Then
Else
If ((pass = 1) _AndAlso _DirExists(SearchDir + File)) _OrElse ((pass = 2) _AndAlso _FileExists(SearchDir + File)) Then
FileCount = FileCount + 1
If FileCount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(FileCount + 1000) As String
If Flag And 8 Then File = SearchDir + File 'we want the full path info
ReturnArray(FileCount) = File
End If
End If
File = _Files$
Loop
Next
Else 'unsorted so files and directories are simply listed in alphabetical order
File = _Files$(Search) 'one single pass where we just grab all the info at once
Do While Len(File)
If File = ".\" _OrElse File = "..\" Then
Else
If ((Flag And 1) _AndAlso _FileExists(SearchDir + File)) _OrElse ((Flag And 2) _AndAlso _DirExists(SearchDir + File)) Then
FileCount = FileCount + 1
If FileCount > UBound(ReturnArray) Then ReDim _Preserve ReturnArray(FileCount + 1000) As String
If Flag And 8 Then File = SearchDir + File 'we want the full path info
ReturnArray(FileCount) = File
End If
End If
File = _Files$
Loop
End If
ReDim _Preserve ReturnArray(FileCount) As String
End Sub
Add in one more feature to this which others might find useful -- the ability to filter the file list into a set of extensions.
If the _FILES$ command works with more than one set of filters, I don't know the syntax for it and it's not documented anywhere.
We can filter our command to look for all *.bas files, but I know of no way to look for (*.bas, *.bi, *.bm, *.h, *.txt) all in one go. So my work around is to just grab everything and then filter for those extensions all at once with the new command here.
I think the code above should showcase how to make use of it, if you want to give it a go. (Note that I'm not checking for wildcards and such here; this is just a filter for extensions so I can quickly gather other image types or all movie types or all fonts, ect.)
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
This is very nice and useful. Let me contribute a little. This very simple program will list the valid disk drives of the computer.
Code: (Select All)
ReDim Drives(0) As String
GetDriveList Drives()
Print "Found drives:"
For f = 0 To UBound(Drives)
Print Drives(f)
Next
End
Sub GetDriveList (drives() As String)
Dim c As Long
Dim letter As String
Dim root As String
ReDim drives(0) As String
dCount = 0
$If WINDOWS Then
c = 65
While c <= 90
letter = Chr$(c)
root = letter + ":\"
If _DirExists(root) Then
drives(dCount) = root
dCount = dCount + 1
ReDim _Preserve drives(dCount) As String
End If
c = c + 1
Wend
$End If
End Sub
Posts: 347
Threads: 45
Joined: Jun 2024
Reputation:
32
Code: (Select All) #include <vector>
#include <string>
#include <filesystem>
#include <algorithm>
#include <cstring>
#include <cstdint>
namespace fs = std::filesystem;
extern "C" {
struct Node {
std::string name, path;
int64_t size;
bool is_dir;
};
std::vector<Node*> vault;
fs::recursive_directory_iterator it;
bool is_crawling = false;
// Safety Buffers for String Exchange
static char name_buf[1024];
static char path_buf[2048];
static char live_buf[2048];
// Main Engine
__declspec(dllexport) void Pimp_Start(const char* root, int32_t recursive) {
for(auto n : vault) delete n;
vault.clear();
std::error_code ec;
fs::path p(root);
if (p.has_parent_path() && p != p.root_path()) {
vault.push_back(new Node{".. [Go Back]", p.parent_path().string(), 0, true});
}
if (recursive) {
it = fs::recursive_directory_iterator(root, fs::directory_options::skip_permission_denied, ec);
is_crawling = !ec;
} else {
for (const auto& entry : fs::directory_iterator(root, ec)) {
if (ec) { ec.clear(); continue; }
vault.push_back(new Node{entry.path().filename().string(), entry.path().string(),
entry.is_directory() ? 0 : (int64_t)fs::file_size(entry, ec), entry.is_directory()});
}
is_crawling = false;
}
}
__declspec(dllexport) int32_t Pimp_Pulse() {
if (!is_crawling || it == fs::recursive_directory_iterator()) return 0;
std::error_code ec;
try {
const auto& entry = *it;
vault.push_back(new Node{entry.path().filename().string(), entry.path().string(),
entry.is_directory() ? 0 : (int64_t)fs::file_size(entry, ec), entry.is_directory()});
strncpy(live_buf, entry.path().string().c_str(), 2047);
it.increment(ec);
if (ec) is_crawling = false;
} catch (...) { return 0; }
return 1;
}
__declspec(dllexport) void Pimp_Sort() {
if (vault.size() < 2) return;
std::sort(vault.begin(), vault.end(), [](Node* a, Node* b) {
if (a->name.find("..") != std::string::npos) return true;
if (b->name.find("..") != std::string::npos) return false;
if (a->is_dir != b->is_dir) return a->is_dir > b->is_dir;
return a->name < b->name;
});
}
__declspec(dllexport) int32_t Pimp_Count() { return (int32_t)vault.size(); }
__declspec(dllexport) const char* Pimp_GetName(int32_t i) { strncpy(name_buf, vault[i]->name.c_str(), 1023); return name_buf; }
__declspec(dllexport) const char* Pimp_GetPath(int32_t i) { strncpy(path_buf, vault[i]->path.c_str(), 2047); return path_buf; }
__declspec(dllexport) int64_t Pimp_GetSize(int32_t i) { return vault[i]->size; }
__declspec(dllexport) bool Pimp_IsDir(int32_t i) { return vault[i]->is_dir; }
__declspec(dllexport) const char* Pimp_GetLive() { return live_buf; }
}
Save that as FS_Pimped.h in your Qb64 folder and then
Code: (Select All)
' //////////////////////////////////////////////////////////////////////////////////////////////////////
' // S-TIER VFS MASTER (2026 FORUM RELEASE)
' // Optimized for 800x600 Laptop Screens
' //////////////////////////////////////////////////////////////////////////////////////////////////////
' Declare using the shared library name (renamed manually by user if 32 or 64 bit)
DECLARE LIBRARY "FS_Pimped"
SUB Pimp_Start (path AS STRING, BYVAL recursive AS LONG)
FUNCTION Pimp_Pulse& ()
FUNCTION Pimp_GetLive$ ()
SUB Pimp_Sort ()
FUNCTION Pimp_Count& ()
FUNCTION Pimp_GetName$ (BYVAL index AS LONG)
FUNCTION Pimp_GetPath$ (BYVAL index AS LONG)
FUNCTION Pimp_GetSize&& (BYVAL index AS LONG)
FUNCTION Pimp_IsDir%% (BYVAL index AS LONG)
END DECLARE
SCREEN _NEWIMAGE(800, 600, 32)
fnt& = _LOADFONT("C:\windows\fonts\consola.ttf", 16): _FONT fnt&
DIM SHARED Path$, MenuRef, ViewOffset, MaxView
Path$ = "C:\"
MenuRef = 0: ViewOffset = 0: MaxView = 22
Pimp_Start Path$ + CHR$(0), 0: Pimp_Sort
DO
_LIMIT 60: CLS: Count& = Pimp_Count&
' UI Header
COLOR _RGB32(0, 255, 120): PRINT " S-TIER VFS MASTER 2026 | "; Path$
COLOR _RGB32(70, 70, 70): PRINT STRING$(80, "-")
' --- MOUSE & INPUT HUB ---
DO WHILE _MOUSEINPUT
mx = _MOUSEX: my = _MOUSEY: ml = _MOUSEBUTTON(1): mw = _MOUSEWHEEL
' Synchronized Scroll Wheel
IF mw <> 0 THEN
MenuRef = MenuRef + mw: IF MenuRef < 0 THEN MenuRef = 0
IF MenuRef > Count& - 1 THEN MenuRef = Count& - 1
IF MenuRef < ViewOffset THEN ViewOffset = MenuRef
IF MenuRef >= ViewOffset + MaxView THEN ViewOffset = MenuRef - MaxView + 1
END IF
' Hover Selection
IF mx <> lastMX OR my <> lastMY THEN
FOR i = 0 TO MaxView - 1
yT = 70 + (i * 20): yB = yT + 20
IF mx > 20 AND mx < 530 AND my > yT AND my < yB THEN
hIdx = ViewOffset + i: IF hIdx < Count& THEN MenuRef = hIdx
END IF
NEXT
END IF
lastMX = mx: lastMY = my
' Click to Drill Down
IF ml AND Count& > 0 THEN
IF Pimp_IsDir%%(MenuRef) THEN
Path$ = Pimp_GetPath$(MenuRef): Pimp_Start Path$ + CHR$(0), 0: Pimp_Sort
MenuRef = 0: ViewOffset = 0: _DELAY .2
END IF
END IF
LOOP
' --- LIST RENDER ---
FOR i = 0 TO MaxView - 1
idx& = ViewOffset + i: IF idx& >= Count& THEN EXIT FOR
y = 70 + (i * 20)
IF idx& = MenuRef THEN
COLOR _RGB32(0, 0, 0), _RGB32(0, 255, 200): _PRINTSTRING (20, y), " > " + LEFT$(Pimp_GetName(idx&), 55)
COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
ELSE
IF Pimp_IsDir%%(idx&) THEN COLOR _RGB32(255, 255, 0) ELSE COLOR _RGB32(180, 180, 180)
_PRINTSTRING (20, y), " " + LEFT$(Pimp_GetName(idx&), 55)
END IF
NEXT
' --- SIDEBAR ---
LINE (550, 70)-(785, 530), _RGB32(25, 25, 35), BF
COLOR _RGB32(0, 255, 255): _PRINTSTRING (565, 90), "[ FILE DATA ]"
COLOR _RGB32(255, 255, 255): _PRINTSTRING (565, 130), "Size: " + STR$(Pimp_GetSize&&(MenuRef))
_PRINTSTRING (565, 500), "[F]ind [ESC] Exit"
' Viewport Auto-Clamp
IF MenuRef < ViewOffset THEN ViewOffset = MenuRef
IF MenuRef >= ViewOffset + MaxView THEN ViewOffset = MenuRef - MaxView + 1
' Hotkeys
k$ = INKEY$
IF LCASE$(k$) = "f" THEN RunSearchDialog
_DISPLAY
LOOP UNTIL k$ = CHR$(27)
SYSTEM
' //////////////////////////////////////////////////////////////////////////////////////////////////////
SUB RunSearchDialog
SearchStr$ = ""
DO ' Phase 1: Custom Dialog Input
_LIMIT 60: CLS: LINE (150, 200)-(650, 350), _RGB32(40, 40, 50), BF
LINE (150, 200)-(650, 350), _RGB32(0, 255, 255), B
COLOR _RGB32(255, 255, 255): _PRINTSTRING (170, 220), "Enter Filename Pattern:"
_PRINTSTRING (170, 250), "> " + SearchStr$ + "_"
_PRINTSTRING (170, 320), "[ENTER] Scan | [ESC] Cancel"
c$ = INKEY$
IF c$ = CHR$(13) THEN EXIT DO
IF c$ = CHR$(27) THEN EXIT SUB
IF c$ = CHR$(8) AND LEN(SearchStr$) > 0 THEN SearchStr$ = LEFT$(SearchStr$, LEN(SearchStr$) - 1)
IF LEN(c$) = 1 AND c$ >= " " THEN SearchStr$ = SearchStr$ + c$
_DISPLAY
LOOP
' Phase 2: Async Recursive Pulse
Pimp_Start Path$ + CHR$(0), 1
ScanDone = 0
DO
FOR p = 1 TO 400
IF Pimp_Pulse& = 0 THEN
ScanDone = 1
EXIT FOR
END IF
NEXT
IF ScanDone = 1 THEN EXIT DO
CLS: LINE (100, 200)-(700, 405), _RGB32(40, 40, 50), BF
LINE (100, 200)-(700, 405), _RGB32(255, 50, 50), B
COLOR _RGB32(255, 255, 255): _PRINTSTRING (120, 220), "DEEP SCAN IN PROGRESS..."
_PRINTSTRING (120, 250), "TARGET: " + SearchStr$
_PRINTSTRING (120, 280), "FOUND: " + STR$(Pimp_Count&)
COLOR _RGB32(150, 150, 150): _PRINTSTRING (120, 330), "DIR: " + LEFT$(Pimp_GetLive$, 68)
COLOR _RGB32(255, 200, 0): _PRINTSTRING (120, 380), "[ESC] TO STOP AND BROWSE"
IF INKEY$ = CHR$(27) THEN EXIT DO
_DISPLAY: _LIMIT 60
LOOP
Pimp_Sort: MenuRef = 0: ViewOffset = 0
END SUB
It aint perfect, but it works FAST AS F! Mouse works (wheel up and down is slightly dodgy though!) Press F to search for a file or format...please mod, edit hack and cuss it out as you feel (i think i made this so it should work on 32 and 64 bit qb64 too so id like to know if that effort failed!)
Unseen
Posts: 3,447
Threads: 376
Joined: Apr 2022
Reputation:
345
@Petr
If you're looking for a windows only drive routine, give this one a try and see what it tells you:
Code: (Select All)
Screen _NewImage(800, 600, 32)
Type DriveInfo
Root As String * 16
Label As String * 128
UsedGB As _Integer64
FreeGB As _Integer64
End Type
ReDim Drives(0) As DriveInfo
Dim count As Integer
Call GetDriveInfo(Drives())
Print "Drive", "Label";
Locate , 40: Print "Used (GB)", "", "Free (GB)"
For i = 0 To UBound(Drives)
Print RTrim$(Drives(i).Root),
Print RTrim$(Drives(i).Label);
Locate , 40
Print Using "###,###.### GB"; Drives(i).UsedGB / _ONE_GB,
Print "", Using "###,###.### GB"; Drives(i).FreeGB / _ONE_GB
Next
Sub GetDriveInfo (drives() As DriveInfo)
Dim As String tempPath, psCmd
Dim ff As Integer
tempPath = "tempdrives.txt"
psCmd = "cmd /c powershell -Command " + Chr$(34)
psCmd = psCmd + "$drives = Get-PSDrive -PSProvider 'FileSystem'; "
psCmd = psCmd + "foreach ($d in $drives) { "
psCmd = psCmd + "$label = if ([string]::IsNullOrWhiteSpace($d.DisplayRoot)) { 'None' } else { $d.DisplayRoot }; "
psCmd = psCmd + "$fields = @($d.Root, $label, $d.used, $d.free); "
psCmd = psCmd + "Write-Output $fields }"
psCmd = psCmd + Chr$(34) + " > " + tempPath
Shell _Hide psCmd
ff = FreeFile: Open tempPath For Input As #ff
ReDim drives(100) As DriveInfo
Do While Not EOF(ff)
Input #ff, drives(count).Root, drives(count).Label, drives(count).UsedGB, drives(count).FreeGB
count = count + 1
Loop
If count > 0 Then ReDim _Preserve drives(count - 1) As DriveInfo
Close #ff
Kill tempPath
End Sub
Here's my general output:
Code: (Select All) Drive Label Used (GB) Free (GB)
C:\ None 737.200 GB 1,143.500 GB
X:\ \\10.243.1.1\My Book Duo 6,449.300 GB 15,902.700 GB
Z:\ None 0.000 GB 12.000 GB
Press any key to continue
Notice that it also has my network drive (X: ), which is mapped to the \\10.243.1.1\ network path, as well as my local hard drive and my ramdrive (Z: ).
It has a little more info that just "What drives are there," as it also tells you used space and free space, which might also be nice for you to know sometime with your stuff.
Give it a test run and let me know how it works out for you. Let me know if it doesn't work, as it seems a little quirky with command and shell and powershell and whether it wants to shell out to a terminal or a console or just crap up sometimes. Something with SHELL just doesn't always want to play 100% reliable, unless you just tweak the command absolutely perfect.
SHELL "cmd /c powershell -command" <-- this seems redundant to me and unnecessary, but it's the only odd combination which seems to work unless I'm in a console window to start with. So we shell to command to run powershell to run the script. /sigh
And if that makes sense to anyone else, kindly explain it to me. WTF wouldn't SHELL "powershell - command" work just as easily?
|
