QB64.org Forum

Active Forums => Programs => Topic started by: bplus on January 31, 2022, 02:22:45 pm

Title: Quick Directory Files Listing for Windows Only
Post by: bplus on January 31, 2022, 02:22:45 pm
I thought I posted this already here at forum, maybe just Discord. I remember Spriggsy's help with Console use:
Code: QB64: [Select]
  1. _Title "Quick Dir Listing Windows only" ' b+ 2022-01-19
  2.  
  3. Dim Shared tmpDir As String '  establish a permanent spot for temp files
  4. If Environ$("TEMP") <> "" Then 'Thanks to Steve McNeill use user temp files directory
  5.     tmpDir = Environ$("TEMP")
  6. ElseIf Environ$("TMP") <> "" Then
  7.     tmpDir = Environ$("TMP")
  8. Else 'Thanks to Steve McNeill this should be very unlikely
  9.     If _DirExists("C:\temp") Then Else MkDir "C:\temp"
  10.     tmpDir = "C:\temp"
  11.  
  12. ' thanks Spriggsy  
  13. '$ScreenHide
  14. '_Console On
  15. '_Dest _Console
  16.  
  17.  
  18. ' assuming in th edirectory of interest otherwise chdir
  19. ChDir ".." ' the above directory
  20.  
  21. ReDim fileList$(0) ' setup Dynamic Array to load into
  22. loadFiles fileList$() ' get the files
  23.  
  24. ' see what we caught
  25. For i = 0 To UBound(fileList$) ' 0 item is always nothing so ubound of FileList$ = number of real files
  26.     Print i, fileList$(i)
  27.  
  28.     ' from here you can weed out the files you dont want
  29.  
  30.  
  31. ' nice simple little file catcher for Windows
  32. Sub loadFiles (fa() As String)
  33.     Dim tmpFile As String, Index%
  34.     tmpFile = tmpDir + "\FILE$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
  35.  
  36.     ' this sorts first by file extention then by filename
  37.     Shell _Hide "DIR *.* /a:-d /b /o:-gen > " + tmpFile
  38.     '*.* any name and extension
  39.     '/b is bare list
  40.     '/a:-d nodirectories
  41.     '/o:-gen no directories, sort by extension then name
  42.  
  43.     Open tmpFile$ For Input As #1
  44.     Do While Not EOF(1)
  45.         Index% = Index% + 1
  46.         ReDim _Preserve fa(Index%) As String
  47.         Line Input #1, fa(Index%)
  48.     Loop
  49.     Close #1
  50.     Kill tmpFile$
  51.  
  52.  

No you don't have to use this code in Console, I just did because it scrolls back so you can read longer lists.
You just need the first block that sets up TempDir variable and the Sub LoadFiles. You can mod that for particular use, say just looking for .bas files change *.* to *.bas :)

EDIT: sorry I posted old copy before Spriggsy help
Title: Re: Quick Directory Files Listing for Windows Only
Post by: SpriggsySpriggs on January 31, 2022, 03:36:20 pm
This is basically the same code as what's on the Wiki. I'd change this to use pipecom so you don't use temp files at all.
Title: Re: Quick Directory Files Listing for Windows Only
Post by: SierraKen on January 31, 2022, 03:47:12 pm
Pretty cool. If someone just wants to see all the files on a Notepad text file, a dir.txt (or any other name you want to make it), you just need to do this:

Code: QB64: [Select]
  1. a$ = "dir > C:\qb64\dir.txt"
  2. Shell _DontWait "c:\qb64\dir.txt"
  3.  
Title: Re: Quick Directory Files Listing for Windows Only
Post by: bplus on January 31, 2022, 04:08:11 pm
This is basically the same code as what's on the Wiki. I'd change this to use pipecom so you don't use temp files at all.

Sure, it's a quick fix for a beginner on Windows.

