10 '*
15 '*************************************************************************
20 '*
25 '*                     BASIC WORKSHOP SERIES
30 '*
35 '*                           NUMBER   1
40 '*
45 '*                              BY
50 '*
55 '*                         JAMES P. MORGAN
60 '*                   1749 AMERICANA BLVD APT 23-G
65 '*                         ORLANDO FLA, 32809
70 '*
75 '*                     WORK PH:(305) 826-7297
80 '*
85 '*  I HAVE PUT TOGETHER, FOR YOU, A SET OF CALLABLE ASSEMBLER SUBROUTINES
90 '* FROM BASIC, TO ALLOW YOU MORE CONTROL OVER YOUR SYSTEM. THESE ROUTINES
95 '* ENABLE YOU TO ACCESS DOS FUNCTIONS NOT SUPPORTED BY THE INTERPRETER OR
100 '* THE BASIC COMPILER, FOR MOST OF THE NEW EXTENDED DOS 2.0 FUNCTIONS.
105 '*
110 '*  I HAVE DEBUGGED THE ROUTINES AS MUCH AS MY LIMITED TIME WOULD PERMIT.
115 '* PLEASE EXCUSE THE TYPING ERROR, I COME FROM THE HUNT AND PEEK SCHOOL
120 '* OF TYPING. ALSO I SCRATCHED MY MASTER FILE AND HAD TO REKEY ALL OF THIS.
125 '* THE LESSON LEARNED , ALWAYS KEEP A BACK UP OF LARGE FILES, EVEN IF
130 '* NOT A TOTAL CURRENT ONE.
135 '*
140 '*  A NOTE OF WARNING, THESE SUBROUTINES DO LITTLE OR NO VALIDITY CHECKING
145 '* AS TO THE FORMAT, TYPE AND RANGE OF VARIABLES PASSED, SO BE WARNED IF
150 '* YOU DO NOT FOLLOW THE RULES AND YOUR MACHINE LOCKS UP TIGHT.
155 '*
160 '*  THERE ARE MORE SUBROUTINES FORTHCOMING, SO LOOK FOR THEM, SUCH AS
165 '* GETTING/SETTING THE INTERRUPT VECTORS, PARSEING A FILENAME, PASSING
170 '* RETURN CODES FROM A PROGRAM TO BATCH JOBS, AND MORE.
175 '*
180 '*                        DOS 2.0 DEFINITIONS
185 '*                      -----------------------
190 '*
195 '*       ASCIIZ STRING - NORMAL TEXT STRING, USUALLY CONSISTING OF A DRIVE,
200 '*                      PATH , AND/OR FILENAME (EXP:"A:\COBOL\COBPGM.COB")
205 '*                      TERMINATED BY A HEX 00/(CHR$(0)).
210 '*
215 '*   THERE ARE MORE RETURN CODES OUTPUT BY THE NEW DOS 2.0 FUNCTION CALLS.
220 '*
225 '*   1 - INVALID FUNCTION NUMBER
230 '*   2 - FILE NOT FOUND
235 '*   3 - PATH NOT FOUND
240 '*   4 - TOO MANY OPEN FILES
245 '*   5 - ACCESS DENIED
250 '*   6 - INVALID HANDLE
255 '*   7 - MEMORY CONTROL BLOCKS DESTROYED
260 '*   8 - INSUFFICIENT MEMORY
265 '*   9 - INVALID MEMORY BLOCK ADDRESS
270 '*  10 - INVALID ENVIRONMENT
275 '*  11 - INVALID FORMAT
280 '*  12 - INVALID ACCESS CODE
285 '*  15 - INVALID DRIVE WAS SPECIFIED
290 '*  16 - ATTEMPTED TO REMOVE THE CURRENT DIRECTORY
295 '*  17 - NOT SAME DEVICE
300 '*  18 - MO MORE FILES
305 '*
310 '*   SOME SUBROUTINES STILL DO CALLS TO THE DOS 1.1 FUNCTION CALLS
315 '*  AND THEY RETURN THEIR OWN PARTICULAR RESULT CODES.
320 '*
325 '*   AS ALWAYS, IF IN DOUBT, CONSULT THE TECHNICAL GUIDE AND THE TECHNICAL
330 '*  SECTION OF THE DOS MANUAL AS TO THE FORMAT AND OBJECTIVE OF ANY OF THE
335 '*  FUNCTION CALLS.
340 '*
345 '*  NOTE:
350 '*       THE PROGRAMS WILL CREATE A .COM TYPE FILE, IF YOU TEST RUN EACH
360 '*    ONE SEPARATELY. THESE .COM TYPE FILES MAY THEN BE READ BY OTHER
370 '*    PROGRAMS AND POKED INTO A VARIABLE ARRAY IN THE NEW PROGRAM, AS WAS
380 '*    DONE IN THE TEST PROGRAMS.
390 '*       BOTH THE INTERPERTER AND BASIC COMPILER ARE SUPPORTED IN THE DATA
400 '*    STATEMENTS IN THE PROGRAMS. YOU MUST, I REPEAT, YOU MUST COMMENT OUT
405 '*    THE DATA STATEMENTS FLAGGED THAT DO NOT APPLY TO THE MODE YOU ARE
410 '*    RUNNING IN. YOU CANNOT RUN THE BASIC COMPILER DATA STATEMENTS WHILE
415 '*    RUNNING THE INTERPERTER. YOU MAY HOWEVER CREATE THE .COM TYPE FILES
420 '*    FOR USE BY COMPILED PROGRAMS. BY CHANGING THE DATA STATEMENTS AS
425 '*    ADVISED AND PUTTING AN "END' STATEMENT JUST AFTER THE 'GOSUB' THAT
430 '*    CREATES THE DISK .COM FILE.
435 '*
440 '*   'KEEP ON COMPUTING AND SHARING'
500 '**********************************************************************
501 '*
502 '* SUBROUTINE FUNCTION : CNTL-BREAK CHECK
503 '*
504 '* VERSION             : 1.0
505 '*
506 '* DATE LAST UPDATED   : SEPT 25, 1983
507 '*
508 '* AUTHOR              : JAMES P MORGAN
509 '*
510 '* CALL FORMAT         :
511 '* ---------------------
512 '* CALL OFFSET%(CNTL.BREAK.STATE%,RETURN.CODE%)
513 '*
514 '* PARAMETERS PASSED   : CNTL.BREAK.STATE% (00=REQUEST CURRENT STATE
515 '*                                          01=FLIP/FLOP CURRENT STATE
516 '*
517 '*                       RETURN.CODE%=0
518 '*
519 '* PARAMETERS RETURNED : CNTL.CREAK.STATE%
520 '*
521 '*                       RETURN.CODE%       (00=CNTL-BREAK ON
522 '*                                           01=CNTL-BREAK OFF)
523 '*
524 '* COMMENTS            :
525 '*
526 '*                       THIS SUBROUTINE WILL FLIP/FLOP THE CNTL-BREAK
527 '*                     SWITCH FROM ON/OFF OR OFF/ON AND RETURN THE CURRENT
528 '*                     STATE OR JUST RETURN THE CURRENT STATE OF THE
529 '*                     CNTL-BREAK SWITCH.
530 '*
531 '**************************************************************************
537 CLS
538 CLOSE
539 DEF SEG
540 DEFINT A-Z
541 DIM SUBRT%(40)
542 OFFSET%=0
543 CNTL.BREAK.STATE%=0
544 CURRENT.STATE%=0
545 RETURN.CODE%=0
546 GOSUB 576
547 GOSUB 555
548 OFFSET%=VARPTR(SUBRT%(0))
549 CALL OFFSET%(CNTL.BREAK.STATE%,RETURN.CODE%)
550 CURRENT.STATE%=RETURN.CODE%
551 PRINT "CNTL BREAK REQUEST= ";CNTL.BREAK.STATE%
552 PRINT "CURRENT STATE     = ";CURRENT.STATE%
553 PRINT "RETURN CODE       = ";RETURN.CODE%
554 END
555 FOR I=0 TO 31
556 READ J
557 POKE (VARPTR(SUBRT%(0))+I),J
558 NEXT
559 RETURN
560 DATA &H55
561 DATA &H89,&HE5
562 DATA &HB0,&H00
563 DATA &HB2,&H00
564 DATA &HB4,&H33
565 DATA &HCD,&H21
566 DATA &H8B,&H76,&H08
567 DATA &H8A,&H04
568 DATA &H80,&HF2,&H01
569 DATA &HB4,&H33
570 DATA &HCD,&H21
571 DATA &H8B,&H76,&H06
572 DATA &H88,&H14
573 DATA &H5D
574 DATA &HCA,&H04,&H00
575 END
576 RESTORE
577 FILENAME$="A:"+"CNTLBRK.EMU"
578 PGM.LEN=31
579 OPEN FILENAME$ AS #1 LEN=1
580 FIELD #1, 1 AS PGM.BYTE$
581 FOR I=0 TO PGM.LEN
582 READ J
583 LSET PGM.BYTE$=CHR$(J)
584 PUT #1
585 NEXT
586 CLOSE
587 RESTORE
588 RETURN
1000 '**********************************************************************
1001 '*
1002 '* SUBROUTINE FUNCTION : GET DRIVE TYPE
1003 '*
1004 '* VERSION             : 1.0
1005 '*
1006 '* DATE LAST UPDATED   : SEPT 25, 1983
1007 '*
1008 '* AUTHOR              : JAMES P MORGAN
1009 '*
1010 '* CALL FORMAT         :
1011 '* ---------------------
1012 '* CALL OFFSET%(DRIVE%,RETURN.CODE%)
1013 '*
1014 '* PARAMETERS PASSED   : DRIVE%            (00=DEFAULT,1=A,2=B..ECT)
1015 '*
1016 '*                       RETURN.CODE%=0
1017 '*
1018 '* PARAMETERS RETURNED : DRIVE%
1019 '*
1020 '*                       RETURN.CODE%       (255=INVALID DRIVE)
1021 '*
1022 '* COMMENTS            :
1023 '*
1024 '*                       THIS ROUTINE RETURNS THE DRIVE TYPE. THE DOS
1025 '*                     FUNCTION CALL '1CH' ID USED. THIS DOS FUNCTION CALL
1026 '*                     DOES NOT FUNCTION UNDER 2.0 AS IT DID UNDER 1.1.
1027 '*                       UNDER 1.1 THE FATS (FILE ALLOCATION TABLES) WERE
1028 '*                     MAINTAINED IN MEMORY AND THIS CALL WOULD POINT YOU
1029 '*                     TO THE FAT IN MEMORY.
1030 '*                       UNDER 2.0 THIS CALL NOW ONLY POINTS YOU TO THE
1031 '*                     DRIVE TYPE CODE IN MEMORY.
1032 '**************************************************************************
1033 CLS
1034 CLOSE
1035 DEF SEG
1036 DEFINT A-Z
1037 DIM SUBRT%(40)
1038 OFFSET%=0
1039 DRIVE%=0
1040 DUAL.8.SECTORS=255            'FF
1041 SINGLE.8.SECTORS=254          'FE
1042 DUAL.9.SECTORS=253            'FD
1043 SINGLE.9.SECTORS=252          'FC
1044 FIXED.DISK=248                'F8
1045 RETURN.CODE%=0
1046 GOSUB 1086
1047 GOSUB 1062
1048 REQUESTED.DRIVE%=DRIVE%
1049 OFFSET%=VARPTR(SUBRT%(0))
1050 CALL OFFSET%(DRIVE%,RETURN.CODE%)
1051 PRINT "DRIVE   REQUESTED = ";REQUESTED.DRIVE%
1052 PRINT "DRIVE TYPE CODE   = ";DRIVE%
1053 IF RETURN.CODE%=255 THEN DRIVE.TYPE$="INVALID DRIVE SPECIFIED":GOTO 1059
1054 IF DRIVE%=255 THEN DRIVE.TYPE$="DUAL.SIDED, 8 SECTORS PER TRACK"
1055 IF DRIVE%=254 THEN DRIVE.TYPE$="SINGLE SIDED, 8 SECTORS PER TRACK"
1056 IF DRIVE%=253 THEN DRIVE.TYPE$="DUAL SIDED, 9 SECTORS PER TRACK"
1057 IF DRIVE%=252 THEN DRIVE.TYPE$="SINGLE SIDED, 9 SECTORS PER TRACK"
1058 IF DRIVE%=248 THEN DRIVE.TYPE$="FIXED DISK"
1059 PRINT "DRIVE TYPE        = ";DRIVE.TYPE$
1060 PRINT "RETURN CODE       = ";RETURN.CODE%
1061 END
1062 FOR I=0 TO 37
1063 READ J
1064 POKE (VARPTR(SUBRT%(0))+I),J
1065 NEXT
1066 RETURN
1067 DATA &H55
1068 DATA &H89,&HE5
1069 DATA &H31,&HC0
1070 DATA &H31,&HDB
1071 DATA &H31,&HC9
1072 DATA &H31,&HD2
1073 DATA &H8B,&H76,&H08
1074 DATA &H8A,&H14
1075 DATA &HB4,&H1C
1076 DATA &H1E
1077 DATA &HCD,&H21
1078 DATA &H8A,&H27
1079 DATA &H1F
1080 DATA &H8B,&H76,&H08
1081 DATA &H88,&H24
1082 DATA &H8B,&H76,&H06
1083 DATA &H88,&H04
1084 DATA &H5D
1085 DATA &HCA,&H04,&H00
1086 RESTORE
1087 FILENAME$="A:"+"DRIVETYP.EMU"
1088 PGM.LEN=37
1089 OPEN FILENAME$ AS #1 LEN=1
1090 FIELD #1, 1 AS PGM.BYTE$
1091 FOR I=0 TO PGM.LEN
1092 PGM.LEN=37
1093 PUT #1
1094 NEXT
1095 CLOSE
1096 RESTORE
1097 RETURN
1500 '**********************************************************************
1501 '*
1502 '* SUBROUTINE FUNCTION : GET FIRST/NEXT MATCHING FILE
1503 '*
1504 '* VERSION             : 1.0
1505 '*
1506 '* DATE LAST UPDATED   : SEPT 25, 1983
1507 '*
1508 '* AUTHOR              : JAMES P MORGAN
1509 '*
1510 '* CALL FORMAT         :
1511 '* ---------------------
1512 '* CALL OFFSET%(FUNCTION.CODE%,ATTRIBUTE%,ASCIIZ.STRING$,DTA%(0),RETURN.CODE%)
1513 '*
1514 '* PARAMETERS PASSED   : FUNCTION.CODE%    (&H4E=FIND FIRST MATCHING FILE
1515 '*                                          &H4F=FIND NEXT MATCHING FILE)
1516 '*
1517 '*                       ATTRIBUTE%         (ATTRIBUTE TO BE USED IN
1518 '*                                           SEARCHING FOR THE FILE)
1519 '*
1520 '*                       ASCIIZ.STRING$     (DRIVE,PATH, AND FILENAME)
1521 '*
1522 '*                       DTA%(0)            (PSEUDO DTA TO HOLD MATCHING
1523 '*                                           FILE INFORMATION)
1524 '*
1525 '*                       RETURN.CODE%=0
1526 '*
1527 '* PARAMETERS RETURNED : FUNCTION.CODE%
1528 '*
1529 '*                       ATTRIBUTE%
1530 '*
1531 '*                       ASCIIZ.STRING$
1532 '*
1533 '*                       DTA%(0)            (FILLED WITH MATCHING DTA INFO)
1534 '*
1535 '*                       RETURN.CODE%
1536 '*
1537 '* COMMENTS            :
1538 '*
1539 '*                       THIS SUBROUTINE SEARCHS A DIRECTORY FOR A
1540 '*                     FILE WITH MATCHING FILE ATTRIBUTE AND CHARACTERS.
1541 '*                       THE ASCIIZ STRING CONSISTS OF A DRIVE , PATH ,
1542 '*                     AND FILENAME. GLOBAL FILENAME CHARACTERS ARE ALLOWED
1543 '*                     IN THE FILENAME PORTION OF THE STRING.
1544 '*                       IF A FILE IS FOUND THAT MATCHES THE SPECIFIED
1545 '*                      DRIVE, PATH, AND FILENAME AND ATTRIBUTE, THE DTA
1546 '*                      IS FILLED IN AS FOLLOWS:
1547 '*
1548 '*                      21 BYTES - RESERVED FOR DOS USE ON SUBSEQUENT
1549 '*                                 FIND NEXT CALLS
1550 '*
1551 '*                       2 BYTES - FILES CREATE/UPDATE TIME
1552 '*
1553 '*                       2 BYTES - FILES CREATE/UPDATE DATE
1554 '*
1555 '*                       2 BYTES - LOW WORD OF FILE SIZE
1556 '*
1557 '*                       2 BYTES - HIGH WORD OF FILE SIZE
1558 '*
1559 '*                      13 BYTES - NAME AND EXTENTION OF FILE FOUND
1560 '*                                 FOLLOWED BY A BYTE OF HEX 00.
1561 '*
1562 '*                                 ALL BLANKS ARE REMOVED FROM THE NAME
1563 '*                                AND EXTENTION, AND IF AN EXTENTION IS
1564 '*                                PRESENT, IT IS PRECEEDED BY A PERIOD.
1565 '*                                 THE NAME WOULD BE RETURNED JUST AS YOU
1566 '*                                HAD ENTERED IT AS A COMMAND PARAMETER,
1567 '*                                SUCH AS 'TREE.COM'.
1568 '*                                 IF YOU ASK FOR ALL FILES IN A SUB-DIREC-
1569 '*                                TORY, THIS ROUTINE WILL RETURN THE '.'
1570 '*                                THE '..' THAT YOU SEE WHEN YOU DO A 'DIR'
1571 '*                                ON A SUB-DIRECTORY.
1572 '*                                 YOU CAN USE THE GET FIRST OPTION TO
1573 '*                                RETURN THE VOLUMN LABEL, SINCE IT IS
1574 '*                                BASICALLY AN EMPTY FILE WITH A SPECIAL
1575 '*                                ATTRIBUTE IN THE DIRECTORY.
1576 '*
1577 '**************************************************************************
1578 CLS
1579 CLOSE
1580 DEF SEG
1581 DEFINT A-Z
1582 DIM SUBRT%(40)
1583 OFFSET%=0
1584 DIM DTA%(40)
1585 FOR I=0 TO 40:DTA%(I)=-1:NEXT
1586 FUNCTION.CODE%=&H4E
1587 PATH$="A:*.*"
1588 ASCIIZ.STRING$=PATH$+CHR$(0)
1589 ATTRIBUTE%=255
1590 RETURN.CODE%=0
1591 GOSUB 1652
1592 GOSUB 1608
1593 GOSUB 1598
1594 FUNCTION.CODE%=&H4F
1595 GOSUB 1598
1596 IF RETURN.CODE%=0 GOTO 1595
1597 END
1598 OFFSET%=VARPTR(SUBRT%(0))
1599 CALL OFFSET%(FUNCTION.CODE%,ATTRIBUTE%,ASCIIZ.STRING$,DTA%(0),RETURN.CODE%)
1600 PRINT "RETURN CODE        = ";RETURN.CODE%
1601 IF RETURN.CODE%=18 THEN PRINT :RETURN
1602 FOR I=30 TO 43
1603 PRINT CHR$(PEEK(VARPTR(DTA%(0))+I));
1604 NEXT
1605 PRINT
1606 RETURN
1607 END
1608 FOR I=0 TO 65
1609 READ J
1610 POKE (VARPTR(SUBRT%(0))+I),J
1611 NEXT
1612 RETURN
1613 DATA &H55
1614 DATA &H89,&HE5
1615 DATA &H31,&HC0
1616 DATA &H31,&HC9
1617 DATA &H31,&HD2
1618 DATA &H8B,&H76,&H0E
1619 DATA &H8A,&H24
1620 DATA &H8B,&H76,&H0C
1621 DATA &H8B,&H0C
1622 DATA &H8B,&H76,&H0A
1623 '********COMMENT OUT THE NEXT DATA STATEMENT IF USED WITH THE BASIC COMPILER
1624 DATA &H8B,&H54,&H01
1625 '********COMMENT OUT THE NEXT DATA STATEMENT IF USED WITH THE BASIC INTERPRETER
1626 'DATA &H8B,&H54,&H02
1627 DATA &HCD,&H21
1628 DATA &H8B,&H76,&H06
1629 DATA &H88,&H04
1630 DATA &H8B,&H76,&H08
1631 DATA &H89,&HF7
1632 DATA &H06
1633 DATA &H31,&HDB
1634 DATA &HB4,&H2F
1635 DATA &HCD,&H21
1636 DATA &HFC
1637 DATA &HB9,&H2C,&H00
1638 DATA &H89,&HDE
1639 DATA &H90,&H90,&H90
1640 DATA &H1E
1641 DATA &H06
1642 DATA &H1F
1643 DATA &H07
1644 DATA &HF3
1645 DATA &HA4
1646 DATA &H06
1647 DATA &H1F
1648 DATA &H07
1649 DATA &H5D
1650 DATA &HCA,&H0A,&H00
1651 END
1652 RESTORE
1653 FILENAME$="A:"+"FRSTNEXT.EMU"
1654 PGM.LEN=65
1655 OPEN FILENAME$ AS #1 LEN=1
1656 FIELD #1,1 AS PGM.BYTE$
1657 FOR I=0 TO PGM.LEN
1658 READ J
1659 LSET PGM.BYTE$=CHR$(J)
1660 PUT #1
1661 NEXT
1662 CLOSE
1663 RESTORE
1664 RETURN
2000 '**********************************************************************
2001 '*
2002 '* SUBROUTINE FUNCTION : GET VERIFY STATE
2003 '*
2004 '* VERSION             : 1.0
2005 '*
2006 '* DATE LAST UPDATED   : SEPT 25, 1983
2007 '*
2008 '* AUTHOR              : JAMES P MORGAN
2009 '*
2010 '* CALL FORMAT         :
2011 '* ---------------------
2012 '* CALL OFFSET%(RETURN.CODE%)
2013 '*
2014 '* PARAMETERS PASSED   : RETURN.CODE%=0
2015 '*
2016 '* PARAMETERS RETURNED : RETURN.CODE%       (00=VERIFY OFF,01=VERIFY ON)
2017 '*
2018 '**************************************************************************
2019 CLS
2020 CLOSE
2021 DEF SEG
2022 DEFINT A-Z
2023 DIM SUBRT%(40)
2024 OFFSET%=0
2025 VERIFY.STATE%=0
2026 RETURN.CODE%=0
2027 GOSUB 2051
2028 GOSUB 2035
2029 OFFSET%=VARPTR(SUBRT%(0))
2030 CALL OFFSET%(RETURN.CODE%)
2031 VERIFY.STATE%=RETURN.CODE%
2032 PRINT "VERIFY STATE      = ";VERIFY.STATE%
2033 PRINT "RETURN CODE       = ";RETURN.CODE%
2034 END
2035 RESTORE
2036 FOR I=0 TO 17
2037 READ J
2038 POKE (VARPTR(SUBRT%(0))+I),J
2039 NEXT
2040 RETURN
2041 DATA &H55
2042 DATA &H89,&HE5
2043 DATA &H30,&HC0
2044 DATA &HB4,&H54
2045 DATA &HCD,&H21
2046 DATA &H8B,&H76,&H06
2047 DATA &H88,&H04
2048 DATA &H5D
2049 DATA &HCA,&H02,&H00
2050 END
2051 RESTORE
2052 FILENAME$="A:"+"VERSTATE.EMU"
2053 PGM.LEN=17
2054 OPEN FILENAME$ AS #1 LEN=1
2055 FIELD #1, 1 AS PGM.BYTE$
2056 FOR I=0 TO PGM.LEN
2057 READ J
2058 LSET PGM.BYTE$=CHR$(J)
2059 PUT #1
2060 NEXT
2061 CLOSE
2062 RESTORE
2063 RETURN
2500 '**********************************************************************
2501 '*
2502 '* SUBROUTINE FUNCTION : SET/RESET VERIFY SWITCH
2503 '*
2504 '* VERSION             : 1.0
2505 '*
2506 '* DATE LAST UPDATED   : SEPT 25, 1983
2507 '*
2508 '* AUTHOR              : JAMES P MORGAN
2509 '*
2510 '* CALL FORMAT         :
2511 '* ---------------------
2512 '* CALL OFFSET%(RETURN.CODE%)
2513 '*
2514 '* PARAMETERS PASSED   : RETURN.CODE%=0
2515 '*
2516 '* PARAMETERS RETURNED : RETURN.CODE%       (00=VERIFY OFF,01=VERIFY ON)
2517 '*
2518 '* COMMENTS           :
2519 '*                     THIS ROUTINE WILL FLIP/FLOP THE VERIFY STATE
2520 '*                    SWITCH FROM ON/OFF OR OFF/ON AND RETURN THE CURRENT
2521 '*                    STATE.
2522 '*                     WHEN ON,DOS WILL PERFORM A VERIFY OPERATION EACH
2523 '*                    TIME IT PERFORMS A DISKETTE WRITE TO ASSURE PROPER
2524 '*                    DATA RECORDING. ALTHOUGH RECORDING ERRORS ARE VERY
2525 '*                    RARE, THIS FUNCTION IS PROVIDED FOR THOSE USER
2526 '*                    APPLICATIONS IN WHICH YOU MAY WISH TO VERIFY THE
2527 '*                    PROPER RECORDING OF CRITICAL DATA.
2528 '**************************************************************************
2529 CLS
2530 CLOSE
2531 DEF SEG
2532 DEFINT A-Z
2533 DIM SUBRT%(40)
2534 OFFSET%=0
2535 VERIFY.STATE%=0
2536 RETURN.CODE%=0
2537 GOSUB 2566
2538 GOSUB 2545
2539 OFFSET%=VARPTR(SUBRT%(0))
2540 CALL OFFSET%(RETURN.CODE%)
2541 VERIFY.STATE%=RETURN.CODE%
2542 PRINT "VERIFY STATE      = ";VERIFY.STATE%
2543 PRINT "RETURN CODE       = ";RETURN.CODE%
2544 END
2545 RESTORE
2546 FOR I=0 TO 27
2547 READ J
2548 POKE (VARPTR(SUBRT%(0))+I),J
2549 NEXT
2550 RETURN
2551 DATA &H55
2552 DATA &H89,&HE5
2553 DATA &HB4,&H54
2554 DATA &HCD,&H21
2555 DATA &H34,&H01
2556 DATA &HB2,&H00
2557 DATA &HB4,&H2E
2558 DATA &HCD,&H21
2559 DATA &HB4,&H54
2560 DATA &HCD,&H21
2561 DATA &H8B,&H76,&H06
2562 DATA &H88,&H04
2563 DATA &H5D
2564 DATA &HCA,&H02,&H00
2565 END
2566 RESTORE
2567 FILENAME$="A:"+"VERRESET.EMU"
2568 PGM.LEN=17
2569 OPEN FILENAME$ AS #1 LEN=1
2570 FIELD #1, 1 AS PGM.BYTE$
2571 FOR I=0 TO PGM.LEN
2572 READ J
2573 LSET PGM.BYTE$=CHR$(J)
2574 PUT #1
2575 NEXT
2576 CLOSE
2577 RESTORE
2578 RETURN
3000 '**********************************************************************
3001 '*
3002 '* SUBROUTINE FUNCTION : GET SYSTEM TIME
3003 '*
3004 '* VERSION             : 1.0
3005 '*
3006 '* DATE LAST UPDATED   : SEPT 25, 1983
3007 '*
3008 '* AUTHOR              : JAMES P MORGAN
3009 '*
3010 '* CALL FORMAT         :
3011 '* ---------------------
3012 '* CALL OFFSET%(HOURS%,MINUTES%,SECONDS%,HUNDREDS.SECONDS%,RETURN.CODE%)
3013 '*
3014 '* PARAMETERS PASSED   : HOURS%=0
3015 '*                       MINUTES%=0
3016 '*                       SECONDS%-0
3017 '*                       HUNDREDS.SECONDS%=0
3018 '*                       RETURN.CODE%=0
3019 '*
3020 '* PARAMETERS RETURNED : HOURS%             (0-23)
3021 '*                       MINUTES%           (0-59)
3022 '*                       SECONDS%           (0-59)
3023 '*                       HUNDREDS.SECONDS%  (0-99)
3024 '*                       RETURN.CODE%
3025 '*
3026 '* COMMENTS           :
3027 '*                     THIS FORMAT IS READILY CONVERTED TO A PRINTABLE
3028 '*                    FORM YET CAN BE USED FOR CALCULATIONS , SUCH AS
3029 '*                    SUBTRACTING ONE TIME VALUE FROM ANOTHER.
3030 '*
3031 '**************************************************************************
3032 CLS
3033 CLOSE
3034 DEF SEG
3035 DEFINT A-Z
3036 DIM SUBRT%(40)
3037 OFFSET%=0
3038 HOURS%=0
3039 MINUTES%=0
3040 SECONDS%=0
3041 HUNDREDS.SECONDS%=0
3042 RETURN.CODE%=0
3043 GOSUB 3080
3044 GOSUB 3054
3045 OFFSET%=VARPTR(SUBRT%(0))
3046 CALL OFFSET%(HOURS%,MINUTES%,SECONDS%,HUNDREDS.SECONDS%,RETURN.CODE%)
3047 PRINT "HOURS             = ";HOURS%
3048 PRINT "MINUTES           = ";MINUTES%
3049 PRINT "SECONDS           = ";SECONDS%
3050 PRINT "1/100 SECONDS     = ";HUNDREDS.SECONDS%
3051 PRINT "RETURN CODE       = ";RETURN.CODE%
3052 PRINT "CURRENT TIME      = ";TIME$
3053 END
3054 RESTORE
3055 FOR I=0 TO 41
3056 READ J
3057 POKE (VARPTR(SUBRT%(0))+I),J
3058 NEXT
3059 RETURN
3060 DATA &H55
3061 DATA &H89,&HE5
3062 DATA &H31,&HC9
3063 DATA &H31,&HD2
3064 DATA &HB4,&H2C
3065 DATA &HCD,&H21
3066 DATA &H8B,&H76,&H0E
3067 DATA &H88,&H2C
3068 DATA &H8B,&H76,&H0C
3069 DATA &H88,&H0C
3070 DATA &H8B,&H76,&H0A
3071 DATA &H88,&H34
3072 DATA &H8B,&H76,&H08
3073 DATA &H88,&H14
3074 DATA &H30,&HD2
3075 DATA &H8B,&H76,&H06
3076 DATA &H88,&H14
3077 DATA &H5D
3078 DATA &HCA,&H0A,&H00
3079 END
3080 RESTORE
3081 FILENAME$="A:"+"GETTIME.EMU"
3082 PGM.LEN=41
3083 OPEN FILENAME$ AS #1 LEN=1
3084 FIELD #1, 1 AS PGM.BYTE$
3085 FOR I=0 TO PGM.LEN
3086 READ J
3087 LSET PGM.BYTE$=CHR$(J)
3088 PUT #1
3089 NEXT
3090 CLOSE
3091 RESTORE
3092 RETURN
3500 '**********************************************************************
3501 '*
3502 '* SUBROUTINE FUNCTION : GET SYSTEM DATE
3503 '*
3504 '* VERSION             : 1.0
3505 '*
3506 '* DATE LAST UPDATED   : SEPT 25, 1983
3507 '*
3508 '* AUTHOR              : JAMES P MORGAN
3509 '*
3510 '* CALL FORMAT         :
3511 '* ---------------------
3512 '* CALL OFFSET%(CENTURY%,YEAR%,MONTH%,DAY%,RETURN.CODE%)
3513 '*
3514 '* PARAMETERS PASSED   : CENTURY%=0
3515 '*                       YEAR%=0
3516 '*                       MONTH%=0
3517 '*                       DAY%=0
3518 '*                       RETURN.CODE%=0
3519 '*
3520 '* PARAMETERS RETURNED : CENTURY%
3521 '*                       YEAR%
3522 '*                       MONTH%
3523 '*                       DAY%
3524 '*                       RETUURN.CODE%
3525 '*
3526 '* COMMENTS           :
3527 '*                     IF THE TIME-OF-DAY CLOCK ROLLS OVER TO THE NEXT
3528 '*                    DAY, THE DATA IS ADJUSTED ACCORDINGLY, TAKING
3529 '*                    INTO ACCOUNT THE NUMBER OF DAYS IN EACH MONTH AND
3530 '*                    LEAP YEARS.
3531 '**************************************************************************
3532 CLS
3533 CLOSE
3534 DEF SEG
3535 DEFINT A-Z
3536 DIM SUBRT%(40)
3537 OFFSET%=0
3538 CENTURY%=0
3539 YEAR%=0
3540 MONTH%=0
3541 DAY%=0
3542 RETURN.CODE%=0
3543 GOSUB 3581
3544 GOSUB 3555
3545 OFFSET%=VARPTR(SUBRT%(0))
3546 CALL OFFSET%(CENTURY%,YEAR%,MONTH%,DAY%,RETURN.CODE%)
3547 PRINT "CENTURY           = ";CENTURY%
3548 PRINT "YEAR              = ";YEAR%
3549 PRINT "CENTURY + YEAR    = ";CENTURY%+YEAR%
3550 PRINT "MONTH             = ";MONTH%
3551 PRINT "DAY               = ";DAY%
3552 PRINT "RETURN CODE       = ";RETURN.CODE%
3553 PRINT "CURRENT DATE      = ";DATE$
3554 END
3555 RESTORE
3556 FOR I=0 TO 42
3557 READ J
3558 POKE (VARPTR(SUBRT%(0))+I),J
3559 NEXT
3560 RETURN
3561 DATA &H55
3562 DATA &H89,&HE5
3563 DATA &H31,&HC9
3564 DATA &H31,&HD2
3565 DATA &HB4,&H2A
3566 DATA &HCD,&H21
3567 DATA &H8B,&H76,&H0E
3568 DATA &H88,&H6C,&H01
3569 DATA &H8B,&H76,&H0C
3570 DATA &H88,&H0C
3571 DATA &H8B,&H76,&H0A
3572 DATA &H88,&H34
3573 DATA &H8B,&H76,&H08
3574 DATA &H88,&H14
3575 DATA &H8B,&H76,&H06
3576 DATA &H31,&HD2
3577 DATA &H89,&H14
3578 DATA &H5D
3579 DATA &HCA,&H0A,&H00
3580 END
3581 RESTORE
3582 FILENAME$="A:"+"GETDATE.EMU"
3583 PGM.LEN=42
3584 OPEN FILENAME$ AS #1 LEN=1
3585 FIELD #1, 1 AS PGM.BYTE$
3586 FOR I=0 TO PGM.LEN
3587 READ J
3588 LSET PGM.BYTE$=CHR$(J)
3589 PUT #1
3590 NEXT
3591 CLOSE
3592 RESTORE
3593 RETURN
4000 '**********************************************************************
4001 '*
4002 '* SUBROUTINE FUNCTION : GET DOS VERSION NUMBER
4003 '*
4004 '* VERSION             : 1.0
4005 '*
4006 '* DATE LAST UPDATED   : SEPT 25, 1983
4007 '*
4008 '* AUTHOR              : JAMES P MORGAN
4009 '*
4010 '* CALL FORMAT         :
4011 '* ---------------------
4012 '* CALL OFFSET%(MAJOR.VERSION%,MINOR.VERSION%,RETURN.CODE%)
4013 '*
4014 '* PARAMETERS PASSED   : MAJOR.VERSION%=0
4015 '*                       MINOR.VERSION%=0
4016 '*                       RETURN.CODE%=0
4017 '*
4018 '* PARAMETERS RETURNED : MAJOR.VERSION%  (MAJOR DOS VERSION NUMBER)
4019 '*                       MINOR.VERSION%  (MINOR DOS VERSION NUMBER)
4020 '*                       RETURN.CODE%
4021 '*
4022 '* COMMENTS           :
4023 '*                     IF THE MAJOR.VERSION% RETURNS ZERO(0), IT IS
4024 '*                    ASSUMED THAT THIS IS A PRE-DOS 2.0 SYSTEM.
4025 '*
4026 '**************************************************************************
4027 CLS
4028 CLOSE
4029 DEF SEG
4030 DEFINT A-Z
4031 DIM SUBRT%(40)
4032 OFFSET%=0
4033 MAJOR.VERSION%=0
4034 MINOR.VERSION%=0
4035 RETURN.CODE%=0
4036 GOSUB 4064
4037 GOSUB 4044
4038 OFFSET%=VARPTR(SUBRT%(0))
4039 CALL OFFSET%(MAJOR.VERSION%,MINOR.VERSION%,RETURN.CODE%)
4040 PRINT "MAJOR.VERSION     = ";MAJOR.VERSION%
4041 PRINT "MINOR VERSION     = ";MINOR.VERSION%
4042 PRINT "RETURN CODE       = ";RETURN.CODE%
4043 END
4044 RESTORE
4045 FOR I=0 TO 27
4046 READ J
4047 POKE (VARPTR(SUBRT%(0))+I),J
4048 NEXT
4049 RETURN
4050 DATA &H55
4051 DATA &H89,&HE5
4052 DATA &HB4,&H30
4053 DATA &HCD,&H21
4054 DATA &H8B,&H76,&H0A
4055 DATA &H88,&H04
4056 DATA &H8B,&H76,&H08
4057 DATA &H88,&H24
4058 DATA &H8B,&H76,&H06
4059 DATA &H31,&HDB
4060 DATA &H89,&H1C
4061 DATA &H5D
4062 DATA &HCA,&H06,&H00
4063 END
4064 RESTORE
4065 FILENAME$="A:"+"DOSVER.EMU"
4066 PGM.LEN=27
4067 OPEN FILENAME$ AS #1 LEN=1
4068 FIELD #1, 1 AS PGM.BYTE$
4069 FOR I=0 TO PGM.LEN
4070 READ J
4071 LSET PGM.BYTE$=CHR$(J)
4072 PUT #1
4073 NEXT
4074 CLOSE
4075 RESTORE
4076 RETURN
4500 '**********************************************************************
4501 '*
4502 '* SUBROUTINE FUNCTION : GET DISK FREE SPACE
4503 '*
4504 '* VERSION             : 1.0
4505 '*
4506 '* DATE LAST UPDATED   : SEPT 25, 1983
4507 '*
4508 '* AUTHOR              : JAMES P MORGAN
4509 '*
4510 '* CALL FORMAT         :
4511 '* ---------------------
4512 '* CALL OFFSET%(DRIVE%,NUM.ALLOC.UNITS%,NUM.SEC.PER.UNIT%,SECTOR.SIZE%,AVAIL.CLUSTERS%,RETURN.CODE%)
4513 '*
4514 '* PARAMETERS PASSED   : DRIVE%                (0=DEFAULT,1=A,2=B..ECT)
4515 '*                       NUM.ALLOC.UNITS%=0
4516 '*                       NUM.SEC.PER.UNIT%=0
4517 '*                       SECTOR.SIZE%=0
4518 '*                       AVAIL.CLUSTERS%=0
4519 '*                       RETURN.CODE%=0
4520 '*
4521 '* PARAMETERS RETURNED : DRIVE%
4522 '*                       NUM.ALLOC.UNITS%      (TOTAL CLUSTERS ON THE
4523 '*                                             DRIVE)
4524 '*
4525 '*                       NUM.SEC.PER.UNIT%     (NUMBER OF SECTORS PER
4526 '*                                             CLUSTER)
4527 '*
4528 '*                       SECTOR.SIZE%          (BYTES PER SECTOR)
4529 '*
4530 '*                       AVAIL.CLUSTERS%       (NUMBER OF AVAILABLE CLUSTERS)
4531 '*
4532 '*                       RETURN.CODE%          (255=INVALID DRIVE)
4533 '*
4534 '*
4535 '* COMMENTS           :
4536 '*                     THIS DOS FUNCTION CALL RETURNS THE SANE INFO
4537 '*                    (EXCEPT FOR THE FAT POINTER) AS THE GET FAT POINTER
4538 '*                    CALL (1BH) DID UNDER PREVIOUS VERSIONS OF DOS.
4539 '**************************************************************************
4540 CLS
4541 CLOSE
4542 DEF SEG
4543 DEFINT A-Z
4544 DIM SUBRT%(40)
4545 OFFSET%=0
4546 DRIVE%=1
4547 NUM.ALLOC.UNITS%=0
4548 NUM.SEC.PER.UNIT%=0
4549 SECTOR.SIZE%=0
4550 AVAIL.CLUSTERS%=0
4551 RETURN.CODE%=0
4552 GOSUB 4596
4553 GOSUB 4564
4554 OFFSET%=VARPTR(SUBRT%(0))
4555 CALL OFFSET%(DRIVE%,NUM.ALLOC.UNITS%,NUM.SEC.PER.UNIT%,SECTOR.SIZE%,AVAIL.CLUSTERS%,RETURN.CODE%)
4556 PRINT "DRIVE REQUESTED   = ";DRIVE%
4557 PRINT "ALLOC CLUSTERS    = ";NUM.ALLOC.UNITS%
4558 PRINT "SECTORS PER CLUSTE= ";NUM.SEC.PER.UNIT%
4559 PRINT "BYTES PER SECTOR  = ";SECTOR.SIZE%
4560 PRINT "AVAIL. CLUSTERS   = ";AVAIL.CLUSTERS%
4561 PRINT "FREE SPACE        = ";SECTOR.SIZE%*NUM.SEC.PER.UNIT%*AVAIL.CLUSTERS%
4562 PRINT "RETURN CODE       = ";RETURN.CODE%
4563 END
4564 RESTORE
4565 FOR I=0 TO 60
4566 READ J
4567 POKE (VARPTR(SUBRT%(0))+I),J
4568 NEXT
4569 RETURN
4570 DATA &H55
4571 DATA &H89,&HE5
4572 DATA &H31,&HC0
4573 DATA &H31,&HDB
4574 DATA &H31,&HC9
4575 DATA &H31,&HD2
4576 DATA &H8B,&H76,&H10
4577 DATA &H8A,&H14
4578 DATA &HB4,&H36
4579 DATA &HCD,&H21
4580 DATA &H8B,&H76,&H0E
4581 DATA &H88,&H14
4582 DATA &H88,&H74,&H01
4583 DATA &H8B,&H76,&H0C
4584 DATA &H88,&H04
4585 DATA &H88,&H64,&H01
4586 DATA &H8B,&H76,&H0A
4587 DATA &H88,&H0C
4588 DATA &H88,&H6C,&H01
4589 DATA &H8B,&H76,&H08
4590 DATA &H88,&H1C
4591 DATA &H88,&H7C,&H01
4592 DATA &H8B,&H76,&H06
4593 DATA &H89,&H04
4594 DATA &H5D
4595 DATA &HCA,&H0C,&H00
4596 RESTORE
4597 FILENAME$="A:"+"FREESPAC.EMU"
4598 PGM.LEN=60
4599 OPEN FILENAME$ AS #1 LEN=1
4600 FIELD #1, 1 AS PGM.BYTE$
4601 FOR I=0 TO PGM.LEN
4602 READ J
4603 LSET PGM.BYTE$=CHR$(J)
4604 PUT #1
4605 NEXT
4606 CLOSE
4607 RESTORE
4608 RETURN
5000 '**********************************************************************
5001 '*
5002 '* SUBROUTINE FUNCTION : CHANGE/CREATE/REMOVE A DIRECTORY
5003 '*
5004 '* VERSION             : 1.0
5005 '*
5006 '* DATE LAST UPDATED   : SEPT 25, 1983
5007 '*
5008 '* AUTHOR              : JAMES P MORGAN
5009 '*
5010 '* CALL FORMAT         :
5011 '* ---------------------
5012 '* CALL OFFSET%(FUNCTION.CALL%,ASCIIZ.STRING$,RETURN.CODE%)
5013 '*
5014 '* PARAMETERS PASSED   : FUNCTION.CALL%        (&H39 - MKDIR
5015 '*                                              &H3A - RMDIR
5016 '*                                              &H3B - CHDIR)
5017 '*
5018 '*                       ASCIIZ.STRING$        (THE ASCII STRING  OF THE
5019 '*                                             DIRECTORY TO BE USED)
5020 '*
5021 '*                       RETURN.CODE%=0
5022 '*
5023 '* PARAMETERS RETURNED : FUNCTION.CALL%
5024 '*                       ASCIIZ.STRING$
5025 '*                       RETURN.CODE%          (SEE ERROR CODE LIST)
5026 '*
5027 '*
5028 '* COMMENTS           :
5029 '*
5030 '* EACH OF THE DIRECTORY MAINTENANCE FUNCTIONS ARE DISCUSSED SEPARATELY
5031 '*
5032 '*         MKDIR   ------------- CREATE A DIRECTORY
5033 '*
5034 '*                THE ASCIIZ STRING CONTAINS THE DRIVE AND DIRECTORY
5035 '*               PATH NAMES. IF ANY MEMBER OF THE DIRECTORY PATH DOES NOT
5036 '*               EXIST THEN THE DIRECTORY PATH IS NOT CHANGED. ON RETURN
5037 '*               A NEW DIRECTORY IS CREATED AT THE END OF THE SPECIFIED
5038 '*               PATH.
5039 '*
5040 '*         RMDIR   ------------- REMOVE A SUB-DIRECTORY
5041 '*
5042 '*                THE ASCIIZ STRING CONTAINS THE DRIVE AND DIRECTORY
5043 '*               PATH NAMES. THE SPECIFIED DIRECTORY IS REMOVED FROM THE
5044 '*               STRUCTURE. THE CURRENT DIRECTORY CANNOT BE REMOVED.
5045 '*
5046 '*         CHDIR   ------------- CHANGE THE CURRENT DIRECTORY
5047 '*
5048 '*                THE ASCIIZ STRING CONTAINS THE DRIVE AND DIRECTORY
5049 '*               PATH NAMES. IF ANY MEMBER OF THE DIRECTORY DOES NOT EXIST
5050 '*               THEN THE DIRECTORY PATH IS NOT CHANGED.
5051 '*
5052 '*************************************************************************
5053 CLS
5054 CLOSE
5055 DEF SEG
5056 DEFINT A-Z
5057 DIM SUBRT%(40)
5058 OFFSET%=0
5059 FUNCTION.CALL%=&H3B
5060 FUNCTION.TYPE$=""
5061 PATH.NAME$="C:\EMULATOR"
5062 ASCIIZ.STRING$=PATH.NAME$+CHR$(0)
5063 RETURN.CODE%=0
5064 GOSUB 5099
5065 GOSUB 5076
5066 OFFSET%=VARPTR(SUBRT%(0))
5067 CALL OFFSET%(FUNCTION.CALL%,ASCIIZ.STRING$,RETURN.CODE%)
5068 IF FUNCTION.CALL%=&H39 THEN FUNCTION.TYPE$="CREATE A SUB-DIRECTORY"
5069 IF FUNCTION.CALL%=&H3A THEN FUNCTION.TYPE$="REMOVE A DIRECTORY"
5070 IF FUNCTION.CALL%=&H3B THEN FUNCTION.TYPE$="CHANGE THE CURRENT DIRECTORY"
5071 PRINT "FUNCTION CALL CODE= ";FUNCTION.CALL%
5072 PRINT "FUNCTION TYPE     = ";FUNCTION.TYPE$
5073 PRINT "PATH IS           = ";PATH.NAME$
5074 PRINT "RETURN CODE       = ";RETURN.CODE%
5075 END
5076 RESTORE
5077 FOR I=0 TO 30
5078 READ J
5079 POKE (VARPTR(SUBRT%(0))+I),J
5080 NEXT
5081 RETURN
5082 DATA &H55
5083 DATA &H89,&HE5
5084 DATA &H31,&HC0
5085 DATA &H8B,&H76,&H0A
5086 DATA &H8A,&H24
5087 DATA &H8B,&H76,&H08
5088 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER
5089 DATA &H8B,&H54,&H01
5090 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER
5091 'DATA &H8B,&H54,&H02
5092 DATA &HCD,&H21
5093 DATA &H72,&H02
5094 DATA &H30,&HC0
5095 DATA &H8B,&H76,&H06
5096 DATA &H88,&H04
5097 DATA &H5D
5098 DATA &HCA,&H06,&H00
5099 RESTORE
5100 FILENAME$="A:"+"DIRMAINT.EMU"
5101 PGM.LEN=30
5102 OPEN FILENAME$ AS #1 LEN=1
5103 FIELD #1, 1 AS PGM.BYTE$
5104 FOR I=0 TO PGM.LEN
5105 READ J
5106 LSET PGM.BYTE$=CHR$(J)
5107 PUT #1
5108 NEXT
5109 CLOSE
5110 RESTORE
5111 RETURN
5500 '**********************************************************************
5501 '*
5502 '* SUBROUTINE FUNCTION : GET/SET CURRENT DEFAULT DISK DRIVE
5503 '*
5504 '* VERSION             : 1.0
5505 '*
5506 '* DATE LAST UPDATED   : SEPT 25, 1983
5507 '*
5508 '* AUTHOR              : JAMES P MORGAN
5509 '*
5510 '* CALL FORMAT         :
5511 '* ---------------------
5512 '* CALL OFFSET%(DRIVE%,LOGICAL.DRIVES%,RETURN.CODE%)
5513 '*
5514 '* PARAMETERS PASSED   : DRIVE%                (0=A,2=B..ECT)
5515 '*                       LOGICAL.DRIVES%=0
5516 '*                       RETURN.CODE%=0
5517 '*
5518 '* PARAMETERS RETURNED : DRIVE%
5519 '*                       LOGICAL.DRIVES%       (0-MAX LOGICAL DRIVES)
5520 '*                       RETURN.CODE%          (CURRENT DEFAULT DRIVE)
5521 '*
5522 '*
5523 '* COMMENTS           :
5524 '*                     THIS SUBROUTINE WILL ASSIGN, DRIVE%, AS THE
5525 '*                    DEFAULT DRIVE (IF VALID). THE NUMBER OF LOGICAL
5526 '*                    DRIVES (TOTAL DISKETTE AND FIXED) ARE RETURNED.
5527 '*                     IF THE SYSTEM HAS ONLY ONE DISKETTE DRIVE, IT WILL
5528 '*                    BE COUNTED AS TWO TO BE CONSISTANT WITH THE
5529 '*                    PHILOSOPHY OF THINKING OF THE SYSTEM AS HAVING
5530 '*                    LOGICAL DRIVES "A" AND "B".
5531 '*                     AS A SIDE EFFECT, IF YOU GIVE THIS SUBROUTINE
5532 '*                    AN INVALID DRIVE (255), IT WILL ONLY RETURN THE
5533 '*                    CURRENT DEFAULT DRIVE SO YOU DO NOT NEED TO DO
5534 '*                    A DOS FUNCTION CALL &H19, CURRENT DISK.
5535 '*
5536 '*                      BIOS EQUIPMENT CHECK DETERMINATION (INT 11H)
5537 '*                    CAN BE USED TO DETERMINE THE NUMBER OF ACTUAL
5538 '*                    PHYSICAL DRIVES.
5539 '*
5540 '*************************************************************************
5541 CLS
5542 CLOSE
5543 DEF SEG
5544 DEFINT A-Z
5545 DIM SUBRT%(40)
5546 OFFSET%=0
5547 DRIVE%=0
5548 LOGICAL.DRIVES%=0
5549 RETURN.CODE%=0
5550 GOSUB 5578
5551 GOSUB 5558
5552 OFFSET%=VARPTR(SUBRT%(0))
5553 CALL OFFSET%(DRIVE%,LOGICAL.DRIVES%,RETURN.CODE%)
5554 PRINT "DEFAULT REQUESTED = ";DRIVE%
5555 PRINT "LOGICAL DRIVES    = ";LOGICAL.DRIVES%
5556 PRINT "NEW DEFAULT DRIVE = ";RETURN.CODE%
5557 END
5558 RESTORE
5559 FOR I=0 TO 29
5560 READ J
5561 POKE (VARPTR(SUBRT%(0))+I),J
5562 NEXT
5563 RETURN
5564 DATA &H55
5565 DATA &H89,&HE5
5566 DATA &H8B,&H76,&H0A
5567 DATA &H8A,&H14
5568 DATA &HB4,&H0E
5569 DATA &HCD,&H21
5570 DATA &H8B,&H76,&H08
5571 DATA &H88,&H04
5572 DATA &HB4,&H19
5573 DATA &HCD,&H21
5574 DATA &H8B,&H76,&H06
5575 DATA &H88,&H04
5576 DATA &H5D
5577 DATA &HCA,&H06,&H00
5578 RESTORE
5579 FILENAME$="A:"+"DRIVEDEF.EMU"
5580 PGM.LEN=29
5581 OPEN FILENAME$ AS #1 LEN=1
5582 FIELD #1, 1 AS PGM.BYTE$
5583 FOR I=0 TO PGM.LEN
5584 READ J
5585 LSET PGM.BYTE$=CHR$(J)
5586 PUT #1
5587 NEXT
5588 CLOSE
5589 RESTORE
5590 RETURN
6000 '**********************************************************************
6001 '*
6002 '* SUBROUTINE FUNCTION : GET CURRENT DIRECTORY
6003 '*
6004 '* VERSION             : 1.0
6005 '*
6006 '* DATE LAST UPDATED   : SEPT 25, 1983
6007 '*
6008 '* AUTHOR              : JAMES P MORGAN
6009 '*
6010 '* CALL FORMAT         :
6011 '* ---------------------
6012 '* CALL OFFSET%(DRIVE%,ASCIIZ.STRING$,RETURN.CODE%)
6013 '*
6014 '* PARAMETERS PASSED   : DRIVE%                (0=DEFAULT,1=A,2=B..ECT)
6015 '*                       ASCIIZ.STRING$        (AT LEAST A 64 BYTE
6016 '*                                             CHARACTER STRING RETURN
6017 '*                                             AREA)
6018 '*
6019 '*                       RETURN.CODE%=0
6020 '*
6021 '* PARAMETERS RETURNED : DRIVE%
6022 '*                       ASCIIZ.STRING$        (CURRENT DIRECTORY)
6023 '*                       RETURN.CODE%          (SEE ERROR CODE LIST)
6024 '*
6025 '*
6026 '* COMMENTS           :
6027 '*                     THIS SUBROUTINE WILL RETURN THE CURRENT DIRECTORY
6028 '*                    FOR THE SPECIFIED DRIVE. THE FULL PATH NAME ,
6029 '*                    STARTING WITH THE ROOT DIRECTORY IS RETURNED.
6030 '*                     THE DRIVE LETTER WILL NOT BE PART OF THE RETURNED
6031 '*                    STRING. THE STRING WILL NOT BEGIN WITH THE "\" AND
6032 '*                    WILL BE TERMINATED WITH A BYTE CONTAINING A HEX 00.
6033 '*
6034 '*************************************************************************
6035 CLS
6036 CLOSE
6037 DEF SEG
6038 DEFINT A-Z
6039 DIM SUBRT%(40)
6040 OFFSET%=0
6041 DRIVE%=0
6042 ASCIIZ.STRING$=STRING$(80,0)
6043 CURRENT.DIRECTORY$=""
6044 RETURN.CODE%=0
6045 GOSUB 6079
6046 GOSUB 6057
6047 OFFSET%=VARPTR(SUBRT%(0))
6048 CALL OFFSET%(DRIVE%,ASCIIZ.STRING$,RETURN.CODE%)
6049 IF RETURN.CODE%<>0 THEN CURRENT.DIRECTORY$="INVALID DRIVE SPECIFIED":GOTO 6053
6050 INSTR.LOC=INSTR(ASCIIZ.STRING$,CHR$(0))
6051 IF INSTR.LOC<2 THEN CURRENT.DIRECTORY$="\":GOTO 6053
6052 CURRENT.DIRECTORY$="\"+LEFT$(ASCIIZ.STRING$,INSTR.LOC-1)
6053 PRINT "DRIVE REQUESTED   = ";DRIVE%
6054 PRINT "CURRENT DIRECTORY = ";CURRENT.DIRECTORY$
6055 PRINT "RETURN CODE       = ";RETURN.CODE%
6056 END
6057 RESTORE
6058 FOR I=0 TO 28
6059 READ J
6060 POKE (VARPTR(SUBRT%(0))+I),J
6061 NEXT
6062 RETURN
6063 DATA &H55
6064 DATA &H89,&HE5
6065 DATA &H8B,&H76,&H0A
6066 DATA &H8A,&H14
6067 DATA &H8B,&H5E,&H08
6068 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER
6069 DATA &H8B,&H77,&H01
6070 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER
6071 'DATA &H8B,&H77,&H02
6072 DATA &H31,&HC0
6073 DATA &HB4,&H47
6074 DATA &HCD,&H21
6075 DATA &H8B,&H76,&H06
6076 DATA &H88,&H04
6077 DATA &H5D
6078 DATA &HCA,&H06,&H00
6079 RESTORE
6080 FILENAME$="A:"+"DIRCURR.EMU"
6081 PGM.LEN=28
6082 OPEN FILENAME$ AS #1 LEN=1
6083 FIELD #1, 1 AS PGM.BYTE$
6084 FOR I=0 TO PGM.LEN
6085 READ J
6086 LSET PGM.BYTE$=CHR$(J)
6087 PUT #1
6088 NEXT
6089 CLOSE
6090 RESTORE
6091 RETURN
6500 '**********************************************************************
6501 '*
6502 '* SUBROUTINE FUNCTION : RENAME A FILE
6503 '*
6504 '* VERSION             : 1.0
6505 '*
6506 '* DATE LAST UPDATED   : SEPT 25, 1983
6507 '*
6508 '* AUTHOR              : JAMES P MORGAN
6509 '*
6510 '* CALL FORMAT         :
6511 '* ---------------------
6512 '* CALL OFFSET%(ASCIIZ.STRING1$,ASCIIZ.STRING2$,RETURN.CODE%)
6513 '*
6514 '* PARAMETERS PASSED   : ASCIIZ.STRING1$       (THE ASCII STRING  OF THE
6515 '*                                             CURRENT FILE NAME)
6516 '*
6517 '*                       ASCIIZ.STRING2$       (THE ASCII STRING  OF THE
6518 '*                                             NEW FILE NAME)
6519 '*
6520 '*                       RETURN.CODE%=0
6521 '*
6522 '* PARAMETERS RETURNED : ASCIIZ.STRING1$
6523 '*                       ASCIIZ.STRING2$
6524 '*                       RETURN.CODE%          (SEE ERROR CODE LIST)
6525 '*
6526 '*
6527 '* COMMENTS           :
6528 '*                     THIS SUBROUTINE WILL RENAME A DIRECTORY ENTRY
6529 '*                    ASSOCIATED WITH A FILE NAME.
6530 '*                     THE ASCIIZ.STRING CONSISTS OF A DRIVE, PATH AND
6531 '*                    FILE NAME .GLOBAL FILE NAME CHARACTERS ARE NOT
6532 '*                    ALLOWED IN ANY PART OF THE STRING.
6533 '*                     IF A DRIVE IS SPECIFIED IN THE SECOND STRING, IT
6534 '*                    MUST BE THE SAME AS THE DRIVE SPECIFIED OR IMPLIED
6535 '*                    IN THE FIRST STRING. THE DIRECTORY PATHS NEED NOT BE
6536 '*                    THE SAME, ALLOWING A FILE TO BE MOVED TO ANOTHER
6537 '*                    DIRECTORY AND RENAMED IN THE PROCESS.
6538 '*
6539 '*
6540 '*************************************************************************
6541 CLS
6542 CLOSE
6543 DEF SEG
6544 DEFINT A-Z
6545 DIM SUBRT%(40)
6546 OFFSET%=0
6547 ASCIIZ.STRING2$="A:\CNTLBRK.EMU"+CHR$(0)
6548 ASCIIZ.STRING1$="A:\CNTLBRAK.EMU"+CHR$(0)
6549 RETURN.CODE%=0
6550 GOSUB 6587
6551 GOSUB 6558
6552 OFFSET%=VARPTR(SUBRT%(0))
6553 CALL OFFSET%(ASCIIZ.STRING1$,ASCIIZ.STRING2$,RETURN.CODE%)
6554 PRINT "OLD FILE NAME     = ";LEFT$(ASCIIZ.STRING1$,LEN(ASCIIZ.STRING1$)-1)
6555 PRINT "NEW FILE NAME     = ";LEFT$(ASCIIZ.STRING2$,LEN(ASCIIZ.STRING2$)-1)
6556 PRINT "RETURN CODE       = ";RETURN.CODE%
6557 END
6558 RESTORE
6559 FOR I=0 TO 37
6560 READ J
6561 POKE (VARPTR(SUBRT%(0))+I),J
6562 NEXT
6563 RETURN
6564 DATA &H55
6565 DATA &H89,&HE5
6566 DATA &H31,&HC0
6567 DATA &H31,&HD2
6568 DATA &H31,&HFF
6569 DATA &H8B,&H76,&H0A
6570 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER
6571 DATA &H8B,&H54,&H01
6572 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER
6573 'DATA &H8B,&H54,&H02
6574 DATA &H8B,&H76,&H08
6575 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER
6576 DATA &H8B,&H7C,&H01
6577 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER
6578 'DATA &H8B,&H7C,&H02
6579 DATA &HB4,&H56
6580 DATA &HCD,&H21
6581 DATA &H72,&H02
6582 DATA &H30,&HC0
6583 DATA &H8B,&H76,&H06
6584 DATA &H88,&H04
6585 DATA &H5D
6586 DATA &HCA,&H06,&H00
6587 RESTORE
6588 FILENAME$="A:"+"RENFILE.EMU"
6589 PGM.LEN=37
6590 OPEN FILENAME$ AS #1 LEN=1
6591 FIELD #1, 1 AS PGM.BYTE$
6592 FOR I=0 TO PGM.LEN
6593 READ J
6594 LSET PGM.BYTE$=CHR$(J)
6595 PUT #1
6596 NEXT
6597 CLOSE
6598 RESTORE
6599 RETURN
7000 '**********************************************************************
7001 '*
7002 '* SUBROUTINE FUNCTION : DELETE A FILE FROM A SPECIFIC DIRECTORY (UNLINK)
7003 '*
7004 '* VERSION             : 1.0
7005 '*
7006 '* DATE LAST UPDATED   : SEPT 25, 1983
7007 '*
7008 '* AUTHOR              : JAMES P MORGAN
7009 '*
7010 '* CALL FORMAT         :
7011 '* ---------------------
7012 '* CALL OFFSET%(ASCIIZ.STRING$,RETURN.CODE%)
7013 '*
7014 '* PARAMETERS PASSED   : ASCIIZ.STRING$        (THE ASCII STRING  OF THE
7015 '*                                             FILE TO BE DELETED)
7016 '*
7017 '*                       RETURN.CODE%=0
7018 '*
7019 '* PARAMETERS RETURNED : ASCIIZ.STRING$
7020 '*                       RETURN.CODE%          (SEE ERROR CODE LIST)
7021 '*
7022 '*
7023 '* COMMENTS           :
7024 '*                     THIS SUBROUTINE WILL REMOVE A DIRECTORY ENTRY
7025 '*                    ASSOCIATED WITH A FILE NAME.
7026 '*                     THE ASCIIZ.STRING CONSISTS OF A DRIVE, PATH AND
7027 '*                    FILE NAME .GLOBAL FILE NAME CHARACTERS ARE NOT
7028 '*                    ALLOWED IN ANY PART OF THE STRING.
7029 '*                     READ-ONLY FILES CANNOT BE DELETED WITH THIS CALL.
7030 '*                    TO DELETE ONE OF THESE FILES, FIRST USE AN INT 43H
7031 '*                    CALL (OR THE CHANGE MODE SUBROUTINE INCLUDED WITH
7032 '*                    THIS SERIES OF SUBROUTINES) TO CHANGE THE FILES
7033 '*                    ATTRIBUTE TO ZERO(0) , THEN DELETE THE FILE.
7034 '*************************************************************************
7035 CLS
7036 CLOSE
7037 DEF SEG
7038 DEFINT A-Z
7039 DIM SUBRT%(40)
7040 OFFSET%=0
7041 ASCIIZ.STRING$="C:\CNTLBRK.EMU"+CHR$(0)
7042 RETURN.CODE%=0
7043 GOSUB 7073
7044 GOSUB 7050
7045 OFFSET%=VARPTR(SUBRT%(0))
7046 CALL OFFSET%(ASCIIZ.STRING$,RETURN.CODE%)
7047 PRINT "DELETED FILE NAME = ";LEFT$(ASCIIZ.STRING$,LEN(ASCIIZ.STRING$)-1)
7048 PRINT "RETURN CODE       = ";RETURN.CODE%
7049 END
7050 RESTORE
7051 FOR I=0 TO 29
7052 READ J
7053 POKE (VARPTR(SUBRT%(0))+I),J
7054 NEXT
7055 RETURN
7056 DATA &H55
7057 DATA &H89,&HE5
7058 DATA &H31,&HC0
7059 DATA &H31,&HD2
7060 DATA &H8B,&H76,&H08
7061 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER
7062 DATA &H8B,&H54,&H01
7063 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER
7064 'DATA &H8B,&H54,&H02
7065 DATA &HB4,&H41
7066 DATA &HCD,&H21
7067 DATA &H72,&H02
7068 DATA &H30,&HC0
7069 DATA &H8B,&H76,&H06
7070 DATA &H88,&H04
7071 DATA &H5D
7072 DATA &HCA,&H04,&H00
7073 RESTORE
7074 FILENAME$="A:"+"DELFILE.EMU"
7075 PGM.LEN=29
7076 OPEN FILENAME$ AS #1 LEN=1
7077 FIELD #1, 1 AS PGM.BYTE$
7078 FOR I=0 TO PGM.LEN
7079 READ J
7080 LSET PGM.BYTE$=CHR$(J)
7081 PUT #1
7082 NEXT
7083 CLOSE
7084 RESTORE
7085 RETURN
7500 '**********************************************************************
7501 '*
7502 '* SUBROUTINE FUNCTION : CHANGE A FILE'S MODE (ATTRIBUTE)
7503 '*
7504 '* VERSION             : 1.0
7505 '*
7506 '* DATE LAST UPDATED   : SEPT 25, 1983
7507 '*
7508 '* AUTHOR              : JAMES P MORGAN
7509 '*
7510 '* CALL FORMAT         :
7511 '* ---------------------
7512 '* CALL OFFSET%(FUNCTION.CODE%,ATTRIBUTE%,ASCIIZ.STRING$,RETURN.CODE%)
7513 '*
7514 '* PARAMETERS PASSED   : FUNCTION.CODE%        (00=RETURN ATTRIBUTE
7515 '*                                              01=CHANGE ATTRIBUTE
7517 '*
7518 '*                       ATTRIBUTE%            (FILE ATTRIBUTE)
7519 '*
7520 '*                       ASCIIZ.STRING$        (THE ASCII STRING  OF THE
7521 '*                                             FILE)
7522 '*
7523 '*                       RETURN.CODE%=0
7524 '*
7525 '* PARAMETERS RETURNED : FUNCTION.CODE%
7526 '*                       ATTRIBUTE%            (FILE ATTRIBUTE)
7527 '*                       ASCIIZ.STRING$
7528 '*                       RETURN.CODE%          (SEE ERROR CODE LIST)
7529 '*
7530 '*
7531 '* COMMENTS           :
7532 '*                     IF THE FUNCTION.CODE% IS SET TO 00 THEN THE FILES
7533 '*                    CURRENT ATTRIBUTE WILL BE RETURNED, ELSE IF THE
7534 '*                    FUNCTION.CODE% IS SET TO 01, THE FILE'S ATTRIBUTE
7535 '*                    WILL BE CHANGED TO THE ATTRIBUTE% PASSED TO THE
7536 '*                    SUBROUTINE.
7537 '*                     THE ASCIIZ STRING CONSISTS OF THE DRIVE, PATH, AND
7538 '*                    FILENAME.
7539 '*                     SEEMS THAT THIS DOS FUNCTION CALL WILL NOT LET YOU
7540 '*                    CHANGE A FILES MODE TO THAT OF A VOLUME LABEL (&H8).
7541 '*
7542 '*
7543 '*************************************************************************
7544 '*
7545 '*************** FILE ATTRIBUTE BYTES - VALUES IN HEXADECIMAL ***********
7546 '*
7547 '*            01H - FILE IS READ ONLY          (CAN BE USED WITH OTHERS)
7548 '*            02H - HIDDEN FILE
7549 '*            04H - SYSTEM FILE
7550 '*            08H - VOLUME LABEL               (ONLY FIRST 11 CHARACTERS)
7551 '*            10H - SUB-DIRECTORY ENTRY
7552 '*            20H - ARCHIVE BIT                (CAN BE USED WITH OTHERS
7553 '*                                  SET WHEN FILE WRITTEN TO AND CLOSED)
7554 CLS
7555 CLOSE
7556 DEF SEG
7557 DEFINT A-Z
7558 DIM SUBRT%(40)
7559 OFFSET%=0
7560 FUNCTION.CODE%=1
7561 ATTRIBUTE%=0
7562 ATTRIBUTE.SENT%=ATTRIBUTE%
7563 PATH.NAME$="C:DOSVER.EMU"
7564 ASCIIZ.STRING$=PATH.NAME$+CHR$(0)
7565 RETURN.CODE%=0
7566 GOSUB 7606
7567 GOSUB 7576
7568 OFFSET%=VARPTR(SUBRT%(0))
7569 CALL OFFSET%(FUNCTION.CODE%,ATTRIBUTE%,ASCIIZ.STRING$,RETURN.CODE%)
7570 PRINT "FUNCTION REQUESTED= ";FUNCTION.CODE%
7571 PRINT "FILE PATH         = ";PATH.NAME$
7572 PRINT "ATTRIBUTE SENT    = ";ATTRIBUTE.SENT%
7573 PRINT "ATTRIBUTE RETURNED= ";ATTRIBUTE%
7574 PRINT "RETURN CODE       = ";RETURN.CODE%
7575 END
7576 RESTORE
7577 FOR I=0 TO 46
7578 READ J
7579 POKE (VARPTR(SUBRT%(0))+I),J
7580 NEXT
7581 RETURN
7582 DATA &H55
7583 DATA &H89,&HE5
7584 DATA &H31,&HC0
7585 DATA &H31,&HC9
7586 DATA &H31,&HD2
7587 DATA &H8B,&H76,&H0C
7588 DATA &H8A,&H04
7589 DATA &H8B,&H76,&H08
7590 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC COMPILER
7591 DATA &H8B,&H54,&H01
7592 '********COMMENT OUT THE FOLLOWING DATA STATEMENT IF USED WITH THE BASIC INTERPRETER
7593 'DATA &H8B,&H54,&H02
7594 DATA &H8B,&H76,&H0A
7595 DATA &H8B,&H0C
7596 DATA &HB4,&H43
7597 DATA &HCD,&H21
7598 DATA &H72,&H02
7599 DATA &H30,&HC0
7600 DATA &H8B,&H76,&H06
7601 DATA &H88,&H04
7602 DATA &H8B,&H76,&H0A
7603 DATA &H89,&H0C
7604 DATA &H5D
7605 DATA &HCA,&H08,&H00
7606 RESTORE
7607 FILENAME$="A:"+"CHNGMODE.EMU"
7608 PGM.LEN=46
7609 OPEN FILENAME$ AS #1 LEN=1
7610 FIELD #1, 1 AS PGM.BYTE$
7611 FOR I=0 TO PGM.LEN
7612 READ J
7613 LSET PGM.BYTE$=CHR$(J)
7614 PUT #1
7615 NEXT
7616 CLOSE
7617 RESTORE
7618 RETURN