home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / BASIC / IQB9203.ZIP / DIR_READ.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-02-06  |  1.7 KB  |  58 lines
  1. ' Dir_Read.Bas - Program to demonstrate the DirFun package.
  2.  
  3. ' $INCLUDE: 'DIRFUN.BI'
  4.  
  5. DEFINT A-Z
  6.  
  7. DIM MyDTA AS DataTransferArea
  8. DIM DirEntry AS DirectoryRecord
  9.   
  10.   CLS: INPUT "Enter file specification: "; filespec$
  11.   SetDTA MyDTA
  12.   
  13.   FindStatus = FindFirst(0, filespec$, DirEntry, MyDTA)
  14.   PrintDirEntry DirEntry, FindStatus
  15.   FindStatus = FindNext(DirEntry, MyDTA)
  16.   'IF FindStatus <> 0 then there are no more files
  17.   '   or no match was found or no prev call to FindFirst
  18.   WHILE FindStatus = 0
  19.     PrintDirEntry DirEntry, FindStatus
  20.     FindStatus = FindNext(DirEntry, MyDTA)
  21.     SetDTA MyDTA
  22.   WEND
  23. END
  24.  
  25. FUNCTION FmtDate$ (FDate)
  26. Day = FDate AND &H1F: Month = (FDate AND &H1E0) \ 32
  27. Year = (FDate AND &HFE00) \ 512 + 1980
  28. FmtDate$ = RStr$(Month, 2) + "-" + RStr$(Day, 2) + "-" + RStr$(Year, 4)
  29. END FUNCTION
  30.  
  31. FUNCTION FmtTime$ (T%)
  32. Seconds = (T% AND &H1F) * 2: Minutes = (T% AND &H7E0) \ 32
  33. Hours = (T% < 0) * (-16) + ((T% AND &H7FFF) \ 2048)
  34. Abbr$ = " am"
  35. IF Hours = 12 THEN Abbr$ = " pm"
  36. IF Hours = 0 THEN Hours = 12
  37. IF Hours > 12 THEN   'Reset to 12 hour clock
  38.   Hours = Hours MOD 12: Abbr$ = " pm"
  39. END IF
  40. FmtTime$ = RStr$(Hours, 2) + ":" + RStr$(Minutes, 2) + ":" _
  41.           + RStr$(Seconds, 2) + Abbr$
  42. END FUNCTION
  43.  
  44. SUB PrintDirEntry (DR AS DirectoryRecord, FindStatus)
  45. FmtStr$ = "\          \  ##,###,###  " + "\        \ \           \  ###"
  46. IF FindStatus = 0 THEN
  47.   PRINT USING FmtStr$; DR.FileName; DR.FileSize; _
  48.               FmtDate$(DR.FileDate); FmtTime$(DR.FileTime); DR.FileAttb
  49. ELSE
  50.   PRINT "Error on file lookup"
  51. END IF
  52. END SUB
  53.  
  54. FUNCTION RStr$ (X%, LX%)
  55. X$ = STR$(X%)
  56. RStr$ = RIGHT$("00000" + RIGHT$(X$, LEN(X$) - 1), LX%)
  57. END FUNCTION
  58.