@SpriggsySpriggs  BTW last I heard with Pipecom you couldn't get Linux to cooperate with a proper split out of a simple file listing.
Title: Re: Quick Directory Files Listing for Windows Only
Post by: SMcNeill on January 31, 2022, 04:23:48 pm
I've always kind of wondered:  Why does no one ever mention the FILES command?
Title: Re: Quick Directory Files Listing for Windows Only
Post by: SpriggsySpriggs on January 31, 2022, 04:35:10 pm
@bplus That would be incorrect. It's been compatible with all operating systems since release. You might be thinking of a different issue where there was a null character throwing off results. That issue has since been resolved. However, the code you wrote here wasn't designed for Linux so even if my code wasn't compatible with Linux, it has no need to be mentioned here.
Title: Re: Quick Directory Files Listing for Windows Only
Post by: bplus on January 31, 2022, 05:09:43 pm
Here is my PipeCom version, @SpriggsySpriggs  might show us better???
Code: QB64: [Select]
  1. _Title "Windows Dir FileList" ' b+ 2022-01-31
  2.  
  3. ReDim FileList$(1 To 1) ' to call DirFiles with array name to load with files
  4. DirFiles FileList$() 'try the directory above current
  5. For i = 1 To UBound(FileList$)
  6.     If FileList$(i) <> "" Then Print i, FileList$(i)
  7.  
  8.  
  9. Sub DirFiles (FileList$())
  10.     a$ = pipecom_lite$("DIR *.* /a:-d /b /o:-gen")
  11.     Split a$, Chr$(10), FileList$()
  12.  
  13. ' note: I buggered this twice now, FOR base 1 array REDIM MyArray (1 to 1) AS ... the (1 to 1) is not same as (1) which was the Blunder!!!
  14. 'notes: REDIM the array(0) to be loaded before calling Split '<<<< IMPORTANT dynamic array and empty, can use any lbound though
  15. 'This SUB will take a given N delimited string, and delimiter$ and create an array of N+1 strings using the LBOUND of the given dynamic array to load.
  16. 'notes: the loadMeArray() needs to be dynamic string array and will not change the LBOUND of the array it is given.  rev 2019-08-27
  17. Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
  18.     Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
  19.     curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
  20.     dpos = InStr(curpos, SplitMeString, delim)
  21.     Do Until dpos = 0
  22.         loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
  23.         arrpos = arrpos + 1
  24.         If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
  25.         curpos = dpos + LD
  26.         dpos = InStr(curpos, SplitMeString, delim)
  27.     Loop
  28.     loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
  29.     ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
  30.  
  31. $If PIPECOM = UNDEFINED Then
  32.     $Let PIPECOM = TRUE
  33.     Function pipecom& (cmd As String, stdout As String, stderr As String)
  34.         stdout = "": stderr = ""
  35.         $If WIN Then
  36.             Type SECURITY_ATTRIBUTES
  37.                 As _Unsigned Long nLength
  38.                 $If 64BIT Then
  39.                     As String * 4 padding
  40.                 $End If
  41.                 As _Offset lpSecurityDescriptor
  42.                 As Long bInheritHandle
  43.                 $If 64BIT Then
  44.                     As String * 4 padding2
  45.                 $End If
  46.             End Type
  47.  
  48.             Type STARTUPINFO
  49.                 As Long cb
  50.                 $If 64BIT Then
  51.                     As String * 4 padding
  52.                 $End If
  53.                 As _Offset lpReserved, lpDesktop, lpTitle
  54.                 As _Unsigned Long dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
  55.                 As _Unsigned Integer wShowWindow, cbReserved2
  56.                 $If 64BIT Then
  57.                     As String * 4 padding2
  58.                 $End If
  59.                 As _Offset lpReserved2, hStdInput, hStdOutput, hStdError
  60.             End Type
  61.  
  62.             Type PROCESS_INFORMATION
  63.                 As _Offset hProcess, hThread
  64.                 As _Unsigned Long dwProcessId
  65.                 $If 64BIT Then
  66.                     As String * 4 padding
  67.                 $End If
  68.             End Type
  69.  
  70.             Const STARTF_USESTDHANDLES = &H00000100
  71.             Const CREATE_NO_WINDOW = &H8000000
  72.  
  73.             Const INFINITE = 4294967295
  74.             Const WAIT_FAILED = &HFFFFFFFF
  75.  
  76.             Declare CustomType Library
  77.                 Function CreatePipe& (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As _Unsigned Long)
  78.                 Function CreateProcess& (ByVal lpApplicationName As _Offset, Byval lpCommandLine As _Offset, Byval lpProcessAttributes As _Offset, Byval lpThreadAttributes As _Offset, Byval bInheritHandles As Long, Byval dwCreationFlags As _Unsigned Long, Byval lpEnvironment As _Offset, Byval lpCurrentDirectory As _Offset, Byval lpStartupInfo As _Offset, Byval lpProcessInformation As _Offset)
  79.                 Function GetExitCodeProcess& (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
  80.                 Sub HandleClose Alias "CloseHandle" (ByVal hObject As _Offset)
  81.                 Function ReadFile& (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As _Unsigned Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
  82.                 Function WaitForSingleObject~& (ByVal hHandle As _Offset, Byval dwMilliseconds As _Unsigned Long)
  83.             End Declare
  84.  
  85.             Dim As Long ok: ok = 1
  86.             Dim As _Offset hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
  87.             Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
  88.  
  89.             If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
  90.                 pipecom = -1
  91.                 Exit Function
  92.             End If
  93.  
  94.             If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
  95.                 pipecom = -1
  96.                 Exit Function
  97.             End If
  98.  
  99.             Dim As STARTUPINFO si
  100.             si.cb = Len(si)
  101.             si.dwFlags = STARTF_USESTDHANDLES
  102.             si.hStdError = hStdOutPipeError
  103.             si.hStdOutput = hStdOutPipeWrite
  104.             si.hStdInput = 0
  105.             Dim As PROCESS_INFORMATION procinfo
  106.             Dim As _Offset lpApplicationName
  107.             Dim As String lpCommandLine: lpCommandLine = "cmd /c " + cmd + Chr$(0)
  108.             Dim As _Offset lpProcessAttributes, lpThreadAttributes
  109.             Dim As Long bInheritHandles: bInheritHandles = 1
  110.             Dim As _Unsigned Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
  111.             Dim As _Offset lpEnvironment, lpCurrentDirectory
  112.             ok = CreateProcess(lpApplicationName, _Offset(lpCommandLine), lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory, _Offset(si), _Offset(procinfo))
  113.  
  114.             If ok = 0 Then
  115.                 pipecom = -1
  116.                 Exit Function
  117.             End If
  118.  
  119.             HandleClose hStdOutPipeWrite
  120.             HandleClose hStdOutPipeError
  121.  
  122.             Dim As String buf: buf = Space$(4096 + 1)
  123.             Dim As _Unsigned Long dwRead
  124.             While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
  125.                 buf = Mid$(buf, 1, dwRead)
  126.                 GoSub RemoveChr13
  127.                 stdout = stdout + buf
  128.                 buf = Space$(4096 + 1)
  129.             Wend
  130.  
  131.             While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
  132.                 buf = Mid$(buf, 1, dwRead)
  133.                 GoSub RemoveChr13
  134.                 stderr = stderr + buf
  135.                 buf = Space$(4096 + 1)
  136.             Wend
  137.  
  138.             Dim As Long exit_code, ex_stat
  139.             If WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED Then
  140.                 If GetExitCodeProcess(procinfo.hProcess, _Offset(exit_code)) Then
  141.                     ex_stat = 1
  142.                 End If
  143.             End If
  144.  
  145.             HandleClose hStdOutPipeRead
  146.             HandleClose hStdReadPipeError
  147.             If ex_stat = 1 Then
  148.                 pipecom = exit_code
  149.             Else
  150.                 pipecom = -1
  151.             End If
  152.  
  153.             Exit Function
  154.  
  155.             RemoveChr13:
  156.             Dim As Long j
  157.             j = InStr(buf, Chr$(13))
  158.             Do While j
  159.                 buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
  160.                 j = InStr(buf, Chr$(13))
  161.             Loop
  162.             Return
  163.         $Else
  164.             Declare CustomType Library
  165.             Function popen%& (cmd As String, readtype As String)
  166.             Function feof& (ByVal stream As _Offset)
  167.             Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
  168.             Function pclose& (ByVal stream As _Offset)
  169.             End Declare
  170.  
  171.             Declare Library
  172.             Function WEXITSTATUS& (ByVal stat_val As Long)
  173.             End Declare
  174.  
  175.             Dim As _Offset stream
  176.  
  177.             Dim buffer As String * 4096
  178.             If _FileExists("pipestderr") Then
  179.             Kill "pipestderr"
  180.             End If
  181.             stream = popen(cmd + " 2>pipestderr", "r")
  182.             If stream Then
  183.             While feof(stream) = 0
  184.             If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
  185.             stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
  186.             End If
  187.             Wend
  188.             Dim As Long status, exit_code
  189.             status = pclose(stream)
  190.             exit_code = WEXITSTATUS(status)
  191.             If _FileExists("pipestderr") Then
  192.             Dim As Integer errfile
  193.             errfile = FreeFile
  194.             Open "pipestderr" For Binary As #errfile
  195.             If LOF(errfile) > 0 Then
  196.             stderr = Space$(LOF(errfile))
  197.             Get #errfile, , stderr
  198.             End If
  199.             Close #errfile
  200.             Kill "pipestderr"
  201.             End If
  202.             pipecom = exit_code
  203.             Else
  204.             pipecom = -1
  205.             End If
  206.         $End If
  207.  
  208.     Function pipecom_lite$ (cmd As String)
  209.         Dim As Long a
  210.         Dim As String stdout, stderr
  211.         a = pipecom(cmd, stdout, stderr)
  212.         If stderr <> "" Then
  213.             pipecom_lite = stderr
  214.         Else
  215.             pipecom_lite = stdout
  216.         End If
  217.  

In LOC the first version wins hands down! ;-))
Title: Re: Quick Directory Files Listing for Windows Only
Post by: _vince on January 31, 2022, 06:26:00 pm
nicely done, bplus.  First win, then come back to win again at their own game
Title: Re: Quick Directory Files Listing for Windows Only
Post by: SMcNeill on January 31, 2022, 08:20:17 pm
Here's the quickest, dirtest, old-skool way of doing this:

Code: QB64: [Select]
  1. Screen _NewImage(1280, 720, 256)
  2. Print File$("*.BAS")
  3.  
  4. Function File$ (limit$)
  5.     Dim m As _MEM, s As String * 1
  6.     d = _Dest
  7.     tempimage = _NewImage(256, 10000, 0)
  8.     _Dest tempimage: m = _MemImage(tempimage)
  9.     Files limit$
  10.     _Dest d
  11.  
  12.     f$ = Space$(m.SIZE)
  13.     Do
  14.         $Checking:Off
  15.         _MemGet m, m.OFFSET + o, s
  16.         Mid$(f$, o \ 2 + 1) = s
  17.         o = o + 2
  18.         If s = " " Then count = count + 1 Else count = 0
  19.         If count > 1000 Then f$ = Left$(f$, o \ 2 - 999): Exit Do '1000 spaces = END OF DATA.  No need to read further
  20.         $Checking:On
  21.     Loop Until o >= m.SIZE
  22.     File$ = f$
  23.     _FreeImage tempimage
  24.  

All the data is now stored in a single string, so parsing it might be a little bit of a challenge, but at least there's your data -- and using the built in FILES command to boot!!
Title: Re: Quick Directory Files Listing for Windows Only
Post by: bplus on January 31, 2022, 08:48:16 pm
Wow, that's interesting!

