home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / basic / bmag / dirlist.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-26  |  3.3 KB  |  101 lines
  1. '─ Area: F-QUICKBASIC ─────────────────────────────────────────────────────────
  2. '  Msg#: 414                                          Date: 14 Apr 94  14:26:05
  3. '  From: Coridon Henshaw                              Read: Yes    Replied: No 
  4. '    To: All                                          Mark:                     
  5. '  Subj: Directory list routine 1/2
  6. '──────────────────────────────────────────────────────────────────────────────
  7. FUNCTION FileSearch (LookFor$, Attributes%, FileNames() AS FileSpecs)
  8.  
  9. DIM Regs AS RegTypeX
  10. DIM DOSFindBuff AS DOSFindType  'DOS Findfirst buffer
  11.  
  12. Regs.AX = &H2F00              'Get the old DTA address
  13. InterruptX &H21, Regs, Regs
  14.  
  15. OldDTASeg% = Regs.ES          'Save it to restore later
  16. OldDTAOff% = Regs.BX
  17.  
  18. Regs.AX = &H1A00              'Set our filefind buffer as
  19. Regs.DS = VARSEG(DOSFindBuff) 'the new DTA
  20. Regs.DX = VARPTR(DOSFindBuff)
  21. InterruptX &H21, Regs, Regs
  22.  
  23. FindFileBuff$ = LookFor$ + CHR$(0)
  24. Regs.AX = &H4E00
  25. Regs.CX = Attributes%
  26. Regs.DS = SSEG(FindFileBuff$)
  27. Regs.DX = SADD(FindFileBuff$)
  28. InterruptX &H21, Regs, Regs
  29.  
  30. IF Regs.AX = 0 THEN 'No Error
  31.     Pntr = 1
  32.     GOSUB SaveData
  33.     DO
  34.         Pntr = Pntr + 1
  35.         Regs.AX = &H4F00
  36.         InterruptX &H21, Regs, Regs
  37.         IF Regs.AX = &H12 THEN 'No more files
  38.             ExitFlag = True
  39.         ELSE
  40.             GOSUB SaveData
  41.         END IF
  42.     LOOP UNTIL ExitFlag = True
  43. END IF
  44.  
  45. Regs.AX = &H1A00              '| Restore the original DTA
  46. Regs.DS = OldDTASeg%
  47. Regs.DX = OldDTAOff%
  48. InterruptX &H21, Regs, Regs
  49.  
  50. IF Pntr > 1 THEN REDIM PRESERVE FileNames(1 TO Pntr - 1) AS FileSpecs
  51. FileSearch = Pntr - 1
  52.  
  53. EXIT FUNCTION
  54. SaveData:
  55.  
  56. IF Pntr = UBOUND(FileNames) THEN
  57.     REDIM PRESERVE FileNames(1 TO Pntr + 64) AS FileSpecs
  58. END IF
  59.  
  60. FileNames(Pntr).FileName = SPACE$(12)
  61. FileNames(Pntr).FileName = LEFT$(DOSFindBuff.FileName,_
  62.  INSTR(DOSFindBuff.FileName, CHR$(0)) - 1)
  63. FileNames(Pntr).Attributes = ASC(DOSFindBuff.DFileAttr)
  64. FileNames(Pntr).FileSize = DOSFindBuff.FileSize
  65.  
  66. HMS& = CVTLong(DOSFindBuff.DosTime)                  ' Use long integer_
  67. ' for
  68. IF HMS& < 0& THEN HMS& = 65536 + HMS&   ' positive numbers
  69. Hours = (HMS& \ 2048&) AND 31           ' Hours is first 5 bits
  70. Minutes = (HMS& \ 32&) AND 63&          ' Minutes is nxt 6 bits
  71. Seconds = (HMS& AND 31&) * 2            ' Secnds is last 5 bits
  72. h$ = LTRIM$(STR$(Hours)): IF LEN(h$) = 1 THEN h$ = "0" + h$
  73. m$ = LTRIM$(STR$(Minutes)): IF LEN(m$) = 1 THEN m$ = "0" + m$
  74. s$ = LTRIM$(STR$(Seconds)): IF LEN(s$) = 1 THEN s$ = "0" + s$
  75. FileNames(Pntr).FileTime = h$ + ":" + m$ + ":" + s$
  76.  
  77. YMD& = CVTLong(DOSFindBuff.DOSDate)                   ' Long int here_
  78. ' too
  79. IF YMD& < 0 THEN YMD& = 65536 + YMD&    ' Cnv +
  80. Year = 1980& + YMD& \ 512&              ' Year is first 7 bits
  81. Month = (YMD& AND 511&) \ 31&           ' Month is next 4 bits
  82. Day = YMD& AND 31&                      ' Day is last 5 bits
  83. Y$ = LTRIM$(STR$(Year))
  84. m$ = LTRIM$(STR$(Month)): IF LEN(m$) = 1 THEN m$ = "0" + m$
  85. d$ = LTRIM$(STR$(Day)): IF LEN(d$) = 1 THEN d$ = "0" + d$
  86. FileNames(Pntr).FileDate = m$ + "-" + d$ + "-" + Y$
  87.  
  88. RETURN
  89.  
  90. END FUNCTION
  91.  
  92. 'Here's the TYPE structure you'll need:
  93.  
  94. TYPE FileSpecs
  95.  Attributes  AS INTEGER
  96.  FileTime    AS STRING * 8
  97.  FileDate    AS STRING * 10
  98.  FileSize    AS LONG
  99.  FileName    AS STRING * 12
  100. END TYPE
  101.