Author Topic: Quick Directory Files Listing for Windows Only (Read 7158 times)

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]

_Title "Quick Dir Listing Windows only" ' b+ 2022-01-19
 
Dim Shared tmpDir As String '  establish a permanent spot for temp files
If Environ$("TEMP") <> "" Then 'Thanks to Steve McNeill use user temp files directory
    tmpDir = Environ$("TEMP")
ElseIf Environ$("TMP") <> "" Then
    tmpDir = Environ$("TMP")
Else 'Thanks to Steve McNeill this should be very unlikely
    If _DirExists("C:\temp") Then Else MkDir "C:\temp"
    tmpDir = "C:\temp"
End If
 
' thanks Spriggsy   
$Console:Only
'$ScreenHide
'_Console On
'_Dest _Console
 
 
' assuming in th edirectory of interest otherwise chdir
ChDir ".." ' the above directory
 
ReDim fileList$(0) ' setup Dynamic Array to load into
loadFiles fileList$() ' get the files
 
' see what we caught
For i = 0 To UBound(fileList$) ' 0 item is always nothing so ubound of FileList$ = number of real files
    Print i, fileList$(i)
 
    ' from here you can weed out the files you dont want
 
Next
 
' nice simple little file catcher for Windows
Sub loadFiles (fa() As String)
    Dim tmpFile As String, Index%
    tmpFile = tmpDir + "\FILE$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
 
    ' this sorts first by file extention then by filename
    Shell _Hide "DIR *.* /a:-d /b /o:-gen > " + tmpFile
    '*.* any name and extension
    '/b is bare list
    '/a:-d nodirectories
    '/o:-gen no directories, sort by extension then name
 
    Open tmpFile$ For Input As #1
    Do While Not EOF(1)
        Index% = Index% + 1
        ReDim _Preserve fa(Index%) As String
        Line Input #1, fa(Index%)
    Loop
    Close #1
    Kill tmpFile$
End Sub
 
 

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

SpriggsySpriggs · « **Reply #1 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.

SierraKen · « **Reply #2 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]

a$ = "dir > C:\qb64\dir.txt"
Shell _Hide _DontWait a$
Shell _DontWait "c:\qb64\dir.txt"
 

bplus · « **Reply #3 on:** January 31, 2022, 04:08:11 pm »

Quote from: 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.

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.

SMcNeill · « **Reply #4 on:** January 31, 2022, 04:23:48 pm »

I've always kind of wondered: Why does no one ever mention the FILES command?

SpriggsySpriggs · « **Reply #5 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.

bplus · « **Reply #6 on:** January 31, 2022, 05:09:43 pm »

Here is my PipeCom version, @SpriggsySpriggs might show us better???

Code: QB64: [Select]

_Title "Windows Dir FileList" ' b+ 2022-01-31
 
ReDim FileList$(1 To 1) ' to call DirFiles with array name to load with files
DirFiles FileList$() 'try the directory above current
For i = 1 To UBound(FileList$)
    If FileList$(i) <> "" Then Print i, FileList$(i)
Next
 
 
Sub DirFiles (FileList$())
    a$ = pipecom_lite$("DIR *.* /a:-d /b /o:-gen")
    Split a$, Chr$(10), FileList$()
End Sub
 
' 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!!!
'notes: REDIM the array(0) to be loaded before calling Split '<<<< IMPORTANT dynamic array and empty, can use any lbound though
'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.
'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
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
    Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
    dpos = InStr(curpos, SplitMeString, delim)
    Do Until dpos = 0
        loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
        curpos = dpos + LD
        dpos = InStr(curpos, SplitMeString, delim)
    Loop
    loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
    ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub
 
