home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / basic / bas-rel1.lbr / RDIR.BZS / RDIR.BAS
Encoding:
BASIC Source File  |  1988-02-27  |  3.4 KB  |  167 lines
  1. '   Directory reading program.  
  2. '   Adapted from READDIR.BAS by Ron Kreymborg
  3. '   Lawrence Davis - 2/23/88
  4.  
  5. '   Compile: BASCOM =RDIR/O/Z/C
  6. '   Link   : L80 RDIR,UCASE,CTAIL,DIR.RRUN,RDIR/N/E
  7.  
  8.      DEFINT A-Z
  9.  
  10. '    Set maximum number of files in DIR$(n)
  11.      DIM FCB(20) , DMA(64) , DIR$(100) , CR(2)
  12.  
  13. '    Read CP/M command line.
  14.      CALL CTAIL(A$)
  15.  
  16.      IF A$<>"" _
  17.         THEN CMD=-1:GOTO 305
  18.  
  19. 300  PRINT
  20.      INPUT "Enter d:filespec to match: " , A$
  21.  
  22.      IF A$ = "" _
  23.         THEN END
  24.  
  25. '    Convert to upper-case
  26. 305  CALL UCASE(A$)
  27.  
  28. '    Extract drive letter and convert to drive code
  29.      DSPEC=INSTR(A$,":")
  30.  
  31.      IF DSPEC=0 _
  32.         THEN DRV=0
  33.  
  34.      IF DSPEC >0 THEN _
  35.         DRV$ = LEFT$ (A$ , 1) : DRV = ASC (DRV$) - 64 : A$ = MID$ (A$ , 3)
  36.  
  37.      PRINT
  38.  
  39. '    Check for name/ext seperator
  40.      A = INSTR (A$ , ".") : 
  41.  
  42.      IF A = 0 _
  43.         THEN 310
  44.  
  45.      A1$ = LEFT$ (A$ , A - 1) : A2$ = MID$ (A$ , A + 1)
  46.  
  47. '    Process wild card
  48.  
  49.      IF A1$ = "*" _
  50.         THEN A1$ = "????????"
  51.  
  52.      IF A2$ = "*" _
  53.         THEN A2$ = "???"
  54.  
  55. '    Make sure filename is exactly 11 characters
  56. 310  IF LEN (A1$) < 8 _
  57.         THEN A1$ = A1$ + SPACE$ (8 - LEN (A1$))
  58.  
  59.      IF LEN (A2$) < 3 _
  60.         THEN A2$ = A2$ + SPACE$ (3 - LEN (A2$))
  61.  
  62.      FIL$ = A1$ + A2$
  63.      FCB$ = CHR$(DRV) + FIL$
  64.  
  65.      FOR I = 1 TO 100
  66.        DIR$ (I) = "           "
  67.       NEXT I
  68.  
  69.     ' Copy the specified filename into the FCB.
  70.  
  71.      J = 0
  72.      FCB$ = FCB$+"      "
  73.  
  74.      FOR I = 0 TO 5
  75.        J = J + 1 : M = 1 : GOSUB 660
  76.        J = J + 1 : M = 256 : GOSUB 660
  77.      NEXT I
  78.  
  79. '    Set DMA buffer address
  80.      CALL SETDMA(DMA(0))
  81.  
  82. '    Check if file named in FCB exists
  83.      CALL GET1ST (FCB(0) , FLG)
  84.  
  85. 500  WHILE FLG < 4
  86.      E = E + 1
  87.      GOSUB 720
  88.      CALL GETNXT(FCB(0) , FLG) ' Check for next occurence of file
  89.      WEND
  90.  
  91. 560  GOSUB 900
  92.  
  93.      POKE 128 , 0             'Clear command line
  94.      IF CMD _
  95.        THEN END
  96.  
  97.      CALL RRUN
  98. ' -------------------------------------------------------------------
  99.  
  100. '    Sub-Routines
  101. '    ------------
  102.  
  103.      ' Load the ASCII sequence number into the correct
  104.      ' byte (specified by M) of the Ith FCB word.
  105.  
  106. 660  B$ = MID$(FCB$,J,1)
  107.      FCB(I) = FCB(I)+ASC(B$)*M
  108.      RETURN
  109.  
  110.      ' Extract each byte from the DMA buffer and load
  111.      ' them into the DIR$ string.
  112.  
  113. 720  K = FLG*16
  114.      U = U+1
  115.      L = 1
  116.      FOR I=K TO K+5
  117.        CALL SPLIT(DMA(I), CR(1), CR(0))
  118.        FOR J=0 TO 1
  119.            IF (I = K AND J = 0)_
  120.               THEN 810
  121.           MID$(DIR$(U),L,1) = CHR$(CR(J))
  122.           L = L+1
  123. 810   NEXT J
  124.      NEXT I
  125.      RETURN
  126.  
  127. '    Sort Directory
  128.  
  129. 900  N = E - 1
  130.      J4 = N
  131. 910  J4 = J4 \ 2
  132.      IF J4 = 0 _
  133.         THEN 950
  134.      J2 = N - J4
  135.      J = 1
  136. 920  I = J
  137. 930  J3 = I + J4
  138.      A = 1 : B = 12
  139.      IF MID$ (DIR$(I) , A , B) <= MID$ (DIR$(J3) , A , B) _
  140.         THEN 940
  141.      SWAP DIR$(I) , DIR$(J3)
  142.      I = I - J4
  143.  
  144.      IF I >= 1 _
  145.         THEN 930
  146.  
  147. 940  J = J + 1
  148.  
  149.      IF J > J2 _
  150.         THEN 910
  151.  
  152.      GOTO 920
  153.  
  154. ' Print Directory
  155.  
  156. 950 FOR I = 1 TO E-1
  157.       IF (I-1) MOD 5 = 0 _
  158.          THEN PRINT 
  159.       PRINT DIR$(I);" : ";
  160. 960 NEXT
  161.     PRINT
  162.     PRINT
  163.     F = E - 1
  164.     IF F = 1 THEN _
  165.         PRINT F ; "File found." ELSE PRINT F ; "Files found."
  166.     RETURN
  167.