Credits in a program!

 BBS: Inland Empire Archive
Date: 11-02-92 (19:59)             Number: 373
From: ERIC B. FORD                 Refer#: NONE
  To: DICK DENNISON                 Recvd: NO  
Subj: Credits in a program!          Conf: (2) Quik_Bas

 > EBF>FastCopy    (copies files ten times faster than shell)

 > JG> I don't know who wrote that one, but I would be *really* interested in
 > JG> getting a copy of it!  Is there a BBS I can download it from?
 >
 > 'Don't know if this is the one Eric is talking about,
 > but it's real
 > fast:

 > 'Don't know where this originally came from
 > 'but I modified it 9/92 - Dick Dennison
 > 'COPYFILE.bas - public domain - might be Mike Welch's
 > code
 > DECLARE FUNCTION GetHandle& (FileName$)
 > DECLARE SUB CloseHandle (Handle&)
 > DECLARE SUB GetSetTimeDate (Which%, Handle&, Time&,
 > Date&)

Well, I don't think so, is that any better than this?

'$INCLUDE: 'qb.bi'               'needed for interrupt/x
'$DYNAMIC DEFINT A-Z

DECLARE FUNCTION FastCopy& (sourcefile$, destfile$, DateFlag%)

CONST FALSE = 0
CONST TRUE = NOT FALSE

  CLS
  LINE INPUT "File to be copied >", infile$
  LINE INPUT "Destination name  >", outfile$
  IF infile$ = "" OR outfile$ = "" THEN END
  result& = FastCopy(infile$, outfile$, TRUE)  'get any error code
  IF result& < 0 THEN
     PRINT "Error code is:"; result&
  ELSE
     PRINT "Bytes Copied:"; result&
  END IF

' Far String Version
FUNCTION FastCopy& (sourcefile$, destfile$, DateFlag AS INTEGER)
  REDIM buffer(0 TO 16383) AS LONG  'far data 64k bytes long
  DIM reg AS RegType                'our regs for interrupt call
  DIM regx AS RegTypeX              'ditto for interruptx
  DIM inhandle AS INTEGER
  DIM outhandle AS INTEGER
  DIM intime AS INTEGER             'source file time/date stamp
  DIM outtime AS INTEGER

  infile$ = sourcefile$ + CHR$(0)   'append a null to filenames
  outfile$ = destfile$ + CHR$(0)
  BytesRead& = 0

  regx.ax = &H3D00                   'open file
  regx.dx = SADD(infile$)            'filename
  regx.ds = VARSEG(infile$)
  CALL INTERRUPTX(&H21, regx, regx)
  IF regx.flags AND 1 THEN           'check carry flag
     'PRINT "error opening "; infile$ 'for debugging
     FastCopy& = -1                   'error code -1 = open infile error
     EXIT FUNCTION                   'bail out
  END IF
  inhandle = regx.ax                'save handle
  reg.bx = inhandle                 'put into bx
  reg.ax = &H5700                   'get date stamp info
  CALL INTERRUPT(&H21, reg, reg)
  intime = reg.cx                   'save em
  indate = reg.dx
  regx.ax = &H3C00                   'creat output file
  regx.dx = SADD(outfile$)           'filename
  regx.ds = VARSEG(outfile$)
  regx.cx = 0
  CALL INTERRUPTX(&H21, regx, regx)
  IF regx.flags AND 1 THEN           'check carry flag
     'PRINT "error opening "; outfile$ 'for debugging
     GOSUB CloseInfile
     FastCopy& = -2                  'error opening outfile = -2
     EXIT FUNCTION
  END IF
  outhandle = regx.ax                'save handle
  DO
     regx.ax = &H3F00
     regx.bx = inhandle
     regx.cx = &HFFFF                'do up to 65535 at a time
     regx.dx = &H0                   'starting offset assume at 0
     regx.ds = VARSEG(buffer(0))     'segment of buffer
     CALL INTERRUPTX(&H21, regx, regx)
     IF regx.flags AND 1 THEN
             'PRINT "error reading input file" 'for debugging
             GOSUB CloseInfile
             GOSUB CloseOutfile
             FastCopy& = -3                'read error = -3
             EXIT DO
     ELSE
        IF regx.ax <> 0 THEN          'something to write ?
          '--------------------------------------------------------
          'this area keeps a running total of bytes copied
          IF regx.ax < 0 THEN
             BytesRead& = BytesRead& + regx.ax + &H10000
          ELSE
             BytesRead& = BytesRead& + regx.ax
          END IF
          '---------------------------------------------------------
          regx.cx = regx.ax           'number of bytes to write
          regx.dx = 0                 'start of buffer
          regx.bx = outhandle
          regx.ax = &H4000            '
          CALL INTERRUPTX(&H21, regx, regx)
          IF (regx.flags AND 1) OR (regx.ax <> regx.cx) THEN
             'PRINT "error writing outfile" 'for debugging
             GOSUB CloseInfile
             GOSUB CloseOutfile
             FastCopy& = -4            'error writing file = -4
             EXIT DO
          END IF
        ELSE
          IF DateFlag THEN
             reg.ax = &H5701
             reg.bx = outhandle
             reg.cx = intime
             reg.dx = indate
             CALL INTERRUPT(&H21, reg, reg)
        END IF
        GOSUB CloseInfile
        GOSUB CloseOutfile
        FastCopy& = BytesRead&      'no hits, no runs, no errors
        EXIT DO
        END IF
     END IF
  LOOP

EXIT FUNCTION
CloseInfile:
          reg.ax = &H3E00                  'close file
          reg.bx = inhandle                'input file
          CALL INTERRUPT(&H21, reg, reg)
RETURN

CloseOutfile:
          reg.ax = &H3E00                  'close file
          reg.bx = outhandle               'output file
          CALL INTERRUPT(&H21, reg, reg)
RETURN

END FUNCTION

---
 * Origin: Eric Ford (1:3632/1.6)