'===========================================================================
' Subject: MODEM CHAT                         Date: 08-04-97 (01:22)       
'  Author: Paul Maunders                      Code: QB, QBasic, PDS        
'  Origin: Cyberax@hotmail.com              Packet: MODEM.ABC
'===========================================================================
' This program can be used to dial up a friend and talk to him
' You can also send files to each other.
' The file sending routine needs a little work.
' If anyone has a better version of this type of program please mail me
' Cyberax@Hotmail.com
' Come to mention it if anyone has any qbasic modem programs please send me
' them.
' Written By Paul Maunders (Pyrosoft 1997)

OPEN "COM2:9600 ,,,,BIN,,,,RB32767" FOR RANDOM AS #1
CLS
COLOR 14, 1
PRINT SPACE$(80)
LOCATE 1, 2: PRINT "Modem Software V2.0"
LOCATE 1, 64: PRINT "By Paul Maunders"
COLOR , 0
PRINT
PRINT #1, "ATZ"

100     DO
        a$ = INKEY$
        IF a$ <> "" THEN GOTO 200
110             IF LOC(1) <> 0 THEN
                in$ = INPUT$(1, 1)
                GOTO 500
        END IF
        LOOP UNTIL a$ = CHR$(27)

CLOSE #1
COLOR 7
END

200     IF a$ = CHR$(8) THEN GOTO 250           '       BACKSPACE
        IF a$ = CHR$(13) THEN GOTO 300          '       ENTER
        IF a$ = CHR$(0) + ";" THEN GOTO 1100    '       F1 : Help
        IF a$ = CHR$(0) + "<" THEN GOTO 1200    '       F2 : Dial
        IF a$ = CHR$(0) + "=" THEN GOTO 1300    '       F3 : Modem Info
        IF a$ = CHR$(0) + ">" THEN GOTO 1340    '       F4 : Modem Type
        IF a$ = CHR$(0) + "?" THEN GOTO 1350    '       F5 : Modem Speed
        IF a$ = CHR$(0) + "@" THEN GOTO 1360    '       F6
        IF a$ = CHR$(0) + "A" THEN GOTO 1400    '       F7
        IF a$ = CHR$(0) + "B" THEN GOTO 800     '       F8 : Send Files
        IF a$ = CHR$(0) + "C" THEN GOTO 1550    '       F9
        IF a$ = CHR$(0) + "D" THEN GOTO 1600    '       F10 : Soft Reset
        IF a$ = CHR$(0) + "" THEN GOTO 1700    '       F11 : Factory Reset
        IF a$ = CHR$(0) + "" THEN GOTO 1800    '       F12 : Hangup (+++ATH)
        COLOR 14
        lin = CSRLIN
        IF lin > 23 THEN CLS
        PRINT a$;
        total$ = total$ + a$
        GOTO 110

250 REM Deleting Routine
    l = LEN(total$)
    lin = CSRLIN
    IF lin > 23 THEN CLS
    IF l > 0 THEN LOCATE lin, 1: PRINT SPACE$(l);
    l = l - 1
    IF l < 0 THEN l = 0
    total$ = LEFT$(total$, l)
    LOCATE lin, 1: PRINT total$;
    GOTO 100

300 REM Enter-key Routine
    PRINT #1, total$
    PRINT #1, CHR$(13)
    PRINT CHR$(10);
    total$ = ""
    GOTO 100

500 REM Input Checking Routine
    COLOR 13
    IF in$ = CHR$(13) THEN GOTO 600
    IF in$ = CHR$(10) THEN PRINT CHR$(13); : GOTO 600
    PRINT in$;
    Totali$ = Totali$ + in$
    GOTO 100

600     'COLOR 15
        'PRINT "("; Totali$; ")"
        IF Totali$ = "OK" THEN SOUND 200, 1.5: SOUND 600, 1
        IF Totali$ = "ERROR" THEN SOUND 600, 1.5: SOUND 200, 1
        IF Totali$ = "RING" THEN GOTO 700
        IF LEFT$(Totali$, 7) = "CONNECT" THEN PRINT CHR$(13); "Connected...."
        IF Totali$ = "SEND" THEN GOTO 900 ' Receive
        Totali$ = ""
        GOTO 100

700  REM Ring / Answer Procedure
     PRINT #1, "ATA"
     GOTO 100

