home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol10n21.zip / PCTODAY.ZIP / PCTODAY.BAS < prev    next >
BASIC Source File  |  1991-11-01  |  16KB  |  414 lines
  1. '********** PCTODAY.BAS - reports all files that have changed today
  2. '
  3. 'Copyright (c) 1991 Ethan Winer
  4. 'First published in PC Magazine December 10, 1991
  5. '
  6. 'Compile and link as follows:
  7. '
  8. '  bc pctoday /o /s;
  9. '  link /ex pctoday , , nul , qb.lib pctoday.lib
  10. '
  11. 'For best size, compile and link with Crescent Software's P.D.Q. like this:
  12. '
  13. '  bc pctoday /o /s ;
  14. '  link /nod /noe /ex /pack /far /stack:8192 pctoday +
  15. '    str49152 _noread _noval _noerror , , nul, [basic7] pdq ;
  16.  
  17.  
  18. DEFINT A-Z
  19.  
  20. DECLARE FUNCTION FileCount% (DirFlag)
  21. DECLARE FUNCTION GetDir$ ()
  22. DECLARE FUNCTION GetDrive% ()
  23. DECLARE FUNCTION GoodDrive% (Drive%)
  24. DECLARE FUNCTION LoadNames% (Array() AS ANY, DirFlag)
  25. DECLARE FUNCTION ParseDate% (Work$)
  26. DECLARE FUNCTION PDQShr% (BYVAL Value, BYVAL Bits)
  27. DECLARE FUNCTION PDQValI% (Work$)
  28. DECLARE FUNCTION Redirected% ()
  29. DECLARE FUNCTION Remote% (Drive)
  30. DECLARE FUNCTION Removable% (Drive)
  31. DECLARE FUNCTION ScreenLines% ()
  32. DECLARE FUNCTION TestDates% ()
  33. DECLARE FUNCTION Trim$ (IntValue)
  34.  
  35. DECLARE SUB Display ()
  36. DECLARE SUB SetDrive (Drive)
  37.  
  38. DECLARE SUB Interrupt (IntNumber, InRegs AS ANY, OutRegs AS ANY)
  39. 'DECLARE SUB Interrupt (IntNumber, Regs AS ANY)         'use this with P.D.Q.
  40.  
  41. TYPE RegType
  42.   AX    AS INTEGER
  43.   BX    AS INTEGER
  44.   CX    AS INTEGER
  45.   DX    AS INTEGER
  46.   BP    AS INTEGER
  47.   SI    AS INTEGER
  48.   DI    AS INTEGER
  49.   Flags AS INTEGER
  50. END TYPE
  51.  
  52. TYPE DTA                        'used by the DOS Find First/Next services
  53.   Reserved  AS STRING * 21      'reserved for use by DOS
  54.   Attribute AS STRING * 1       'the file's attribute
  55.   FileTime  AS INTEGER          'the file's time
  56.   FileDate  AS INTEGER          'the file's date
  57.   FileSize  AS LONG             'the file's size
  58.   FileName  AS STRING * 13      'the file's name
  59. END TYPE
  60.  
  61. TYPE Names                      'used by LoadNames to display full file info
  62.   FileName  AS STRING * 13
  63.   FileMonth AS INTEGER
  64.   FileDay   AS INTEGER
  65.   FileYear  AS INTEGER
  66. END TYPE
  67.  
  68. DIM SHARED DateSpec, Spec$, TotalFiles, Zero$, Zero, Redir, ScreenRows
  69. DIM SHARED DOS, DTAData AS DTA, Regs AS RegType
  70. DIM SHARED TestDate(1 TO 3)
  71.  
  72. DOS = &H21                      'defining this as shared saves 64 bytes
  73. Redir = Redirected%             'see and remember if we're being redirected
  74. IF NOT Redir THEN               'if the program output is going to the screen
  75.   LOCATE , , 1                  'turn on cursor for "--more--" prompt later
  76.   PRINT "PCTODAY 1.00 Copyright (c) 1991 Ethan Winer"     'then say hello
  77.   PRINT
  78. END IF
  79.  
  80. Zero$ = CHR$(0)                     'do this once here for smaller code
  81. Spec$ = "*.*" + Zero$               'used to find file/directory names
  82. Cmd$ = UCASE$(COMMAND$)             'use a copy (UCASE$ needed w/P.D.Q. only)
  83. ScreenRows = ScreenLines% - 1       'invoke this function just once for speed
  84.  
  85. IF INSTR(Cmd$, "/?") THEN
  86.   PRINT "Syntax: PCTODAY [D:] [/D mm-dd-yyyy] [> filename.ext]"
  87.   END
  88. END IF
  89.  
  90. DriveSpec = INSTR(Cmd$, ":") > 0    'remember if any drive letters were given
  91.  
  92. DateSpec = INSTR(Cmd$, "/D")                'see if a date was specified
  93. IF DateSpec THEN                            'if there is a date
  94.   Temp$ = LTRIM$(MID$(Cmd$, DateSpec + 2))  'use a copy for efficiency
  95. ELSE                                        'no date given
  96.   Temp$ = DATE$                             'work from today's date
  97. END IF
  98. TestDate(2) = ParseDate%(Temp$)             'grab the month value
  99. TestDate(3) = ParseDate%(Temp$)             'get the day
  100. TestDate(1) = ParseDate%(Temp$)             'get the year
  101. IF TestDate(1) < 100 THEN TestDate(1) = TestDate(1) + 1900  'adjust as needed
  102.  
  103.  
  104. 'Examine every drive (0-based drive numbers).  If this drive was explicitly
  105. 'specified, or no drives were specified and this drive is a local hard disk,
  106. 'list the file.
  107. '
  108. Drive = GetDrive%           'save the current drive before changing it
  109.  
  110. FOR X = 0 TO 25
  111.   ThisDriveGiven = INSTR(Cmd$, CHR$(X + 65) + ":") > 0
  112.   LocalHardDrive = (NOT Removable%(X)) AND (NOT Remote%(X))
  113.   IF GoodDrive%(X) AND (ThisDriveGiven OR ((NOT DriveSpec) AND LocalHardDrive)) THEN
  114.     CALL SetDrive(X)        'change to that drive
  115.     Original$ = GetDir$     'save current directory
  116.     CHDIR "\"               'start searching in the root
  117.     CALL Display            'display all of the files
  118.     CHDIR Original$         'restore the directory for this drive
  119.   END IF
  120. NEXT
  121.  
  122. CALL SetDrive(Drive)                                  'restore original drive
  123. IF NOT Redir THEN PRINT TotalFiles; "File(s) Found"   'show the total files
  124.  
  125. SUB Display
  126.  
  127.   STATIC NewLines                             'to know when to print --more--
  128.   IF NewLines = 0 THEN NewLines = 2           'protect the copyright notice
  129.  
  130.   CurrentDir$ = GetDir$                       'get directory, current drive
  131.   REDIM FArray(1 TO 1) AS Names               'establish the file names array
  132.   NumFiles = LoadNames%(FArray(), LocalZero)  'load the names and count them
  133.   TotalFiles = TotalFiles + NumFiles          'add to the accumulator
  134.   ThisDrive$ = CHR$(GetDrive% + 65)           'get the current drive
  135.  
  136.   FOR X = 1 TO NumFiles                       'for each file
  137.     PRINT ThisDrive$; ":"; CurrentDir$;       'print the name
  138.     IF CurrentDir$ <> "\" THEN PRINT "\";
  139.     PRINT FArray(X).FileName;
  140.     IF NOT Redir THEN                         'we're printing to the screen,
  141.       PRINT " ";                              '  display the extra goodies
  142.       PRINT Trim$(FArray(X).FileMonth); "-";
  143.       PRINT Trim$(FArray(X).FileDay); "-";
  144.       PRINT Trim$(FArray(X).FileYear)
  145.       GOSUB DoMore                            'see if it's time for --more--
  146.     ELSE
  147.       PRINT                                   'we are redirected, just finish
  148.     END IF                                    '  the line with an empty PRINT
  149.   NEXT
  150.  
  151.   IF NumFiles AND NOT Redir THEN              'add a blank line between
  152.     PRINT                                     '  directories for cosmetics
  153.     GOSUB DoMore                              'see if it's time for --more--
  154.   END IF
  155.  
  156.   REDIM DArray(1 TO 1) AS Names               'establish the directory array
  157.   DirCount = LoadNames%(DArray(), -1)         'count dirs under this one
  158.        
  159.   IF DirCount THEN                            'if there are any, then
  160.     IF CurrentDir$ = "\" THEN                 'if we're in the root, use a
  161.       Prefix$ = ""                            '  blank, otherwise use the
  162.     ELSE                                      '  current directory
  163.       Prefix$ = CurrentDir$
  164.     END IF
  165.  
  166.     FOR X = 1 TO DirCount                     'for each directory,
  167.       CHDIR Prefix$ + "\" + DArray(X).FileName'  change to it and
  168.       CALL Display                            '  invoke this routine again
  169.     NEXT
  170.   END IF
  171.  
  172.   EXIT SUB
  173.  
  174. DoMore:
  175.  NewLines = NewLines + 1                'show another line was printed
  176.  IF (NewLines MOD ScreenRows) = 0 THEN  'print "--more--" if needed
  177.    PRINT "--more-- ";
  178.    WHILE LEN(INKEY$) = 0: WEND          'and wait for a keypress
  179.    PRINT
  180.  END IF
  181.  RETURN
  182.  
  183. END SUB
  184.  
  185. FUNCTION FileCount% (DirFlag) STATIC
  186.  
  187.   Regs.DX = VARPTR(DTAData)         'set new DTA address
  188.   Regs.AX = &H1A00                  'specify service 1Ah, set DTA service
  189.   CALL Interrupt(DOS, Regs, Regs)   'call DOS to do the real work
  190.  'CALL Interrupt(DOS, Regs)         'use this with P.D.Q.
  191.  
  192.   Regs.DX = SADD(Spec$)         'the file specification address
  193.   Regs.CX = 39                  'find files, also hidden/read-only
  194.   IF DirFlag THEN Regs.CX = 19  'find directories instead
  195.   Regs.AX = &H4E00              'find first matching name
  196.  
  197.   Count = 0                     'clear the counter
  198.   DO
  199.     CALL Interrupt(DOS, Regs, Regs)     'see if there's a match
  200.    'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
  201.     IF Regs.Flags AND 1 THEN EXIT DO    'no more files
  202.     IF DirFlag OR TestDates% THEN               'test file dates only
  203.       IF DirFlag THEN                           'do they want directories?
  204.         IF ASC(DTAData.Attribute) AND 16 THEN   'is it really a directory?
  205.           IF ASC(DTAData.FileName) <> 46 THEN   'filter out "." and ".."
  206.             Count = Count + 1                   'increment the counter
  207.           END IF
  208.         END IF
  209.       ELSE
  210.         Count = Count + 1       'they want regular files
  211.       END IF
  212.     END IF
  213.     Regs.AX = &H4F00            'find the next name
  214.   LOOP
  215.  
  216.   FileCount% = Count            'assign the function
  217.  
  218. END FUNCTION
  219.  
  220. FUNCTION GetDir$ STATIC
  221.  
  222.   Temp$ = SPACE$(65)                'DOS stores the name here
  223.  
  224.   Regs.AX = &H4700                  'get directory service
  225.   Regs.DX = 0                       'specify the current default drive
  226.   Regs.SI = SADD(Temp$)             'show DOS where Temp$ is
  227.  
  228.   CALL Interrupt(DOS, Regs, Regs)   'call DOS
  229.  'CALL Interrupt(DOS, Regs)         'use this with P.D.Q.
  230.  
  231.   Zero = INSTR(Temp$, Zero$)             'find the CHR$(0) that marks the end
  232.   GetDir$ = "\" + LEFT$(Temp$, Zero - 1) 'keep just what precedes that
  233.  
  234. END FUNCTION
  235.  
  236. FUNCTION GetDrive% STATIC
  237.  
  238.   Regs.AX = &H1900                  'DOS service for getting default
  239.   CALL Interrupt(DOS, Regs, Regs)   'result comes back in AL
  240.  'CALL Interrupt(DOS, Regs)         'use this with P.D.Q.
  241.   GetDrive% = Regs.AX AND 255       'ignore what's in AH
  242.  
  243. END FUNCTION
  244.  
  245. FUNCTION GoodDrive% (Drive) STATIC
  246.  
  247.   GoodDrive% = 0                'assume its not a valid drive
  248.   SavedDrive = GetDrive%        'first save the current drive
  249.   CALL SetDrive(Drive)          'try to change it
  250.   IF Drive = GetDrive% THEN     'if the new drive took
  251.     GoodDrive% = -1             'then it's a valid drive
  252.     CALL SetDrive(SavedDrive)   'and we need to restore the original
  253.   END IF
  254.  
  255. END FUNCTION
  256.  
  257. FUNCTION LoadNames% (Array() AS Names, DirFlag) STATIC
  258.  
  259.   NumNames = FileCount%(DirFlag)        'count the names
  260.   LoadNames% = NumNames                 'assign the function output
  261.   IF NumNames = 0 THEN EXIT FUNCTION    'exit if none
  262.   REDIM Array(1 TO NumNames) AS Names   'dimension the array
  263.  
  264.  '---- The following code isn't really needed because we know that FileCount%
  265.  '     has already set the DTA address.  It is shown here merely for clarity.
  266.  'Regs.DX = VARPTR(DTAData)             'assign the new DTA address
  267.  'Regs.AX = &H1A00                      'specify service 1Ah
  268.  'CALL Interrupt(DOS, Regs, Regs)       'DOS set DTA service
  269.  
  270.   Regs.DX = SADD(Spec$)                 'the file spec address
  271.   Regs.CX = 39                          'find files, also hidden/read-only
  272.   IF DirFlag THEN Regs.CX = 19          'find directories instead
  273.   Regs.AX = &H4E00                      'find first matching name
  274.  
  275.   Count = 0                             'clear the name counter
  276.   DO
  277.     CALL Interrupt(DOS, Regs, Regs)     'see if there's a match
  278.    'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
  279.     IF Regs.Flags AND 1 THEN EXIT DO    'no more
  280.     Valid = 0                           'assume invalid
  281.  
  282.     IF DirFlag OR TestDates% THEN               'this file is not recent
  283.       IF DirFlag THEN                           'do they want directories?
  284.         IF ASC(DTAData.Attribute) AND 16 THEN   'is it really a directory?
  285.           IF ASC(DTAData.FileName) <> 46 THEN   'filter "." and ".."
  286.             Valid = -1                          'this name is valid
  287.           END IF
  288.         END IF
  289.       ELSE
  290.         Valid = -1                              'they want regular files
  291.       END IF
  292.     END IF
  293.  
  294.     IF Valid THEN                               'process the file if it
  295.       Count = Count + 1                         '  passed all the tests
  296.       Zero = INSTR(DTAData.FileName, Zero$)     'find zero and assign name
  297.       Array(Count).FileName = LEFT$(DTAData.FileName, Zero - 1) 'assign data
  298.       Array(Count).FileMonth = PDQShr%(DTAData.FileDate AND &H1E0, 5)
  299.       Array(Count).FileDay = DTAData.FileDate AND &H1F
  300.       Array(Count).FileYear = PDQShr%(DTAData.FileDate AND &HFE00, 9) + 1980
  301.     END IF
  302.     Regs.AX = &H4F00        'find next matching name service
  303.   LOOP
  304.  
  305. END FUNCTION
  306.  
  307. FUNCTION ParseDate% (Work$) STATIC  'returns the value of the next date part
  308.  
  309.   Length = LEN(Work$)               'get the length just once
  310.   FOR X = 1 TO Length               'search for "-" or "/" date separators
  311.     Char = ASC(MID$(Work$, X, 1))   'work with the ASCII value for efficiency
  312.     IF Char = 45 OR Char = 47 OR X = Length THEN
  313.       ParseDate% = PDQValI%(Work$)  'we know PDQValI% stops on "-" or "/"
  314.       Work$ = MID$(Work$, X + 1)    'keep just what's past that for later
  315.       EXIT FOR                      'all done
  316.     END IF
  317.   NEXT
  318.  
  319. END FUNCTION
  320.  
  321. FUNCTION Redirected% STATIC
  322.  
  323.   Regs.AX = &H4400              'service &H44 tells if a handle is redirected
  324.   Regs.BX = 1                       'handle 1 is the console output (STDOUT)
  325.   CALL Interrupt(DOS, Regs, Regs)   'DOS does the dirty work
  326.  'CALL Interrupt(DOS, Regs)         'use this with P.D.Q.
  327.  
  328.   Redirected% = -1                  'assume we are being redirected
  329.   IF Regs.DX AND &H80 THEN          'well, are we?
  330.     Redirected% = 0                 'no
  331.   END IF
  332.  
  333. END FUNCTION
  334.  
  335. FUNCTION Remote% (Drive) STATIC         'checks if redirected network drive
  336.  
  337.   Regs.AX = &H4409                  'service 44 in AH, function 9 in AL
  338.   Regs.BX = Drive + 1               '0=default, 1=A, 2=B, and so forth
  339.   CALL Interrupt(DOS, Regs, Regs)   'call DOS
  340.  'CALL Interrupt(DOS, Regs)         'use this with P.D.Q.
  341.   Remote% = 0                       'assume it is not a remote drive
  342.   IF Regs.DX AND 4096 THEN          'DX contains the info in bit 12
  343.     Remote% = -1                    'if that bit is set it's remote
  344.   END IF
  345.  
  346. END FUNCTION
  347.  
  348. FUNCTION Removable% (Drive) STATIC  'tests if a drive is removeable
  349.  
  350.   Regs.AX = &H4408                  'changeable block service
  351.   Regs.BX = Drive + 1               'adjust to 1-based
  352.   CALL Interrupt(DOS, Regs, Regs)   'DOS does the hard part
  353.  'CALL Interrupt(DOS, Regs)         'use this with P.D.Q.
  354.   Removable% = Regs.AX - 1          'return -1 if removable, 0 if not
  355.  
  356. END FUNCTION
  357.  
  358. FUNCTION ScreenLines% STATIC
  359.  
  360.   DEF SEG = 0                   'look in low memory at the adapter type
  361.   ScreenLines% = 25              'assume 25 lines
  362.   IF PEEK(&H463) = &HB4 THEN    'it's a monchrome display, so 25 is correct
  363.     EXIT FUNCTION
  364.   END IF
  365.  
  366.   Regs.AX = &H1200              'it's color, test if EGA or VGA
  367.   Regs.BX = &H10
  368.   CALL Interrupt(&H10, Regs, Regs)      'call the BIOS video interrupts
  369.  'CALL Interrupt(&H10, Regs)            'use this with P.D.Q.
  370.   IF (Regs.BX AND &HFF) = &H10 THEN     'it's a CGA
  371.     EXIT FUNCTION                       'so again, 25 lines is correct
  372.   END IF
  373.  
  374.   ScreenLines% = PEEK(&H484)     'this address holds the number of screen
  375.                                 '  rows for EGA/VGA display adapters
  376. END FUNCTION
  377.  
  378. SUB SetDrive (Drive) STATIC
  379.  
  380.   Regs.AX = &HE00                   'service for set-drive
  381.   Regs.DX = Drive                   'drive goes in DL (A=0, B=1, etc.)
  382.   CALL Interrupt(DOS, Regs, Regs)   'call DOS to do the work
  383.  'CALL Interrupt(DOS, Regs)         'use this with P.D.Q.
  384.  
  385. END SUB
  386.  
  387. FUNCTION TestDates% STATIC
  388.  
  389.   TestDates% = -1                           'assume the file is new enough
  390.   Temp = DTAData.FileDate                   'use a copy for readability below
  391.   DIM ThisDate(1 TO 3)                      'facilitates comparing in a loop
  392.  
  393.   ThisDate(1) = PDQShr%(Temp AND &HFE00, 9) + 1980 'compute the year
  394.   ThisDate(2) = PDQShr%(Temp AND &H1E0, 5)         'compute the month
  395.   ThisDate(3) = Temp AND &H1F                      'isolate the day
  396.  
  397.   FOR X = 1 TO 3                            'cycle through comparing dates
  398.     IF ThisDate(X) < TestDate(X) THEN
  399.       TestDates% = 0                        'fail if the file is older
  400.       EXIT FOR                              'and leave early
  401.     ELSEIF ThisDate(X) > TestDate(X) THEN   'if the file is newer
  402.       EXIT FOR                              '  skip comparing and exit
  403.     END IF
  404.   NEXT
  405.  
  406. END FUNCTION
  407.  
  408. FUNCTION Trim$ (IntValue) STATIC
  409.  
  410.   Trim$ = RIGHT$("0" + LTRIM$(STR$(IntValue)), 2)
  411.  
  412. END FUNCTION
  413.  
  414.