Development of a program for automatic search for music and movies

[Petr]

Hi, I'm starting this new thread, where I'm going to add parts of one and the same program during development to search the specified folder, including subdirectories, find music and video files, get information from them, and pass them on to the user.

I will develop individual functions gradually. For a start, I had to solve the most basic thing. Select the folder that is the root. The search will start from it. To make this possible on network drives as well, I chose our wiki on QB64 and used the windows dialog. The same then to get a short name. This is required for compatibility if, for example, the music album contains unicode characters in the name.

Here is the absolute beginning: Selecting a folder. No mask filtering yet. Several libraries are used, including the SteveMcNeill DirEntry library. This will be absolutely crucial in this program.

Code: QB64: [Select]

1. TYPE FileList
2.     ShtName AS STRING
3.     LngName AS STRING
4.     Path AS STRING
5. END TYPE
6.  
7.  
8.  
9. Path$ = SelectDIR$
10. SPath$ = ShortName$(Path$) '                                                                           is need for access to files and directories, which use unicode characters in name
11. IF SPath$ = "" THEN SPath$ = _CWD$
12. PRINT Path$, SPath$
13. CHDIR SPath$ '                                                                                         if short name not exists, function ShortName return long name as result.
14. mask$ = "AVI,MPG,MKV,MPG,MPEG,WAV,ACC,MP4,MP3,MP2,VOC,S3M,MOD,XM,TS,MOV,AC3,WMA,WMV,FLAC"
15. REDIM files_found(0) AS STRING
16. SearchFiles mask$, files_found()
17.  
18.  
19.  
20.  
21.  
22.  
23.  
24. SUB SearchFiles (mask AS STRING, FilesFound() AS STRING)
25.     DECLARE CUSTOMTYPE LIBRARY ".\direntry" '                                               Steve mcNeill's library
26.         FUNCTION load_dir& (s AS STRING)
27.         FUNCTION has_next_entry& ()
28.         SUB close_dir ()
29.         SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
30.     END DECLARE
31.     REDIM DirNew(0) AS STRING
32.     REDIM FileNew(0) AS STRING
33.     GetFileList _CWD$, DirNew(), FileNew()
34.  
35.  
36.  
37.     PrintIt FileNew(), DirNew()
38.  
39.  
40.  
41.  
42.  
43.  
44.  
45. END SUB
46.  
47. SUB PrintIt (F() AS STRING, D() AS STRING)
48.     FOR p = LBOUND(f) TO UBOUND(f)
49.         PRINT "Found file:"; F(p)
50.         _DELAY .1
51.     NEXT
52.     _DELAY 1
53.     FOR p = LBOUND(d) + 3 TO UBOUND(d)
54.         PRINT "Found Directory:"; D(p)
55.         _DELAY .1
56.     NEXT
57. END SUB
58.  
59.  
60.  
61.  
62.  
63.  
64. SUB GetFileList (SearchDirectory AS STRING, DirList() AS STRING, FileList() AS STRING) '    Steve mcNeill's SUB
65.     CONST IS_DIR = 1
66.     CONST IS_FILE = 2
67.     DIM flags AS LONG, file_size AS LONG
68.  
69.     REDIM _PRESERVE DirList(100), FileList(100)
70.     DirCount = 0: FileCount = 0
71.  
72.     IF load_dir(SearchDirectory) THEN
73.         DO
74.             length = has_next_entry
75.             IF length > -1 THEN
76.                 nam$ = SPACE$(length)
77.                 get_next_entry nam$, flags, file_size
78.                 IF flags AND IS_DIR THEN
79.                     DirCount = DirCount + 1
80.                     IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
81.                     DirList(DirCount) = nam$
82.                 ELSEIF flags AND IS_FILE THEN
83.                     FileCount = FileCount + 1
84.                     IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
85.                     FileList(FileCount) = nam$
86.                 END IF
87.             END IF
88.         LOOP UNTIL length = -1
89.         close_dir
90.     ELSE
91.     END IF
92.     REDIM _PRESERVE DirList(DirCount)
93.     REDIM _PRESERVE FileList(FileCount)
94. END SUB
95.  
96.  
97.  
98.  
99.  
100. FUNCTION ShortName$ (name$)
101.     DECLARE LIBRARY '                                                                                      Directory Information using KERNEL32
102.         FUNCTION GetShortPathNameA (lpLongPath AS STRING, lpShortPath AS STRING, BYVAL cBufferLen AS LONG)
103.     END DECLARE
104.  
105.     ShortPathName$ = SPACE$(260)
106.     Result = GetShortPathNameA(name$ + CHR$(0), ShortPathName$, LEN(ShortPathName$))
107.     IF Result THEN ShortName$ = ShortPathName$ ELSE ShortName$ = name$
108.  
109. END FUNCTION
110.  
111.  
112. FUNCTION SelectDIR$
113.     DECLARE CUSTOMTYPE LIBRARY
114.         FUNCTION FindWindow& (BYVAL ClassName AS _OFFSET, WindowName$)
115.     END DECLARE
116.     hwnd& = _WINDOWHANDLE
117.     TYPE BROWSEINFO '                    typedef struct _browseinfo 'Microsoft MSDN
118.         hwndOwner AS _OFFSET '           HWND
119.         pidlRoot AS _OFFSET '            PCIDLIST_ABSOLUTE
120.         pszDisplayName AS _OFFSET '      LPTSTR
121.         lpszTitle AS _OFFSET '           LPCTSTR
122.         ulFlags AS _UNSIGNED LONG '      UINT
123.         lpfn AS _OFFSET '                BFFCALLBACK
124.         lParam AS _OFFSET '              LPARAM
125.         iImage AS LONG '                 int
126.     END TYPE '                           BROWSEINFO, *PBROWSEINFO, *LPBROWSEINFO;
127.  
128.     DECLARE DYNAMIC LIBRARY "shell32"
129.         FUNCTION SHBrowseForFolder%& (x AS BROWSEINFO) '                           Microsoft MSDN
130.         SUB SHGetPathFromIDList (BYVAL lpItem AS _OFFSET, BYVAL szDir AS _OFFSET) 'Microsoft MSDN
131.     END DECLARE
132.  
133.     DIM b AS BROWSEINFO
134.     b.hwndOwner = hwnd
135.     DIM s AS STRING * 1024
136.     b.pszDisplayName = _OFFSET(s$)
137.     a$ = "Select folder for searching movies and music:" + CHR$(0)
138.     b.lpszTitle = _OFFSET(a$)
139.     DIM o AS _OFFSET
140.     _SCREENHIDE
141.     o = SHBrowseForFolder(b)
142.     _SCREENSHOW
143.     IF o THEN
144.         '   Path$ = LEFT$(s$, INSTR(s$, CHR$(0)) - 1)
145.         DIM s2 AS STRING * 1024
146.         SHGetPathFromIDList o, _OFFSET(s2$)
147.         SelectDIR$ = LEFT$(s2$, INSTR(s2$, CHR$(0)) - 1)
148.     ELSE
149.         PRINT "Directory not selected, using current directory"
150.         SelectDIR$ = _CWD$
151.     END IF
152. END FUNCTION
153.  

