'=========================================================================== ' Subject: SCAN DIRECTORIES Date: 02-25-00 (16:16) ' Author: Hermann Seegert Code: PB ' Origin: Hermann.Seegert@t-online.de Packet: DOS.ABC '=========================================================================== $if 0 Detmold, Germany, 25.2.2000 ÚÄÄÄÄÄÄ¿Ü ³ Hi ! ³Û ÀÄÄÄÄÄÄÙÛ ßßßßßßßßß Here there is a little useful program (I hope). It' s scanning the directories in an array and is also capable, to show the files from each directory. The program isn't all done by me. Most of the 'sub ScanforDirs' is done by Nathan C. Durland, and I've tried to send an email to him, but unfortunately without success. If you- Nathan- are reading this lines, I would be glad to get an email from you. By the way I thank you for your nice and well commented listing, which was useful for my needs. Ok, what does this program do? You know already, that it's able, to scan your HD for directories. But also there are shown the fi- les of each directory, and it's possible to scroll forward and backwards (much better than DIR from DOS). All directories and all files are well sorted with the powerful array sort from powerBa- sic (it's programed with PowerBASIC 3.2). If you only want to know, how many files are in a directoriy (to- gether with all sub- directories), you can type /i or /I and after some seconds you get this info (in the original listing, Nathan is writing: only an informed user is a happy user ;)). You can type in a directory together with a file mask or nothing, then you get all stuff from the current directory. If you will look to procedure masc(...) you will find, which possibilities there are for command- line- inputs. It's just like in DOS- you can make an input like c:\dos\.txt, and it will be interpreted like c:\dos\*.txt. You can type in .. and it will be shown he pre- vious directory. Well, probably there is the one or other bug in here. You see, it's just late to send it to good William, and if I will find a lot of bugs, which I don't hope, I will offer a new scandirs.bas in the next edition of ABC- collection, ok? But all in all I think, this listing is structured enough and so it can simply be extended. Who is me? ÄÄÄÄÄÄÄÄÄÄ I'm Hermann Seegert, I'm German, living in Detmold, a small town in the north of Germany (pretty nice place...). Emails are ap- preciated. Here my address: hermann.seegert@t-online.de Feel free to make critics, wishes or anything else.... PS: You find some stuff from me in PB.ABC in the ABC- collection. $endif $lib all off $compile exe "dirr.exe" 'change it, if you like! $optimize speed 'possibly the best... defint a-z shared schirm$(),colores,dosline 'screen- saving,colors,cursor shared message,info 'for option /i (or /I) call blink(1) 'set blinkbit (useful here!) dosline=csrlin 'where is cursor now? screenreadwrite "R",1 'save screen %false=0 %true=not %false '-1 from_path$=ucase$(remove$(command$,any chr$(0,9,32,255))) 'command line ' if instr(from_path$,"/I") then 'Option for small info info=%true from_path$=remove$(from_path$,"/I") 'here the input... end if 'from_path$="C:\SPIELE\NOGAMES\COMPILER\*.BAS" 'test in the IDE call masc(from_path$,path$,mask$) 'get path and masc & check it! 'the following is the first main- procedure...... call ScanforDirs(from_path$,path$,mask$) end 'that's it! ' '---------------------- scanning for directories ------------------- ' sub ScanforDirs(from_path$,path$,mask$) local DirPtr&,DirCount& dim dirnames$(4000) 'enough I hope! - for all directories ' dirnames$(0)=path$ 'first path (from where we go) if right$(dirnames$(0),1)<>"\" then dirnames$(0)=dirnames$(0)+"\" ' dirptr&=-1 : dircount&=0 xline=csrlin 'we need one for a message... while dircount&>dirptr& locate xline,5 ? "Working busy, scanning sub directory no.";dirptr&;" .........."; if inkey$=chr$(27) then print : ? tab(5) "Abort...."; : end 'exit incr dirptr&,1 thedir$=dirnames$(dirptr&) 'the directory ' Use an attribute value of 55. This will make DIR$ return di- ' rectory names and all sorts of files. x$=dir$(thedir$+"*.*",55) ' if there are no items in the directory ..... if x$="" and dircount&=0 then ? tab(5) "There are no files / directories in:" showdir$=rtrim$(thedir$,"\") if right$(showdir$,1)=":" then showdir$=showdir$+"\" ? tab(5) showdir$; : end end if ' while x$<>"" if inkey$=chr$(27) then print : ? tab(5) "Abort...."; : end ' exit thefile$=thedir$+x$ ' Check the attribute of the returned file name. If bit 4 is ' set, then the file is a directory. If it's a directory, then ' increase the dircount& and store this directory name. z?=attrib(thefile$) if bit(z?,4) then 'then it's a directory incr DirCount&,1 if right$(thefile$,1)<>"\" then thefile$=thefile$+"\" dirnames$(dircount&)=thefile$ end if x$=dir$ wend 'error........ if dirptr&>3999 then 'info, if to much dirs... dirnames$(dirptr&)="SORRY, TO MANY DIRECTORIES, CAN'T READ THEM ALL!" dircount&=dirptr& 'because of array sort... end if wend ' if not info then array sort dirnames$() for dircount&+1 'sort directory names end if 'now let's look for files in the directory we just are.... for anz&=0 to dircount& 'the following is the second and last main- procedure.... call lookforfiles(from_path$,mask$,dirnames$(),anz&,_ dircount&,filewhole&) next anz& 'if info is true (info and message are shared!) if message then locate csrlin,5 ? "There are ";DirCount&;" subdirectories and ";_ filewhole&;" files in sub directory:" trimdir$=rtrim$(dirnames$(0),"\") 'no backslash on the end if right$(trimdir$,1)=":" then trimdir$=trimdir$+"\" 'Root- directory ? tab(5) trimdir$; end end if end sub ' '---------------------- scanning for directories ------------------- ' sub lookforfiles(from_path$,mask$,dirnames$(),anz&,_ dircount&,filewhole&) top=%true 'very important flag! if top then 'show current directory once... showdir$=rtrim$(dirnames$(anz&),"\") 'no backslash on the end if right$(showdir$,1)=":" then showdir$=showdir$+"\" 'Root- directory top=%false end if ' redim filenames$(1100) 'for 1055 files in a directory, 'probably enough, I hope... filess=1 file_in_dir$=dir$(dirnames$(anz&)+mask$,39) while file_in_dir$<>"" incr filess filenames$(filess)=file_in_dir$ if filess>1055 then 'you have to subtract because of 'correct showing!! look at: 'redim filenames$(1100)!) filenames$(filess)="TO MUCH FILES IN SUB- DIRECTORY, "+_ "NOT EACH CAN BE SHOWN" exit loop end if file_in_dir$=dir$ wend 'no files in directory? An informed user... is ... a happy user..! if filenames$(2)="" then filenames$(2)="No "+mask$+" files in this directory!!" end if ' xline=csrlin if info then 'check filenumber... locate xline,5 ? "Moment, looking for files in sub directory no. ";anz&;_ "........"; filewhole&=filewhole&+filess-1 message=%true if inkey$=chr$(27) then print : ? tab(5) "Abort...."; : end ' exit exit sub end if array sort filenames$() for filess+1 'sort file names '- put it on the screen... numblines=pbvscrnrows '*** e.g. 50 rows under DOS length=filess '*** length of 'text' topline=2 : bottomline=numblines-1 '*** page 1 rightleft=1 '*** Scrolling right/left do '................. begin of main loop call colors(colores,vg,hg) color hg,vg firstline$=string$(80," ") mid$(firstline$,80-len(showdir$))=ucase$(showdir$) if anz&=0 then dirnumb$=" !" else dirnumb$=str$(anz&) mid$(firstline$,1)=dirnumb$+"/"+ltrim$(str$(dircount&)) locate 1,1 : print firstline$ color vg,hg : locate 2,1 '.............. begin of showing files for nr=topline to bottomline if farb then color 31,0 : farb=%false emptyline$=string$(80," ") mid$(emptyline$,1)=mid$(filenames$(nr),rightleft,79) print emptyline$; if not farb then color vg,hg next '.............. end of showing files color hg,vg lastline$=string$(80," ") mid$(lastline$,1)=" File:"+space$(30)+"F1=Help, ENTER/"+_ "ESC=changing dir., ALT+x=End" mid$(lastline$,7)=str$(topline-1) mid$(lastline$,12)=" from"+str$(length-1) mid$(lastline$,23)="Col.: "+str$(rightleft) locate numblines,1 : print lastline$; do t$=inkey$ loop until t$<>"" select case t$ '*** ask for the keys case chr$(0,81),chr$(32) '*** page down and space incr topline,numblines-3 incr bottomline,numblines-3 if topline=>length then topline=length : bottomline=topline+numblines-3 end if case chr$(0,80) '*** cursor down incr topline : incr bottomline if topline=>length then topline=length : bottomline=topline+numblines-3 end if case chr$(0,79) '*** end- key topline=length-numblines+3 : bottomline=length if length=3255 then rightleft=1 'LOL case chr$(0,75) '*** cursor left decr rightleft if rightleft<1 then rightleft=1 case chr$(0,116) '*** CTRL + cursor right incr rightleft,10 if rightleft>=3255 then rightleft=1 'LOL case chr$(0,115) '*** CTRL + cursor left decr rightleft,10 if rightleft<=1 then rightleft=1 case chr$(0,59) '*** Help (F1) call helpme(vg,hg) case chr$(0,60) '*** color (F2) incr colores if colores=4 then colores=0 call colors(colores,vg,hg) case chr$(13) '*** next sub directory if anz&=dircount& then 'last one is loaded, play "c64" 'so why press a key? iterate else exit sub end if case chr$(27) '*** sub directory before decr anz&,2 if anz&<-1 then play "c64" : anz&=0 'no previous sub directory iterate end if exit sub case chr$(0,45) '*** definitely end of program locate dosline-1 screenreadwrite "W",1 end case chr$(1) to chr$(255) 'first letter of a file if told$="" or t$<>told$ then for a=0 to length 'check, if item valid if left$(filenames$(a),1)=ucase$(t$) then there=%true : exit for end if next if not there then iterate loop end if if topline-towhere>1 then topline=0 if t$=told$ then incr topline : startold=topline else topline=0 end if for towhere=topline to length if left$(filenames$(towhere),1)=ucase$(t$) then told$=t$ : exit for end if next topline=towhere 'filepointer=Var 'towhere' if topline-1=length then 'last item, show it in color! told$="" : topline=startold-1 : farb=%true end if there=%false 'must be false here in each 'case! bottomline=topline+numblines-3 case else '*** invalid key... iterate loop end select loop '.............. End of main loop end sub ' '****************** procedures for the 'lister' ******************** ' '------------------------ color setting ---------------------------- ' sub colors(colores,vg,hg) if colores=0 then vg=7 : hg=0 if colores=1 then vg=15 : hg=1 if colores=2 then vg=4 : hg=3 if colores=3 then vg=14 : hg=1 end sub ' '--------------------------- Help ---------------------------------- ' sub helpme(vg,hg) cls : locate 3,15 : color vg,hg ? " ******* HELP for the internal LISTER ****** " color hg,vg : locate 5,5 ? "PAGE "+chr$(24)+" PAGE "+chr$(25)+" : next / previous page" locate,5 : ? chr$(24,32,25,32,47,32,26,32,27)+_ " : Scrolling rows / columns" locate,5 : ? "CTRL + "+chr$(26)+"/ CTRL + "+chr$(27)+_ " : Scrolling in jumps of 10 bytes right / left" locate,5 : ? "END / POS 1 : end of file list / begin of file list" locate,5 : ? "F2 : color changing" locate,5 : ? "-> By pressing a sign, you jump to the 1st file, "_ "which begins with it!" locate,5 : ? "ENTER : next sub directory (if false, then sound)" locate,5 : ? "ESC : previous sub directory (if false, then sound)" locate,5 : ? "ALT + x : definitely ending program" print locate,15 : color vg,hg ? " .............. PRESS ANY KEY ............... " do t$=inkey$ loop until t$<>"" end sub ' '********************* helping procedures ************************** ' '--------- set blink bit, because we have blinking colors ---------- ' sub blink (byval mode) ' Mode: 1 = blink / 0 = hilite background if mode<>0 then mode=1 ! mov ax,&H1003 ! mov bx,mode ! int &H10 end sub ' '---------------------- file mask and path ------------------------- ' sub masc(from_path$,path$,mask$) 'here procedure sub right_in_string(signs$,back1$,back2$) is used ' 'Well, we all want to have a little bit of comfort like the input 'under dos. Instead of typing *.txt we want to type .txt. ' With the following, all this is possible. ' on local error resume next actpath$=curdir$ if from_path$=".." then 'like under dos.... from_path$=actpath$ call right_in_string(from_path$,from_path$,"") from_path$=from_path$+"\*.*" 'here it is: the previous dir.! end if if right$(from_path$,1)=":" and _ 'dropp the AND, if you like len(from_path$)=2 then 'scan a drive from root from_path$=from_path$+"\*.*" end if if left$(from_path$,1)="\" then 'scan a path on current drive from_path$=left$(actpath$,2)+rtrim$(from_path$,"\")+"\*.*" end if ' if instr(from_path$,"\")=0 and _ from_path$<>"" then 'without path, but with mask from_path$=rtrim$(actpath$,"\")+"\"+from_path$ elseif from_path$="" then 'nothing from_path$=rtrim$(actpath$,"\")+"\*.*" end if ' call right_in_string(from_path$,x1$,x2$) 'you were typing in e.g.: c:\dos\.txt (changing into: ...\*.txt) if left$(x2$,1)="." then x2$="*."+mid$(x2$,2) 'you were typing in e.g.: c:\dos\letters. (changing into: ...\letters.*) if right$(x2$,1)="." then x2$=left$(x2$,len(x2$)-1)+".*" from_path$=x1$+"\"+x2$ 'build the whole string ' z?=attrib(from_path$) 'if here will occur an error, this 'doesn't matter. If you have joker 'and wildcards in from_path$, normal- 'ly here will be an error then. This 'is the main reason for a local er- 'ror- handler in this procedures, and 'because of this construction it's 'working (try it out with several in- 'puts!). if bit(z?,4) then 'then directory from_path$=from_path$+"\*.*" end if 'in each case, now we have the filemask and the directory.... ' let's have a look again for path and mask! call right_in_string(from_path$,path$,mask$) 'because we want to know, if the given path is valid, we call the 'procedure sub checkpath to check this out.... call ckeckpath(path$) end sub ' '--------------- a simple INSTR from right ------------------------- ' sub right_in_string(signs$,back1$,back2$) 'for sub masc(...), back1$=left to delimiter, back2$=mid$ delimiter ' to the end for a=len(signs$) to 1 step -1 if mid$(signs$,a,1)="\" then decr a : exit next a back1$=left$(signs$,a) 'here: path back2$=mid$(signs$,a+2) 'here: file mask end sub ' '------------------ check out, if path is valid -------------------- ' sub ckeckpath(path$) on local error resume next actpath2$=curdir$ if right$(path$,1)=":" then path$=path$+"\" 'root- directories.... chdrive left$(path$,1) chdir mid$(path$,3) if err<>0 then if err=71 or err=72 then ? tab(5) "Invalid drive, make a correct input......" else ? tab(5) "Invalid path, make a correct input......." end if chdrive left$(actpath2$,1) chdir mid$(actpath2$,3) end 'program ends because of invalid path end if chdrive left$(actpath2$,1) 'back to where we come from ;) chdir mid$(actpath2$,3) 'back to where we come from ;) end sub ' '---------------- Screen saving and restoring ---------------------- ' sub screenreadwrite(modus$,pages) 'SAVE-SCREEN as STRING$ if (pbvScrnCard and 1)=0 then def seg=&HB800 'color else def seg=&HB000 'B/W end if if li=25 then n=4 else n=8 if modus$="R" then 'now read screen with "R" $STRING can be 1 kB! for i=1 to n schirm$(pages*i)=peek$((i-1)*1000,1000) next else 'now restore with "W" $STRING can be 1 kB! for i=1 to n poke$ (i-1)*1000,schirm$(pages*i) next end if end sub ' '******************************* EOF *******************************