'===========================================================================
' Subject: FILE COPY                          Date: 04-10-94 (00:00)       
'  Author: Phil Weber                         Code: QB, QBasic, PDS        
'  Origin: www.ocf.berkeley.edu/~horie/     Packet: DOS.ABC
'===========================================================================
' FILECOPY.BAS by Phil Weber
' typed in by T. Horie 4/10/94
' interface design by T. Horie
' demonstrates integrated assembly routines in QBasic.
' To run in QBasic, QBASIC /RUN FCOPYC.BAS
' for QB45 type, QB /RUN FCOPYC.BAS /L

DECLARE SUB FILECOPY (SRC$, DEST$, BUFFER%())
DECLARE FUNCTION EXIST% (FILESPEC$)
DECLARE SUB GETLN (MAXLN%, WORDS$, X1%, Y1%)
DECLARE SUB INT86 (INTNUM%, REGS AS ANY)
DECLARE SUB READARRAY (HANDLE%, BUFFER%(), BYTES&)
DECLARE SUB WRITEARRAY (HANDLE%, BUFFER%(), BYTES&)

DEFINT A-Z
TYPE REGTYPE
        AX AS INTEGER
        BX AS INTEGER
        CX AS INTEGER
        DX AS INTEGER
        BP AS INTEGER
        SI AS INTEGER
        DI AS INTEGER
        FLAGS AS INTEGER
        DS AS INTEGER
        ES AS INTEGER
END TYPE

DIM SHARED REGS AS REGTYPE

REDIM SHARED INTRPT(1 TO 50)
DEF SEG = VARSEG(INTRPT(1))
ADDRESS = VARPTR(INTRPT(1))
FOR I = 0 TO 99
        READ A
        POKE ADDRESS + I, A
NEXT

REDIM BUFFER(1 TO 15360)
REM MAXIMUM IS A 15K BUFFER...
COLOR 15, 0: CLS : M = 12
COLOR 15, 1
LOCATE 1, M:     PRINT "Þßßßßßßßßßßß                            ßßßßßßßßßßßßßÛ"
LOCATE 1, M + 12: COLOR 8, 7: PRINT " FILECOPY.BAS by Phil Weber "
COLOR 15, 1
LOCATE 2, M:     PRINT "Þ                                                    Û±±"
LOCATE 3, M:     PRINT "Þ                                                    Û±±"
LOCATE 4, M:     PRINT "Þ                                                    Û±±"
LOCATE 5, M:     PRINT "ÞÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ±±"
LOCATE 6, M + 2: PRINT "±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±±"
LOCATE 4, M + 6: COLOR 7, 1: PRINT "Interface design by Toshihiro Horie 4/94": COLOR 15, 1
DEF SEG = 0: POKE &H417, &H40: DEF SEG
LOCATE 2, M + 3: PRINT "     Enter source filename:"
LOCATE 3, M + 3: PRINT "Enter destination filename:"
WORDS$ = "": MAXLN% = 20: X1% = M + 30: Y1% = 2
CALL GETLN(MAXLN%, WORDS$, X1%, Y1%)
SRC$ = WORDS$: WORDS$ = ""
MAXLN% = 20: X1% = M + 30: Y1% = 3
CALL GETLN(MAXLN%, WORDS$, X1%, Y1%)
DEST$ = WORDS$
LOCATE 9, 10: PRINT STRING$(60, 32): LOCATE 10, 10: PRINT STRING$(60, 32)
LOCATE 13, 10: PRINT STRING$(60, 32)
LOCATE 11, 10: PRINT "     ÃÁÁÁÁÁÁÁÁÁÅÁÁÁÁÁÁÁÁÁÅÁÁÁÁÁÁÁÁÁÅÁÁÁÁÁÁÁÁÁÁÅÁÁÁÁÁÁÁÁÁ´   "
LOCATE 12, 10: PRINT "     0        20        40        60         80       100%  "
CALL FILECOPY(SRC$, DEST$, BUFFER())
END

DATA 85,139,236,86,87,30,139,118,6,139,4,139,92,2,139,76,4,139,84,6
DATA 139,108,8,139,124,12,142,68,18,255,116,10,131,124,18,255,117,2,30,7
DATA 131,124,16,255,116,3,142,92,16
DATA 94,205,33,85,139,236,30,86,142,94,2,139,118,14,137,4,137,92,2,137,76,4
DATA 137,84,6,143,68,10,143,68,16,143,68,8,137,124,12,140,68,18,156,143,68,14
DATA 95,95,94,93,202,2,0