$If PIPECOM = UNDEFINED Then
    $Let PIPECOM = TRUE
    Function pipecom& (cmd As String, stdout As String, stderr As String)
        stdout = "": stderr = ""
        $If WIN Then
            Type SECURITY_ATTRIBUTES
                As _Unsigned Long nLength
                $If 64BIT Then
                    As String * 4 padding
                $End If
                As _Offset lpSecurityDescriptor
                As Long bInheritHandle
                $If 64BIT Then
                    As String * 4 padding2
                $End If
            End Type
 
            Type STARTUPINFO
                As Long cb
                $If 64BIT Then
                    As String * 4 padding
                $End If
                As _Offset lpReserved, lpDesktop, lpTitle
                As _Unsigned Long dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
                As _Unsigned Integer wShowWindow, cbReserved2
                $If 64BIT Then
                    As String * 4 padding2
                $End If
                As _Offset lpReserved2, hStdInput, hStdOutput, hStdError
            End Type
 
            Type PROCESS_INFORMATION
                As _Offset hProcess, hThread
                As _Unsigned Long dwProcessId
                $If 64BIT Then
                    As String * 4 padding
                $End If
            End Type
 
            Const STARTF_USESTDHANDLES = &H00000100
            Const CREATE_NO_WINDOW = &H8000000
 
            Const INFINITE = 4294967295
            Const WAIT_FAILED = &HFFFFFFFF
 
            Declare CustomType Library
                Function CreatePipe& (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As _Unsigned Long)
                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)
                Function GetExitCodeProcess& (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
                Sub HandleClose Alias "CloseHandle" (ByVal hObject As _Offset)
                Function ReadFile& (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As _Unsigned Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
                Function WaitForSingleObject~& (ByVal hHandle As _Offset, Byval dwMilliseconds As _Unsigned Long)
            End Declare
 
            Dim As Long ok: ok = 1
            Dim As _Offset hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
            Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
 
            If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            Dim As STARTUPINFO si
            si.cb = Len(si)
            si.dwFlags = STARTF_USESTDHANDLES
            si.hStdError = hStdOutPipeError
            si.hStdOutput = hStdOutPipeWrite
            si.hStdInput = 0
            Dim As PROCESS_INFORMATION procinfo
            Dim As _Offset lpApplicationName
            Dim As String lpCommandLine: lpCommandLine = "cmd /c " + cmd + Chr$(0)
            Dim As _Offset lpProcessAttributes, lpThreadAttributes
            Dim As Long bInheritHandles: bInheritHandles = 1
            Dim As _Unsigned Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
            Dim As _Offset lpEnvironment, lpCurrentDirectory
            ok = CreateProcess(lpApplicationName, _Offset(lpCommandLine), lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory, _Offset(si), _Offset(procinfo))
 
            If ok = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            HandleClose hStdOutPipeWrite
            HandleClose hStdOutPipeError
 
            Dim As String buf: buf = Space$(4096 + 1)
            Dim As _Unsigned Long dwRead
            While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
                buf = Mid$(buf, 1, dwRead)
                GoSub RemoveChr13
                stdout = stdout + buf
                buf = Space$(4096 + 1)
            Wend
 
            While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
                buf = Mid$(buf, 1, dwRead)
                GoSub RemoveChr13
                stderr = stderr + buf
                buf = Space$(4096 + 1)
            Wend
 
            Dim As Long exit_code, ex_stat
            If WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED Then
                If GetExitCodeProcess(procinfo.hProcess, _Offset(exit_code)) Then
                    ex_stat = 1
                End If
            End If
 
            HandleClose hStdOutPipeRead
            HandleClose hStdReadPipeError
            If ex_stat = 1 Then
                pipecom = exit_code
            Else
                pipecom = -1
            End If
 
            Exit Function
 
            RemoveChr13:
            Dim As Long j
            j = InStr(buf, Chr$(13))
            Do While j
                buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
                j = InStr(buf, Chr$(13))
            Loop
            Return
        $Else
            Declare CustomType Library
            Function popen%& (cmd As String, readtype As String)
            Function feof& (ByVal stream As _Offset)
            Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
            Function pclose& (ByVal stream As _Offset)
            End Declare
 
            Declare Library
            Function WEXITSTATUS& (ByVal stat_val As Long)
            End Declare
 
            Dim As _Offset stream
 
            Dim buffer As String * 4096
            If _FileExists("pipestderr") Then
            Kill "pipestderr"
            End If
            stream = popen(cmd + " 2>pipestderr", "r")
            If stream Then
            While feof(stream) = 0
            If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
            stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
            End If
            Wend
            Dim As Long status, exit_code
            status = pclose(stream)
            exit_code = WEXITSTATUS(status)
            If _FileExists("pipestderr") Then
            Dim As Integer errfile
            errfile = FreeFile
            Open "pipestderr" For Binary As #errfile
            If LOF(errfile) > 0 Then
            stderr = Space$(LOF(errfile))
            Get #errfile, , stderr
            End If
            Close #errfile
            Kill "pipestderr"
            End If
            pipecom = exit_code
            Else
            pipecom = -1
            End If
        $End If
    End Function
 
    Function pipecom_lite$ (cmd As String)
        Dim As Long a
        Dim As String stdout, stderr
        a = pipecom(cmd, stdout, stderr)
        If stderr <> "" Then
            pipecom_lite = stderr
        Else
            pipecom_lite = stdout
        End If
    End Function
$End If
 

In LOC the first version wins hands down! ;-))