[SMcNeill]

 

Code: [Select]

IF _FILEEXISTS("C:\ProgramData\PhotoList.txt") = 0 OR AlwaysRefreshListing THEN
    'will create the new listing if your directory doesn't contain one,
    'OR, will create one every time you run the program, if you set the flag to make it do so.
    PhotoList$ = PhotoFolder + "*.bmp " + PhotoFolder + "*.jpg " + PhotoFolder + "*.png " + PhotoFolder + "*.gif "
    SHELL "DIR " + PhotoList$ + "/b /s /a-d >C:\ProgramData\PhotoList.txt"
END IF
If you look at my little wallpaper changer, you'll see the above is the simple way I use to get my various image files.  https://www.qb64.org/forum/index.php?topic=1008.msg112746#msg112746

It's about as short and simple of a process as you can get, and might work sufficiently enough for your needs.  ;)

 

 

[Petr]

Thanks Steve for this help. It will be much easier this way. I was thinking about how to achieve the same result with DIRENTRY. I would have to note at what level of the directory/subdirectory/sub sub directory..../ I am in to go through the whole structure. A function that would return the number of subdirectories in each directory would be useful ... it would be a lengthy complication. But I will definitely try to do it (later). I continue to develop this program, I have no desire to complicate it unnecessarily.

[bplus]

@Petr

Just to clarify, are you going for cross platform solution which uses DirEntry, I think, or Windows only with Shell (which works fine for Windows users) or a Windows File Dialog like what Spriggsy helped me with recently?

[Petr]

Hi BPlus.

I cheered prematurely. DIR turned out to be - nice bitch again. He works nicely. NO UNICODE characters in filenames! He replaces unicode characters beautifully with SPACES!!!

I'm really pissed. BPlus, I'll start all over again. Absolutely again. I will use DIRENTRY.H which means that I will really have to write a directory listing function. None DIR. This time I'll make it compatible with Linux. (Windows begin stay as is now, in Linux i'll write special SUB using ls for folder finding)

[bplus]

Here is my bare bones starter with DIRENTRY.h works first time but buggy with repeated calls, at least the way I developed it.

It might do to replace FILES statement.

Code: QB64: [Select]

1. ' direntry.h needs to be in QB64 folder
2. DECLARE CUSTOMTYPE LIBRARY ".\direntry"
3.     FUNCTION load_dir& (s AS STRING)
4.     FUNCTION has_next_entry& ()
5.     SUB close_dir ()
6.     SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
7. END DECLARE
8.  
9. REDIM Dir(0) AS STRING, File(0) AS STRING
10.  
11. 'D$ = _CWD$
12. D$ = "C:\\"
13. GetFileList D$, Dir(), File()
14.  
15. PRINT "SUBDIRECTORIES"; UBOUND(dir)
16. FOR i = 1 TO UBOUND(dir)
17.     PRINT Dir(i),
18. NEXT
19. PRINT
20. PRINT
21. SLEEP
22.  
23. PRINT "FILES"; UBOUND(file): PRINT: PRINT
24. SLEEP
25. FOR i = 1 TO UBOUND(file)
26.     PRINT File(i),
27. NEXT
28. PRINT
29.  
30. SUB GetFileList (SearchDirectory AS STRING, DirList() AS STRING, FileList() AS STRING)
31.     CONST IS_DIR = 1
32.     CONST IS_FILE = 2
33.     DIM flags AS LONG, file_size AS LONG
34.  
35.     REDIM _PRESERVE DirList(100), FileList(100)
36.     DirCount = 0: FileCount = 0
37.  
38.     IF load_dir(SearchDirectory) THEN
39.         DO
40.             length = has_next_entry
41.             IF length > -1 THEN
42.                 nam$ = SPACE$(length)
43.                 get_next_entry nam$, flags, file_size
44.                 IF (flags AND IS_DIR) OR _DIREXISTS(SearchDirectory + nam$) THEN
45.                     DirCount = DirCount + 1
46.                     IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
47.                     DirList(DirCount) = nam$
48.                 ELSEIF (flags AND IS_FILE) OR _FILEEXISTS(SearchDirectory + nam$) THEN
49.                     FileCount = FileCount + 1
50.                     IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
51.                     FileList(FileCount) = nam$
52.                 END IF
53.             END IF
54.         LOOP UNTIL length = -1
55.         close_dir
56.     ELSE
57.     END IF
58.     REDIM _PRESERVE DirList(DirCount)
59.     REDIM _PRESERVE FileList(FileCount)
60. END SUB
61.  
62.  

