' 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