_vince · « **Reply #7 on:** January 31, 2022, 06:26:00 pm »

nicely done, bplus. First win, then come back to win again at their own game

SMcNeill · « **Reply #8 on:** January 31, 2022, 08:20:17 pm »

Here's the quickest, dirtest, old-skool way of doing this:

Code: QB64: [Select]

Screen _NewImage(1280, 720, 256)
Print File$("*.BAS")
 
Function File$ (limit$)
    Dim m As _MEM, s As String * 1
    d = _Dest
    tempimage = _NewImage(256, 10000, 0)
    _Dest tempimage: m = _MemImage(tempimage)
    Files limit$
    _Dest d
 
    f$ = Space$(m.SIZE)
    Do
        $Checking:Off
        _MemGet m, m.OFFSET + o, s
        Mid$(f$, o \ 2 + 1) = s
        o = o + 2
        If s = " " Then count = count + 1 Else count = 0
        If count > 1000 Then f$ = Left$(f$, o \ 2 - 999): Exit Do '1000 spaces = END OF DATA.  No need to read further
        $Checking:On
    Loop Until o >= m.SIZE
    File$ = f$
    _FreeImage tempimage
End Function
 

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!!

bplus · « **Reply #9 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.

SMcNeill · « **Reply #10 on:** January 31, 2022, 09:50:39 pm »

Quote from: 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.

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. ;)

bplus · « **Reply #11 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.

SpriggsySpriggs · « **Reply #12 on:** February 01, 2022, 02:47:08 am »

Since we're doing Windows only:

Code: QB64: [Select]

Option Explicit
$NoPrefix
$Console:Only
 
Const MAX_PATH = 260
 
Type FILETIME
    As Unsigned Long dwLowDateTime, dwHighDateTime
End Type
 
Type WIN32_FIND_DATA
    As Unsigned Long dwFileAttributes
    As FILETIME ftCreationTime, ftLastAccessTime, ftLastWriteTime
    As Unsigned Long nFileSizeHigh, nFileSizeLow, dwReserved0, dwReserved1
    As String * Max_path cFileName
    As String * 14 cAlternateFileName
    As Unsigned Long dwFileType, dwCreatorType
    As Unsigned Integer wFinderFlags
End Type
 
Declare CustomType Library
    Function FindFirstFile%& (ByVal lpFileName As Offset, Byval lpFindFileData As Offset)
    Function FindNextFile& (ByVal hFindFile As Offset, Byval lpFindFileData As Offset)
End Declare
 
Dim As String start: start = CWD$ + "\*.bas" + Chr$(0)
Dim As Offset lpFileName: lpFileName = Offset(start)
Dim As WIN32_FIND_DATA find
 
ReDim As String * MAX_PATH filelist(0 To 0)
 
Dim As Offset hFind: hFind = FindFirstFile(lpFileName, Offset(find))
 
If hFind Then
    Dim As Unsigned Integer64 filesize: filesize = SHL(find.nFileSizeHigh, 32) Or find.nFileSizeLow
    filelist(0) = find.cFileName
    Print filelist(0), filesize; "bytes"
    While FindNextFile(hFind, Offset(find))
        filesize = SHL(find.nFileSizeHigh, 32) Or find.nFileSizeLow
        ReDim Preserve As String * 260 filelist(UBound(filelist) + 1)
        filelist(UBound(filelist)) = find.cFileName
        Print filelist(UBound(filelist)), filesize; "bytes"
    Wend
    Print UBound(filelist); "files"
