5748099 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n demond.bas
   1: DECLARE SUB SLEEP2 (t!)
   2: COM(1) ON
   3: ON COM(1) GOSUB 120
   4: DIM nms(1 TO 200) AS STRING * 20
   5: q = 1
   6: CLS
   7: PRINT "DEMON DIALER V1.0"
   8: INPUT "What is the first two digits of your phone number"; ph$
   9: INPUT "Special dialing prefix (default is *67)"; dp$
  10: IF ph$ = "" THEN END
  11: IF LEN(ph$) = 2 THEN  ELSE END
  12: IF LTRIM$(dp$) = "" THEN dp$ = "*67"
  13: 10 RANDOMIZE TIMER
  14: OPEN "COM1:2400" FOR RANDOM AS #1
  15: r$ = RTRIM$(LTRIM$(STR$(INT(RND * 9))))
  16: r2$ = RTRIM$(LTRIM$(STR$(INT(RND * 9))))
  17: r4$ = RTRIM$(LTRIM$(STR$(INT(RND * 9))))
  18: f2$ = RTRIM$(LTRIM$(STR$(INT(RND * 9))))
  19: Phn$ = dp$ + "," + ph$ + f2$ + "-" + r$ + r2$ + r3$ + r4$
  20: 'Phn$ = "*67,1800-365-4636"
  21: x% = CSRLIN + 1: y% = POS(0)
  22: LOCATE 4, 1: PRINT "Dialing "; Phn$
  23: LOCATE x%, LEN(c$) + 1
  24: PRINT #1, "ATDT" + Phn$
  25: SLEEP2 26
  26: LOCATE x% - 1, y%
  27: CLOSE 1
  28: IF INKEY$ = CHR$(27) THEN FOR m = 1 TO q: PRINT nms(m): NEXT m: END
  29: GOTO 10
  30: END
  31: 
  32: 120 COM(1) OFF
  33: b$ = ""
  34: INPUT #1, b$
  35: 'PRINT b$
  36: IF RIGHT$(b$, 1) = CHR$(7) THEN b$ = ""
  37: IF UCASE$(b$) = UCASE$("connect 2400") THEN nms(q) = Phn$: q = q + 1: FOR v = 1 TO 25: PRINT #1, "+++ATH+++": NEXT v: c$ = "": PRINT Phn$; " has been added to the list": b$ = "": CLOSE 1:  GOTO 123
  38: IF UCASE$(b$) = UCASE$("no carrier") THEN FOR v = 1 TO 25: PRINT #1, "+++ATH+++": NEXT v: c$ = ""
  39: IF UCASE$(b$) = UCASE$("no dialtone") THEN PRINT "Requires Dialtone": FOR m = 1 TO q: PRINT nms(m): NEXT m: END
  40: IF UCASE$(b$) = UCASE$("error") THEN PRINT "An error Has Occured"
  41: IF UCASE$(b$) = UCASE$("busy") THEN PRINT Phn$; " is busy"
  42: 123 COM(1) ON
  43: d$ = ""
  44: b$ = ""
  45: RETURN
  46: 
  47: SUB SLEEP2 (t)
  48: a = TIMER + t
  49: DO UNTIL TIMER >= a: LOOP
  50: PRINT "Time Elapsed"
  51: END SUB
  52: 
5748100 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:21:07