.J 10 *NAME Z88COM 20 REM Version 2.3 -- Phil Wheeler, 2/5/89 -- Copyright 1989 30 REM Minor fixes in dialing and logon: 2/7/89 40 REM Released for unlimited FREE distribution; not for sale 50 REM Version 2.3 adds message upload capability 60 : 70 REM See Z88COM.DOC for usage info 80 : 90 PACE=.2 100 DIM CODE 1500, RXFILE 30, TXFILE 30, EFLG 1, BUFF1 40, BUFF2 40 110 DIM MFLG 1, CMFILE 10, FFLG 1 120 OS_GB=&39:OS_PB=&3C:OS_MV=&45:GN_OPF=&6009:GN_CL=&6209 130 OS_GBT=&3F:GN_SOP=&3A09:$CMFILE=":COM.0" 140 GN_ESP=&4C09:GN_SOE=&3C09:GN_NLN=&2E09:OS_OUT=&27:GN_PDN=&1209 150 OS_ERH=&75:OS_ESC=&6F:RC_QUIT=&67:RC_ESC=&01:RC_EOF=&09 160 : 170 DIM NM$(5), NO$(5), MSG$(5), C(5), C$(5), D1(5), D1$(5), D2(5),D2$(5) 180 BL$=CHR$(1)+"B" 190 SOH=1:SOH$=CHR$(1):EOT=4:EOT$=CHR$(4):ACK=6:ACK$=CHR$(6) 200 NAK=21:NAK$=CHR$(21):CAN=24:CAN$=CHR$(24) 210 PH%=OPENIN("PHONE.LOG"):FOR N=1 TO 5:INPUT#PH%,NM$(N):INPUT#PH%,NO$(N) 220 INPUT#PH%,C$(N):C(N)=VAL(C$(N)):INPUT#PH%,D1$(N):D1(N)=VAL(D1$(N)) 230 INPUT#PH%,D2$(N):D2(N)=VAL(D2$(N)):INPUT#PH%,MSG$(N):NEXT 240 CLOSE#PH% 250 ON ERROR GOTO 380 260 CLS:PRINT TAB(0,3)"Loading M/L code...."; 270 PROC_ASM 280 CLS:PRINT TAB(0,0)BL$"Z88COM: Z88 Terminal Support, Vers. 2.3"BL$ 290 PRINT TAB(0,2)BL$;"D";BL$;")ial the Phone (Hayes)"; 300 PRINT TAB(0,3)BL$;"R";BL$;")eceive with Xmodem"; 310 PRINT TAB(0,4)BL$;"S";BL$;")end with Xmodem"; 320 PRINT TAB(0,5)BL$;"M";BL$;")essage Upload (ASCII)"; 330 PRINT TAB(0,6)BL$;"G";BL$;")o to Terminal"; 340 PRINT TAB(0,7)BL$;"E";BL$;")xit Z88COM"; 350 ON((INSTR("dDrRsSMmgGeE",GET$)+3) DIV 2) GOTO 280,430,980,1100,1260,5140,370 360 IF ERL=1280 THEN PROC_BAD:GOTO 1260 370 CLEAR:CLS:END 380 IF ERL=1170 THEN PROC_BAD:GOTO 1120 390 IF ERL=1300 THEN PROC_BAD:GOTO 1260 400 IF ERL=1040 THEN PROC_BAD:GOTO 1000 410 CLS:PRINT TAB(0,3);"UNIDENTIFIED ERROR":PROC_WAIT:PRINT:GOTO 280 420 REM ------------------------------------------------------- 430 REM Dial the phone (Hayes modem with result codes assumed; 440 REM otherwise, dial manually while on line) 450 REM ------------------------------------------------------- 460 CM%=OPENIN(":COM.0"):T=0 470 PRINT#CM%,"AT E1 Q0 V1 T S7=50 S11=70" :REM Initialize modem 480 CLS:PROC_PHONES:PRINT TAB(0,1);"Dialing ";X$ 490 PRINT TAB(0,3);"Press ESC to abort. Then cycle Z88 (or modem)" 500 PRINT TAB(0,4);"OFF then ON and redial from menu" 510 PRINT TAB(0,6);"No. of this try: "; 520 T=T+1:PRINT TAB(17,6);T; 530 PRINT#CM%,"ATDT"+X$ 540 REPEAT 550 INPUT#CM%,Y$ 560 IF INSTR(Y$,"NO CARRIER") THEN 520 570 IF INSTR(Y$,"CONNECT") THEN 600 580 UNTIL FALSE 590 IF M=0 THEN 610 600 PROC_LOG 610 GOTO 5140 620 GOTO 280 630 DEF PROC_PHONES 640 PRINT"[--------------------Directory--------------------]" 650 PRINT"| A: ";TAB(6);NM$(1);TAB(35);NO$(1);TAB(50);"|" 660 PRINT"| B: ";TAB(6);NM$(2);TAB(35);NO$(2);TAB(50);"|" 670 PRINT"| C: ";TAB(6);NM$(3);TAB(35);NO$(3);TAB(50);"|" 680 PRINT"| D: ";TAB(6);NM$(4);TAB(35);NO$(4);TAB(50);"|" 690 PRINT"| E: ";TAB(6);NM$(5);TAB(35);NO$(5);TAB(50);"|" 700 PRINT"[-------------------------------------------------]" 710 PRINT"Enter (A-E) or any phone number: ";:INPUT LINE X$ 720 IF X$="" THEN 280 730 IF LEN(X$)=1 AND X$>="A" AND X$<="E" THEN M=ASC(X$)-64:X$=NO$(M):GOTO 760 740 IF LEN(X$)=1 AND X$>="a" AND X$<="e" THEN M=ASC(X$)-96:X$=NO$(M):GOTO 760 750 M=0 760 CLS 770 ENDPROC 780 DEFPROC_LOG 790 I=C(M) 800 CLS:PRINT TAB(0,3);"CONNECTED, now logging on. Please wait ...." 810 IF I=0 THEN 860 820 REPEAT 830 FOR J=1 TO 2000:NEXT 840 BPUT#CM%,32:I=I-1 850 UNTIL I=0 860 A$=MSG$(M) 870 FOR J=1 TO 1000*D1(M)+1:NEXT 880 FOR I=1 TO LEN(A$) 890 Q$=MID$(A$,I,1) 900 IF Q$="{" THEN BPUT#CM%,13:GOTO 930 910 IF Q$="^" THEN BPUT#CM%,ASC(MID$(A$,I+1,1))-64:I=I+1:GOTO 940 920 BPUT#CM%,ASC(Q$):GOTO 940 930 FOR J=1 TO 1000*D2(M)+1:NEXT 940 NEXT 950 ENDPROC 960 : 970 REM ----------------------------------------------------------- 980 REM Receive Xmodem file 990 REM ----------------------------------------------------------- 1000 CLS:PROC_BOLD:PRINT:PRINT "Receive file with Xmodem protocol":PROC_BOLD 1010 ?MFLG=1:?EFLG=0:?FFLG=0:$BLOCK=" " 1020 PRINT "File to Receive : ";:INPUT $RXFILE 1030 IF $RXFILE="" THEN 5140 1040 FX%=OPENOUT($RXFILE) 1050 CLOSE#FX% 1060 CALL CODE 1070 IF ?EFLG=1 THEN PROC_WAIT 1080 GOTO 5140 1090 REM -------------------------------------------------------- 1100 REM Send Xmodem file 1110 REM -------------------------------------------------------- 1120 CLS:PROC_BOLD:PRINT:PRINT "Send file with Xmodem protocol":PROC_BOLD 1130 ?MFLG=2:?EFLG=0:$BLOCK=" " 1140 PRINT "File to Send : ";:INPUT $TXFILE 1150 IF $TXFILE="" THEN 5140 1160 FX%=OPENIN($TXFILE) 1170 FLN=EXT#FX%:TBLK=FLN/128 1180 PRINT "Total blocks to send = ";INT(TBLK-.000001)+1 1190 CLOSE#FX% 1200 CALL CODE 1210 IF ?EFLG=1 THEN PROC_WAIT 1220 GOTO 5140 1230 REM ------------------------------------------- 1240 REM Message Upload 1250 REM ------------------------------------------- 1260 CLS:PROC_BOLD:PRINT:PRINT "ASCII Message Upload":PROC_BOLD 1270 PRINT:PRINT "Message File : ";:INPUT MFILE$ 1280 IF MFILE$="" THEN 5140 1290 FX%=OPENIN(MFILE$):CM%=OPENIN(":COM.0") 1300 IF EOF#FX% THEN 5140 1310 INPUT#FX%,M$:IF M$="" THEN M$=" " 1320 PRINT#CM%,M$:BPUT#CM%,10 1330 INPUT#CM%,R$:PRINT RIGHT$(R$,LEN(R$)-1) 1340 FOR I=1 TO 1+1000*PACE:NEXT 1350 GOTO 1300 1360 REM ------------------------------------ 1370 REM General Procedures 1380 REM ------------------------------------ 1390 DEF PROC_BOLD 1400 VDU 1,ASC"B" 1410 ENDPROC 1420 : 1430 DEF PROC_WAIT 1440 PROC_BOLD 1450 PRINT CHR$(7);TAB(0,7);">>Press any key to continue<<"; 1460 PROC_BOLD 1470 WT$=GET$ 1480 ENDPROC 1490 DEF PROC_BAD 1500 CLS:PRINT TAB(0,3);"Bad File Name -- Try again":PROC_WAIT 1510 ENDPROC 1520 DEFPROC_ASM 1530 FOR PASS=0 TO 2 STEP 2 1540 P%=CODE 1550 [OPT PASS 1560 LD HL,0:ADD HL,SP:LD (BSTK),HL:LD SP,(&1FFE):XOR A:LD B,A 1570 LD HL,ERRHAN:RST &20:DEFB OS_ERH:LD (OBOU),A:LD (OERR),HL 1580 CALL MAIN 1590 .EXIT 1600 LD HL,(OERR):LD A,(OBOU):LD B,0:RST &20:DEFB OS_ERH:LD SP,(BSTK) 1610 RET 1620 \ 1630 .ERRHAN 1640 RET Z:CP RC_ESC:JR NZ,ERR1:RST &20:DEFB OS_ESC:CALL REP_ERR:JR EXIT 1650 .ERR1 1660 CP RC_QUIT:JR NZ,ERR2:LD HL,(OERR):LD A,(OBOU):RST &20:DEFB OS_ERH 1670 CALL REP_ERR:LD SP,(BSTK):LD HL,(OERR):LD A,RC_QUIT-1:INC A:SCF 1680 JP (HL) 1690 .ERR2 1700 CP A 1710 RET 1720 \ 1730 .BSTK DEFW 0 1740 .OBOU DEFB 0 1750 .OERR DEFW 0 1760 \ 1770 .REP_ERR 1780 RST &20:DEFW GN_ESP:RST &20:DEFW GN_SOE:RST &20:DEFW GN_NLN 1790 RET 1800 .MAIN 1810 LD A,0:LD (EFLG),A \zero exit flag -- then OPEN com for I/O 1820 LD BC,20:LD DE,BUFF1:LD HL,CMFILE:LD A,1:RST &20:DEFW GN_OPF 1830 LD (HDLCM),IX \store com file handle 1840 LD A,(MFLG) \check entry flag 1850 CP 2 \1=rcv, 2=snd 1860 JP Z,UPPER 1870 .DOWNER 1880 LD BC,20:LD DE,BUFF2:LD HL,RXFILE:LD A,2:RST &20:DEFW GN_OPF 1890 LD A,0:LD (EFLG),A 1900 LD (HDLRX),IX 1910 LD A,1:LD (SEC),A \init sector cnt 1920 LD HL,1:LD (BLK),HL \init blk cnt 1930 .RRTY 1940 LD A,NAK:CALL WTCM \send a NAK 1950 .SCLOOP 1960 LD E,0 1970 LD HL,XSTR-1 \point to start of input string buffer - 1 1980 .GTTER 1990 INC E:INC HL 2000 CALL RXRDCM \get a byte with timeout 2010 LD (HL),A \put byte in address of (HL) in XSTR 2020 LD A,E:CP 1 \see if we are at first byte 2030 JR NZ,OVER1 \skip tests if past first byte 2040 LD A,(XSTR) 2050 CP EOT 2060 JP Z,REOT \if EOT recvd 2070 CP CAN 2080 JP Z,RCAN \if CAN recvd 2090 .OVER1 2100 LD A,E 2110 CP 132 2120 JR C,GTTER \loop back for another char 2130 LD HL,XSTR 2140 LD A,SOH 2150 CP (HL) 2160 CALL NZ,SOHERR 2170 INC HL 2180 LD A,(SEC) 2190 CP (HL) 2200 JP NZ,SECERR 2210 INC HL 2220 XOR 255 2230 CP (HL) 2240 JP NZ,CMPERR 2250 CALL CKSUM 2260 LD (CKS),A 2270 INC HL 2280 CP (HL) 2290 JP NZ,CKERR \wrong CHKSUM 2300 LD HL,XSTR+3 2310 LD DE,0 2320 LD BC,128 2330 LD IX,(HDLRX) 2340 RST &20:DEFB OS_MV \write 128 bytes to RXFILE 2350 LD HL,RXMSG:CALL PRTMSG:LD A,(SEC):CALL PRTBLK:CALL CRLF 2360 LD A,ACK:CALL WTCM \send ACK 2370 LD A,(SEC):ADD A,1:LD (SEC),A \incr SEC cnt 2380 LD HL,(BLK):INC HL:LD (BLK),HL 2390 JP SCLOOP 2400 \ 2410 .SOHERR \attempt to resync 2420 LD E,21 2430 .SYNCLP 2440 INC HL 2450 DEC E 2460 CALL FLUSH 2470 LD A,E 2480 CP 0 2490 RET Z 2500 LD A,SOH 2510 CP (HL) 2520 JR NZ,SYNCLP 2530 RET 2540 \ 2550 \ 2560 .UPPER 2570 LD HL,0: LD (BLK),HL \init blk, sec, flags 2580 LD A,0:LD (SEC),A:LD (EFLG),A 2590 LD A,1:LD (EOFLG),A 2600 LD BC,20:LD DE,BUFF2:LD HL,TXFILE:LD A,1:RST &20:DEFW GN_OPF 2610 LD (HDLTX),IX 2620 \ 2630 .GTONE 2640 CALL TXRDCM 2650 CP CAN 2660 JP Z,ENDALL 2670 CP NAK 2680 JP Z,NXT 2690 JP GTONE 2700 \ 2710 .NXT 2720 LD HL,(BLK):INC HL:LD (BLK),HL:LD A,(SEC):INC A:LD (SEC),A 2730 LD B,129:LD HL,XSTR+2:LD IX,(HDLTX) 2740 .BLKLP 2750 INC HL 2760 DEC B 2770 JP Z,CONTIN 2780 LD A,(EOFLG) 2790 CP 0 2800 JP Z,STUFF 2810 RST &20:DEFB OS_GB 2820 JP C,SETEOF 2830 LD (HL),A 2840 JP BLKLP 2850 \ 2860 .SETEOF 2870 LD A,B 2880 CP 128 2890 JP Z,SNDOVR 2900 LD A,0 2910 LD (EOFLG),A 2920 .STUFF 2930 LD A,26 2940 LD (HL),A 2950 JP BLKLP 2960 \ 2970 .CONTIN 2980 LD HL,XSTR+2 2990 CALL CKSUM 3000 LD (CKS),A 3010 \ 3020 .SNDSEC 3030 LD HL,TXMSG:CALL PRTMSG:LD A,(SEC):CALL PRTBLK:CALL CRLF 3040 LD A,SOH:CALL WTCM 3050 LD A,(SEC):CALL WTCM 3060 XOR 255:CALL WTCM 3070 LD HL,XSTR+2:LD B,129 3080 .SDLOOP 3090 INC HL 3100 DEC B 3110 JP Z,DONSND 3120 LD A,(HL):CALL WTCM 3130 JP SDLOOP 3140 .DONSND 3150 LD A,(CKS):CALL WTCM 3160 \ 3170 .ACKLP 3180 CALL TXRDCM 3190 CP CAN 3200 JP Z,SNDCAN 3210 CP NAK 3220 JP Z,SNDAGN 3230 CP ACK 3240 JP Z,MORE 3250 JP ACKLP 3260 \ 3270 .SNDAGN 3280 LD HL,RESND:CALL PRTMSG:LD A,(SEC):CALL PRTBLK:CALL CRLF 3290 JP SNDSEC 3300 \ 3310 .MORE 3320 LD A,(EOFLG) 3330 CP 0 3340 JP Z,SNDOVR 3350 JP NXT 3360 \ 3370 .SNDOVR 3380 LD HL,SNDCMP:CALL PRTMSG:CALL CRLF 3390 LD A,EOT:CALL WTCM 3400 JP ENDALL 3410 \ 3420 .SNDCAN 3430 LD HL,CANMSG:CALL PRTMSG:CALL CRLF 3440 LD A,1:LD (EFLG),A 3450 JP ENDALL 3460 \ 3470 .RXRDCM 3480 LD A,10 3490 LD (CHRCNT),A 3500 .RDLOOP 3510 LD IX,(HDLCM):LD BC,200:RST &20:DEFB OS_GBT 3520 JP C,RTMOUT 3530 RET 3540 \ 3550 .RTMOUT 3560 LD A,(CHRCNT) 3570 DEC A 3580 LD (CHRCNT),A 3590 CP 0 3600 JP Z,TIMOUT 3610 LD A,NAK 3620 CALL WTCM 3630 JP RDLOOP 3640 \ 3650 .FLUSH 3660 LD IX,(HDLCM):LD BC,1000:RST &20:DEFB OS_GBT 3670 JP C,TIMOUT 3680 RET 3690 \ 3700 .TXRDCM 3710 LD IX,(HDLCM):LD BC,2000:RST &20:DEFB OS_GBT 3720 JP C,TIMOUT 3730 RET 3740 \ 3750 .WTCM 3760 LD IX,(HDLCM):RST &20:DEFB OS_PB 3770 RET 3780 \ 3790 .PRTMSG 3800 RST &20:DEFW GN_SOP 3810 RET 3820 \ 3830 .PRTCHR 3840 ADD A,&30 3850 RST &20:DEFB OS_OUT 3860 RET 3870 \ 3880 .CRLF 3890 RST &20:DEFW GN_NLN 3900 RET 3910 \ 3920 .CKSUM 3930 LD B,128 3940 SUB A 3950 .CKLP 3960 INC HL 3970 ADD A,(HL) 3980 DEC B 3990 JR NZ,CKLP 4000 RET 4010 \ 4020 .TIMOUT 4030 POP AF 4040 LD HL,TIMMSG:CALL PRTMSG:CALL CRLF 4050 JP SETFLG 4060 \ 4070 .REOT 4080 LD HL,EOTMSG:CALL PRTMSG:CALL CRLF 4090 LD A,ACK:CALL WTCM 4100 JP ENDALL 4110 \ 4120 .RCAN 4130 LD HL,CANMSG:CALL PRTMSG:CALL CRLF 4140 .SETFLG 4150 LD A,1:LD (EFLG),A 4160 JP ENDALL 4170 \ 4180 .CKERR 4190 LD HL,CHKMSG:CALL PRTMSG:CALL PRTBLK:CALL CRLF 4200 JP RRTY 4210 \ 4220 .SECERR 4230 LD HL,SECMSG:CALL PRTMSG:CALL PRTBLK:CALL CRLF 4240 JP RRTY 4250 \ 4260 .CMPERR 4270 LD HL,CMPMSG:CALL PRTMSG:CALL PRTBLK:CALL CRLF 4280 JP RRTY 4290 \ 4300 .ENDALL 4310 LD IX,(HDLCM):CALL CLZ 4320 LD A,(MFLG) 4330 CP 1 4340 JP Z,ENDRCV 4350 LD IX,(HDLTX):CALL CLZ 4360 RET 4370 \ 4380 .ENDRCV 4390 LD IX,(HDLRX):CALL CLZ 4400 RET 4410 \ 4420 .CLZ 4430 RST &20:DEFW GN_CL 4440 RET 4450 \ 4460 .DIAG 4470 PUSH AF 4480 LD (AA),A 4490 LD A,H: LD (HH),A 4500 LD A,L: LD (LL),A 4510 LD A,D: LD (DD),A 4520 LD A,E: LD (EE),A 4530 LD A,B: LD (BB),A 4540 LD A,C: LD (CC),A 4550 LD A,(HL): LD (CHL),A 4560 POP AF 4570 RET 4580 .HH DEFB 0 4590 .LL DEFB 0 4600 .DD DEFB 0 4610 .EE DEFB 0 4620 .BB DEFB 0 4630 .CC DEFB 0 4640 .AA DEFB 0 4650 .CHL DEFB 0 4660 \ 4670 .PRTBLK 4680 LD A,0:LD BC,(BLK) 4690 LD HL,2 4700 LD DE,BLOCK 4710 RST &20:DEFW GN_PDN 4720 LD HL,BLOCK 4730 CALL PRTMSG 4740 RET 4750 \ 4760 .PRTCR 4770 LD A,13 4780 RST &20:DEFB OS_OUT 4790 RET 4800 .RDCMNT 4810 LD, IX,(HDLCM):RST &20:DEFB OS_GB 4820 RET 4830 .XSTR DEFM STRING$(225," ") 4840 .CHRCNT DEFB 0 4850 .CKS DEFB 0 4860 .SEC DEFB 0 4870 .BLK DEFW 0 4880 .EOFLG DEFB 1 4890 .HDLRX DEFW 0 4900 .HDLTX DEFW 0 4910 .HDLCM DEFW 0 4920 .DONE DEFB 1 4930 .CHKMSG DEFM "Checksum error in #":DEFB 0 4940 .SECMSG DEFM "Block # error in #":DEFB 0 4950 .EOTMSG DEFM "File closed":DEFB 0 4960 .CMPMSG DEFM "Complement error in #":DEFB 0 4970 .TIMMSG DEFM "Timed Out":DEFB 0 4980 .CANMSG DEFM "Transfer aborted":DEFB 0 4990 .RXMSG DEFM "Received #":DEFB 0 5000 .TXMSG DEFM "Sending #":DEFB 0 5010 .BLKMSG DEFM "Total Blocks to Send = ":DEFB 0 5020 .RESND DEFM "Resending Block #":DEFB 0 5030 .SNDCMP DEFM "Send Completed":DEFB 0 5040 .FILMSG DEFM "Bad file spec; try again":DEFB 0 5050 .BLOCK DEFM " ":DEFB 0 5060 \ 5070 ] 5080 NEXT PASS 5090 ENDPROC 5100 : 5110 REM ------------------------------- 5120 REM Exit to Terminal, with loopback 5130 REM ------------------------------- 5140 CLOSE#0:*CLI #V 5150 GOTO 280