End If

SpriggsySpriggs · « **Reply #13 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]

Option _Explicit
$Console:Only
 
Dim comm As String
comm = pipecom_lite("DIR *.* /a:-d /b /o:-gen")
 
ReDim As String filelist(0 To 0)
tokenize comm, Chr$(10), filelist()
Dim As _Integer64 i
For i = 0 To UBound(filelist) - 1
    Print i + 1, filelist(i)
Next
Sleep
 
Function pointerToString$ (pointer As _Offset)
    Declare CustomType Library
        Function strlen%& (ByVal ptr As _Unsigned _Offset)
    End Declare
    Dim As _Offset length: length = strlen(pointer)
    If length Then
        Dim As _MEM pString: pString = _Mem(pointer, length)
        Dim As String ret: ret = Space$(length)
        _MemGet pString, pString.OFFSET, ret
        _MemFree pString
    End If
    pointerToString = ret
End Function
 
Sub tokenize (toTokenize As String, delimiters As String, StorageArray() As String)
    Declare CustomType Library
        Function strtok%& (ByVal str As _Offset, delimiters As String)
    End Declare
    Dim As _Offset tokenized
    Dim As String tokCopy: tokCopy = toTokenize + Chr$(0)
    Dim As String delCopy: delCopy = delimiters + Chr$(0)
    Dim As _Unsigned Long lowerbound: lowerbound = LBound(StorageArray)
    Dim As _Unsigned Long i: i = lowerbound
    tokenized = strtok(_Offset(tokCopy), delCopy)
    While tokenized <> 0
        ReDim _Preserve StorageArray(lowerbound To UBound(StorageArray) + 1)
        StorageArray(i) = pointerToString(tokenized)
        tokenized = strtok(0, delCopy)
        i = i + 1
    Wend
    ReDim _Preserve StorageArray(UBound(StorageArray) - 1)
End Sub
 