FUNCTION EXIST (FILESPEC$)
TEMP$ = FILESPEC$ + CHR$(0)
REGS.AX = &H4E00
REGS.CX = &HFF
REGS.DS = VARSEG(TEMP$)
REGS.DX = SADD(TEMP$)
CALL INT86(&H21, REGS)
IF (REGS.FLAGS AND 1) THEN EXIST = 0 ELSE EXIST = -1
END FUNCTION

SUB FILECOPY (SRC$, DEST$, BUFFER())
IF NOT EXIST(SRC$) THEN EXIT SUB
SRC = FREEFILE
OPEN SRC$ FOR BINARY AS SRC
DEST = FREEFILE
OPEN DEST$ FOR OUTPUT AS DEST
REMAINING& = LOF(SRC)
whole& = LOF(SRC)
DO WHILE REMAINING& > 0
        BYTES& = UBOUND(BUFFER) * 2
        CALL READARRAY(SRC, BUFFER(), BYTES&)
        IF BYTES& = -1 THEN EXIT DO
        CALL WRITEARRAY(DEST, BUFFER(), BYTES&)
        IF BYTES& <= 0 THEN EXIT DO
        REMAINING& = REMAINING& - BYTES&
        PERCENT% = INT(100 - ((REMAINING& / whole&) * 100))
        LOCATE 9, 15: PRINT STR$(PERCENT%) + "% copied... "
        COLOR 14, 1: LOCATE 10, 15: PRINT STRING$(PERCENT% / 2 + 2, 219): COLOR 15, 1
        LOOP
CLOSE SRC, DEST
LOCATE 13, 10
PRINT "   Finished transferring "; STR$(whole&); " bytes."
END SUB

SUB GETLN (MAXLN%, WORDS$, X1%, Y1%) STATIC
high:
lnwd = 0: LOCATE Y1%, X1%: PRINT STRING$(MAXLN, 95): WORDS$ = "": LOCATE Y1%, X1%
TOP:
letter$ = INPUT$(1): lnwd = LEN(WORD$)
IF letter$ = CHR$(13) THEN GOTO DONE
IF letter$ = CHR$(8) AND lnwd > 1 THEN WORD$ = LEFT$(WORD$, lnwd - 1): X1% = X1% - 1: LOCATE Y1%, X1%: GOTO SKIPWD
IF letter$ = CHR$(8) AND lnwd = 0 THEN GOTO high
WORDS$ = WORDS$ + letter$
LOCATE Y1%, X1%: PRINT WORDS$
IF LEN(WORDS$) = MAXLN% THEN GOTO DONE
SKIPWD:
GOTO TOP
DONE:
END SUB

SUB INT86 (INTNUM, REGS AS REGTYPE)
DEF SEG = VARSEG(INTRPT(1))
ADDRESS = VARPTR(INTRPT(1))
POKE ADDRESS + 51, INTNUM
CALL ABSOLUTE(REGS, ADDRESS)
END SUB

SUB READARRAY (HANDLE, BUFFER(), BYTES&)
REGS.AX = &H3F00
REGS.BX = FILEATTR(HANDLE, 2)
IF BYTES& > 32767 THEN BYTES& = BYTES& - 65536
REGS.CX = BYTES&
REGS.DS = VARSEG(BUFFER(LBOUND(BUFFER)))
REGS.DX = VARPTR(BUFFER(LBOUND(BUFFER)))
REGS.ES = -1
CALL INT86(&H21, REGS)
BYTES& = REGS.AX AND &HFFFF&
IF (REGS.FLAGS AND 1) THEN BYTES& = -1
END SUB

SUB WRITEARRAY (HANDLE, BUFFER(), BYTES&)
REGS.AX = &H4000
REGS.BX = FILEATTR(HANDLE, 2)
IF BYTES > 32767 THEN BYTES& = BYTES& - 65536
REGS.CX = BYTES&
REGS.DS = VARSEG(BUFFER(LBOUND(BUFFER)))
REGS.DX = VARPTR(BUFFER(LBOUND(BUFFER)))
REGS.ES = -1
CALL INT86(&H21, REGS)
BYTES& = REGS.AX AND &HFFFF&
IF (REGS.FLAGS AND 1) THEN BYTES& = -1
END SUB