home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Programmer's Library 1.3 / Microsoft-Programers-Library-v1.3.iso / sampcode / msj / msjv2_4 / qbasic / browse.bas next >
Encoding:
BASIC Source File  |  1989-03-02  |  10.7 KB  |  360 lines
  1.  
  2. rem        Figure 3
  3. rem        ========
  4.  
  5.  
  6.  
  7. rem        BROWSE.BAS
  8.  
  9.  
  10. 'BROWSE.BAS - a file browser/directory maintenance routine
  11. 'To compile in the editor environment, make a user library by
  12. 'assembling DSEARCH.ASM, using BUILDLIB to add it and USERLIB.OBJ
  13. 'to a user library (call it MYLIB.EXE, for instance), and then
  14. 'use the /L switch to load QB, as in "QB BROWSE /L MYLIB.EXE".
  15. 'To compile standalone, use "LINK BROWSE+DSEARCH+USERLIB...."
  16.  
  17. defint a-z
  18. dim winrec(8) 'holds window dimensions, colors for text and borders
  19.  
  20. 'the following arrays and constants are used for int86()
  21. dim inary(7), outary(7)
  22. const ax = 0, bx = 1, cx = 2, dx = 3
  23. const bp = 4, si = 5, di = 6, flag = 7
  24.  
  25. 'actions returned by PageAndSelect
  26. const disk.change = 1, delete.file = 2, type.file = 3, quit = 4
  27. action.flag = 0  'set by PageAndSelect to one of the above
  28.  
  29. rem $dynamic
  30. dim filename$(0)
  31. dim shared ScreenData (0,0)
  32.  
  33. def fn.min(x,y)
  34.    if x < y then fn.min = x else fn.min = y
  35. end def
  36.  
  37. def fn.max(x,y)
  38.    if x > y then fn.max = x else fn.max = y
  39. end def
  40.  
  41. '************************ MAIN PROGRAM **************************
  42.  
  43. call GetCurrDisk(origdisk$)
  44. call GetCurrPath(origdisk$,origpath$)
  45.  
  46. disk$ = origdisk$
  47.  
  48. 'get a count of all normal and subdir files
  49.  
  50. Do
  51.    call GetCurrPath(disk$,CurrPath$)
  52.    searchpath$ = disk$ + ":" + CurrPath$ + "*.*"
  53.  
  54.    attr = &H10 : count  =  0 : selective = 0
  55.    arrofs = int(varptr(filename$(0)))
  56.    call dsearch (searchpath$,attr,count,selective,arrofs)
  57.  
  58.    ' This should never happen!...
  59.    if count = -1 then
  60.       locate 25,1:print "Invalid path: "searchpath$
  61.       print "Strike a key...":a$ = input$(1):end
  62.    end if
  63.  
  64.    redim filename$(count-1)
  65.    for i = 0 to count-1:filename$(i) = space$(12):next i
  66.  
  67.    arrofs = int(varptr(filename$(0)))
  68.    call dsearch (searchpath$,attr,count,selective,arrofs)
  69.  
  70.    'now filename$(0 to count-1) have all the files and subdirs
  71.    winrec(1) = 1 : winrec(2) = 1    'upper left of window  (row,col)
  72.    winrec(3) = 10 : winrec(4) = 80   'lower right of window
  73.    winrec(5) = 0 : winrec(6) = 11    'fg/bg color
  74.    winrec(7) = 10 : winrec(8) = 0    'border colors, fg/bg
  75.  
  76.    call makewindow (winrec())
  77.  
  78.    'do window/cursor/path manipulation.
  79.  
  80.    call PageAndSelect(winrec(),filename$(),action.flag,f$)
  81.  
  82.    'f$ comes back as fixed-length (12) string
  83.    ' ...strip off trailing blanks
  84.    i = instr(f$," ") : if i > 0 then f$ = left$(f$,i-1)
  85.  
  86.    select case action.flag
  87.       case quit
  88.          call SetCurrDisk(OrigDisk$)
  89.          call SetCurrPath(OrigPath$)
  90.          cls : end
  91.       case disk.change
  92.          cls : print "Enter new disk drive letter: ";
  93.          disk$ = input$(1) : print disk$;
  94.          if disk$ > "Z" then disk$ = chr$(asc(disk$) and &HDF)
  95.          call SetCurrDisk(disk$)
  96.          action.flag = 0
  97.       case type.file
  98.          if right$(f$,1) = "\" then
  99.             CurrPath$ = CurrPath$ + f$
  100.             call SetCurrPath(CurrPath$)
  101.          else
  102.             call ListIt (disk$+":"+CurrPath$+f$)
  103.          end if
  104.       case delete.file
  105.          kill (disk$+":"+CurrPath$+f$)
  106.    end select
  107.  
  108.    action.flag = 0
  109. loop while (1)
  110.  
  111. '****************************************************************
  112.  
  113. sub makewindow (winrec(1)) static
  114. y1 = winrec(1):x1 = winrec(2):y2 = winrec(3):x2 = winrec(4)
  115. fc = winrec(5):bc = winrec(6):bfc = winrec(7):bbc = winrec(8)
  116. wid  =  x2-x1+1 : height = y2-y1+1
  117.  
  118. const vert = 186,upright = 187,lowright = 188
  119. const lowleft = 200,upleft = 201,horiz = 205
  120.  
  121. color bfc,bbc
  122. locate y1,x1:print chr$(upleft);string$(wid-2,horiz);chr$(upright);
  123. for i = 2 to height-1
  124.    locate y1+i-1,x1:print chr$(vert);
  125.    locate y1+i-1,x2:print chr$(vert);
  126. next i
  127. locate y2,x1:print chr$(lowleft);string$(wid-2,horiz);chr$(lowright);
  128.  
  129. call clearwindow(winrec())
  130. end sub
  131.  
  132. '****************************************************************
  133.  
  134. sub clearwindow (winrec(1)) static
  135. y1 = winrec(1):x1 = winrec(2):y2 = winrec(3):x2 = winrec(4)
  136. fc = winrec(5):bc = winrec(6):bfc = winrec(7):bbc = winrec(8)
  137. wid  =  x2-x1+1 : height = y2-y1+1
  138.  
  139. color fc,bc
  140. for i = 2 to height-1
  141.    locate y1+i-1,x1+1:print string$(wid-2," ");
  142. next i
  143. end sub
  144.  
  145. '****************************************************************
  146.  
  147. sub savewindow (winrec(1)) static
  148. y1 = winrec(1):x1 = winrec(2):y2 = winrec(3):x2 = winrec(4)
  149. fc = winrec(5):bc = winrec(6):bfc = winrec(7):bbc = winrec(8)
  150. wid = x2-x1+1 : height = y2-y1+1
  151.  
  152. for i = x1 to x2
  153.    for j = y1 to y2
  154.       ScreenData(j-y1,i-x1) = screen(j,i,1) * 256 + screen (j,i,0)
  155.    next j
  156. next i
  157. end sub
  158.  
  159. '****************************************************************
  160.  
  161. sub restorewindow (winrec(1)) static
  162. y1 = winrec(1):x1 = winrec(2):y2 = winrec(3):x2 = winrec(4)
  163. fc = winrec(5):bc = winrec(6):bfc = winrec(7):bbc = winrec(8)
  164.  
  165. for j = y1 to y2
  166.    locate j,x1
  167.    for i = x1 to x2
  168.       d = ScreenData(j-y1,i-x1)
  169.       bc = (d\256)\8 : fc = (d\256) mod 8 : color fc,bc
  170.       print chr$(d and &hff);
  171.    next i
  172. next j
  173. end sub
  174.  
  175. '****************************************************************
  176.  
  177. sub PageAndSelect_
  178.   (winrec(1),file$(1),action.flag,FileSelected$) static
  179.  
  180. 'This routine does all the work here.  It assumes MakeWindow
  181. 'has been called before entering, and does all key processing and
  182. 'subsequent window updates.  action.flag is returned as the action
  183. 'for the main program to take (see the constants in the main program
  184. 'for a list of possible actions).
  185.  
  186. shared disk$,CurrPath$,count
  187.  
  188. 'second codes from extended keys used in PageAndSelect
  189. const up = 72, down = 80, left = 75, right = 77
  190. const f1 = 59, AltD = 32, AltX = 45
  191.  
  192. y1 = winrec(1):x1 = winrec(2):y2 = winrec(3):x2 = winrec(4)
  193. fc = winrec(5):bc = winrec(6):bfc = winrec(7):bbc = winrec(8)
  194. wid = x2-x1+1 : height = y2-y1+1
  195.  
  196. locate y1,x1+1:color bfc,bbc:print " ";disk$;":";CurrPath$;" "
  197. locate y2,x1+1
  198. print "RET-Type file  AltD - delete file  F1 - chg disk  AltX - quit"
  199. locate y1,x2-1-9:print count;"files"
  200.  
  201. NamesPerLine = (wid-2)\15 'how many filenames on each line in window
  202. lines = height-2          'how many usable lines inside window
  203. FilesPerWindow = lines * NamesPerLine
  204.  
  205. StartIndex = 0 'first file$() to be displayed in window
  206. CurrIndex = 0  'current file$() being highlighted
  207. NewIndex = 0   'updated file$() index after moving cursor
  208.  
  209. do
  210.    call clearwindow(winrec())
  211.    limit = fn.min (ubound(file$) - StartIndex, FilesPerWindow - 1)
  212.    color fc,bc : locate y1+1
  213.    for i = 0 to limit step NamesPerLine
  214.       for j = 0 to NamesPerLine-1
  215.          locate ,x1 + 1 + j*15
  216.          if StartIndex + i + j <= ubound(file$) then
  217.             print file$(StartIndex+i+j);
  218.          else
  219.             print space$(15);
  220.          end if
  221.       next j
  222.    print
  223.    next i
  224.  
  225.    'initialize highlight bar position
  226.    BarRow = y1+1 : BarCol = x1 + 1
  227.  
  228.    do
  229.       color fc,bc : locate BarRow,BarCol : print file$(CurrIndex);
  230.       CurrIndex = NewIndex
  231.       BarRow = (CurrIndex-StartIndex)\NamesPerLine + y1 + 1
  232.       BarCol = (CurrIndex mod NamesPerLine)*15 + x1 + 1
  233.       color bc,fc : locate BarRow,BarCol : print file$(CurrIndex);
  234.  
  235.       'wait for extended character (look for cursor keys) or RETURN
  236.       GetKey:
  237.          a$ = "" : while a$ = "" : a$ = inkey$ : wend
  238.          if a$ = chr$(13) then
  239.             action.flag = type.file
  240.             FileSelected$ = file$(CurrIndex)
  241.             exit do
  242.          end if
  243.       if len(a$)<>2 then goto GetKey
  244.  
  245.       redraw = 0  'flag to indicate when window must be redrawn
  246.                   'and in which direction the cursor was moving
  247.       select case asc(right$(a$,1))
  248.          case up
  249.             NewIndex = fn.max (0,CurrIndex-NamesPerLine)
  250.             if NewIndex < StartIndex then redraw = -1
  251.          case down
  252.             NewIndex = fn.min (ubound(file$), CurrIndex+NamesPerLine)
  253.             if NewIndex > StartIndex + FilesPerWindow - 1 _
  254.              then redraw = 1
  255.          case left
  256.             NewIndex = fn.max (0,CurrIndex-1)
  257.             if NewIndex < StartIndex then redraw = -1
  258.          case right
  259.             NewIndex = fn.min (ubound(file$), CurrIndex + 1)
  260.             if NewIndex > StartIndex + FilesPerWindow - 1 _
  261.              then redraw = 1
  262.  
  263.          case f1
  264.             action.flag = disk.change : file.selected = -1 : exit do
  265.          case AltX
  266.             action.flag = quit : file.selected = -1 : exit do
  267.          case AltD
  268.             action.flag = delete.file
  269.             FileSelected$ = file$(CurrIndex) : exit do
  270.          case else
  271.             sound 440,2:sound 220,2
  272.       end select
  273.    loop while redraw = 0
  274.  
  275.    if action.flag then exit do
  276.    'otherwise, fall through and redo the entire "do" loop
  277.    select case sgn(redraw)
  278.       case -1
  279.         StartIndex = fn.max (StartIndex - FilesPerWindow , 0)
  280.       case 1
  281.         StartIndex = fn.min (StartIndex + FilesPerWindow , _
  282.                              ubound(file$))
  283.    end select
  284.    CurrIndex = StartIndex
  285. loop while not action.flag
  286.  
  287. end sub
  288.  
  289. '****************************************************************
  290.  
  291. sub     GetCurrPath(disk$,CurrPath$) static
  292. shared inary(),outary()
  293.  
  294. 'first set up 64-byte work area for Int 21h Function 47h
  295. ' (get current directory)
  296. CurrPath$ = space$(64) : pathptr = sadd(CurrPath$)
  297.  
  298. inary(dx)=asc(disk$)-65+1
  299. inary(si)=pathptr 'pointer to area to fill
  300. inary(ax)=&H4700  'function number
  301. call int86(&H21,varptr(inary(0)),varptr(outary(0)))
  302.  
  303. 'strip off trailing NUL, rest of blanks
  304. CurrPath$=left$(CurrPath$,instr(CurrPath$,chr$(0))-1)
  305. CurrPath$="\"+CurrPath$
  306. if CurrPath$ <> "\" then CurrPath$=CurrPath$+"\"
  307. end sub
  308.  
  309. '****************************************************************
  310.  
  311. sub GetCurrDisk(disk$) static
  312. shared inary(),outary()
  313. inary(ax) = &H1900
  314. call int86(&H21,varptr(inary(0)),varptr(outary(0)))
  315. disk$ = chr$(65 + (outary(ax) and 255))
  316. end sub
  317.  
  318. '****************************************************************
  319.  
  320. sub SetCurrDisk(disk$) static
  321. shared inary(),outary()
  322.  
  323. inary(ax) = &H0E00
  324. inary(dx) = asc(disk$) - 65
  325. call int86(&H21,varptr(inary(0)),varptr(outary(0)))
  326.  
  327. end sub
  328.  
  329. '****************************************************************
  330.  
  331. sub SetCurrPath(path$) static
  332. shared inary(),outary()
  333.  
  334. newpath$=path$
  335. if newpath$<>"\" then newpath$=left$(newpath$,len(newpath$)-1)
  336. newpath$=newpath$+chr$(0)
  337.  
  338. inary(ax) = &H3B00
  339. inary(dx) = sadd(newpath$)
  340. call int86(&H21,varptr(inary(0)),varptr(outary(0)))
  341.  
  342. end sub
  343.  
  344. '****************************************************************
  345.  
  346. sub TypeIt (path$) static
  347.    cls
  348.    shell ("type "+path$+" | more")
  349.    locate 25,1:print "Any key to continue...";
  350.    a$=input$(1):cls
  351. end sub
  352.  
  353. '****************************************************************
  354.  
  355. sub ListIt (path$) static
  356.    shell ("list "+path$)
  357.    cls
  358. end sub
  359.  
  360.