$If PIPECOM = UNDEFINED Then
    $Let PIPECOM = TRUE
    Function pipecom& (cmd As String, stdout As String, stderr As String)
        stdout = "": stderr = ""
        $If WIN Then
            Type SECURITY_ATTRIBUTES
                As _Unsigned Long nLength
                $If 64BIT Then
                    As String * 4 padding
                $End If
                As _Offset lpSecurityDescriptor
                As Long bInheritHandle
                $If 64BIT Then
                    As String * 4 padding2
                $End If
            End Type
 
            Type STARTUPINFO
                As Long cb
                $If 64BIT Then
                    As String * 4 padding
                $End If
                As _Offset lpReserved, lpDesktop, lpTitle
                As _Unsigned Long dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags
                As _Unsigned Integer wShowWindow, cbReserved2
                $If 64BIT Then
                    As String * 4 padding2
                $End If
                As _Offset lpReserved2, hStdInput, hStdOutput, hStdError
            End Type
 
            Type PROCESS_INFORMATION
                As _Offset hProcess, hThread
                As _Unsigned Long dwProcessId
                $If 64BIT Then
                    As String * 4 padding
                $End If
            End Type
 
            Const STARTF_USESTDHANDLES = &H00000100
            Const CREATE_NO_WINDOW = &H8000000
 
            Const INFINITE = 4294967295
            Const WAIT_FAILED = &HFFFFFFFF
 
            Declare CustomType Library
                Function CreatePipe& (ByVal hReadPipe As _Offset, Byval hWritePipe As _Offset, Byval lpPipeAttributes As _Offset, Byval nSize As _Unsigned Long)
                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)
                Function GetExitCodeProcess& (ByVal hProcess As _Offset, Byval lpExitCode As _Offset)
                Sub HandleClose Alias "CloseHandle" (ByVal hObject As _Offset)
                Function ReadFile& (ByVal hFile As _Offset, Byval lpBuffer As _Offset, Byval nNumberOfBytesToRead As _Unsigned Long, Byval lpNumberOfBytesRead As _Offset, Byval lpOverlapped As _Offset)
                Function WaitForSingleObject~& (ByVal hHandle As _Offset, Byval dwMilliseconds As _Unsigned Long)
            End Declare
 
            Dim As Long ok: ok = 1
            Dim As _Offset hStdOutPipeRead, hStdOutPipeWrite, hStdReadPipeError, hStdOutPipeError
            Dim As SECURITY_ATTRIBUTES sa: sa.nLength = Len(sa): sa.lpSecurityDescriptor = 0: sa.bInheritHandle = 1
 
            If CreatePipe(_Offset(hStdOutPipeRead), _Offset(hStdOutPipeWrite), _Offset(sa), 0) = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            If CreatePipe(_Offset(hStdReadPipeError), _Offset(hStdOutPipeError), _Offset(sa), 0) = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            Dim As STARTUPINFO si
            si.cb = Len(si)
            si.dwFlags = STARTF_USESTDHANDLES
            si.hStdError = hStdOutPipeError
            si.hStdOutput = hStdOutPipeWrite
            si.hStdInput = 0
            Dim As PROCESS_INFORMATION procinfo
            Dim As _Offset lpApplicationName
            Dim As String lpCommandLine: lpCommandLine = "cmd /c " + cmd + Chr$(0)
            Dim As _Offset lpProcessAttributes, lpThreadAttributes
            Dim As Long bInheritHandles: bInheritHandles = 1
            Dim As _Unsigned Long dwCreationFlags: dwCreationFlags = CREATE_NO_WINDOW
            Dim As _Offset lpEnvironment, lpCurrentDirectory
            ok = CreateProcess(lpApplicationName, _Offset(lpCommandLine), lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDirectory, _Offset(si), _Offset(procinfo))
 
            If ok = 0 Then
                pipecom = -1
                Exit Function
            End If
 
            HandleClose hStdOutPipeWrite
            HandleClose hStdOutPipeError
 
            Dim As String buf: buf = Space$(4096 + 1)
            Dim As _Unsigned Long dwRead
            While ReadFile(hStdOutPipeRead, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
                buf = Mid$(buf, 1, dwRead)
                GoSub RemoveChr13
                stdout = stdout + buf
                buf = Space$(4096 + 1)
            Wend
 
            While ReadFile(hStdReadPipeError, _Offset(buf), 4096, _Offset(dwRead), 0) <> 0 And dwRead > 0
                buf = Mid$(buf, 1, dwRead)
                GoSub RemoveChr13
                stderr = stderr + buf
                buf = Space$(4096 + 1)
            Wend
 
            Dim As Long exit_code, ex_stat
            If WaitForSingleObject(procinfo.hProcess, INFINITE) <> WAIT_FAILED Then
                If GetExitCodeProcess(procinfo.hProcess, _Offset(exit_code)) Then
                    ex_stat = 1
                End If
            End If
 
            HandleClose hStdOutPipeRead
            HandleClose hStdReadPipeError
            If ex_stat = 1 Then
                pipecom = exit_code
            Else
                pipecom = -1
            End If
 
            Exit Function
 
            RemoveChr13:
            Dim As Long j
            j = InStr(buf, Chr$(13))
            Do While j
                buf = Left$(buf, j - 1) + Mid$(buf, j + 1)
                j = InStr(buf, Chr$(13))
            Loop
            Return
        $Else
            Declare CustomType Library
            Function popen%& (cmd As String, readtype As String)
            Function feof& (ByVal stream As _Offset)
            Function fgets$ (str As String, Byval n As Long, Byval stream As _Offset)
            Function pclose& (ByVal stream As _Offset)
            End Declare
 
            Declare Library
            Function WEXITSTATUS& (ByVal stat_val As Long)
            End Declare
 
            Dim As _Offset stream
 
            Dim buffer As String * 4096
            If _FileExists("pipestderr") Then
            Kill "pipestderr"
            End If
            stream = popen(cmd + " 2>pipestderr" + Chr$(0), "r")
            If stream Then
            While feof(stream) = 0
            If fgets(buffer, 4096, stream) <> "" And feof(stream) = 0 Then
            stdout = stdout + Mid$(buffer, 1, InStr(buffer, Chr$(0)) - 1)
            End If
            Wend
            Dim As Long status, exit_code
            status = pclose(stream)
            exit_code = WEXITSTATUS(status)
            If _FileExists("pipestderr") Then
            Dim As Integer errfile
            errfile = FreeFile
            Open "pipestderr" For Binary As #errfile
            If LOF(errfile) > 0 Then
            stderr = Space$(LOF(errfile))
            Get #errfile, , stderr
            End If
            Close #errfile
            Kill "pipestderr"
            End If
            pipecom = exit_code
            Else
            pipecom = -1
            End If
        $End If
    End Function
 
    Function pipecom_lite$ (cmd As String)
        Dim As Long a
        Dim As String stdout, stderr
        a = pipecom(cmd, stdout, stderr)
        If stderr <> "" Then
            pipecom_lite = stderr
        Else
            pipecom_lite = stdout
        End If
    End Function
$End If
 

bplus · « **Reply #14 on:** February 01, 2022, 11:52:19 am »

Quote from: SpriggsySpriggs on February 01, 2022, 02:47:08 am

Since we're doing Windows only:

Code: QB64: [Select]
Option Explicit
$NoPrefix
$Console:Only

Const MAX_PATH = 260

Type FILETIME
As Unsigned Long dwLowDateTime, dwHighDateTime
End Type

Type WIN32_FIND_DATA
As Unsigned Long dwFileAttributes
As FILETIME ftCreationTime, ftLastAccessTime, ftLastWriteTime
As Unsigned Long nFileSizeHigh, nFileSizeLow, dwReserved0, dwReserved1
As String * Max_path cFileName
As String * 14 cAlternateFileName
As Unsigned Long dwFileType, dwCreatorType
As Unsigned Integer wFinderFlags
End Type

Declare CustomType Library
Function FindFirstFile%& (ByVal lpFileName As Offset, Byval lpFindFileData As Offset)
Function FindNextFile& (ByVal hFindFile As Offset, Byval lpFindFileData As Offset)
End Declare

Dim As String start: start = CWD$ + "\*.bas" + Chr$(0)
Dim As Offset lpFileName: lpFileName = Offset(start)
Dim As WIN32_FIND_DATA find

ReDim As String * MAX_PATH filelist(0 To 0)

Dim As Offset hFind: hFind = FindFirstFile(lpFileName, Offset(find))

If hFind Then
Dim As Unsigned Integer64 filesize: filesize = SHL(find.nFileSizeHigh, 32) Or find.nFileSizeLow
filelist(0) = find.cFileName
Print filelist(0), filesize; "bytes"
While FindNextFile(hFind, Offset(find))
filesize = SHL(find.nFileSizeHigh, 32) Or find.nFileSizeLow
ReDim Preserve As String * 260 filelist(UBound(filelist) + 1)
filelist(UBound(filelist)) = find.cFileName
Print filelist(UBound(filelist)), filesize; "bytes"
Wend
Print UBound(filelist); "files"
End If

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.

News:

Author Topic: Quick Directory Files Listing for Windows Only (Read 7158 times)

bplus

Quick Directory Files Listing for Windows Only

SpriggsySpriggs

Re: Quick Directory Files Listing for Windows Only

SierraKen

Re: Quick Directory Files Listing for Windows Only

bplus

Re: Quick Directory Files Listing for Windows Only

SMcNeill

Re: Quick Directory Files Listing for Windows Only

SpriggsySpriggs

Re: Quick Directory Files Listing for Windows Only

bplus

Re: Quick Directory Files Listing for Windows Only

_vince

Re: Quick Directory Files Listing for Windows Only

SMcNeill

Re: Quick Directory Files Listing for Windows Only

bplus

Re: Quick Directory Files Listing for Windows Only

SMcNeill

Re: Quick Directory Files Listing for Windows Only

bplus

Re: Quick Directory Files Listing for Windows Only

SpriggsySpriggs

Re: Quick Directory Files Listing for Windows Only

SpriggsySpriggs

Re: Quick Directory Files Listing for Windows Only

bplus

Re: Quick Directory Files Listing for Windows Only