home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
kaypro
/
advent1.ark
/
TRPATCH.BAS
< prev
next >
Wrap
BASIC Source File
|
1986-09-19
|
8KB
|
223 lines
10 REM TRPATCH.BAS TurboROM patch program 6/13/86
12 DEFINT A-Z
14 ON ERROR GOTO 9000
20 GOSUB 200 ' SET UP PROGRAM VARIABLES
30 GOSUB 500 ' READ OVERLAY FILE
40 CONTFLG = 1 ' FORCE INITIAL PASS PASS THROUGH MAIN PRGM LOOP
50 ' MAIN PROGRAM LOOP
60 GOSUB 1000 ' DISPLAY MENU
70 GOSUB 2000 ' PATCH PROGRAM
90 GOTO 50 ' END MAIN PROGRAM LOOP
100 ' EXIT ROUTINE FOR MAIN PROGRAM
110 PRINT:PRINT:PRINT
120 STOP
200 ' SET UP PROGRAM VARIABLES
220 WIDTH 255
240 DIM TEXT$(300),PRGNM(32),HEXBYTES(32)
250 HEXDIGTS$ = "123456789ABCDEF"
260 CLR$ = CHR$(&H1A) ' CLEAR SCREEN SEQUENCE
270 ESC$ = CHR$(&H1B) ' ASCII ESCAPE CHARACTER
310 POSITION$ = ESC$+"="
315 OVERLAY$ = "TRPATCH.DAT"
317 SIGNON$ = "TurboROM Patch Program 6/13/86 2.A"
320 RETURN
500 ' READ PATCH OVERLAY FILE INTO MEMORY AND BUILD INDEX ARRAY
510 TNDX = 0' TEXT INDEX [0..N]
520 PNDX = 1' PROGRAM INDEX [1..N]
522 GOSUB 3000 ' clear the screen
524 A$ = SIGNON$:GOSUB 3100
528 PRINT:PRINT "Reading data file: ";OVERLAY$;"... ";
530 OPEN "I",#1,OVERLAY$
540 WHILE NOT EOF(1) ' READ OVERLAY FILE
550 LINE INPUT #1, A$
555 IF LEFT$(A$,4) = ";VER" THEN VERSION$ = MID$(A$,5):GOTO 560
560 IF LEFT$(A$,1) <> ";" THEN TEXT$(TNDX)=A$: TNDX = TNDX + 1
570 WEND
580 CLOSE #1
584 PRINT:PRINT "Scanning data... ";
590 FOR I = 0 TO TNDX-1
600 IF LEFT$(TEXT$(I),1) = ":" THEN GOTO 640
610 PRGNM(PNDX) = I
620 PNDX = PNDX + 1
630 I = I + 1 ' SKIP FILE NAME
640 NEXT I
645 PRINT
650 RETURN
1000 ' DISPLAY MENU LOOP. RETURNS INDEX OR 0
1010 GOSUB 3000 ' clear the screen
1020 A$ = SIGNON$+VERSION$+" Main Menu" : GOSUB 3100
1030 IF PNDX < 17 THEN X = 20 ELSE X = 0
1040 Y = 3
1050 FOR I = 1 TO PNDX
1055 IF I = 17 THEN X = 40:Y = 3
1060 GOSUB 3300 ' position cursor
1070 PRINT "[";I;"]";
1072 X = X+8:GOSUB 3300: X = X-8
1074 IF I <> PNDX THEN A$ = TEXT$(PRGNM(I)) ELSE A$ = "Quit"
1076 PRINT A$;
1080 Y = Y+1
1090 NEXT I
1120 X = 20:IF PNDX > 16 THEN Y = 20 ELSE Y = Y+ 2
1130 GOSUB 3300 ' position cursor
1140 PRINT "Menu Choice ( 1 -";PNDX;"): ";
1150 GOSUB 7000:MENU=ANS
1160 IF ((MENU >= 1) AND (MENU < PNDX)) THEN RETURN ' exit menu display
1165 IF (MENU = PNDX) THEN GOTO 100
1170 GOTO 1000 ' REDISPLAY (WASTES SOME TIME)
2000 ' patch selected program
2010 TNDX = PRGNM(MENU)
2020 PATCH$ = TEXT$(TNDX) ' PATCH IDENTIFIER STRING
2030 COMFILE$ = TEXT$(TNDX+1) ' NAME OF COM FILE TO PATCH
2050 GOSUB 3000 ' clear the screen
2060 PRINT "Patching: ";PATCH$;" for TurboROM compatibility"
2070 PRINT
2080 PRINT "Which drive has the ";COMFILE$;" program to patch (A,B,...P) " ;
2090 GOSUB 7000 ' GET INPUT
2100 IF LEN(ANS$) = 0 THEN ANS$ = CHR$((PEEK(4) AND 15)+ &H41)
2110 DRIVE$ = LEFT$(ANS$,1)
2112 IF DRIVE$ < "A" OR DRIVE$ > "P" THEN GOTO 2050
2120 INFILE$=DRIVE$+":"+COMFILE$
2125 RESET ' make certain that all is ok
2130 OPEN "I",#1,INFILE$
2140 CLOSE #1:GOTO 2200 ' FILE EXISTS break loop
2150 ' file not found handler
2155 CLOSE:PRINT:PRINT
2160 PRINT "FILE: ";INFILE$;" not found..."
2170 GOSUB 3500 ' pause
2180 RETURN
2200 ' FILE FOUND TO PATCH, SO DO IT
2210 TNDX = TNDX+2 ' ADJUST INDEX FOR PATTERN MATCH STRING
2220 GOSUB 4000 ' TRY AND FIND PATTERN MATCH
2225 IF MFLAG THEN GOTO 2240 ' id strings match
2230 PRINT:PRINT "Version numbers do not match"
2232 PRINT "Do you want to patch the file anyway (Y/N): ";
2234 GOSUB 7000 ' get input and convert to upper case
2236 IF LEFT$(ANS$,1) <> "Y" THEN GOTO 2999 ELSE GOTO 2300
2240 ' versions match request confirmation
2250 PRINT:PRINT"Do you want to patch the file: ";INFILE$;" (Y/N): ";
2260 GOSUB 7000
2270 IF LEFT$(ANS$,1) <> "Y" THEN GOTO 2999
2300 GOSUB 4200 ' patch the file
2999 RETURN
3000 ' clear Screen and home cursor
3010 PRINT CLR$;
3020 RETURN
3100 ' PRINT A$, CENTERED
3110 PRINT SPC((80-LEN(A$))/2);A$
3120 RETURN
3300 ' direct cursor postion
3310 PRINT POSITION$;CHR$(Y+32);CHR$(X+32);
3320 RETURN
3500 ' PAUSE QUESTION
3505 A$=INKEY$:IF A$<>""THEN GOTO 3505
3510 PRINT:PRINT "Press RETURN to continue...";
3520 GOSUB 7000
3530 RETURN
4000 ' VERIFY MATCH RETURNS MATCH FLAG TRUE ON PATTERN MATCH
4010 PRINT:PRINT "Verifing version of: ";INFILE$;"... ";
4020 OPEN "R",#1,INFILE$,128
4030 FIELD #1,128 AS SECTOR$
4040 GOSUB 6000 ' GET HEX LINE
4050 CURRENT = (ADDRESS \ 128) - 1 ' FIRST SECTOR TO PATCH
4060 GET #1,CURRENT
4070 MFLAG = 1 ' ASSUME THAT ALL BYTES WILL MATCH
4080 FOR I = 1 TO BYTECOUNT
4090 RECORD = (ADDRESS \ 128) - 1
4100 BYTENUM = (ADDRESS MOD 128)
4110 IF CURRENT = RECORD THEN GOTO 4130
4120 GET #1,RECORD: CURRENT = RECORD
4130 TEMP$ = MID$(SECTOR$,BYTENUM+1,1)
4140 IF TEMP$ <> CHR$(HEXBYTES(I)) THEN MFLAG = 0
4150 ADDRESS = ADDRESS + 1
4160 NEXT I
4170 CLOSE #1 ' CLOSE THE .COM FILE
4180 IF MFLAG THEN A$ = "OK." ELSE A$ = "Error."
4185 PRINT A$
4190 RETURN
4200 ' patch image file
5000 PRINT:PRINT "Updating ";INFILE$;" ... ";
5010 OPEN "R",#1,INFILE$,128
5020 FIELD #1,128 AS SECTOR$
5030 GOSUB 6000 ' READ FIRST LINE
5040 CURRENT = (ADDRESS \ 128) - 1 ' FIRST SECTOR TO PATCH
5050 GET #1,CURRENT
5060 SECDAT$=SECTOR$
5070 WHILE BYTECOUNT <> 0
5080 FOR I = 1 TO BYTECOUNT
5090 RECORD = (ADDRESS \ 128) - 1
5100 BYTENUM = (ADDRESS MOD 128)
5110 IF CURRENT = RECORD THEN GOTO 5170
5120 LSET SECTOR$=SECDAT$
5130 PUT #1,CURRENT
5140 GET #1,RECORD
5150 CURRENT = RECORD
5160 SECDAT$=SECTOR$
5170 TEMP$ = LEFT$(SECDAT$,BYTENUM) + CHR$(HEXBYTES(I))
5180 TEMP$ = TEMP$ + RIGHT$(SECDAT$,127-BYTENUM)
5190 SECDAT$=TEMP$
5200 ADDRESS = ADDRESS + 1
5210 NEXT I
5220 GOSUB 6000 ' READ NEXT LINE
5230 WEND
5240 LSET SECTOR$=SECDAT$
5250 PUT #1,CURRENT
5260 GET #1,1 ' ensure that buffers are flushed
5270 CLOSE #1 ' CLOSE THE .COM FILE
5275 RESET ' ensure flush to disk
5280 ' job completed message
5300 PRINT "Update complete."
5310 PRINT
5315 GOSUB 3500
5320 RETURN
6000 ' READ AND DECODE ONE LINE OF INTEL HEX
6010 HEXLINE$ = TEXT$(TNDX): TNDX = TNDX+1
6020 HEXPOS = 2: GOSUB 6130: BYTECOUNT = HEXDATA
6030 HEXPOS = 4: GOSUB 6110: ADDRESS = HEXDATA
6040 HEXPOS = 10 ' FIRST DATA BYTE
6050 FOR I = 1 TO BYTECOUNT
6060 GOSUB 6130
6070 HEXBYTES(I) = HEXDATA
6080 HEXPOS = HEXPOS + 2
6090 NEXT I
6100 RETURN
6110 ' CONVERT 4 HEX DIGITS TO AN INTEGER
6120 HEXLENGTH = 4 : GOTO 6150
6130 ' CONVERT 2 HEX DIGITS TO AN INTEGER
6140 HEXLENGTH = 2 ' INITIAL VALUES
6150 HEXDATA = 0
6160 FOR DIGIT = HEXPOS TO HEXPOS + HEXLENGTH - 1
6170 HEXDATA = HEXDATA * 16 + INSTR(HEXDIGTS$,MID$(HEXLINE$,DIGIT,1))
6180 NEXT DIGIT
6190 RETURN
7000 ' INPUT ANS$ THEN CONVERT ANS$ TO UPPER CASE, ANS AS INTEGER
7010 LINE INPUT; ANS$
7020 TEMP$=""
7030 FOR J = 1 TO LEN(ANS$)
7040 A$ = MID$(ANS$,J,1)
7050 IF A$ >="a" AND A$ <= "z" THEN A$ = CHR$(ASC(A$)-32)
7060 TEMP$ = TEMP$ + A$
7070 NEXT J
7080 ANS$ = TEMP$:ANS = VAL(ANS$)
7090 RETURN
9000 ' error handlers
9010 IF ERL = 530 THEN RESUME 9200 ' PATCH DATA FILE NOT FOUND
9020 IF ERL = 2130 THEN RESUME 2150 ' FILE NOT FOUND
9030 IF ERL = 4020 THEN RESUME 9300
9035 IF ERL = 5010 THEN RESUME 9300
9040 IF ERL = 5130 THEN RESUME 9400
9042 IF ERL = 5250 THEN RESUME 9400
9044 IF ERL = 5270 THEN RESUME 9400
9050 PRINT:PRINT "Error on line: ";ERL;" Error number ";ERR
9060 GOTO 100
9200 ' PATCH DATA FILE NOT FOUND ERROR HANDLER
9210 PRINT:PRINT "Overlay file: ";OVERLAY$;" not found"
9220 GOTO 100
9300 ' error in opening target file
9310 PRINT:PRINT "Error in opening file: ";INFILE$;
9320 GOTO 9420
9400 ' error in writing to target file
9410 PRINT:PRINT "Error in writing to file: ";INFILE$;
9420 PRINT "Disk or file may be READ ONLY"
9430 GOTO 100
rget file
9410 PRINT:PRINT "Er