Author Topic: Development of a program for automatic search for music and movies  (Read 1455 times)

Offline Petr

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

Online SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2584
    • Steve’s QB64 Archive Forum
Re: Development of a program for automatic search for music and movies
« Reply #1 on: June 22, 2020, 07:11:54 PM »
 
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.  ;)

 

 
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Petr

  • Forum Resident
  • Posts: 1351
  • The best code is the DNA of the hops.
Re: Development of a program for automatic search for music and movies
« Reply #2 on: June 24, 2020, 04:27:24 PM »
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.

Offline bplus

  • Forum Resident
  • Posts: 4564
  • B+ nots
Re: Development of a program for automatic search for music and movies
« Reply #3 on: June 24, 2020, 05:12:40 PM »
@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?

« Last Edit: June 24, 2020, 06:26:44 PM by bplus »

Offline Petr

  • Forum Resident
  • Posts: 1351
  • The best code is the DNA of the hops.
Re: Development of a program for automatic search for music and movies
« Reply #4 on: June 24, 2020, 06:45:05 PM »
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)

Offline bplus

  • Forum Resident
  • Posts: 4564
  • B+ nots
Re: Development of a program for automatic search for music and movies
« Reply #5 on: June 24, 2020, 07:16:13 PM »
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.     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.  
  7. REDIM Dir(0) AS STRING, File(0) AS STRING
  8.  
  9. 'D$ = _CWD$
  10. D$ = "C:\\"
  11. GetFileList D$, Dir(), File()
  12.  
  13. PRINT "SUBDIRECTORIES"; UBOUND(dir)
  14. FOR i = 1 TO UBOUND(dir)
  15.     PRINT Dir(i),
  16.  
  17. PRINT "FILES"; UBOUND(file): PRINT: PRINT
  18. FOR i = 1 TO UBOUND(file)
  19.     PRINT File(i),
  20.  
  21. SUB GetFileList (SearchDirectory AS STRING, DirList() AS STRING, FileList() AS STRING)
  22.     CONST IS_DIR = 1
  23.     CONST IS_FILE = 2
  24.     DIM flags AS LONG, file_size AS LONG
  25.  
  26.     REDIM _PRESERVE DirList(100), FileList(100)
  27.     DirCount = 0: FileCount = 0
  28.  
  29.     IF load_dir(SearchDirectory) THEN
  30.         DO
  31.             length = has_next_entry
  32.             IF length > -1 THEN
  33.                 nam$ = SPACE$(length)
  34.                 get_next_entry nam$, flags, file_size
  35.                 IF (flags AND IS_DIR) OR _DIREXISTS(SearchDirectory + nam$) THEN
  36.                     DirCount = DirCount + 1
  37.                     IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
  38.                     DirList(DirCount) = nam$
  39.                 ELSEIF (flags AND IS_FILE) OR _FILEEXISTS(SearchDirectory + nam$) THEN
  40.                     FileCount = FileCount + 1
  41.                     IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
  42.                     FileList(FileCount) = nam$
  43.                 END IF
  44.             END IF
  45.         LOOP UNTIL length = -1
  46.         close_dir
  47.     ELSE
  48.     END IF
  49.     REDIM _PRESERVE DirList(DirCount)
  50.     REDIM _PRESERVE FileList(FileCount)
  51.  
  52.  
« Last Edit: June 24, 2020, 07:18:57 PM by bplus »

Online SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2584
    • Steve’s QB64 Archive Forum
Re: Development of a program for automatic search for music and movies
« Reply #6 on: June 24, 2020, 08:07:48 PM »
@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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

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

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.

« Last Edit: June 24, 2020, 11:29:33 PM by bplus »

Offline Petr

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

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

 
« Last Edit: June 25, 2020, 04:43:33 AM by Petr »

Offline Petr

  • Forum Resident
  • Posts: 1351
  • The best code is the DNA of the hops.
Re: Development of a program for automatic search for music and movies
« Reply #9 on: June 25, 2020, 05:14:07 AM »
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).

Offline SpriggsySpriggs

  • Seasoned Forum Regular
  • Posts: 259
  • DIM JohnSilver AS LONG, yarn AS STRING
    • My GitHub
Re: Development of a program for automatic search for music and movies
« Reply #10 on: June 25, 2020, 07:08:57 AM »
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.         FUNCTION load_dir& (s AS STRING)
  2.         FUNCTION has_next_entry& ()
  3.         SUB close_dir ()
  4.         SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
  5.     END DECLARE
  6.  
  7.     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.     SUB STRING.Split (Expression AS STRING, delimiter AS STRING, StorageArray() AS STRING, preserve AS INTEGER)
  59.         DIM copy AS STRING, p AS LONG, curpos AS LONG, arrpos AS LONG, dpos AS LONG
  60.         copy = Expression
  61.         IF delimiter = " " THEN
  62.             copy = RTRIM$(LTRIM$(copy))
  63.             p = INSTR(copy, "  ")
  64.             WHILE p > 0
  65.                 copy = MID$(copy, 1, p - 1) + MID$(copy, p + 1)
  66.                 p = INSTR(copy, "  ")
  67.             WEND
  68.         END IF
  69.         curpos = 1
  70.         IF preserve <> 0 THEN
  71.             arrpos = UBOUND(StorageArray)
  72.             dpos = INSTR(curpos, copy, delimiter)
  73.             DO UNTIL dpos = 0
  74.                 StorageArray(UBOUND(StorageArray)) = MID$(copy, curpos, dpos - curpos)
  75.                 REDIM _PRESERVE StorageArray(UBOUND(StorageArray) + 1) AS STRING
  76.                 curpos = dpos + LEN(delimiter)
  77.                 dpos = INSTR(curpos, copy, delimiter)
  78.             LOOP
  79.             StorageArray(UBOUND(StorageArray)) = MID$(copy, curpos)
  80.             REDIM _PRESERVE StorageArray(UBOUND(StorageArray) + 1) AS STRING
  81.         ELSEIF preserve = 0 THEN
  82.             arrpos = 0
  83.             dpos = INSTR(curpos, copy, delimiter)
  84.             DO UNTIL dpos = 0
  85.                 StorageArray(arrpos) = MID$(copy, curpos, dpos - curpos)
  86.                 arrpos = arrpos + 1
  87.                 IF arrpos > UBOUND(StorageArray) THEN REDIM _PRESERVE StorageArray(UBOUND(StorageArray) + 1) AS STRING
  88.                 curpos = dpos + LEN(delimiter)
  89.                 dpos = INSTR(curpos, copy, delimiter)
  90.             LOOP
  91.             StorageArray(arrpos) = MID$(copy, curpos)
  92.             REDIM _PRESERVE StorageArray(arrpos) AS STRING
  93.         END IF
  94.     END SUB
  95.  

Online SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 2584
    • Steve’s QB64 Archive Forum
Re: Development of a program for automatic search for music and movies
« Reply #11 on: June 25, 2020, 07:22:03 AM »
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
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SpriggsySpriggs

  • Seasoned Forum Regular
  • Posts: 259
  • DIM JohnSilver AS LONG, yarn AS STRING
    • My GitHub
Re: Development of a program for automatic search for music and movies
« Reply #12 on: June 25, 2020, 07:42:36 AM »
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.

Offline Petr

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

Offline bplus

  • Forum Resident
  • Posts: 4564
  • B+ nots
Re: Development of a program for automatic search for music and movies
« Reply #14 on: June 25, 2020, 12:19:02 PM »
@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.