home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol10n21.zip / PCTODAY.ZIP / PCCOPY.BAS next >
BASIC Source File  |  1991-11-01  |  20KB  |  483 lines
  1. '********** PCCOPY.BAS - smart COPY utility that copies only newer files
  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 pccopy /o /s;
  9. '  link /ex pccopy , , nul, qb.lib today.lib
  10. '
  11. 'For best size compile and link using Crescent Software's P.D.Q. like this:
  12. '
  13. '  bc pccopy /o /s ;
  14. '  link /noe /nod /ex /far /packc pccopy +
  15. '    str49152 _noval _noread _noerror , , nul , smalldos [basic7] pdq ;
  16.  
  17.  
  18. '---- Function, Subroutine, and TYPE declarations
  19. '
  20. DEFINT A-Z
  21. DECLARE FUNCTION DiskFree& (Drive)
  22. DECLARE FUNCTION DoExclude% (FileName$)
  23. DECLARE FUNCTION FileCount% (Spec$)
  24. DECLARE FUNCTION NameOnly$ (FullName$)
  25. DECLARE FUNCTION PDQShl% (BYVAL Value, BYVAL Bits)
  26. DECLARE FUNCTION PDQShr% (BYVAL Value, BYVAL Bits)
  27. DECLARE FUNCTION Trim$ (Work$)
  28.  
  29. DECLARE SUB CopyFile (InFile$, OutFile$, DTA AS ANY)
  30. DECLARE SUB ErrorExit (Message$)
  31. DECLARE SUB FileInfo (Info AS ANY, DTA AS ANY)
  32. DECLARE SUB LoadNames (Spec$, Array$())
  33. DECLARE SUB Interrupt (IntNumber, InRegs AS ANY, OutRegs AS ANY)
  34. 'DECLARE SUB Interrupt (IntNumber, Regs AS ANY)  'use this with P.D.Q.
  35.  
  36.  
  37. TYPE RegType
  38.   AX    AS INTEGER
  39.   BX    AS INTEGER
  40.   CX    AS INTEGER
  41.   DX    AS INTEGER
  42.   BP    AS INTEGER
  43.   SI    AS INTEGER
  44.   DI    AS INTEGER
  45.   Flags AS INTEGER
  46. END TYPE
  47.  
  48. TYPE DTAType                    'this is used by DOS find first/next service
  49.   Reserved  AS STRING * 21      'reserved for use by DOS
  50.   Attribute AS STRING * 1       'the file's attribute
  51.   FileTime  AS INTEGER          'the file's time
  52.   FileDate  AS INTEGER          'the file's date
  53.   FileSize  AS LONG             'the file's size
  54.   FileName  AS STRING * 13      'the file's name
  55. END TYPE
  56.  
  57. TYPE FInfo                      'translates each file's information
  58.   Year   AS INTEGER             '  into a usable form
  59.   Month  AS INTEGER
  60.   Day    AS INTEGER
  61.   Hour   AS INTEGER
  62.   Minute AS INTEGER
  63.   Second AS INTEGER
  64. END TYPE
  65.  
  66.  
  67. '---- Print the sign-on message first
  68. '
  69. PRINT "PCCOPY 1.00 Copyright (c) 1991 Ethan Winer"
  70. PRINT
  71.  
  72.  
  73. '---- Initialize key variables and dimension arrays
  74. '
  75. DIM SHARED Regs AS RegType      'RegType is used by the Interrupt routine
  76. DIM SHARED SourceDTA AS DTAType 'this DTA holds the source file information
  77. DIM TargetDTA AS DTAType        'and this one is for the destination files
  78. DIM File(1 TO 6, 1 TO 2)        'this holds the information for both files
  79. DIM Excluded$(1 TO 10)          'holds the exclude specifications
  80. REDIM SHARED ExcludeList$(0)    'this holds the actual names to trap
  81. DIM SHARED Zero$                'so everyone can get at it
  82. Zero$ = CHR$(0)                 'avoids repeated calls to CHR$() later
  83. DIM SHARED DOS, Temp, NumExclude, TargetSize&   'these save a few bytes of
  84. DOS = &H21                                      '  code later too
  85. Syntax$ = "Syntax: PCCOPY Source [Destination] [/X Filespec]" + CHR$(13) + CHR$(10) + "   -OR- PCCOPY @Responsefile [Destination]"
  86.  
  87.  
  88. '---- Parse out the exclude specifications if any were given
  89. '
  90. Cmd$ = UCASE$(COMMAND$) + " "   'work with a copy of COMMAND$ to save code
  91.                                 'the added blank aids parsing below
  92.  
  93. IF INSTR(Cmd$, "/?") THEN       '/? means they want the syntax
  94.   CALL ErrorExit(Syntax$)
  95. END IF
  96.  
  97. DO                              'stripping all double blanks now helps too
  98.   Temp = INSTR(Cmd$, "  ")      'is there a double blank?
  99.   IF Temp = 0 THEN EXIT DO      'yes, strip it out and keep looking
  100.   Cmd$ = LEFT$(Cmd$, Temp) + MID$(Cmd$, Temp + 2)
  101. LOOP
  102.  
  103. DO
  104.   X = INSTR(Cmd$, "/X")                 'see if they used the /X command
  105.   IF X = 0 THEN EXIT DO                 'no more, all done
  106.   Excludes = Excludes + 1               'show we found another one
  107.   Temp = INSTR(X + 3, Cmd$, " ")        'find the end of the exclude spec
  108.   Excluded$(Excludes) = Trim$(MID$(Cmd$, X + 2, Temp - X - 2))  'keep spec
  109.   Cmd$ = LEFT$(Cmd$, X - 1) + MID$(Cmd$, Temp + 1)              'strip it out
  110. LOOP WHILE Excludes < 10                'up to 10 exclude specifications
  111.  
  112.  
  113. '---- Parse the source and destination file arguments
  114. '
  115. Space = INSTR(Cmd$, " ")        'find the space that separates the arguments
  116. IF Space THEN                   'if there is a space
  117.   Source$ = Trim$(LEFT$(Cmd$, Space))        'grab the source file spec
  118.   Target$ = UCASE$(Trim$(MID$(Cmd$, Space))) 'and the target drive/path
  119. ELSE
  120.   Source$ = Trim$(Cmd$)         'otherwise the sole argument is the source
  121. END IF
  122.  
  123. Help:
  124. IF LEN(Source$) = 0 THEN        'at least a source argument must be given!
  125.   CALL ErrorExit(Syntax$)
  126. END IF
  127.  
  128. IF LEN(Target$) THEN                    'if a target was given
  129.   Char = ASC(RIGHT$(Target$, 1))        'see what the rightmost character is
  130.   IF Char <> 58 AND Char <> 92 THEN     '":" or "\"
  131.     Target$ = Target$ + "\"             'add a path\file separator
  132.   END IF
  133. END IF
  134.  
  135.  
  136. '---- This section of code handles the source specified in a response file
  137. '
  138. IF ASC(Source$) = 64 THEN               'an "@" means read the response file
  139.  
  140.   Regs.DX = VARPTR(SourceDTA)           'show DOS where the new DTA is
  141.   Regs.AX = &H1A00                      'specify service 1Ah in AH
  142.   CALL Interrupt(DOS, Regs, Regs)       'DOS set DTA service
  143.  'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.
  144.  
  145.   Source$ = LTRIM$(MID$(Source$, 2))    'keep just the file name that follows
  146.   OPEN Source$ FOR INPUT AS #1          'open the response file
  147.   IF ERR THEN                           'if we can't open it, say so and end
  148.     CALL ErrorExit("Unable to open file " + Source$)
  149.   END IF
  150.  
  151.   WHILE NOT EOF(1)
  152.     INPUT #1, ThisFile$                 'read each file name
  153.     ThisZ$ = ThisFile$ + Zero$          'make an ASCIIZ string for DOS
  154.     Regs.AX = &H4E00                    'find first matching name service
  155.     Regs.DX = SADD(ThisZ$)              'show DOS where the file spec is
  156.     Regs.CX = 39                        'attribute for any type of file
  157.     CALL Interrupt(DOS, Regs, Regs)     'now the DTA holds the file date/time
  158.    'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
  159.  
  160.     PRINT "Copying "; UCASE$(ThisFile$);
  161.     IF LEN(Target$) THEN                'show the target only if there is one
  162.       PRINT " to "; Target$
  163.     ELSE
  164.       PRINT
  165.     END IF
  166.  
  167.     CALL CopyFile(ThisFile$, Target$ + NameOnly$(ThisFile$), SourceDTA)
  168.     FilesCopied = FilesCopied + 1       'track how many we process for later
  169.   WEND
  170.  
  171.   Skipped = -1                          'force an empty CRLF later
  172.  
  173.  
  174. '---- This section of code handles the source files given on the command line
  175. '
  176. ELSE                                    'copy only the files that need to be
  177.   Source$ = Source$ + Zero$             'make an ASCIIZ string for DOS
  178.  
  179.   FOR X = LEN(Source$) TO 1 STEP -1     'isolate the drive/path if present
  180.     Char = ASC(MID$(Source$, X))        'get the current character
  181.     IF Char = 58 OR Char = 92 THEN      'colon or backslash
  182.       SourcePath$ = LEFT$(UCASE$(Source$), X) 'keep what precedes the name
  183.       EXIT FOR                                'bail out of the FOR/NEXT loop
  184.     END IF
  185.   NEXT
  186.  
  187.   '---- If they used /x create an array holding all the file names to exclude
  188.   IF Excludes THEN
  189.     FOR X = 1 TO Excludes               'count the number of files to exclude
  190.       NumExclude = NumExclude + FileCount%(SourcePath$ + Excluded$(X))
  191.     NEXT
  192.     REDIM ExcludeList$(1 TO NumExclude) 'create an array to hold their names
  193.     FOR X = 1 TO Excludes               'read in all of the names to exclude
  194.       CALL LoadNames(SourcePath$ + Excluded$(X), ExcludeList$())
  195.     NEXT
  196.   END IF
  197.  
  198.   DO                                    'process all matching source files
  199.     DoUpdate = 0                        'assume the two files are current
  200.     LSET SourceDTA.FileName = ""        'clean out any old name remnants
  201.  
  202.     Regs.DX = VARPTR(SourceDTA)         'show DOS where the source DTA goes
  203.     Regs.AX = &H1A00                    'specify service 1Ah in AH
  204.     CALL Interrupt(DOS, Regs, Regs)     'DOS set DTA service
  205.    'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
  206.  
  207.     IF FilesRead = 0 THEN               'if this is the first time
  208.       Regs.AX = &H4E00                  'find first matching name service
  209.       Regs.DX = SADD(Source$)           'show DOS where the file spec is
  210.       Regs.CX = 39                      'attribute for any type of file
  211.     ELSE
  212.       Regs.AX = &H4F00                  'otherwise find next matching file
  213.     END IF
  214.  
  215.     CALL Interrupt(DOS, Regs, Regs)     'see if there's a match
  216.    'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
  217.     IF Regs.Flags AND 1 THEN EXIT DO    'if carry flag is set we're done
  218.     FilesRead = FilesRead + 1           'otherwise show we read another one
  219.  
  220.     IF DoExclude%(SourceDTA.FileName) GOTO Skip 'exclude this file
  221.  
  222.     CALL FileInfo(File(1, 1), SourceDTA)  'get the source file date and time
  223.   
  224.     Regs.DX = VARPTR(TargetDTA)         'create 2nd DTA for the destination
  225.     Regs.AX = &H1A00                    'specify service 1Ah in AH
  226.     CALL Interrupt(DOS, Regs, Regs)     'DOS set DTA service
  227.    'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
  228.  
  229.     Dest$ = Target$ + SourceDTA.FileName  'concatenate the target and name
  230.     Regs.AX = &H4E00                    'find first matching destination
  231.     Regs.DX = SADD(Dest$)               'show where the new file spec is
  232.   
  233.     CALL Interrupt(DOS, Regs, Regs)     'see if there's a match
  234.    'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
  235.     IF Regs.Flags AND 1 THEN            'if carry is set the file's not there
  236.       DoUpdate = -1                     'so we'll have to update it
  237.       TargetSize& = 0                   'no samed-named target file exists
  238.     ELSE
  239.       TargetSize& = TargetDTA.FileSize  'this much more is available on dest.
  240.       CALL FileInfo(File(1, 2), TargetDTA) 'get the target file date and time
  241.       FOR X = 1 TO 6                       'compare from year through seconds
  242.         IF File(X, 1) > File(X, 2) THEN    'if the target is older
  243.           DoUpdate = -1                    '  set the flag and exit
  244.           EXIT FOR
  245.         ELSEIF File(X, 1) < File(X, 2) THEN   'if target is newer there's no
  246.           EXIT FOR                            '  need to continue comparing
  247.         END IF
  248.       NEXT
  249.     END IF
  250.  
  251.     IF DoUpdate THEN                      'copy only if necessary
  252.       SourceFile$ = SourcePath$ + SourceDTA.FileName
  253.       IF Skipped THEN PRINT               'so the name starts on a new line
  254.      
  255.       PRINT "Copying "; SourceFile$;
  256.       IF LEN(Target$) THEN                'show target only if there is one
  257.         PRINT " to "; Target$
  258.       ELSE
  259.         PRINT
  260.       END IF
  261.  
  262.       CALL CopyFile(SourceFile$, Target$ + SourceDTA.FileName, SourceDTA)
  263.       FilesCopied = FilesCopied + 1       'show that we copied another one
  264.       Skipped = 0
  265.     ELSE
  266.       PRINT ".";                          'show that a file was just skipped
  267.       Skipped = -1
  268.     END IF
  269. Skip:
  270.   LOOP
  271. END IF
  272.  
  273.  
  274. '---- Display the final results and end
  275. '
  276. PRINT                                     'print a line for clarity
  277. IF Skipped THEN PRINT                     'one more if a "." was just printed
  278. IF LEN(ThisZ$) = 0 THEN PRINT FilesRead; "file(s) examined" 'if not @filename
  279. PRINT FilesCopied; "file(s) copied"                         'show total files
  280.  
  281. SUB CopyFile (InFile$, OutFile$, DTAInfo AS DTAType) STATIC
  282.  
  283.   SHARED Regs AS RegType
  284.  
  285.   '-- the next 3 lines strip the trailing CHR$(0) byte; remove with P.D.Q.
  286.   IF INSTR(InFile$, Zero$) THEN
  287.     InFile$ = LEFT$(InFile$, INSTR(InFile$, Zero$) - 1)
  288.   END IF
  289.   OPEN InFile$ FOR BINARY AS #2         'open the source file
  290.  
  291.   '-- the next 3 lines strip the trailing CHR$(0) byte; remove with P.D.Q.
  292.   IF INSTR(OutFile$, Zero$) THEN
  293.     OutFile$ = LEFT$(OutFile$, INSTR(OutFile$, Zero$) - 1)
  294.   END IF
  295.  
  296. ReDo:
  297.   OPEN OutFile$ FOR BINARY AS #3        'open/create the destination
  298.   IF ERR THEN                           'terminate if there's an error
  299.     CALL ErrorExit("Unable to open " + OutFile$)
  300.   END IF
  301.  
  302.   '-- See how big the source is, and how much room is on the destination
  303.   '   drive.  Prompt for a new disk if not enough room.
  304.   Drive = 0                             'assume writing to the default drive
  305.   IF INSTR(OutFile$, ":") THEN          'no, a drive letter was given
  306.     Drive = ASC(OutFile$) - 64          '1=A, 2=B, etc.
  307.   END IF
  308.  
  309.   Needed& = LOF(2)                      'see how big the source file is
  310.   IF Needed& > DiskFree&(Drive) + TargetSize& THEN    'not enough room
  311.     CLOSE #3                            'close the destination file
  312.     KILL OutFile$                       'and erase the zero-byte file we made
  313.     PRINT "Insufficient disk space - insert a new disk and press a key, Escape to quit ";
  314.     DO
  315.       Temp$ = INKEY$
  316.     LOOP UNTIL LEN(Temp$)
  317.     PRINT
  318.     IF Temp$ = CHR$(27) THEN END
  319.     GOTO ReDo
  320.   END IF
  321.  
  322.   '-- If the target file exists and is bigger, erase it.
  323.   IF LOF(3) > Needed& THEN
  324.     CLOSE #3                            'first close the file
  325.     KILL OutFile$                       'then kill it
  326.     OPEN OutFile$ FOR BINARY AS #3      'and finally reopen it again
  327.   END IF
  328.  
  329.   '-- This is the main file copying portion of the program.
  330.   Remaining& = Needed&                  'how many bytes remain to be copied
  331.   DO
  332.     IF Remaining& > 4096 THEN           'copy in 4K blocks
  333.       ThisPass = 4096
  334.     ELSE
  335.       ThisPass = Remaining&             'except the last block may
  336.     END IF                              '  be smaller
  337.  
  338.     IF LEN(Buffer$) <> ThisPass THEN    'make a new buffer only
  339.       Buffer$ = SPACE$(ThisPass)        '  if necessary
  340.     END IF
  341.  
  342.     GET #2, , Buffer$                   'read from Peter
  343.     PUT #3, , Buffer$                   'write to Paul
  344.     IF ERR THEN                         'terminate if an error happens
  345.       CALL ErrorExit("Error writing to " + OutFile$)
  346.     END IF
  347.     Remaining& = Remaining& - ThisPass  'show that we read that much
  348.   LOOP WHILE Remaining&                 'until there no more remains
  349.  
  350.   CLOSE #2                              'close the input file
  351.  
  352.   '-- Set the target date and time to the same as the source file.
  353.   Regs.AX = &H5701                      'set file date/time service
  354.   Regs.BX = FILEATTR(3, 1)              'get the equivalent DOS handle
  355.   Regs.DX = DTAInfo.FileDate            'read the source date
  356.   Regs.CX = DTAInfo.FileTime            'and the source time
  357.   CALL Interrupt(DOS, Regs, Regs)       'call DOS to do it
  358.  'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.
  359.    
  360.   CLOSE #3                              'close the target file
  361.  
  362. END SUB
  363.  
  364. FUNCTION DiskFree& (Drive) STATIC
  365.  
  366.   Regs.AX = &H3600                      'get disk information service
  367.   Regs.DX = Drive                       '0=default, 1=A, 2=B, etc.
  368.   CALL Interrupt(DOS, Regs, Regs)       'call DOS
  369.  'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.
  370.  
  371.   BytesPerCluster = Regs.AX * Regs.CX   'AX=sectors/cluster, CX=bytes/sector
  372.   FreeClusters& = Regs.BX               'use a long int. for huge partitions
  373.   IF Regs.BX < 0 THEN FreeClusters& = Regs.BX + 65536   'adjust for > 32,767
  374.   DiskFree& = BytesPerCluster * FreeClusters&
  375.  
  376. END FUNCTION
  377.  
  378. FUNCTION DoExclude% (FileName$) STATIC
  379.  
  380.   DoExclude% = 0                        'assume we will not exclude this file
  381.   Temp = INSTR(FileName$, Zero$)        'find the terminating zero byte
  382.   ThisName$ = LEFT$(FileName$, Temp - 1)'trim the name to facilitate matching
  383.  
  384.   FOR X = 1 TO NumExclude               'walk through the excluded name list
  385.     IF ThisName$ = ExcludeList$(X) THEN 'we found a match
  386.       DoExclude% = -1                   'show that this is to be excluded
  387.       EXIT FOR                          'and skip the remaining names
  388.     END IF
  389.   NEXT
  390.  
  391. END FUNCTION
  392.  
  393. SUB ErrorExit (Message$) STATIC
  394.  
  395.   PRINT Message$
  396.   END
  397.  
  398. END SUB
  399.  
  400. FUNCTION FileCount% (Spec$) STATIC
  401.  
  402.   SpecZ$ = Spec$ + Zero$                'make a local ASCIIZ copy
  403.  
  404.   Regs.DX = VARPTR(SourceDTA)           'set the new DTA address
  405.   Regs.AX = &H1A00                      'specify service 1Ah, set DTA service
  406.   CALL Interrupt(DOS, Regs, Regs)       'call DOS to do the real work
  407.  'CALL Interrupt(DOS, Regs)             'use this with P.D.Q.
  408.  
  409.   Regs.DX = SADD(SpecZ$)                'the file specification address
  410.   Regs.CX = 39                          'find files, also hidden/read-only
  411.   Regs.AX = &H4E00                      'find first matching name
  412.  
  413.   Count = 0                             'clear the counter
  414.   DO
  415.     CALL Interrupt(DOS, Regs, Regs)     'see if there's a match
  416.    'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
  417.     IF Regs.Flags AND 1 THEN EXIT DO    'no more files
  418.     Count = Count + 1                   'we found another file
  419.     Regs.AX = &H4F00                    'find the next matching name
  420.   LOOP
  421.  
  422.   FileCount% = Count                    'assign the function
  423.  
  424. END FUNCTION
  425.  
  426. SUB FileInfo (Info AS FInfo, DTA AS DTAType) STATIC
  427.  
  428.   Info.Year = PDQShr%(DTA.FileDate AND &HFE00, 9) + 80  'compute the year
  429.   Info.Month = PDQShr%(DTA.FileDate AND &H1E0, 5)       'compute the month
  430.   Info.Day = DTA.FileDate AND &H1F                      'compute the day
  431.   Info.Hour = PDQShr%(DTA.FileTime AND &HF800, 11)      'compute the hour
  432.   Info.Minute = PDQShr%(DTA.FileTime AND &H7E0, 5)      'compute the minute
  433.   Info.Second = PDQShl%(DTA.FileTime AND &H1F, 1)       'compute the second
  434.  
  435. END SUB
  436.  
  437. SUB LoadNames (Spec$, Array$()) STATIC
  438.  
  439.   SpecZ$ = Spec$ + Zero$                'make a local ASCIIZ copy
  440.  
  441.  '---- The following code isn't really needed because we know that FileCount%
  442.  '     has already set the DTA address.  It is shown here merely for clarity.
  443.  'Regs.DX = VARPTR(SourceDTA)           'assign the new DTA address
  444.  'Regs.AX = &H1A00                      'specify service 1Ah
  445.  'CALL Interrupt(DOS, Regs, Regs)       'DOS set DTA service
  446.  
  447.   Regs.DX = SADD(SpecZ$)                'the file spec address
  448.   Regs.CX = 39                          'find files, also hidden/read-only
  449.   Regs.AX = &H4E00                      'find first matching name
  450.  
  451.   DO
  452.     CALL Interrupt(DOS, Regs, Regs)     'see if there's a match
  453.    'CALL Interrupt(DOS, Regs)           'use this with P.D.Q.
  454.     IF Regs.Flags AND 1 THEN EXIT DO    'no more
  455.     ThisEl = ThisEl + 1                         'assign the current element
  456.     Zero = INSTR(SourceDTA.FileName, Zero$)     'find zero and assign name
  457.     Array$(ThisEl) = LEFT$(SourceDTA.FileName, Zero - 1)  'assign the name
  458.     Regs.AX = &H4F00                    'find next matching name service
  459.   LOOP
  460.  
  461. END SUB
  462.  
  463. FUNCTION NameOnly$ (FullName$) STATIC   'extracts file name from a full name
  464.  
  465.     NameOnly$ = FullName$               'assume there's no drive or path
  466.  
  467.     FOR X = LEN(FullName$) TO 1 STEP -1     'walk through the name backwards
  468.       Temp = ASC(MID$(FullName$, X))        'look at this character
  469.       IF Temp = 58 OR Temp = 92 THEN        'colon or backslash?
  470.         NameOnly$ = MID$(FullName$, X + 1)  'yes, keep just what follows
  471.         EXIT FOR                            'and we're all done
  472.       END IF
  473.     NEXT
  474.  
  475. END FUNCTION
  476.  
  477. FUNCTION Trim$ (Work$) STATIC
  478.  
  479.   Trim$ = LTRIM$(RTRIM$(Work$)) 'strip both leading and trailing blanks
  480.  
  481. END FUNCTION
  482.  
  483.