[SMcNeill]

@bplus Here might be the issue in your code:

    IF load_dir(SearchDirectory) THEN
       ....
       close_dir
    ELSE
    END IF

You have a call to load a directory, but if it fails, you don't have a call to try and close it.  (Notice the lack of close_dir in the ELSE statement?)

Try moving that close_dir AFTER the END IF and see if your issue with multiple calls clears up.

[bplus]

Thanks Steve, I will run some tests on it. It's been awhile since I've looked at this.

Update:
That's it! It is working well now. BIG THANKYOU! SMcNeill :)

I do run into snags when I try directories Windows doesn't want me in like Cookies and there is a little snag when I reach C:\\Users\(me) and try to go up, getting 0 selections so nowhere to go. Try 0 anyway, I hacked a little fixer for such events, or when you have to exit the Directory Selection List. Hopefully you can figure it out as you go, nothing crashes like before.

Now maybe Tiny Navigator is cross platform (The majority of this code is for selecting items from large array lists, select by mouse, arrows, page up/dwn, home end, and enter, or type in number and enter as I recall from 10 months ago (Yes, I recall correctly)):

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. ' B+ started 2019-08-22  restart 2020-06-24
3. ' 2019-08-22 orig post at https://www.qb64.org/forum/index.php?topic=1646.msg108682#msg108682
4. ' 2019-08-23_13-25 try fix (to nav all directories) with one place for tmpFile, theory can't write files in some dir's
5. ' For some reason Windows won't write to a fully pathed file in my user folder???from a SHELL command
6. ' Try testing if dir exists "C:\temp" exists and making one if not, yes! and I can write my temp files there
7. ' and now I can chDir anywhere!!!!
8. ' 2019-08-23_14-25 Take Steve's Advice to use users tmp directory for temp files
9. ' 2019-08-23_23+ Have files window working for file selection
10. ' ============================================ all above using SHELL to get lists
11.  
12. ' 2020-06-24 restart using DirEntry.h, wow looks like Steve's fix helped ALLOT! Thanks SMcNeill
13. ' I am hitting glitches where Windows wont let me access I think. So I am offering a c enter option
14. ' to restart at the root but this might not work cross platform.
15.  
16.  
17. ' direntry.h needs to be in QB64 folder
18. DECLARE CUSTOMTYPE LIBRARY ".\direntry"
19.     FUNCTION load_dir& (s AS STRING)
20.     FUNCTION has_next_entry& ()
21.     SUB close_dir ()
22.     SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
23. END DECLARE
24.  
25.  
26. _TITLE "Tiny Navigator using DirEntry:     press f to Start a Select a File list of current directory"
27. SCREEN _NEWIMAGE(1000, 600, 32)
28. _SCREENMOVE 100, 50
29.  
30. DIM SHARED selectedFile AS STRING
31. REDIM SHARED DIRs(0) AS STRING, FILs(0) AS STRING
32. DIM mySelection&, done$, i, t$
33. DO
34.     COLOR _RGB32(180, 180, 255)
35.     CLS
36.  
37.     t$ = "Current Directory: " + _CWD$
38.     LOCATE 2, (_WIDTH / 8 - LEN(t$)) / 2: PRINT t$
39.     REDIM DIRs(0) AS STRING, FILs(0) AS STRING
40.     GetLists _CWD$, DIRs(), FILs()
41.     FOR i = 0 TO UBOUND(FILs) ' this just offers a sample listing of files
42.         IF i < 30 THEN LOCATE i + 4, 60: PRINT FILs(i) ELSE EXIT FOR
43.     NEXT
44.     mySelection& = getArrayItemNumber&(5, 5, 50, 30, DIRs())
45.     CLS
46.     IF selectedFile <> "" THEN
47.         PRINT "You selected a file: "; selectedFile
48.         INPUT "Press enter to continue navigator, any + enter to quit... "; done$
49.         selectedFile = ""
50.     ELSEIF mySelection& <> -1719 THEN
51.         IF _TRIM$(DIRs(mySelection&)) <> "" THEN
52.             CHDIR DIRs(mySelection&)
53.         END IF
54.     ELSE
55.         PRINT "Nothing selected."
56.         PRINT "There are some places your OS might not allow us to go."
57.         PRINT "If you get stuck with 0 slections, press c (for root C:\\) enter..."
58.         INPUT "Press enter to continue navigator, any + enter to quit... "; done$
59.         IF done$ = "c" THEN CHDIR ("C:\\"): done$ = ""
60.     END IF
61.     _LIMIT 60
62. LOOP UNTIL done$ <> ""
63.  
64. SUB GetLists (SearchDirectory AS STRING, DirList() AS STRING, FileList() AS STRING)
65.  
66.     CONST IS_DIR = 1
67.     CONST IS_FILE = 2
68.     DIM flags AS LONG, file_size AS LONG, DirCount AS INTEGER, FileCount AS INTEGER, length AS LONG
69.     DIM nam$
70.     REDIM _PRESERVE DirList(100), FileList(100)
71.     DirCount = 0: FileCount = 0
72.  
73.     IF load_dir(SearchDirectory) THEN
74.         DO
75.             length = has_next_entry
76.             IF length > -1 THEN
77.                 nam$ = SPACE$(length)
78.                 get_next_entry nam$, flags, file_size
79.                 IF (flags AND IS_DIR) OR _DIREXISTS(SearchDirectory + nam$) THEN
80.                     DirCount = DirCount + 1
81.                     IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
82.                     DirList(DirCount) = nam$
83.                 ELSEIF (flags AND IS_FILE) OR _FILEEXISTS(SearchDirectory + nam$) THEN
84.                     FileCount = FileCount + 1
85.                     IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
86.                     FileList(FileCount) = nam$
87.                 END IF
88.             END IF
89.         LOOP UNTIL length = -1
90.         'close_dir 'move to after end if  might correct the multi calls problem
91.     ELSE
92.     END IF
93.     close_dir 'this  might correct the multi calls problem
94.  
95.     REDIM _PRESERVE DirList(DirCount)
96.     REDIM _PRESERVE FileList(FileCount)
97. END SUB
98.  
99. FUNCTION rightOf$ (source$, of$)
100.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
101. END FUNCTION
102.  
103. ' "Escape returns -1719 to allow a Cancel function and signal no slection."
104. FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
105.     'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
106.     'boxWidth and boxHeight are in character units, again for locate and print at correct places.
107.     'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
108.  
109.     DIM curRow AS INTEGER, curCol AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
110.     DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER, mx AS INTEGER, my AS INTEGER
111.     DIM lastMX AS INTEGER, lastMY AS INTEGER, row AS INTEGER, mb AS INTEGER
112.     DIM lba AS LONG, uba AS LONG, choice AS LONG, kh AS LONG, index AS LONG
113.     DIM clrStr AS STRING, b AS STRING, selNum&
114.  
115.     'save old settings to restore at end ofsub
116.     curRow = CSRLIN
117.     curCol = POS(0)
118.     fg = _DEFAULTCOLOR
119.     bg = _BACKGROUNDCOLOR
120.     _KEYCLEAR
121.  
122.     maxWidth = boxWidth '       number of characters in box
123.     maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
124.     lba = LBOUND(arr)
125.     uba = UBOUND(arr)
126.     page = 0
127.     hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
128.     clrStr$ = SPACE$(maxWidth) 'clearing a display line
129.  
130.     GOSUB update '              show the beginning of the array items for selection
131.  
132.     'signal cancel selection process, exit sub with this unlikely index to signal canel
133.     choice = -1719 'primes 7 and 8, not likely to be a select index of an array
134.  
135.     DO 'until get a selection or demand exit
136.  
137.         'handle the key stuff
138.         kh& = _KEYHIT
139.         IF kh& THEN
140.             IF kh& > 0 AND kh& < 255 THEN
141.                 IF INSTR("0123456789", CHR$(kh&)) > 0 THEN b$ = b$ + CHR$(kh&): GOSUB update
142.                 IF CHR$(kh&) = "f" THEN
143.                     'REDIM FILs(0) AS STRING     'hopefully this is already ready
144.                     'loadFiles FILs()
145.                     selNum& = getArrayItemNumber&(5, 60, 60, 30, FILs())
146.                     COLOR _RGB32(180, 180, 255)
147.                     CLS 'need to signal out of file selection
148.                     IF selNum& >= LBOUND(FILs) AND selNum& <= UBOUND(FILs) THEN selectedFile = FILs(selNum&)
149.                     EXIT DO
150.                     'back to directory select
151.                 END IF
152.  
153.                 IF CHR$(kh&) = "c" THEN b$ = "": GOSUB update
154.                 IF kh& = 13 THEN 'enter pressed check if number is being entered?
155.                     IF LEN(b$) THEN
156.                         IF VAL(b$) >= lba AND VAL(b$) <= uba THEN 'we have number started
157.                             choice = VAL(b$): EXIT DO
158.                         ELSE 'clear b$ to show some response to enter
159.                             b$ = "": GOSUB update 'clear the value that doesn't work
160.                         END IF
161.                     ELSE
162.                         choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
163.                     END IF
164.                 END IF
165.                 IF kh& = 27 THEN EXIT DO 'escape clause offered to Cancel selection process
166.                 IF kh& = 32 THEN choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
167.                 IF kh& = 8 THEN 'backspace to edit number
168.                     IF LEN(b$) THEN b$ = LEFT$(b$, LEN(b$) - 1): GOSUB update
169.                 END IF
170.             ELSE
171.                 SELECT CASE kh& 'choosing sections of array to display and highlighted item
172.                     CASE 20736 'pg dn
173.                         IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
174.                     CASE 18688 'pg up
175.                         IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
176.                     CASE 18432 'up
177.                         IF hlite - 1 < 0 THEN
178.                             IF page > 0 THEN
179.                                 page = page - 1: hlite = maxHeight - 1: GOSUB update
180.                             END IF
181.                         ELSE
182.                             hlite = hlite - 1: GOSUB update
183.                         END IF
184.                     CASE 20480 'down
185.                         IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
186.                             IF hlite + 1 > maxHeight - 1 THEN
187.                                 page = page + 1: hlite = 0: GOSUB update
188.                             ELSE
189.                                 hlite = hlite + 1: GOSUB update
190.                             END IF
191.                         END IF
192.                     CASE 18176 'home
193.                         page = 0: hlite = 0: GOSUB update
194.                     CASE 20224 ' end
195.                         page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
196.                 END SELECT
197.             END IF
198.         END IF
199.  
200.         'handle the mouse stuff
201.         WHILE _MOUSEINPUT
202.             IF _MOUSEWHEEL = -1 THEN 'up?
203.                 IF hlite - 1 < 0 THEN
204.                     IF page > 0 THEN
205.                         page = page - 1: hlite = maxHeight - 1: GOSUB update
206.                     END IF
207.                 ELSE
208.                     hlite = hlite - 1: GOSUB update
209.                 END IF
210.             ELSEIF _MOUSEWHEEL = 1 THEN 'down?
211.                 IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
212.                     IF hlite + 1 > maxHeight - 1 THEN
213.                         page = page + 1: hlite = 0: GOSUB update
214.                     ELSE
215.                         hlite = hlite + 1: GOSUB update
216.                     END IF
217.                 END IF
218.             END IF
219.         WEND
220.         mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - locateRow * 16) / 16) + 2
221.         IF _MOUSEBUTTON(1) THEN 'click contols or select array item
222.             'clear mouse clicks
223.             mb = _MOUSEBUTTON(1)
224.             IF mb THEN 'clear it
225.                 WHILE mb 'OK!
226.                     IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
227.                     _LIMIT 100
228.                 WEND
229.             END IF
230.  
231.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
232.                 choice = my + page * maxHeight + lba - 1 'select item clicked
233.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
234.                 IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
235.                     EXIT DO 'escape plan for mouse click top right corner of display box
236.                 ELSE 'PgUp bar clicked
237.                     IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
238.                 END IF
239.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
240.                 IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
241.             END IF
242.         ELSE '   mouse over highlighting, only if mouse has moved!
243.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
244.                 IF mx <> lastMX OR my <> lastMY THEN
245.                     IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
246.                         hlite = my - 1
247.                         lastMX = mx: lastMY = my
248.                         GOSUB update
249.                     END IF
250.                 END IF
251.             END IF
252.         END IF
253.         _LIMIT 200
254.     LOOP UNTIL choice >= lba AND choice <= uba
255.     getArrayItemNumber& = choice
256.     COLOR fg, bg
257.     'clear key presses
258.     _KEYCLEAR
259.     LOCATE curRow, curCol
260.     'clear mouse clicks
261.     mb = _MOUSEBUTTON(1)
262.     IF mb THEN 'clear it
263.         WHILE mb 'OK!
264.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
265.             _LIMIT 100
266.         WEND
267.     END IF
268.     EXIT SUB
269.  
270.  
271.     update: '--------------- display of array sections and controls on screen
272.  
273.     'fix hlite if it has dropped below last array item
274.     WHILE hlite + page * maxHeight + lba > uba
275.         hlite = hlite - 1
276.     WEND
277.  
278.     'main display of array items at page * maxHeight (lines high)
279.     FOR row = 0 TO maxHeight - 1
280.         IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
281.         LOCATE locateRow + row, locateColumn: PRINT clrStr$
282.         index = row + page * maxHeight + lba
283.         IF index >= lba AND index <= uba THEN
284.             LOCATE locateRow + row, locateColumn
285.             PRINT LEFT$(LTRIM$(STR$(index)) + ") " + arr(index), maxWidth)
286.         END IF
287.     NEXT
288.  
289.     'make page up and down bars to click, print PgUp / PgDn if available
290.     COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
291.     LOCATE locateRow - 1, locateColumn: PRINT SPACE$(maxWidth)
292.     IF page <> 0 THEN LOCATE locateRow - 1, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth)
293.     LOCATE locateRow + maxHeight, locateColumn: PRINT SPACE$(maxWidth)
294.     IF page <> INT(uba / maxHeight) THEN
295.         LOCATE locateRow + maxHeight, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth)
296.     END IF
297.     'make exit sign for mouse click
298.     COLOR _RGB32(255, 255, 255), _RGB32(200, 100, 0)
299.     LOCATE locateRow - 1, locateColumn + maxWidth - 3
300.     PRINT " X "
301.  
302.     'if a number selection has been started show it's build = b$
303.     IF LEN(b$) THEN
304.         COLOR _RGB(255, 255, 0), _RGB32(0, 0, 0)
305.         LOCATE locateRow + maxHeight, locateColumn + maxWidth - LEN(b$) - 1
306.         PRINT b$;
307.     END IF
308.     _DISPLAY
309.     _LIMIT 100
310.     RETURN
311. END FUNCTION
312.  
313.  

