===========================================================================
 BBS: The Abacus * HST/DS * Potterville MI
Date: 05-13-93 (00:05)             Number: 68
From: JOE NEGRON                   Refer#: 190
  To: SCOTT WUNSCH                  Recvd: NO  
Subj: File date/time/size            Conf: (35) Quick Basi
---------------------------------------------------------------------------
SW> I finally got fed up with trying to find a decent file
  > copy programme out there and decided to write one myself.
  > However, now I need routines to get a file's date, time and
  > size, and to set a file's date and time.  Now I know
  > there's someone out there just bursting to show off their
  > dull and regular routines...! <bg>

Well, it's not mine, but here is a nice, completely self-contained
FUNCTION that copies a file, complete with date/time stamping.

============================== Begin code ==============================
DEFINT A-Z

'$INCLUDE: 'qbx.bi'

DECLARE FUNCTION CopyFile% (Source$, Dest$)

'***********************************************************************
'* FUNCTION CopyFile%
'*
'* PURPOSE
'*    Copies a file using standard BASIC file I/O.  Uses DOS ISR 21H,
'*    Function 57H (Get/Set File Date and Time) to set the date and time
'*    of the target file.
'*
'*    Returns: 0 - Everything went all right
'*             1 - Source file does not exist
'*             2 - Destination file does exist
'*             3 - Failure in setting copy's time/date to that of source
'*
'* EXTERNAL ROUTINE(S)
'*    QBX.LIB
'*    -------
'*    SUB Interrupt (IntNum%, IRegs AS RegType, ORegs AS RegType)
'*
'* CREDIT(S)
'*    Written by Dave Cleary
'*
'*    Added ACCESS READ LOCK WRITE on the source file and ACCESS WRITE
'*    LOCK READ WRITE on the target file.
'***********************************************************************
FUNCTION CopyFile% (Source$, Dest$) STATIC
   DIM IRegs AS RegType, ORegs AS RegType

   CONST cBlock = 4096                       'Set this to the length you
                                             '  want your buffer to be

   IF LEN(DIR$(Source$)) = 0 THEN
      CopyFile% = 1                          'Source doesn't exist
      EXIT FUNCTION                          'Exit with error code
   END IF

   'See if destination exists
   IF LEN(DIR$(Dest$)) THEN
      CopyFile% = 2                          'Destination already exists
      EXIT FUNCTION                          'Exit with error code
   END IF

   'Open files for BINARY
   SFileNum% = FREEFILE
   OPEN Source$ FOR BINARY ACCESS READ LOCK WRITE AS #SFileNum%

   DFileNum% = FREEFILE
   OPEN Dest$ FOR BINARY ACCESS WRITE LOCK READ WRITE AS #DFileNum%

   'Now copy the files over
   DO
      Buffer$ = INPUT$(cBlock, #SFileNum%)
      PUT #DFileNum%, , Buffer$
   LOOP UNTIL EOF(SFileNum%)

   'Set the date and time of the copy to that of the original
   IRegs.ax = &H5700
   IRegs.bx = FILEATTR(SFileNum%, 2)         'Get DOS's file handle
   Interrupt &H21, IRegs, ORegs              'Get date/time of original

   'Check for an error
   IF (ORegs.flags AND 1) THEN               'Is carry flag set?
      CLOSE #SFileNum, #DFileNum             'Close the files
      KILL Dest$                             'Kill our copy - something
      CopyFile% = 3                          '  went wrong.  Exit with
      EXIT FUNCTION                          '  error.
   END IF

   IRegs.ax = &H5701
   IRegs.bx = FILEATTR(DFileNum%, 2)
   IRegs.cx = ORegs.cx
   IRegs.dx = ORegs.dx
   Interrupt &H21, IRegs, ORegs              'Set date and time of copy

   'Check for an error
   IF (ORegs.flags AND 1) THEN
      CLOSE #SFileNum%, #DFileNum            'Close the files
      KILL Dest$                             'Kill our copy - something
      CopyFile% = 3                          'went wrong.  Exit with
      EXIT FUNCTION                          '  error
   ELSE
      CLOSE #SFileNum%, #DFileNum%           'All done
      CopyFile% = 0                          'Return with success
   END IF
END FUNCTION
=============================== End code ===============================

SW> Oh, BTW, I'm writing this one in PB3.

Shouldn't be very difficult at all to convert to PB3...probably just the
Interrupt call.

          --Joe in Bay Ridge, Brooklyn, NY, Thu, 05-13-1993--
___
 X Blue Wave/QWK v2.12 X

--- Maximus 2.01wb
 * Origin: * BlueDog BBS * (212) 594-4425 * NYC FileBone Hub (1:278/709)
SEEN-BY: 1/211 11/2 4 13/13 101/1 108/89 109/25 110/69 114/5 123/19 124/1
SEEN-BY: 153/752 154/40 77 157/2 159/100 125 430 575 950 203/23 209/209
SEEN-BY: 261/1023 280/1 390/1 396/1 15 397/2 2230/100 2440/5 3603/20