Oh crap, I ran the code and it's not helpful, all files more than 8 chars are abbreviated.
Title: Re: Quick Directory Files Listing for Windows Only
Post by: SMcNeill on January 31, 2022, 09:50:39 pm
Wow, that's interesting!

Oh crap, I ran the code and it's not helpful, all files more than 8 chars are abbreviated.

That's how QB45 and the old DOS systems used to be limited with file names.  8 characters plus 3 for the extension.  Windows will still work with those abbreviated file names -- if you can keep your programs straight with them!

Note how FILES only prints those names to your screen.  You've got to read them back into your program from there, if you actually want to make use of them!!

Personally, I'll just stick with the cross-platform "direntry.h" method.  ;)
Title: Re: Quick Directory Files Listing for Windows Only
Post by: bplus on January 31, 2022, 10:03:54 pm
Quote
Personally, I'll just stick with the cross-platform "direntry.h" method.  ;)

Yeah my choice for complete navigation in oh.

Although pipecom might cover oh's shell needs, I don't know how Linux or other OS handle file commands.
Title: Re: Quick Directory Files Listing for Windows Only
Post by: SpriggsySpriggs on February 01, 2022, 02:47:08 am
Since we're doing Windows only:

Code: QB64: [Select]
  1. Option Explicit
  2.  
  3. Const MAX_PATH = 260
  4.  
  5. Type FILETIME
  6.     As Unsigned Long dwLowDateTime, dwHighDateTime
  7.  
  8. Type WIN32_FIND_DATA
  9.     As Unsigned Long dwFileAttributes
  10.     As FILETIME ftCreationTime, ftLastAccessTime, ftLastWriteTime
  11.     As Unsigned Long nFileSizeHigh, nFileSizeLow, dwReserved0, dwReserved1
  12.     As String * Max_path cFileName
  13.     As String * 14 cAlternateFileName
  14.     As Unsigned Long dwFileType, dwCreatorType
  15.     As Unsigned Integer wFinderFlags
  16.  
  17.     Function FindFirstFile%& (ByVal lpFileName As Offset, Byval lpFindFileData As Offset)
  18.     Function FindNextFile& (ByVal hFindFile As Offset, Byval lpFindFileData As Offset)
  19.  
  20. Dim As String start: start = CWD$ + "\*.bas" + Chr$(0)
  21. Dim As Offset lpFileName: lpFileName = Offset(start)
  22. Dim As WIN32_FIND_DATA find
  23.  
  24. ReDim As String * MAX_PATH filelist(0 To 0)
  25.  
  26. Dim As Offset hFind: hFind = FindFirstFile(lpFileName, Offset(find))
  27.  
  28. If hFind Then
  29.     Dim As Unsigned Integer64 filesize: filesize = SHL(find.nFileSizeHigh, 32) Or find.nFileSizeLow
  30.     filelist(0) = find.cFileName
  31.     Print filelist(0), filesize; "bytes"
  32.     While FindNextFile(hFind, Offset(find))
  33.         filesize = SHL(find.nFileSizeHigh, 32) Or find.nFileSizeLow
  34.         ReDim Preserve As String * 260 filelist(UBound(filelist) + 1)
  35.         filelist(UBound(filelist)) = find.cFileName
  36.         Print filelist(UBound(filelist)), filesize; "bytes"
  37.     Wend
  38.     Print UBound(filelist); "files"
