home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 24 / CD_ASCQ_24_0995.iso / vrac / homonlib.zip / DIR.BAS < prev    next >
BASIC Source File  |  1995-04-13  |  5KB  |  149 lines
  1. DEFINT A-Z
  2.  
  3. ' $INCLUDE: 'QB.BI'
  4. ' $INCLUDE: 'DIR.INC'
  5.  
  6. '(Function declaration is in the include file)
  7.  
  8. DECLARE FUNCTION DTABit% (BitNumber%)   'Used only by the Dir$() function.
  9.  
  10. DIM SHARED DTAOff%
  11.  
  12. FUNCTION Dir$ (file$, DirInfo AS DirType)
  13. '****************************************************************************
  14. 'Credit for this function must go to Fairchild Computer Services.  The code
  15. ' has been altered from the original to suit my purposes.  The original is
  16. ' available on CompuServe as "DIR.ZIP", and comes with some other good stuff.
  17. ' It is one of the most useful things I have ever downloaded.  Thank you, FCS
  18. ' for sharing your knowledge with the rest of us!
  19. '
  20. 'I changed the original function by making the DirType variable a passed
  21. ' parameter rather than a COMMON SHARED variable, and altering the format of
  22. ' the EntryTime & EntryDate values.
  23. '
  24. 'The file$ parameter may be passed as an individual filename, or a filespec
  25. ' that includes wildcards and/or extended pathnames - just as if you were
  26. ' typing "DIR" at the DOS prompt.
  27. '
  28. 'The DirType variable will be filled with other information about the file
  29. ' found (if any).  See DIR.INC for the type declaration.
  30. '
  31. 'If any files match the wildcard, the function will return the filename of
  32. ' the first matching file.  If a single filename was passed, you'll just get
  33. ' the same name back and will then know that the file exists.  The DirType
  34. ' argument will contain the file's other information.
  35. '
  36. 'If no files match the wildcard or the single filename does not exist, Dir$()
  37. ' will return a null string ("") and the DirType variable will not be updated
  38. ' except with an ErrorCode.
  39. '
  40. 'To get further matches to a wildcard, continue to call Dir$() with a null
  41. ' file$ argument.  Keep doing this until a null string is returned.  This
  42. ' will indicate that no further files match the wildcard.
  43. '
  44. 'Example: ' $INCLUDE: 'DIR.INC'
  45. '         DIM DirInfo AS DirType
  46. '         f$ = Dir$("*.*", DirInfo)
  47. '         IF f$ = "" THEN
  48. '              PRINT "No files found"
  49. '         ELSE
  50. '              PRINT "These files were found:"
  51. '              DO
  52. '                   PRINT f$
  53. '                   f$ = Dir$("", DirInfo)
  54. '              LOOP UNTIL f$ = ""
  55. '         END IF
  56. '
  57. 'If there is a problem (such as an invalid pathname) Dir$() will return the
  58. ' string "***ERROR***" and the DirType.ErrorCode will contain a value.
  59. '
  60. 'Caution: Don't try to run Dir$() against an empty diskette drive.  You'll
  61. ' hang the computer.  Make sure there's a diskette in there first!
  62. '
  63. 'See the functions FileExist(), FileSize&() and DirExist() for more examples.
  64. '
  65. 'See the functions in DIRSTUFF.BAS for examples of how to interpret the
  66. ' values in the DirType variable.
  67. '
  68. '****************************************************************************
  69.  
  70. DIM InRegsX AS RegTypeX, OutRegsX AS RegTypeX
  71.  
  72. null$ = ""
  73.  
  74. InRegsX.ax = &H2F00                          'For extensive comments on the
  75. CALL INTERRUPTX(&H21, InRegsX, OutRegsX)     'workings of this function,
  76. DTASeg% = OutRegsX.es                        'download the original DIR.ZIP
  77. DTAOff% = OutRegsX.bx                        'from CompuServe.
  78. t$ = null$
  79. IF file$ <> null$ THEN             'Find first...
  80.     svfile$ = file$ + CHR$(0)
  81.     InRegsX.ax = &H4E00
  82.     InRegsX.cx = &HFFFF
  83.     InRegsX.ds = VARSEG(svfile$)
  84.     InRegsX.dx = SADD(svfile$)
  85.     GOSUB DoInterrupt
  86. ELSE                               'Find next...
  87.     InRegsX.ax = &H4F00
  88.     GOSUB DoInterrupt
  89. END IF
  90. DEF SEG = DTASeg%
  91. c% = 30
  92. t$ = null$
  93. DO
  94.     t$ = t$ + CHR$(DTABit%(c%))
  95.     c% = c% + 1
  96. LOOP UNTIL DTABit%(c%) = 0
  97.  
  98. DirInfo.EntryName = LEFT$(t$ + SPACE$(12), 12)
  99.  
  100. l& = DTABit%(22) + DTABit%(23) * 256&             'Convert Time to HHMM%
  101. c% = (l& \ 2048) * 100                  'Hour 0-23
  102. c% = c% + ((l& \ 32) AND 63)            'Minutes
  103. DirInfo.EntryTime = c%
  104.  
  105. l& = DTABit%(24) + DTABit%(25) * 256&             'Convert Date to YYYYMMDD&
  106. x& = ((l& \ 512) + 1980) * 10000&       'Year
  107. x& = x& + ((l& \ 32) AND 15) * 100&     'Month
  108. x& = x& + (l& AND 31)                   'Day
  109. DirInfo.EntryDate = x&
  110.  
  111. DirInfo.EntrySize = DTABit%(26) + DTABit%(27) * 256& + DTABit%(28) * 65536 + DTABit%(29) * 16777216
  112.  
  113. DirInfo.Attribute = DTABit%(21)
  114.  
  115. DirInfo.DirectoryFlag = DirInfo.Attribute AND 16
  116.  
  117. DEF SEG
  118.  
  119. GOTO ExitDir
  120.  
  121.  
  122. DoInterrupt:
  123.     
  124.     CALL INTERRUPTX(&H21, InRegsX, OutRegsX)
  125.     ErrorFlag% = OutRegsX.flags AND 1
  126.     DirInfo.ErrorCode = OutRegsX.ax
  127.     IF ErrorFlag% THEN
  128.         IF DirInfo.ErrorCode <> 18 THEN     '18=No more files.  That is Ok.
  129.             t$ = "***ERROR***"
  130.         END IF
  131.         GOTO ExitDir
  132.     END IF
  133.     RETURN
  134.  
  135.  
  136. ExitDir:
  137.     
  138.     Dir$ = t$
  139.  
  140.  
  141. END FUNCTION
  142.  
  143. FUNCTION DTABit% (BitNumber%)
  144.  
  145.   DTABit% = PEEK(DTAOff% + BitNumber%)
  146.  
  147. END FUNCTION
  148.  
  149.