I can only test in Windows, so would specially appreciate feedback from Linux or other OS users.

FYI DirEnter.h is at the start of this thread for downloading.

[Petr]

Nice work, BPlus. This can be very useful for Linux. I think, the option in navigator "." can be used for direct access to root directory.

Let me tell you one thing. It hasn't been that long since Pete and me have written here about how clear it is in the morning where you made a mistake in the evening. Well, man. It was confirmed again. Imagine just enclosing a DIR statement listing in quotation marks. And... then it works.... So on Linux, I find a command that does the same thing as a DIR with the parameters provided by Steve. Now i can continue. Here is current harddrive listening - use space for next record in array and enter for running it under windows media player. I use actaully BAT file - it is better when is program developed.


Added mask decomposition (the program correctly places files in the list according to the mask), solved access to files using long file names.

Request. Create a folder that has unicode characters in the name. Insert a supported audio and / or video format (preferably also with unicode characters in the name). Run the program. Select this or the parent folder at the beginning. Use the space bar to scroll to this file and try to run it with the enter key.


Source upgraded. Now you can see difference between system file access and QB64 file access. Some file are unacessible with QB64.  But access is needed for next work...

Code: QB64: [Select]

1. TYPE FileList
2.     ShtName AS STRING
3.     LngName AS STRING
4. END TYPE
5.  
6.  
7.  
8. Path$ = SelectDIR$
9. SPath$ = ShortName$(Path$) '                                                                           is need for access to files and directories, which use unicode characters in name
10. IF SPath$ = "" THEN SPath$ = _CWD$
11. PRINT Path$, SPath$
12. CurrentPath$ = _CWD$
13.  
14.  
15.  
16.  
17. mask$ = "AVI,MPG,MKV,MPG,MPEG,WAV,ACC,MP4,MP3,MP2,VOC,S3M,MOD,XM,TS,MOV,AC3,WMA,WMV,FLAC," '           on end must be comma!
18.  
19. REDIM files_found(0) AS FileList
20. SearchFiles mask$, files_found(), SPath$
21.  
22. PrintIt files_found()
23.  
24.  
25.  
26.  
27.  
28. SUB SearchFiles (mask AS STRING, FL() AS FileList, Path AS STRING)
29.     current$ = _CWD$
30.     CHDIR Path$
31.     P = INSTR(mask$, ",")
32.     DO UNTIL P = 0
33.         f$ = MID$(mask$, 1, P - 1)
34.         mask$ = MID$(mask$, P + 1)
35.         REDIM _PRESERVE mask(i) AS STRING
36.         msk$ = msk$ + _CWD$ + "\*." + f$ + " "
37.         i = i + 1
38.         P = INSTR(mask$, ",")
39.     LOOP
40.     PRINT "Creating database..."
41.     msk$ = LEFT$(msk$, LEN(msk$) - 1)
42.     WorkDir$ = "C:\users\public"
43.     t$ = "DIR " + msk$ + "/b /s /a-d >" + WorkDir$ + "\FilesList.txt"
44.     SHELL _HIDE t$
45.     ff = FREEFILE
46.     OPEN WorkDir$ + "\FilesList.txt" FOR INPUT AS ff
47.     i = 0
48.     REDIM _PRESERVE FL(100 + i) AS FileList
49.     DO UNTIL EOF(ff)
50.         LINE INPUT #ff, LLL$
51.         FL(i).LngName = LLL$
52.         FL(i).ShtName = ShortName$(FL(i).LngName)
53.         i = i + 1
54.         IF i > UBOUND(fl) THEN REDIM _PRESERVE FL(i + 100) AS FileList
55.     LOOP
56.     REDIM _PRESERVE FL(i - 1) AS FileList
57.     CLOSE ff
58.     REM KILL WorkDir$ + "\FilesList.txt"
59.     CHDIR current$
60. END SUB
61.  
62.  
63.  
64. SUB PrintIt (D() AS FileList)
65.     FOR p = LBOUND(d) TO UBOUND(d)
66.         PRINT D(p).ShtName
67.         '  PRINT D(p).LngName
68.         DO UNTIL K$ = " "
69.             K$ = INKEY$
70.             IF K$ = CHR$(13) THEN
71.                 PRINT D(p).ShtName
72.                 ff = FREEFILE
73.                 OPEN "dSWAP.bat" FOR OUTPUT AS #ff
74.                 PRINT #ff, "start wmplayer " + CHR$(34) + D(p).ShtName + CHR$(34)
75.                 CLOSE #ff
76.                 SHELL _DONTWAIT _HIDE "dswap.bat"
77.                 'KILL "dswap.bat"
78.                 IF _FILEEXISTS(D(p).ShtName) THEN PRINT "QB64 accessible" ELSE PRINT "QB64 access error"
79.             END IF
80.         LOOP
81.         K$ = ""
82.     NEXT
83. END SUB
84.  
85.  
86.  
87.  
88.  
89.  
90. FUNCTION ShortName$ (name$)
91.     DECLARE LIBRARY '                                                                                      Directory Information using KERNEL32
92.         FUNCTION GetShortPathNameA (lpLongPath AS STRING, lpShortPath AS STRING, BYVAL cBufferLen AS LONG)
93.     END DECLARE
94.     ShortPathName$ = SPACE$(260)
95.     Result = GetShortPathNameA(nam$ + CHR$(0), ShortPathName$, LEN(ShortPathName$))
96.     IF Result THEN ShortName$ = ShortPathName$ ELSE ShortName$ = name$
97.  
98. END FUNCTION
99.  
100.  
101. FUNCTION SelectDIR$
102.     DECLARE CUSTOMTYPE LIBRARY
103.         FUNCTION FindWindow& (BYVAL ClassName AS _OFFSET, WindowName$)
104.     END DECLARE
105.     hwnd& = _WINDOWHANDLE
106.     TYPE BROWSEINFO '                    typedef struct _browseinfo 'Microsoft MSDN
107.         hwndOwner AS _OFFSET '           HWND
108.         pidlRoot AS _OFFSET '            PCIDLIST_ABSOLUTE
109.         pszDisplayName AS _OFFSET '      LPTSTR
110.         lpszTitle AS _OFFSET '           LPCTSTR
111.         ulFlags AS _UNSIGNED LONG '      UINT
112.         lpfn AS _OFFSET '                BFFCALLBACK
113.         lParam AS _OFFSET '              LPARAM
114.         iImage AS LONG '                 int
115.     END TYPE '                           BROWSEINFO, *PBROWSEINFO, *LPBROWSEINFO;
116.  
117.     DECLARE DYNAMIC LIBRARY "shell32"
118.         FUNCTION SHBrowseForFolder%& (x AS BROWSEINFO) '                           Microsoft MSDN
119.         SUB SHGetPathFromIDList (BYVAL lpItem AS _OFFSET, BYVAL szDir AS _OFFSET) 'Microsoft MSDN
120.     END DECLARE
121.  
122.     DIM b AS BROWSEINFO
123.     b.hwndOwner = hwnd
124.     DIM s AS STRING * 1024
125.     b.pszDisplayName = _OFFSET(s$)
126.     a$ = "Select folder for searching movies and music:" + CHR$(0)
127.     b.lpszTitle = _OFFSET(a$)
128.     DIM o AS _OFFSET
129.     '    _SCREENHIDE
130.     o = SHBrowseForFolder(b)
131.     '    _SCREENSHOW
132.     IF o THEN
133.         '   Path$ = LEFT$(s$, INSTR(s$, CHR$(0)) - 1)
134.         DIM s2 AS STRING * 1024
135.         SHGetPathFromIDList o, _OFFSET(s2$)
136.         SelectDIR$ = LEFT$(s2$, INSTR(s2$, CHR$(0)) - 1)
137.     ELSE
138.         PRINT "Directory not selected, using current directory"
139.         SelectDIR$ = _CWD$
140.     END IF
141. END FUNCTION
142.  