800  REM Send Files
     PRINT "Requesting Permission to send!"
     PRINT #1, "SEND"
     DO
     a$ = INKEY$
     IF a$ = CHR$(27) THEN CLOSE #2: GOTO 100
     INPUT #1, in$
     LOOP UNTIL in$ = "OK"
     INPUT "Filename : "; file$
     OPEN file$ FOR BINARY AS #2
     size = LOF(2)
     PRINT #1, size
     DO
     a$ = INKEY$
     IF a$ = CHR$(27) THEN CLOSE #2: GOTO 100
     INPUT #1, in$
     LOOP UNTIL in$ <> ""
     IF VAL(in$) <> size THEN PRINT "Size Checksum Error": PRINT #1, "ERROR": GOTO 100
     PRINT #1, "OK"
     DO
     a$ = INKEY$
     IF a$ = CHR$(27) THEN CLOSE #2: GOTO 100
     INPUT #1, in$
     LOOP UNTIL in$ <> ""
     IF in$ = "OK" THEN PRINT "Ready"
     send$ = SPACE$(1024)
     lin = CSRLIN
     DO
     a$ = INKEY$
     IF a$ = CHR$(27) THEN CLOSE #2: GOTO 100
     GET #2, , send$
     PRINT #1, send$
     sent = sent + LEN(send$)
     LOCATE lin, 1: PRINT sent; " bytes sent"
     LOOP UNTIL sent >= size
     PRINT "File at "; sent; " bytes sent"
     CLOSE #2
     GOTO 100

900  REM Receive Files
     INPUT "Filename : "; file$
     OPEN file$ FOR BINARY AS #2
     PRINT #1, "OK"
     DO
     a$ = INKEY$
     IF a$ = CHR$(27) THEN CLOSE #2: GOTO 100
     INPUT #1, in$
     LOOP UNTIL in$ <> ""
     size = VAL(in$)
     PRINT #1, size
     DO
     a$ = INKEY$
     IF a$ = CHR$(27) THEN CLOSE #2: GOTO 100
     INPUT #1, in$
     LOOP UNTIL in$ <> ""
     IF in$ = "ERROR" THEN PRINT "Size Checksum Error": GOTO 100
     IF in$ = "OK" THEN PRINT "Ready"
     send$ = SPACE$(1024)
     lin = CSRLIN
     PRINT #1, "OK"
     DO
     a$ = INKEY$
     IF a$ = CHR$(27) THEN CLOSE #2: GOTO 100
     IF LOC(1) <> 0 THEN
        in$ = INPUT$(1, 1)
        in = in + 1
        PUT #2, , in$
        END IF
     IF in = 1024 THEN
        ks = ks + 1
        LOCATE lin, 1
        PRINT ks; "/"; (size / 1024); "  :  "; FIX(ks) / size; "% Complete"
        PRINT #1, "OK"
        in = 0
        END IF
     LOOP UNTIL LOF(2) >= size
     PRINT "File received at "; LOF(2); " bytes"
     PRINT "Original file size "; size
     PRINT #1, LOF(2); "bytes recieved"
     CLOSE #2
     GOTO 100

1000 GOTO 100
1100    PRINT "** Help : Command List **"
        PRINT
        PRINT "F1       : Help"
        PRINT "F2       : Dial"
        PRINT "F3       : Modem Model"
        PRINT "F4       : Modem Type"
        PRINT "F5       : Modem Speed"
        'PRINT "F6       :"
        'PRINT "F7       :"
        PRINT "F8       : SEND FILES"
        'PRINT "F9       :"
        PRINT "F10      : Software Reset"
        PRINT "F11      : Factory Default Reset"
        PRINT "F12      : Hangup"
        PRINT "ESCAPE   : Exit"
        GOTO 100
1200    INPUT "Number to Dial : ", Number$
        IF Number$ = "" THEN PRINT "Aborted": GOTO 100
        PRINT #1, "ATDT"; Number$
        PRINT "Dialing "; Number$
        GOTO 100
1300 PRINT #1, "ATI3": GOTO 100
1340 PRINT #1, "ATI4": GOTO 100
1350 PRINT #1, "ATI": GOTO 100
1360 GOTO 100
1400 GOTO 100
1500 GOTO 100
1550 GOTO 100
1600 PRINT #1, "ATZ": GOTO 100
1700 PRINT #1, "AT&F": GOTO 100
1800 PRINT #1, "+++ATH": GOTO 100  ' F12 : Hangup

'Added chr$(10) recognition (when modem fucks and puts picture instead of cr)
'Added escape options from send routine (PRESS ESCAPE)