I just came across the files from some 5.25-inch floppy disks I was using back in the late 1980s.
One of them had the compiled program and QuickBASIC 4.0 source code that I wrote in 1987/1988 to set the AT CMOS RAM date and time, as well as the DOS date and time.
Surprise, surprise, it doesn't run on my current Windows 11 64-bit desktop PC.
' ATCLOCK: A program to set the AT CMOS RAM date and time
' and the DOS date and time.
'
' Written by: Lloyd Borrett, PC Connection Australia
'
' Revision 1.00 - November 1987
'
' Revision 1.01 - February 1988
' Conversion to QuickBASIC 4.0.
' Now checks for DOS 3.00 or greater.
' Now checks for PC/AT type computer.
' Supports both / and - on command switches.
'
'
' Program command line has the following format:
'
' atclock [/d[=date]] [/t[=[time]] [/q] [/m|/c] [/h|?] [/i]
'
' Where:
' /d use the current dos date.
'
' /d=date use the given date.
'
' /t use the cureent dos time.
'
' /t=time use the given time.
'
' /q to run quietly (without display).
'
' /m force display for a monochrome or composite monitor.
'
' /c force display for a colour monitor.
'
' /h output program help.
'
' /i output program information.
'
'
' Note:
' All command line arguments must be separated by spaces.
'
' Examples:
' atclock - ask the user for the date and time
' atclock /d - set the rtc date to the current dos date
' atclock /t - set the rtc time to the current dos time
' atclock /d=21-04-1987 - set the rtc and dos date to the given date
'
' The program passes a return code on completion that can be tested in
' batch files as ERRORLEVEL.
'
' 0 program terminated normally.
'
' 1 program terminated abnormally.
'
' The program is written for the QuickBASIC compiler. It is compiled
' using the command QB ATCLOCK/O/E/Q;
'
' An assembler routine DOSINT is used. Thus to the command to link
' the program is LINK ATCLOCK+DOSINT;
'
'
' *** Initialize
'
DEFINT A-Z:FALSE=0:TRUE=NOT FALSE
DIM TIME.ARG$(10), DATE.ARG$(10)
PRGNAME$="ATCLOCK":VERS$="1.01 - Feb 88"
ERROR1$=" ":ERROR2$=" ":ERROR3$=" ":ERROR4$=" "
SETOUT$=SPACE$(5)
ON ERROR GOTO 19990
HELP=FALSE
INFORMATION=FALSE
QUIET=FALSE
ARG.DATE$=""
ARG.TIME$=""
DOS.DATE=FALSE
DOS.TIME=FALSE
COLOUR=FALSE:GOSUB 3000
'
' *** Main Control
'
GOSUB 2000 ' Process command line
IF NOT FOUND.SCREEN THEN
GOSUB 3100
END IF
IF HELP THEN
GOSUB 6000 ' Display the help
GOTO 1999
END IF
IF INFORMATION THEN ' Display program information
GOSUB 6500
GOTO 1999
END IF
GOSUB 3300 ' Check DOS version number
GOSUB 3400 ' Check the machine model type
GOSUB 3500 ' Get country infomation
IF ARG.DATE$="" AND ARG.TIME$="" AND DOS.DATE=FALSE AND DOS.TIME=FALSE THEN
GOSUB 5000 ' Ask user for date and time
ELSE
IF NOT QUIET THEN GOSUB 4000
IF DOS.DATE THEN GOSUB 5200 ' use dos date
IF ARG.DATE$<>"" THEN GOSUB 5600 ' use date argument
IF DOS.TIME THEN GOSUB 5400 ' use dos time
IF ARG.TIME$<>"" THEN GOSUB 5800 ' use time argument
END IF
1999 CALL ERRORSET.1(0) ' Legal finish - ERRORLEVEL 0
'
' *** Process the command line
'
2000 CLINE$=COMMAND$
LENGTH=LEN(CLINE$)
IF LENGTH<1 THEN RETURN
MAX=(LENGTH/2)+2:DIM ARG$(MAX)
CALL WRDGET(CLINE$," ",NUM,ARG$()) ' Split command line into args
FOUND.INFO=FALSE
FOUND.SCREEN=FALSE
FOUND.QUIET=FALSE
FOUND.DATE=FALSE
FOUND.TIME=FALSE
FOUND.DOS.DATE=FALSE
FOUND.DOS.TIME=FALSE
FOR I=1 TO NUM
II=LEN(ARG$(I))
SELECT CASE ARG$(I)
CASE "?", "/H", "-H" ' help
HELP=TRUE
CASE "/I", "-I" ' information
IF FOUND.INFO THEN 2210
FOUND.INFO=TRUE : INFORMATION=TRUE
CASE "/M", "-M" ' mono screen
IF FOUND.SCREEN THEN 2200
FOUND.SCREEN=TRUE : COLOUR=FALSE
CASE "/C", "-C" ' colour screen
IF FOUND.SCREEN THEN 2200
FOUND.SCREEN=TRUE : COLOUR=TRUE : GOSUB 3000
CASE "/T", "-T" ' dos time
IF FOUND.DOS.TIME OR FOUND.TIME THEN 2210
FOUND.DOS.TIME=TRUE : DOS.TIME=TRUE
CASE "/D", "-D" ' dos date
IF FOUND.DOS.DATE OR FOUND.DATE THEN 2210
FOUND.DOS.DATE=TRUE : DOS.DATE=TRUE
CASE "/Q", "-Q" ' verify
IF FOUND.QUIET THEN 2210
FOUND.QUIET=TRUE : QUIET=TRUE
CASE ELSE
IF II>3 THEN
TMPARG$=LEFT$(ARG$(I),3)
IF TMPARG$="/D=" OR TMPARG$="-D=" THEN ' date argument
IF FOUND.DATE OR FOUND.DOS.DATE THEN 2210
FOUND.DATE=TRUE : ARG.DATE$=RIGHT$(ARG$(I),II-3)
ELSE
IF TMPARG$="/T=" OR TMPARG$="-T=" THEN ' time argument
IF FOUND.TIME OR FOUND.DOS.TIME THEN 2210
FOUND.TIME=TRUE : ARG.TIME$=RIGHT$(ARG$(I),II-3)
ELSE
GOTO 2280 ' invalid argument
END IF
END IF
ELSE
GOTO 2280 ' invalid argument
END IF
END SELECT
NEXT I
RETURN
'
2200 ERROR1$="ILLEGAL MONITOR SPECIFIED"
ERROR2$="Two arguments given specify a monitor type."
GOTO 2290
2210 ERROR1$="ILLEGAL ARGUMENT COMBINATION"
ERROR2$=" "+ARG$(I)+" is a conflicting or redundant argument."
GOTO 2290
2280 ERROR1$="ILLEGAL ARGUMENT"
ERROR2$=" "+ARG$(I)+" is not a valid argument."
2290 ERROR3$="You have:"
ERROR4$=" "+PRGNAME$
FOR I=1 TO NUM:ERROR4$=ERROR4$+" "+ARG$(I):NEXT I
GOTO 19995
'
' *** Set colours in use
'
3000 IF COLOUR THEN
FG1=4:BG1=0 ' Title
FG2=2:BG2=0 ' Bar surround
FG3=14:BG3=0 ' Bar
FG4=3:BG4=0 ' Info titles
FG5=15:BG5=0 ' Info
FG6=3:BG6=0 ' Help
ELSE
FG1=7:BG1=0 ' Title
FG2=7:BG2=0 ' Bar surround
FG3=15:BG3=0 ' Bar
FG4=7:BG4=0 ' Info titles
FG5=15:BG5=0 ' Info
FG6=7:BG6=0 ' Help
END IF
RETURN
'
' *** Try to determine colour mode
'
3100 DEF SEG = 0 ' set DS register to 0
VIDEO.MODE=PEEK(&H449) ' look at location hex 449
IF VIDEO.MODE=1 OR VIDEO.MODE=3 THEN
COLOUR=TRUE:GOSUB 3000
END IF
RETURN
'
' *** Get MS-DOS Version number and check it.
'
3300 CALL GET.DOS(MAJOR,MINOR)
IF MAJOR>=3 THEN RETURN
ERROR1$="ILLEGAL MS-DOS VERSION"
ERROR2$=" "+PRGNAME$+" requires DOS 3.00 or greater."
ERROR3$="You have:"
ERROR4$=" MS/PC-DOS "+STR$(MAJOR)+"."+STR$(MINOR)
GOTO 19995
'
' *** Get machine model type and check it.
'
3400 CALL GET.MODEL(MODEL$)
IF MODEL$="PC/AT" THEN RETURN
ERROR1$="ILLEGAL SYSTEM MODEL"
ERROR2$=" "+PRGNAME$+" requires a PC/AT type computer."
ERROR3$="You have a "+MODEL$+" type computer."
GOTO 19995
'
' *** Get the country details
'
3500 COUNTRY=0 ' Get the default country
CALL GET.COUNTRY(COUNTRY,C.INFO$,C.ERR)
IF C.ERR<>0 THEN
COUNTRY=61 ' Default to Australia
DATE.FORMAT=1
DATE.SEP$="-"
TIME.SEP$=":"
TIME.FORMAT=1
ELSE
DATE.FORMAT=ASC(MID$(C.INFO$,1,1))
DATE.SEP$=MID$(C.INFO$,12,1)
TIME.SEP$=MID$(C.INFO$,14,1)
TIME.FORMAT=ASC(MID$(C.INFO$,18,1))
END IF
CALL DATE.TEMPLATE(DATE.FORMAT,DATE.SEP$,DATE.TEMP$)
CALL TIME.TEMPLATE(TIME.FORMAT,TIME.SEP$,TIME.TEMP$)
RETURN
'
' *** Display Titles
'
4000 PRINT
COLOR FG1,BG1
PRINT SETOUT$;"Lloyd Borrett's ";PRGNAME$;" Version ";VERS$
PRINT SETOUT$;"(C) Copyright PC Connection Australia 1987-1988."
PRINT
COLOR 7,0
RETURN
'
' *** Ask the user for the date and time to set the real time clock with
'
5000 CLS
GOSUB 4000 ' display the title
GOSUB 7200 ' display current date setting
PRINT
COLOR FG6,BG6
PRINT "If the current real time clock DATE is correct press ."
PRINT "If the current real time clock DATE is incorrect, type the new"
PRINT "date ";DATE.TEMP$;". Then press ."
PRINT
5010 COLOR FG5,BG5
DATE.CHANGED=FALSE
INPUT ARG.DATE$
COLOR 7,0
IF ARG.DATE$="" THEN 5100
GOSUB 8500 ' check the arg and split into values
IF DATE.ERR THEN
BEEP:PRINT
COLOR FG1,BG1
PRINT "*** Invalid date value. Please enter correctly."
PRINT
GOTO 5010
END IF
CALL DATE.FMT(DAY.NEW,MONTH.NEW,YEAR.NEW,DATE.FORMAT,DATE.SEP$,DATE.PRN$)
COLOR FG4,BG4
PRINT
PRINT "Your AT real time clock DATE and DOS DATE"
PRINT "will now be made the same as the given date: ";
GOSUB 7600
GOSUB 9500 ' Continue Y/N
IF OKAY THEN
CALL SET.RTC.DATE(DAY.NEW,MONTH.NEW,YEAR.NEW,RTC.ERR)
CALL DATE.FMT(DAY.NEW,MONTH.NEW,YEAR.NEW,0,"-",DATE.NEW$)
DATE$=DATE.NEW$
DATE.CHANGED=TRUE
ELSE
GOTO 5000
END IF
COLOR 7,0
5100 CLS
GOSUB 4000 ' display the title
GOSUB 7400 ' display current time setting
PRINT
COLOR FG6,BG6
PRINT "If the current real time clock TIME is correct press ."
PRINT "If the current real time clock TIME is incorrect, type the new"
PRINT "time hh";TIME.SEP$;"mm";TIME.SEP$;"ss. Then press ."
PRINT
COLOR FG3,BG3
PRINT "24 hour format is required."
COLOR FG6,BG6
PRINT
PRINT "(Example: 1:00:00 pm is equal to 13:00:00 in 24 hour format.)"
PRINT
5110 COLOR FG5,BG5
TIME.CHANGED=FALSE
INPUT ARG.TIME$
COLOR 7,0
IF ARG.TIME$="" THEN 5120
GOSUB 8000 ' check the arg and split into values
IF TIME.ERR THEN
BEEP:PRINT
COLOR FG1,BG1
PRINT "*** Invalid time value. Please enter correctly."
PRINT
GOTO 5110
END IF
CALL TIME.FMT(HOURS.NEW,MINUTES.NEW,SECONDS.NEW,TIME.FORMAT,TIME.SEP$,TIME.PRN$)
COLOR FG4,BG4
PRINT
PRINT "Your AT real time clock TIME and DOS TIME"
PRINT "will now be made the same as the given time: ";
GOSUB 7800
GOSUB 9500 ' Continue Y/N
IF OKAY THEN
CALL SET.RTC.TIME(HOURS.NEW,MINUTES.NEW,SECONDS.NEW,RTC.ERR)
CALL TIME.FMT(HOURS.NEW,MINUTES.NEW,SECONDS.NEW,1,":",TIME.NEW$)
TIME$=TIME.NEW$
TIME.CHANGED=TRUE
ELSE
GOTO 5100
END IF
5120 GOSUB 5150
COLOR 7,0
RETURN
'
' *** Tell them what has happened
'
5150 IF DATE.CHANGED OR TIME.CHANGED THEN
CLS
GOSUB 4000 ' display the title
IF DATE.CHANGED THEN
CALL DATEINT(DATE$,DAY,MONTH,YEAR)
CALL DATE.FMT(DAY,MONTH,YEAR,DATE.FORMAT,DATE.SEP$,DATE.PRN$)
COLOR FG4,BG4
PRINT
PRINT "Your AT real time clock DATE"
PRINT "and DOS DATE are now both set to: ";
GOSUB 7600
END IF
IF TIME.CHANGED THEN
CALL TIMEINT(TIME$,HOURS,MINUTES,SECONDS)
CALL TIME.FMT(HOURS,MINUTES,SECONDS,TIME.FORMAT,TIME.SEP$,TIME.PRN$)
COLOR FG4,BG4
PRINT
PRINT "Your AT real time clock TIME"
PRINT "and DOS TIME are now both set to: ";
GOSUB 7800
END IF
END IF
5199 RETURN
'
' *** Use the DOS date to set the real time clock date
'
5200 GOSUB 7200 ' display current date setting
CALL DATEINT(DATE$,DAY,MONTH,YEAR)
CALL SET.RTC.DATE(DAY,MONTH,YEAR,RTC.ERR)
IF NOT QUIET THEN
CALL DATE.FMT(DAY,MONTH,YEAR,DATE.FORMAT,DATE.SEP$,DATE.PRN$)
COLOR FG4,BG4
PRINT
PRINT "Your AT real time clock DATE"
PRINT "is now the same as the DOS date: ";
GOSUB 7600
END IF
COLOR 7,0
RETURN
'
' *** Use the DOS time to set the real time clock time
'
5400 GOSUB 7400 ' display current time setting
CALL TIMEINT(TIME$,HOURS,MINUTES,SECONDS)
CALL SET.RTC.TIME(HOURS,MINUTES,SECONDS,RTC.ERR)
IF NOT QUIET THEN
CALL TIME.FMT(HOURS,MINUTES,SECONDS,TIME.FORMAT,TIME.SEP$,TIME.PRN$)
COLOR FG4,BG4
PRINT
PRINT "Your AT real time clock TIME"
PRINT "is now the same as the DOS time: ";
GOSUB 7800
END IF
COLOR 7,0
RETURN
'
' *** Use the date argument to set the real time clock date
'
5600 GOSUB 8500 ' check the arg and split into values
IF DATE.ERR THEN 5610
GOSUB 7200 ' display current date setting
CALL SET.RTC.DATE(DAY.NEW,MONTH.NEW,YEAR.NEW,RTC.ERR)
CALL DATE.FMT(DAY.NEW,MONTH.NEW,YEAR.NEW,0,"-",DATE.NEW$)
DATE$=DATE.NEW$
IF NOT QUIET THEN
CALL DATE.FMT(DAY.NEW,MONTH.NEW,YEAR.NEW,DATE.FORMAT,DATE.SEP$,DATE.PRN$)
COLOR FG4,BG4
PRINT
PRINT "Your AT real time clock DATE and DOS DATE"
PRINT "are now both the same as the given date: ";
GOSUB 7600
END IF
COLOR 7,0
RETURN
5610 ERROR1$="ILLEGAL DATE ARGUMENT in program "+PRGNAME$+"."
ERROR2$=" "+ARG.DATE$+" is not a valid date."
GOTO 19995
'
' *** Use the time argument to set the real time clock time
'
5800 GOSUB 8000 ' check the arg and split into values
IF TIME.ERR THEN 5810
GOSUB 7400 ' display current time setting
CALL SET.RTC.TIME(HOURS.NEW,MINUTES.NEW,SECONDS.NEW,RTC.ERR)
CALL TIME.FMT(HOURS.NEW,MINUTES.NEW,SECONDS.NEW,1,":",TIME.NEW$)
TIME$=TIME.NEW$
IF NOT QUIET THEN
CALL TIME.FMT(HOURS.NEW,MINUTES.NEW,SECONDS.NEW,TIME.FORMAT,TIME.SEP$,TIME.PRN$)
COLOR FG4,BG4
PRINT
PRINT "Your AT real time clock TIME and DOS TIME"
PRINT "are now both the same as the given time: ";
GOSUB 7800
END IF
COLOR 7,0
RETURN
5810 ERROR1$="ILLEGAL TIME ARGUMENT in program "+PRGNAME$+"."
ERROR2$=" "+ARG.TIME$+" is not a valid time."
GOTO 19995
'
' *** Display program help
'
6000 CLS:GOSUB 4000 ' Display titles
COLOR FG6,BG6
PRINT SETOUT$;"A program to set the AT real time clock."
PRINT
PRINT SETOUT$;"Command line has the following format:"
PRINT
COLOR FG3,BG3
PRINT SETOUT$;" atclock [/d[=date]] [/t[=time]] [/q] [/m|/c] [/h|?] [/i]"
PRINT
COLOR FG6,BG6
PRINT SETOUT$;"Where:"
PRINT SETOUT$;" /d use DOS date to set the AT clock."
PRINT SETOUT$;" /d=date use given date to set the AT clock & DOS date."
PRINT SETOUT$;" /t use DOS time to set the AT clock."
PRINT SETOUT$;" /t=time use given time to set the AT clock & DOS time."
PRINT SETOUT$;" /q run quietly without verification."
PRINT
PRINT SETOUT$;" /c force display for a colour monitor."
PRINT SETOUT$;" /m force display for a mono or composite monitor."
PRINT SETOUT$;" /h or ? display this help."
PRINT SETOUT$;" /i display program information."
PRINT
PRINT SETOUT$;"Note: All command line arguments must be separated by spaces."
PRINT SETOUT$;" Return codes: 0-no error 1-error detected."
COLOR 7,0
RETURN
'
' *** Display program information
'
6500 CLS:GOSUB 4000 ' Display titles
COLOR FG6,BG6
PRINT
PRINT SETOUT$;PRGNAME$+" should only be run on an IBM AT or compatible"
PRINT SETOUT$;"under DOS 3.xx"
PRINT
PRINT
COLOR FG3,BG3
PRINT SETOUT$;PRGNAME$+" is user supported software. You are granted a limited"
PRINT SETOUT$;"licence to use, copy and distribute it, provided that no fee is"
PRINT SETOUT$;"charged, and that it is distributed in its original, unmodified"
PRINT SETOUT$;"form. Any voluntary contributions for the use of this program"
PRINT SETOUT$;"will be appreciated and should be sent to:"
PRINT
PRINT SETOUT$;SETOUT$;"PC Connection Australia"
PRINT SETOUT$;SETOUT$;"G.P.O. Box 486G"
PRINT SETOUT$;SETOUT$;"Melbourne VIC 3001"
PRINT SETOUT$;SETOUT$;"AUSTRALIA"
PRINT
PRINT SETOUT$;"You may not use this product in a commercial or a government"
PRINT SETOUT$;"organization without paying a licience fee of $15. Site and"
PRINT SETOUT$;"commercial distribution licences are available."
COLOR 7,0
RETURN
'
' *** Display the current date setting of the real time clock.
'
7200 IF NOT QUIET THEN
CALL GET.RTC.DATE(DAY,MONTH,YEAR,RTC.ERR)
CALL DATE.FMT(DAY,MONTH,YEAR,DATE.FORMAT,DATE.SEP$,DATE.PRN$)
COLOR FG4,BG4
PRINT:PRINT
PRINT "Your AT real time clock DATE was: ";
GOSUB 7600
END IF
RETURN
'
' *** Display the current time setting of the real time clock.
'
7400 IF NOT QUIET THEN
CALL GET.RTC.TIME(HOURS,MINUTES,SECONDS,RTC.ERR)
CALL TIME.FMT(HOURS,MINUTES,SECONDS,TIME.FORMAT,TIME.SEP$,TIME.PRN$)
COLOR FG4,BG4
PRINT:PRINT
PRINT "Your AT real time clock TIME was: ";
GOSUB 7800
END IF
RETURN
'
' *** Display the actual time and it template
'
7600 COLOR FG5,BG5
PRINT DATE.PRN$;
COLOR FG4,BG4
PRINT " ";DATE.TEMP$
PRINT
RETURN
'
' *** Display the actual time and it template
'
7800 COLOR FG5,BG5
PRINT TIME.PRN$;
COLOR FG4,BG4
PRINT " ";TIME.TEMP$
PRINT
RETURN
'
' *** Check ARG.TIME$
'
8000 HOURS.NEW=0:MINUTES.NEW=0:SECONDS.NEW=0
LENGTH=LEN(ARG.TIME$)
IF LENGTH<1 8010="" args="" call="" if="" into="" line="" num="" or="" split="" then="" time="" wrdget="">3 THEN 8010
CALL WRDCHK(TIME.ARG$(),NUM,ARG.ERR)
IF ARG.ERR THEN 8010
ON ERROR GOTO 8010
HOURS.NEW=VAL(TIME.ARG$(1))
IF HOURS.NEW<0 hours.new="" or="">23 THEN 8010
IF NUM>1 THEN
MINUTES.NEW=VAL(TIME.ARG$(2))
IF MINUTES.NEW<0 minutes.new="" or="">59 THEN 8010
END IF
IF NUM=3 THEN
SECONDS.NEW=VAL(TIME.ARG$(3))
IF SECONDS.NEW<0 or="" seconds.new="">59 THEN 8010
END IF
ON ERROR GOTO 19990
TIME.ERR=FALSE
RETURN
'
8010 TIME.ERR=TRUE
ON ERROR GOTO 19990
RETURN
'
' *** Check ARG.DATE$
'
8500 DAY.NEW=0:MONTH.NEW=0:YEAR.NEW=0
LENGTH=LEN(ARG.DATE$)
IF LENGTH<1 8590="" args="" call="" date="" if="" into="" line="" num="" or="" split="" then="" wrdget="">3 THEN 8590
CALL WRDCHK(DATE.ARG$(),NUM,ARG.ERR)
IF ARG.ERR THEN 8590
ON ERROR GOTO 8590
SELECT CASE DATE.FORMAT
CASE 0 ' USA
MONTH.NEW=VAL(DATE.ARG$(1))
IF MONTH.NEW<1 hours.new="" or="">12 THEN 8590
IF NUM>1 THEN
DAY.NEW=VAL(DATE.ARG$(2))
IF DAY.NEW<1 day.new="" or="">31 THEN 8590
END IF
IF NUM=3 THEN
YEAR.NEW=VAL(DATE.ARG$(3))
IF YEAR.NEW<80 1900="" 2000="" else="" end="" if="" or="" then="" year.new="">2099 THEN 8590
END IF
CASE 1 ' Europe
DAY.NEW=VAL(DATE.ARG$(1))
IF DAY.NEW<1 day.new="" or="">31 THEN 8590
IF NUM>1 THEN
MONTH.NEW=VAL(DATE.ARG$(2))
IF MONTH.NEW<1 hours.new="" or="">12 THEN 8590
END IF
IF NUM=3 THEN
YEAR.NEW=VAL(DATE.ARG$(3))
IF YEAR.NEW<80 1900="" 2000="" else="" end="" if="" or="" then="" year.new="">2099 THEN 8590
END IF
CASE 2 ' Japan
YEAR.NEW=VAL(DATE.ARG$(1))
IF YEAR.NEW<80 1900="" 2000="" else="" end="" if="" or="" then="" year.new="">2099 THEN 8590
IF NUM>1 THEN
MONTH.NEW=VAL(DATE.ARG$(2))
IF MONTH.NEW<1 hours.new="" or="">12 THEN 8590
END IF
IF NUM=3 THEN
DAY.NEW=VAL(DATE.ARG$(3))
IF DAY.NEW<1 day.new="" or="">31 THEN 8590
END IF
END SELECT
ON ERROR GOTO 19990
DATE.ERR=FALSE
RETURN
'
8590 DATE.ERR=TRUE
ON ERROR GOTO 19990
RETURN
'
' *** Get a key and return it in I$
'
9000 I$=INKEY$:IF I$="" THEN 9000
RETURN
'
' *** Find out if its Okay to continue
'
9500 COLOR FG4,BG4
PRINT "Okay to continue (Y+/N-) ? ";
GOSUB 9000
IF I$="Y" OR I$="y" OR I$="+" THEN OKAY=TRUE:RETURN
IF I$="N" OR I$="n" OR I$="-" THEN OKAY=FALSE:RETURN
GOTO 9500
'
' *** Unexpected error reporting
'
19990 BEEP:COLOR 7,0:CLS:LOCATE 5,1
PRINT " An unexpected error (#=";ERR;") occurred at line ";ERL
PRINT " of the program ";PRGNAME$;" version ";VERS$
PRINT
PRINT " Please write down the above details, and what you were trying to"
PRINT " do when the error occured."
PRINT
PRINT " Please contact PC Connection Australia, passing on the details recorded."
PRINT
PRINT " We apologize for this disruption and will act with all haste to"
PRINT " repair the error."
GOTO 19998
'
' *** Detected error reporting
'
19995 BEEP:COLOR 7,0:CLS:LOCATE 5,1
PRINT " A user correctable error has occurred in the ";PRGNAME$;" program"
PRINT
PRINT SETOUT$;ERROR1$
PRINT SETOUT$;ERROR2$
PRINT
PRINT SETOUT$;ERROR3$
PRINT SETOUT$;ERROR4$
'
19998 PRINT
PRINT
PRINT
PRINT " Press for help, any other key to continue ";
19999 GOSUB 9000 ' Get a key
IF I$=" " THEN GOSUB 6000
COLOR 7,0:PRINT
CALL ERRORSET.1(1)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: WRDCHK
'
' SUB PROG: check that all arguments contain only numbers
'
' Return error flag.
'
' call:
' call wrdchk(in.string$(1),num%,out.code%)
'
' input:
' in.string$ = string array of arguments
' num% = number of arguments
'
' output:
' out.code% = logical flag true if bad, false if okay.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB wrdchk(in.string$(1),num%,out.code%) static
false=0:true=not false
out.code%=true
if num%>0 then
for i%=1 to num%
temp$=in.string$(i%):tmp%=len(temp$)
for ii%=1 to tmp%
ch$=mid$(temp$,ii,1)
if ch$<"0" or ch$>"9" then exit sub
next ii%
next i%
out.code%=false
end if
end sub ' wrdchk
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: WRDGET
'
' SUB PROG: get words in a string using the given word separator.
'
' Return out.string$ and num%
'
' call:
' call wrdget(in.string$,wrd.sep$,num%,out.string$())
'
' input:
' in.string$ = the string to be split into words.
' wrd.sep$ = the character that separates words.
'
' output:
' num% = number of words.
' out.string$ = string array of the words.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB wrdget(in.string$,wrd.sep$,num%,out.string$(1)) static
if len(wrd.sep$)<>1 then
num%=1
out.string$(1)=in.string$
else
i%=1:num%=0:inword%=0
while i%<=len(in.string$)
ch$=mid$(in.string$,i%,1)
if ch$=wrd.sep$ then
if inword%<>0 then inword%=0
else
if inword%=0 then inword%=-1:num%=num%+1:out.string$(num%)=""
out.string$(num%)=out.string$(num%)+ch$
end if
i%=i%+1
wend
end if
end sub ' wrdget
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: TIME.TEMPLATE
'
' SUB PROG: return a template for the desired time format.
'
' Return time.temp$ as string in the desired format.
'
' call:
' call time.template(time.format%,time.sep%,time.temp$)
'
' input:
' time.format% = 0 12 hour clock
' 1 24 hour clock
' time.sep$ = time separator character
'
' output:
' time.temp$ = time template as a string returned
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB time.template(time.format%,time.sep$,time.temp$) static
time.temp$="hh"+time.sep$+"mm"+time.sep$+"ss"
if time.format%=0 then
time.temp$=time.temp$+" 12-hour format"
else
time.temp$=time.temp$+" 24-hour format"
end if
end sub ' time.template
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: DATE.TEMPLATE
'
' SUB PROG: return a template for the desired date format
'
' Return date.temp$ as the desired template.
'
' call:
' call date.template(date.format%,date.sep%,date.temp$)
'
' input:
' date.format% = 0 USA m d y
' 1 Europe d m y
' 2 Japan y m d
' date.sep$ = date separator character
'
' output:
' date.temp$ = date template as a string returned
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB date.template(date.format%,date.sep$,date.temp$) static
date.temp$=""
select case date.format%
case 0 ' USA
date.temp$="mm"+date.sep$+"dd"+date.sep$+"yyyy"
case 1 ' Europe
date.temp$="dd"+date.sep$+"mm"+date.sep$+"yyyy"
case 2 ' Japan
date.temp$="yyyy"+date.sep$+"mm"+date.sep$+"dd"
end select
end sub ' date.template
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: TIME.FMT
'
' SUB PROG: format hours, minutes and seconds using given details.
'
' Return time$ as string in the desired format.
'
' call:
' call time.fmt(hours%,minutes%,seconds%,time.format%,time.sep$,time$)
'
' input:
' hours% = hours
' minutes% = minutes
' seconds% = seconds
' time.format%= 0 12 hour clock
' 1 24 hour clock
' time.sep$ = time separator character
'
' output:
' time$ = time as a string returned
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB time.fmt(z.hours%,z.minutes%,z.seconds%,time.format%,time.sep$,z.time$) static
seconds$=str$(z.seconds%):seconds$=right$(seconds$,len(seconds$)-1)
if len(seconds$)=1 then seconds$="0"+seconds$
minutes$=str$(z.minutes%):minutes$=right$(minutes$,len(minutes$)-1)
if len(minutes$)=1 then minutes$="0"+minutes$
tmp$=""
temp%=z.hours%
if time.format%=0 then
tmp$=" am"
if temp%>=12 then tmp$=" pm"
if temp%>12 then temp%=temp%-12
end if
hours$=str$(temp%):hours$=right$(hours$,len(hours$)-1)
if len(hours$)=1 then hours$="0"+hours$
z.time$=hours$+time.sep$+minutes$+time.sep$+seconds$+tmp$
end sub ' time.fmt
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: DATE.FMT
'
' SUB PROG: format day, months and year using given details.
'
' Return date$ as string in the desired format.
'
' call:
' call date.fmt(day%,month%,year%,date.format%,date.sep%,date$)
'
' input:
' day% = day
' month% = month
' year% = year (1980..2099)
' date.format%= 0 USA m d y
' 1 Europe d m y
' 2 Japan y m d
' date.sep$ = date separator character
'
' output:
' date$ = date as a string returned
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB date.fmt(z.day%,z.month%,z.year%,date.format%,date.sep$,z.date$) static
day$=str$(z.day%):day$=right$(day$,len(day$)-1)
if len(day$)=1 then day$="0"+day$
month$=str$(z.month%):month$=right$(month$,len(month$)-1)
if len(month$)=1 then month$="0"+month$
temp%=z.year%
if temp%<100 then temp%=temp%+1900
year$=str$(temp%):year$=right$(year$,len(year$)-1)
z.date$=""
select case date.format%
case 0 ' USA
z.date$=month$+date.sep$+day$+date.sep$+year$
case 1 ' Europe
z.date$=day$+date.sep$+month$+date.sep$+year$
case 2 ' Japan
z.date$=year$+date.sep$+month$+date.sep$+day$
end select
end sub ' date.fmt
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: TIMEINT
'
' SUB PROG: determine hour, minute, and second as integer values.
'
' Return hour%, minute%, second% from string of hours, minutes,
' and seconds as given from BASIC time$ function.
'
' call:
' call timeint(time$,hour%,minute%,second%)
'
' input:
' time$ = time as a string returned by the BASIC time$ function
'
' output:
' hour% = integer hour of interest
' minute% = integer minute of interest
' second% = integer seconds
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB timeint(z.time$,z.hour%,z.minute%,z.second%) static
' what are the integer values of this time?
z.hour%=val(z.time$) 'hour is easy
k%=2 : gosub strip.time
z.minute%=z.x%
k%=k%+1 'move past number
gosub strip.time
z.second%=z.x%
exit sub
strip.time:
while k%0 then return 'number will return zero
wend : return
END SUB 'timeint
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: DATEINT
'
' SUB PROG: determine month, day, and year as integer values.
'
' Return month%, day%, year% from string of month, day, and year
' in any of several formats.
'
' call:
' call dateint(date$,day%,month%,year%)
'
' input:
' date$ = format returned by the BASIC date$ function
'
' output:
' day% = integer day of interest
' month% = integer month of interest
' year% = integer year of interest
'
' There is no upper limit on the year tested.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB dateint(z.date$,z.day%,z.month%,z.year%) static
' what are the integer values of this date?
z.month%=val(z.date$) 'month is easy
k%=2 : gosub strip.date
z.day%=z.x%
k%=k%+1 'move past number
gosub strip.date
z.year%=z.x% : if z.year%<99 then z.year%=z.year%+1900
exit sub
strip.date:
while k%0 then return 'number will return zero
wend : return
END SUB 'dateint
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: get.rtc.time
'
' SUBROUTINE: Get the AT real time clock time.
'
' CALL:
' call get.rtc.time(z.rtc.hrs%,z.rtc.min%,z.rtc.sec%,z.rtc.err%)
'
' OUTPUT:
' z.rtc.hrs% = hours
' z.rtc.min% = minutes
' z.rtc.sec% = seconds
' z.rtc.err% = error return code - 0 if no error
'
' REFERENCE:
' "Programmer's Guide To The IBM PC", Peter Norton, Pages 239-240.
' "IBM AT Technical Reference", Pages 1-45 & 5-159.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB get.rtc.time(z.rtc.hrs%,z.rtc.min,z.rtc.sec%,z.rtc.err%) static
ah%=0:al%=0:bh%=0:bl%=0:ch%=0:cl%=0:dh%=0:dl%=0:rc%=0
sh%=0:sl%=0
ah%=2 ' read the real time clock time
call dosint(26,ah%,al%,bh%,bl%,ch%,cl%,dh%,dl%,sh%,sl%,rc%)
' convert from BCD (binary coded decimal)
z.rtc.hrs% = ((ch% \ 16) * 10) + (ch% mod 16) ' hours
z.rtc.min% = ((cl% \ 16) * 10) + (cl% mod 16) ' minutes
z.rtc.sec% = ((dh% \ 16) * 10) + (dh% mod 16) ' seconds
z.rtc.err% = rc% ' error return
END SUB ' get.rtc.time
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: set.rtc.time
'
' SUBROUTINE: Set the AT real time clock time.
'
' CALL:
' call set.rtc.time(z.rtc.hrs%,z.rtc.min%,z.rtc.sec%,z.rtc.err%)
'
' INPUT:
' z.rtc.hrs% = hours (0..23)
' z.rtc.min% = minutes (0..59)
' z.rtc.sec% = seconds (0..59)
'
' OUTPUT:
' z.rtc.err% = error return code - 0 if no error
'
' REFERENCE:
' "Programmer's Guide To The IBM PC", Peter Norton, Pages 239-240.
' "IBM AT Technical Reference", Pages 1-45 & 5-159.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB set.rtc.time(z.rtc.hrs%,z.rtc.min%,z.rtc.sec%,z.rtc.err%) static
ah%=0:al%=0:bh%=0:bl%=0:ch%=0:cl%=0:dh%=0:dl%=0:rc%=0
sh%=0:sl%=0
' check for valid values for hours, minutes and seconds
if (z.rtc.hrs% < 0) or (z.rtc.hrs% > 23) then goto set.rtc.time.err
if (z.rtc.min% < 0) or (z.rtc.min% > 59) then goto set.rtc.time.err
if (z.rtc.sec% < 0) or (z.rtc.sec% > 59) then goto set.rtc.time.err
ah%=3 ' set the real time clock time
' convert to BCD (binary coded decimal)
ch% = ((z.rtc.hrs% \ 10) * 16) + (z.rtc.hrs% mod 10) ' hours
cl% = ((z.rtc.min% \ 10) * 16) + (z.rtc.min% mod 10) ' minutes
dh% = ((z.rtc.sec% \ 10) * 16) + (z.rtc.sec% mod 10) ' seconds
dl% = 0 ' daylight savings option
call dosint(26,ah%,al%,bh%,bl%,ch%,cl%,dh%,dl%,sh%,sl%,rc%)
z.rtc.err% = rc% ' error return
exit sub
set.rtc.time.err:
z.rtc.err% = 1
END SUB ' set.rtc.time
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: get.rtc.date
'
' SUBROUTINE: Get the AT real time clock date.
'
' CALL:
' call get.rtc.time(z.rtc.day%,z.rtc.mth%,z.rtc.yrs%,z.rtc.err%)
'
' OUTPUT:
' z.rtc.day% = day
' z.rtc.mth% = month
' z.rtc.yrs% = year (e.g. 1981)
' z.rtc.err% = error return code - 0 if no error
'
' REFERENCE:
' "Programmer's Guide To The IBM PC", Peter Norton, Pages 239-240.
' "IBM AT Technical Reference", Pages 1-45 & 5-159.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB get.rtc.date(z.rtc.day%,z.rtc.mth%,z.rtc.yrs%,z.rtc.err%) static
ah%=0:al%=0:bh%=0:bl%=0:ch%=0:cl%=0:dh%=0:dl%=0:rc%=0
sh%=0:sl%=0
ah%=4 ' read the real time clock date
call dosint(26,ah%,al%,bh%,bl%,ch%,cl%,dh%,dl%,sh%,sl%,rc%)
' convert from BCD (binary coded decimal)
cent% = ((ch% \ 16) * 10) + (ch% mod 16) ' century (19 or 20)
year% = ((cl% \ 16) * 10) + (cl% mod 16) ' year (0..99)
z.rtc.yrs% = (cent% * 100) + year% ' year (1980..2099)
z.rtc.mth% = ((dh% \ 16) * 10) + (dh% mod 16) ' month
z.rtc.day% = ((dl% \ 16) * 10) + (dl% mod 16) ' day
z.rtc.err% = rc% ' error return
END SUB ' get.rtc.date
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: set.rtc.date
'
' SUBROUTINE: Set the AT real time clock date.
'
' CALL:
' call set.rtc.date(z.rtc.day%,z.rtc.mth%,z.rtc.yrs%,z.rtc.err%)
'
' INPUT:
' z.rtc.day% = day (1..31)
' z.rtc.mth% = month (1..12)
' z.rtc.yrs% = year (1980..2099)
'
' OUTPUT:
' z.rtc.err% = error return code - 0 if no error
'
' REFERENCE:
' "Programmer's Guide To The IBM PC", Peter Norton, Pages 239-240.
' "IBM AT Technical Reference", Pages 1-45 & 5-159.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB set.rtc.date(z.rtc.day%,z.rtc.mth%,z.rtc.yrs%,z.rtc.err%) static
ah%=0:al%=0:bh%=0:bl%=0:ch%=0:cl%=0:dh%=0:dl%=0:rc%=0
sh%=0:sl%=0
' check for valid values for day, month and year
if (z.rtc.mth% < 1) or (z.rtc.mth% > 12) then goto set.rtc.date.err
if (z.rtc.day% < 1) or (z.rtc.day% > 31) then goto set.rtc.date.err
if (z.rtc.yrs% < 1980) or (z.rtc.yrs% > 2099) then goto set.rtc.date.err
ah%=5 ' set the real time clock date
' convert to BCD (binary coded decimal)
year% = z.rtc.yrs% mod 100
cl% = ((year% \ 10) * 16) + (year% mod 10) ' year
cent% = z.rtc.yrs \ 100
ch% = ((cent% \ 10) * 16) + (cent% mod 10) ' century
dl% = ((z.rtc.day% \ 10) * 16) + (z.rtc.day% mod 10) ' day
dh% = ((z.rtc.mth% \ 10) * 16) + (z.rtc.mth% mod 10) ' month
call dosint(26,ah%,al%,bh%,bl%,ch%,cl%,dh%,dl%,sh%,sl%,rc%)
z.rtc.err% = rc% ' error return
exit sub
set.rtc.date.err:
z.rtc.err% = 1
END SUB ' set.rtc.date
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: get.country
'
' SUBROUTINE: Get DOS country information
'
' CALL:
' call get.country(z.country%,z.info$,rc.err%)
'
' INPUT:
' z.country% = country code (0 - get current country)
'
' OUTPUT:
' z.info$ = string to store returned information
' bytes 0-1 = date format
' 0 - USA m d y
' 1 - Europe d m y
' 2 - Japan y m d
' bytes 2-6 = currency symbol string
' byte 7 = thousands separator
' byte 8 = zero
' byte 9 = decimal separator
' byte 10 = zero
' byte 11 = date separator
' byte 12 = zero
' byte 13 = time separator
' byte 14 = zero
' byte 15 = currency format
' bit 1 = no. of spaces between value and currency
' symbol. (0 or 1)
' bit 0 = 0 if currency symbol precedes value
' 1 if currency symbol follows value
' byte 16 = number of degits after decimal in currency
' byte 17 = time format
' bit 0 = 0 if 12 hour clock
' 1 if 24 hour clock
' bytes 18-21 = case map call address
' byte 22 = data-list separator character
' byte 23 = zero
' bytes 24-33 = reserved
'
' rc.err% = error return code - 0 if no error
'
' REFERENCE:
' "Advanced MS-DOS", Ray Duncan, Pages 332-334.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB get.country(z.country%,z.info$,rc.err%) static
ah%=0:al%=0:bh%=0:bl%=0:ch%=0:cl%=0:dh%=0:dl%=0:rc%=0
sh%=0:sl%=0
if z.country<0 then ' check for invalid country
rc.err% = 1
exit sub
end if
if z.country<255 then ' handle large country numbers
al%=z.country%
else
al%=255
bh%=z.country% \ 256
bl%=z.country% mod 256
end if
ah%=56 ' get the country information
z.info$=string$(34,0) ' null out the info buffer
temp% = sadd(z.info$) ' set up pointer to info buffer
dh% = temp% \ 256
dl% = temp% mod 256
call dosint(33,ah%,al%,bh%,bl%,ch%,cl%,dh%,dl%,sh%,sl%,rc%)
if al%=2 then ' country code invalid
if rc%=0 then rc%=al%
end if
if rc%<>0 then
rc.err% = rc% ' error return
exit sub
end if
rc.err% = rc%
country% = (bh% * 256) + bl%
if z.country%=0 then
z.country%=country% ' return the country if current asked for
else
if z.country%<>country% then ' should have returned what was
rc.err% = 2 ' asked for
end if
end if
END SUB ' get.country
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: get.dos
'
' SUBROUTINE: Get MS-DOS version number.
'
' CALL:
' call get.dos(z.major%,z.minor%)
'
' OUTPUT:
' z.major% = major version number (MS-DOS 2.1 = 2, etc.)
' z.minor% = minor version number (MS-DOS 2.1 = 1, etc.)
'
' Returns 1.0 for all DOS versions less than DOS 2.0.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB get.dos(z.major%,z.minor%) static
ah%=0:al%=0:bh%=0:bl%=0:ch%=0:cl%=0:dh%=0:dl%=0:rc%=0
sh%=0:sl%=0
ah%=48 'terminate with return code
call dosint(33,ah%,al%,bh%,bl%,ch%,cl%,dh%,dl%,sh%,sl%,rc%)
if al%=0 then
z.major%=1
z.minor%=0
else
z.major% = al%
z.minor% = ah%
end if
exit sub
END SUB ' get.dos
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: get.model
'
' SUBROUTINE: Get IBM Model number.
'
' CALL:
' call get.model(z.model$)
'
' OUTPUT:
' z.model$ = model description
' (PC, PC/XT, PCjr, PC/AT, PC/CVT)
'
' See page 130, "Advanced MS-DOS" by Ray Duncan,
' and page 174, "BYTE - Inside the IBM PCs", volume 12, number 12, 1987.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB get.model(z.model$) static
def seg = &hf000
model% = peek(&hfffe)
def seg = 0
select case model%
case &h0ff
z.model$="PC"
case &h0fe
z.model$="PC/XT"
case &h0fd
z.model$="PCjr"
case &h0fc
z.model$="PC/AT"
case &h0fb
z.model$="XT/2"
case &h0fa
z.model$="PS/2 30"
case &h0f9
z.model$="PC/CVT"
case &h0f8
z.model$="PS/2 80"
case else
z.model$="???"
end select
exit sub
END SUB ' get.dos
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TITLE: errorset.1
'
' SUBROUTINE: Terminitate the program with a return code for use in
' batch files as ERRORLEVEL.
'
' CALL:
' call errorset.1(err%)
'
' INPUT:
' err% = return code.
' OUTPUT:
' none
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SUB errorset.1(z.err%) static
ah%=0:al%=0:bh%=0:bl%=0:ch%=0:cl%=0:dh%=0:dl%=0:rc%=0
sh%=0:sl%=0
ah%=76 'terminate with return code
al%=z.err%
locate ,,1:color 7,0
call dosint(33,ah%,al%,bh%,bl%,ch%,cl%,dh%,dl%,sh%,sl%,rc%)
exit sub
END SUB ' errorset.1
Now that's something you don't expect to find every day.
Tags
Interests