As you see: Windows Media Player run music correctly using long names. But the same string is invalid path for QB64.

 

[Petr]

By testing this program of mine https://www.qb64.org/forum/index.php?topic=321.msg2875#msg2875  it was confirmed again that the only way to do it is DIRENTRY.H, which returns the correct long names (which will eventually be correctly translated to graphic program screen using MAPUNICODE depending on the national environment).

[SpriggsySpriggs]

I edited SMcNeil's GetFileList sub for usage in my programs and I rather like how it works. I'm not sure if it will work any better than what you have. This, of course, uses direntry.h:
Usage:

Code: QB64: [Select]

1. GetFileList _STARTDIR$ + "\Images\", Directories(), File(), ".PNG,.png"

"BI"

Code: QB64: [Select]

1. DECLARE CUSTOMTYPE LIBRARY ".\direntry"
2.         FUNCTION load_dir& (s AS STRING)
3.         FUNCTION has_next_entry& ()
4.         SUB close_dir ()
5.         SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
6.     END DECLARE
7.  
8.     REDIM SHARED Directories(0) AS STRING, File(0) AS STRING

"BM"

Code: QB64: [Select]

1. SUB GetFileList (SearchDirectory AS STRING, DirList() AS STRING, FileList() AS STRING, filter AS STRING)
2.         IF String.EndsWith(D$, "\") = 0 THEN
3.             D$ = D$ + "\"
4.         END IF
5.         CONST IS_DIR = 1
6.         CONST IS_FILE = 2
7.         DIM flags AS LONG, file_size AS LONG
8.         IF filter <> "" THEN
9.             REDIM filters(0) AS STRING
10.             String.Split filter, ",", filters(), 0
11.         END IF
12.         REDIM _PRESERVE DirList(100), FileList(100)
13.         DirCount = 0: FileCount = 0
14.  
15.         IF load_dir(SearchDirectory) THEN
16.             DO
17.                 length = has_next_entry
18.                 IF length > -1 THEN
19.                     nam$ = SPACE$(length)
20.                     get_next_entry nam$, flags, file_size
21.                     IF (flags AND IS_DIR) OR _DIREXISTS(SearchDirectory + nam$) THEN
22.                         DirCount = DirCount + 1
23.                         IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
24.                         DirList(DirCount) = nam$
25.                     ELSEIF (flags AND IS_FILE) OR _FILEEXISTS(SearchDirectory + nam$) THEN
26.                         IF filter <> "" THEN
27.                             FOR I = LBOUND(filters) TO UBOUND(filters)
28.                                 IF String.EndsWith(nam$, filters(I)) THEN
29.                                     FileCount = FileCount + 1
30.                                     IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
31.                                     FileList(FileCount) = nam$
32.                                 END IF
33.                             NEXT
34.                         ELSE
35.                             FileCount = FileCount + 1
36.                             IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
37.                             FileList(FileCount) = nam$
38.                         END IF
39.                     END IF
40.                 END IF
41.             LOOP UNTIL length = -1
42.             close_dir
43.         ELSE
44.         END IF
45.         REDIM _PRESERVE DirList(DirCount)
46.         REDIM _PRESERVE FileList(FileCount)
47.     END SUB
48.     FUNCTION String.EndsWith (check AS STRING, value AS STRING)
49.         IF INSTR(check, value) THEN
50.             IF RIGHT$(check, LEN(value)) = value THEN
51.                 String.EndsWith = -1
52.             ELSE
53.                 String.EndsWith = 0
54.             END IF
55.         ELSE
56.             String.EndsWith = 0
57.         END IF
58.     END FUNCTION
59.     SUB String.Split (Expression AS STRING, delimiter AS STRING, StorageArray() AS STRING, preserve AS INTEGER)
60.         DIM copy AS STRING, p AS LONG, curpos AS LONG, arrpos AS LONG, dpos AS LONG
61.         copy = Expression
62.         IF delimiter = " " THEN
63.             copy = RTRIM$(LTRIM$(copy))
64.             p = INSTR(copy, "  ")
65.             WHILE p > 0
66.                 copy = MID$(copy, 1, p - 1) + MID$(copy, p + 1)
67.                 p = INSTR(copy, "  ")
68.             WEND
69.         END IF
70.         curpos = 1
71.         IF preserve <> 0 THEN
72.             arrpos = UBOUND(StorageArray)
73.             dpos = INSTR(curpos, copy, delimiter)
74.             DO UNTIL dpos = 0
75.                 StorageArray(UBOUND(StorageArray)) = MID$(copy, curpos, dpos - curpos)
76.                 REDIM _PRESERVE StorageArray(UBOUND(StorageArray) + 1) AS STRING
77.                 curpos = dpos + LEN(delimiter)
78.                 dpos = INSTR(curpos, copy, delimiter)
79.             LOOP
80.             StorageArray(UBOUND(StorageArray)) = MID$(copy, curpos)
81.             REDIM _PRESERVE StorageArray(UBOUND(StorageArray) + 1) AS STRING
82.         ELSEIF preserve = 0 THEN
83.             arrpos = 0
84.             dpos = INSTR(curpos, copy, delimiter)
85.             DO UNTIL dpos = 0
86.                 StorageArray(arrpos) = MID$(copy, curpos, dpos - curpos)
87.                 arrpos = arrpos + 1
88.                 IF arrpos > UBOUND(StorageArray) THEN REDIM _PRESERVE StorageArray(UBOUND(StorageArray) + 1) AS STRING
89.                 curpos = dpos + LEN(delimiter)
90.                 dpos = INSTR(curpos, copy, delimiter)
91.             LOOP
92.             StorageArray(arrpos) = MID$(copy, curpos)
93.             REDIM _PRESERVE StorageArray(arrpos) AS STRING
94.         END IF
95.     END SUB
96.  

[SMcNeill]

Your code suffers the same basic flaw, @SpriggsySpriggs:

            close_dir
        ELSE
        END IF

There's no close_dir call in the ELSE segment of the code, which can cause issues as Bplus pointed out above.

Lots of folks have made use of direntry.h, and it seems I glitched the original, which propagated into everyone else's stuff later.  Move that close_dir to after the END IF, and it should help prevent possible issues in the future in your code.  ;D

[SpriggsySpriggs]

Lots of folks have made use of direntry.h, and it seems I glitched the original, which propagated into everyone else's stuff later.  Move that close_dir to after the END IF, and it should help prevent possible issues in the future in your code.  ;D

Thanks, Steve! I'll fix that right away.

[Petr]

So here I try to get directories (only the names of all subdirectories in all subfolders from the default folder) and again an error occurred - probably a memory leak. This time I think I managed to locate the place. I think that this bug really doesn't make any sense at all.

Run it in the directory with QB64 (let's have the same directory structure):

The program first finds the first directories: internal, licenses, programs, source. Adds these 4 directories to the global G field. The G field will be the field of all directories. The next step is to open these 4 directories one by one (the first is the internals folder), find out the subdirectories, write them in the G field, go back one folder, open the next one (licenses), an empty field should be returned here. But it will not return empty. This causes invalid records to be added to the G field. The question is - what is the problem why the field does not return zero.

If you go all the way down in the listing, you'll find a shocking thing: the level entry contains meaningless values ​​that came from nowhere. Localized this error here on line 38. After Disabling AddDirsToGlobal does not cause this error. The current state of the program is incomprehensible. Can someone find the bug? (yes, it is to very long time)

How is this bad Level value incomming to the array? 

Code: QB64: [Select]

1.  
2. DECLARE CUSTOMTYPE LIBRARY ".\direntry"
3.     FUNCTION load_dir& (s AS STRING)
4.     FUNCTION has_next_entry& ()
5.     SUB close_dir ()
6.     SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
7. END DECLARE
8.  
9.  
10.  
11.  
12.  
13.  
14. REDIM D(0) AS STRING
15.  
16.  
17. TYPE GlobalDir
18.     Level AS INTEGER
19.     Path AS STRING
20. END TYPE
21.  
22. REDIM SHARED G(0) AS GlobalDir
23. REDIM Begin(0) AS STRING
24.  
25. GetDIRList _CWD$, Begin()
26. SA Begin()
27. AddDirsToGlobal Begin(), 1
28. ShowGlobal
29.  
30. FOR S = 0 TO UBOUND(begin)
31.     'PRINT Begin(S)
32.     SLEEP
33.     CHDIR Begin(S)
34.     PRINT "Current path: "; _CWD$
35.     REDIM D(0) AS STRING
36.     GetDIRList _CWD$, D()
37.     SA D()
38.     AddDirsToGlobal D(), 2 '                 comment this
39.     CHDIR ".."
40.     PRINT "Current path: "; _CWD$
41.     PRINT "Global size:"; UBOUND(g) + 1
42. NEXT
43.  
44.  
45.  
46. ShowGlobal
47.  
48.  
49.  
50.  
51. SUB SA (a() AS STRING)
52.     FOR s = LBOUND(a) TO UBOUND(a)
53.         PRINT "Array List:"; a(s); " array size:"; UBOUND(a) + 1
54.         SLEEP
55.     NEXT
56. END SUB
57.  
58.  
59.  
60.  
61.  
62.  
63. SUB ShowGlobal
64.     FOR s = 0 TO UBOUND(g)
65.         PRINT G(s).Path, " Level: "; G(s).Level
66.         SLEEP
67.     NEXT
68. END SUB
69.  
70.  
71.  
72. SUB AddDirsToGlobal (s() AS STRING, level AS INTEGER)
73.     IF UBOUND(s) = 0 THEN EXIT SUB
74.     PRINT "To global array added: "; UBOUND(g); "+"; UBOUND(s) + 1
75.  
76.     Start = UBOUND(g)
77.     Eend = UBOUND(g) + UBOUND(s) + 1
78.  
79.     REDIM _PRESERVE G(Start + Eend) AS GlobalDir
80.     FOR a = Start TO Eend - 1
81.         G(a).Path = s(i)
82.         G(a).Level = level
83.         i = i + 1
84.     NEXT
85. END SUB
86.  
87.  
88.  
89.  
90.  
91.  
92. 'my modification just for directory names:
93. SUB GetDIRList (SearchDirectory AS STRING, DirList() AS STRING) 'opravena verze
94.     REDIM DirList(0) AS STRING
95.     CONST IS_DIR = 1
96.     DIM flags AS LONG, file_size AS LONG
97.     DirCount = 0
98.     IF load_dir(SearchDirectory) THEN
99.         DO
100.             length = has_next_entry
101.             IF length > -1 THEN
102.                 nam$ = SPACE$(length)
103.                 get_next_entry nam$, flags, file_size
104.                 IF (flags AND IS_DIR) OR _DIREXISTS(SearchDirectory + nam$) THEN
105.                     IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
106.                     DirList(DirCount) = _CWD$ + "\" + nam$
107.                     DirCount = DirCount + 1
108.                 END IF
109.             END IF
110.         LOOP UNTIL length = -1
111.  
112.  
113.         IF RIGHT$(DirList(0), 1) = "." AND RIGHT$(DirList(1), 2) = ".." THEN
114.             DirCount = DirCount - 3
115.             REDIM Dirl(DirCount) AS STRING
116.             FOR PlaceIt = 0 TO DirCount
117.                 Dirl(PlaceIt) = DirList(PlaceIt + 2)
118.             NEXT
119.             REDIM DirList(DirCount) AS STRING
120.             FOR PlaceIt = 0 TO DirCount
121.                 DirList(PlaceIt) = Dirl(PlaceIt)
122.             NEXT
123.             ERASE Dirl
124.         ELSE
125.             REDIM _PRESERVE DirList(DirCount - 1)
126.         END IF
127.     ELSE
128.     END IF
129.     close_dir
130. END SUB
131.  

[bplus]

@Petr

Looks like you are trying to build a TREE, a listing of all directories or paths. There might be a utility floating around for that but don't know if cross platform. It would probably work by a recursive method.