Title: Re: Quick Directory Files Listing for Windows Only
Post by: SpriggsySpriggs on February 01, 2022, 03:09:17 am
But if we're going to stick to using dir commands, I think my way of splitting a string into an array is slightly better:

Code: QB64: [Select]
  1.  
  2. comm = pipecom_lite("DIR *.* /a:-d /b /o:-gen")
  3.  
  4. ReDim As String filelist(0 To 0)
  5. tokenize comm, Chr$(10), filelist()
  6. For i = 0 To UBound(filelist) - 1
  7.     Print i + 1, filelist(i)
  8.  
  9. Function pointerToString$ (pointer As _Offset)
  10.         Function strlen%& (ByVal ptr As _Unsigned _Offset)
  11.     End Declare
  12.     Dim As _Offset length: length = strlen(pointer)
  13.     If length Then
  14.         Dim As _MEM pString: pString = _Mem(pointer, length)
  15.         Dim As String ret: ret = Space$(length)
  16.         _MemGet pString, pString.OFFSET, ret
  17.         _MemFree pString
  18.     End If
  19.     pointerToString = ret
  20.  
  21. Sub tokenize (toTokenize As String, delimiters As String, StorageArray() As String)
  22.         Function strtok%& (ByVal str As _Offset, delimiters As String)
  23.     End Declare
  24.     Dim As _Offset tokenized
  25.     Dim As String tokCopy: tokCopy = toTokenize + Chr$(0)
  26.     Dim As String delCopy: delCopy = delimiters + Chr$(0)
  27.     Dim As _Unsigned Long lowerbound: lowerbound = LBound(StorageArray)
  28.     Dim As _Unsigned Long i: i = lowerbound
  29.     tokenized = strtok(_Offset(tokCopy), delCopy)
  30.     While tokenized <> 0
  31.         ReDim _Preserve StorageArray(lowerbound To UBound(StorageArray) + 1)
  32.         StorageArray(i) = pointerToString(tokenized)
  33.         tokenized = strtok(0, delCopy)
  34.         i = i + 1
  35.     Wend
  36.     ReDim _Preserve StorageArray(UBound(StorageArray) - 1)
  37.  
  38. $If PIPECOM = UNDEFINED Then
  39.     $Let PIPECOM = TRUE
  40.     Function pipecom& (cmd As String, stdout As String, stderr As String)
  41.         stdout = "": stderr = ""
  42.         $If WIN Then
  43.             Type SECURITY_ATTRIBUTES
  44.                 As _Unsigned Long nLength
  45.                 $If 64BIT Then
  46.                     As String * 4 padding
  47.                 $End If
  48.                 As _Offset lpSecurityDescriptor
  49.                 As Long bInheritHandle
  50.                 $If 64BIT Then
  51.                     As String * 4 padding2
  52.                 $End If
  53.             End Type
  54.  
  55.             Type STARTUPINFO
  56.                 As Long cb
  57.                 $If 64BIT Then
  58.                     As String * 4 padding
  59.                 $End If
  60.                 As _Offset lpReserved, lpDesktop, lpTitle
  61.                 As _Unsigned Long dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
  62.                 As _Unsigned Integer wShowWindow, cbReserved2
  63.                 $If 64BIT Then
  64.                     As String * 4 padding2
  65.                 $End If
  66.                 As _Offset lpReserved2, hStdInput, hStdOutput, hStdError
  67.             End Type
  68.  
  69.             Type PROCESS_INFORMATION
  70.                 As _Offset hProcess, hThread
  71.                 As _Unsigned Long dwProcessId
  72.                 $If 64BIT Then
  73.                     As String * 4 padding
  74.                 $End If
  75.             End Type
  76.  
  77.             Const STARTF_USESTDHANDLES = &H00000100
  78.             Const CREATE_NO_WINDOW = &H8000000
  79.  
  80.             Const INFINITE = 4294967295
  81.             Const WAIT_FAILED = &HFFFFFFFF
  82.  
  83.             Declare CustomType Library
  84.                 Function CreatePipe& (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As _Unsigned Long)
  85.                 Function CreateProcess& (ByVal lpApplicationName As _Offset, Byval lpCommandLine As _Offset, Byval lpProcessAttributes As _Offset, Byval lpThreadAttributes As _Offset, Byval bInheritHandles As Long, Byval dwCreationFlags As _Unsigned Long, Byval lpEnvironment As _Offset, Byval lpCurrentDirectory As _Offset, Byval lpStartupInfo As _Offset, Byval lpProcessInformation As _Offset)
  86.                 Function GetExitCodeProcess& (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
  87.                 Sub HandleClose Alias "CloseHandle" (ByVal hObject As _Offset)
  88.                 Function ReadFile& (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As _Unsigned Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
  89.                 Function WaitForSingleObject~& (ByVal hHandle As _Offset, Byval dwMilliseconds As _Unsigned Long)
  90.             End Declare
  91.  
  92.             Dim As Long ok: ok = 1
  93.             Dim As _Offset hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
  94.             Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
  95.  
  96.             If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
  97.                 pipecom = -1
  98.                 Exit Function
  99.             End If
  100.  
  101.             If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
  102.                 pipecom = -1
  103.                 Exit Function
  104.             End If
  105.  
  106.             Dim As STARTUPINFO si
  107.             si.cb = Len(si)
  108.             si.dwFlags = STARTF_USESTDHANDLES
  109.             si.hStdError = hStdOutPipeError
  110.             si.hStdOutput = hStdOutPipeWrite
  111.             si.hStdInput = 0
  112.             Dim As PROCESS_INFORMATION procinfo
  113.             Dim As _Offset lpApplicationName
  114.             Dim As String lpCommandLine: lpCommandLine = "cmd /c " + cmd + Chr$(0)
  115.             Dim As _Offset lpProcessAttributes, lpThreadAttributes
  116.             Dim As Long bInheritHandles: bInheritHandles = 1
  117.             Dim As _Unsigned Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
  118.             Dim As _Offset lpEnvironment, lpCurrentDirectory
  119.             ok = CreateProcess(lpApplicationName, _Offset(lpCommandLine), lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory, _Offset(si), _Offset(procinfo))
  120.  
  121.             If ok = 0 Then
  122.                 pipecom = -1
  123.                 Exit Function
  124.             End If
  125.  
  126.             HandleClose hStdOutPipeWrite
  127.             HandleClose hStdOutPipeError
  128.  
  129.             Dim As String buf: buf = Space$(4096 + 1)
  130.             Dim As _Unsigned Long dwRead
  131.             While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
  132.                 buf = Mid$(buf, 1, dwRead)
  133.                 GoSub RemoveChr13
  134.                 stdout = stdout + buf
  135.                 buf = Space$(4096 + 1)
  136.             Wend
  137.  
  138.             While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
  139.                 buf = Mid$(buf, 1, dwRead)
  140.                 GoSub RemoveChr13
  141.                 stderr = stderr + buf
  142.                 buf = Space$(4096 + 1)
  143.             Wend
  144.  
  145.             Dim As Long exit_code, ex_stat
  146.             If WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED Then
  147.                 If GetExitCodeProcess(procinfo.hProcess, _Offset(exit_code)) Then
  148.                     ex_stat = 1
  149.                 End If
  150.             End If
  151.  
  152.             HandleClose hStdOutPipeRead
  153.             HandleClose hStdReadPipeError
  154.             If ex_stat = 1 Then
  155.                 pipecom = exit_code
  156.             Else
  157.                 pipecom = -1
  158.             End If
  159.  
  160.             Exit Function
  161.  
  162.             RemoveChr13:
  163.             Dim As Long j
  164.             j = InStr(buf, Chr$(13))
  165.             Do While j
  166.                 buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
  167.                 j = InStr(buf, Chr$(13))
  168.             Loop
  169.             Return
  170.         $Else
  171.             Declare CustomType Library
  172.             Function popen%& (cmd As String, readtype As String)
  173.             Function feof& (ByVal stream As _Offset)
  174.             Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
  175.             Function pclose& (ByVal stream As _Offset)
  176.             End Declare
  177.  
  178.             Declare Library
  179.             Function WEXITSTATUS& (ByVal stat_val As Long)
  180.             End Declare
  181.  
  182.             Dim As _Offset stream
  183.  
  184.             Dim buffer As String * 4096
  185.             If _FileExists("pipestderr") Then
  186.             Kill "pipestderr"
  187.             End If
  188.             stream = popen(cmd + " 2>pipestderr" + Chr$(0), "r")
  189.             If stream Then
  190.             While feof(stream) = 0
  191.             If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
  192.             stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
  193.             End If
  194.             Wend
  195.             Dim As Long status, exit_code
  196.             status = pclose(stream)
  197.             exit_code = WEXITSTATUS(status)
  198.             If _FileExists("pipestderr") Then
  199.             Dim As Integer errfile
  200.             errfile = FreeFile
  201.             Open "pipestderr" For Binary As #errfile
  202.             If LOF(errfile) > 0 Then
  203.             stderr = Space$(LOF(errfile))
  204.             Get #errfile, , stderr
  205.             End If
  206.             Close #errfile
  207.             Kill "pipestderr"
  208.             End If
  209.             pipecom = exit_code
  210.             Else
  211.             pipecom = -1
  212.             End If
  213.         $End If
  214.  
  215.     Function pipecom_lite$ (cmd As String)
  216.         Dim As Long a
  217.         Dim As String stdout, stderr
  218.         a = pipecom(cmd, stdout, stderr)
  219.         If stderr <> "" Then
  220.             pipecom_lite = stderr
  221.         Else
  222.             pipecom_lite = stdout
  223.         End If
  224.  
Title: Re: Quick Directory Files Listing for Windows Only
Post by: bplus on February 01, 2022, 11:52:19 am
Since we're doing Windows only:

Code: QB64: [Select]
  1. Option Explicit
  2.  
  3. Const MAX_PATH = 260
  4.  
  5. Type FILETIME
  6.     As Unsigned Long dwLowDateTime, dwHighDateTime
  7.  
  8. Type WIN32_FIND_DATA
  9.     As Unsigned Long dwFileAttributes
  10.     As FILETIME ftCreationTime, ftLastAccessTime, ftLastWriteTime
  11.     As Unsigned Long nFileSizeHigh, nFileSizeLow, dwReserved0, dwReserved1
  12.     As String * Max_path cFileName
  13.     As String * 14 cAlternateFileName
  14.     As Unsigned Long dwFileType, dwCreatorType
  15.     As Unsigned Integer wFinderFlags
  16.  
  17.     Function FindFirstFile%& (ByVal lpFileName As Offset, Byval lpFindFileData As Offset)
  18.     Function FindNextFile& (ByVal hFindFile As Offset, Byval lpFindFileData As Offset)
  19.  
  20. Dim As String start: start = CWD$ + "\*.bas" + Chr$(0)
  21. Dim As Offset lpFileName: lpFileName = Offset(start)
  22. Dim As WIN32_FIND_DATA find
  23.  
  24. ReDim As String * MAX_PATH filelist(0 To 0)
  25.  
  26. Dim As Offset hFind: hFind = FindFirstFile(lpFileName, Offset(find))
  27.  
  28. If hFind Then
  29.     Dim As Unsigned Integer64 filesize: filesize = SHL(find.nFileSizeHigh, 32) Or find.nFileSizeLow
  30.     filelist(0) = find.cFileName
  31.     Print filelist(0), filesize; "bytes"
  32.     While FindNextFile(hFind, Offset(find))
  33.         filesize = SHL(find.nFileSizeHigh, 32) Or find.nFileSizeLow
  34.         ReDim Preserve As String * 260 filelist(UBound(filelist) + 1)
  35.         filelist(UBound(filelist)) = find.cFileName
  36.         Print filelist(UBound(filelist)), filesize; "bytes"
  37.     Wend
  38.     Print UBound(filelist); "files"

Really looking for a nice clean listing of all the files in the Directory without more details than filename but nice to see less LOC though I don't see newbies using this code. We are lucky if they are using Subs and Functions.
Title: Re: Quick Directory Files Listing for Windows Only
Post by: tomxp411 on February 01, 2022, 11:36:56 pm
I've always kind of wondered:  Why does no one ever mention the FILES command?

Because it's kind of useless if you need an array with a list of filenames, say for a file picker.