home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: DFÜ und Kommunikation / SOS-DFUE.ISO / programm / dos / terminal / ca_29 / learn.cmd < prev    next >
Encoding:
Text File  |  1992-09-21  |  21.8 KB  |  1,385 lines
  1. SET TTHR OFF
  2. S19="Learn   ver 1.0     "
  3. CURS N91,N92
  4. LEGE S19
  5. SUBD S18
  6. DLDI S17
  7. SSIZ N99
  8. SAVE 0,0,N99-2,79
  9. ON ESCA GOSU ESCAPE
  10. SET FLAG(1) OFF
  11. IF STRCMP "_PRIN" "ON"
  12. SET FLAG(1) ON
  13. PRINTER OFF
  14. ENDI
  15. Get_Outp:
  16. S1="Enter a file name to be output:"
  17. GOSU Ask_File
  18. IF NOT SUCCESS EXIT
  19. S16=S0
  20. IF ISFILE S16
  21. S0=S16*" already exists.  Overwrite it? Y/N (cr=no)"
  22. GOSU Ask_YN
  23. IF NOT SUCCESS GOTO Get_Output
  24. ENDI
  25. FOPENO S16 TEXT
  26. IF NOT SUCCESS
  27. S0="Error opening output file: "*S16
  28. GOSU Error
  29. GOTO Get_outp
  30. ENDI
  31. GOSU Initial
  32. SET CHAT OFF
  33. GOTO START
  34. Escape:
  35. SET FLAG(0) ON
  36. RETU
  37. End_Lear:
  38. DWIN CLEAR
  39. IF FLAG(2) and STRCMP "_LOGG" "ON "
  40. WRIT "LOG CLOSE!"
  41. LOG CLOS
  42. ENDI
  43. WRIT "^Z" 2
  44. FCLOSEO
  45. SET DLDI S17
  46. CHDI S18
  47. REST
  48. LOCA N91,N92
  49. IF FLAG(1)
  50. PRINTER ON
  51. ELSE
  52. PRINTER OFF
  53. ENDI
  54. RETU
  55. Exit:
  56. S0="Do you wish to terminate LEARN?  Enter Y to terminate."
  57. GOSU Ask_YN
  58. IF SUCCESS
  59. GOSU End_Lear
  60. EXIT
  61. ENDI
  62. SET FLAG(0) OFF
  63. RETU
  64. Start:
  65. N90=0
  66. S11=""
  67. S12=""
  68. SET FLAG(0) OFF
  69. SET FLAG(9) OFF
  70. SET FLAG(8) OFF
  71. GOSU Screen
  72. LOCA 1,1
  73. DWIN N99-12,2 N99-12 77
  74. GOTO Main
  75. Output:
  76. WRIT S0
  77. WRIT "!"
  78. Main:
  79. LOCA N93,N94
  80. IF FLAG(0) GOSUB Exit
  81. IF NOT HITKEY
  82. IF RECEIVE GOSUB Receive
  83. GOTO Main
  84. ENDI
  85. KEYG S1
  86. LENG S1 N0
  87. SWIT N0
  88. CASE 1
  89. GOTO ASCII
  90. ENDC
  91. CASE 2
  92. GOTO CONTROL
  93. ENDC
  94. CASE 4
  95. GOTO FUNCTION
  96. ENDC
  97. ENDS
  98. GOTO Main
  99. KbdDisp:
  100. IF GT N90 0
  101. S0=S10(0:n90-1)
  102. PRES S0
  103. ATSA N99-12,2 (Default) S0*"  "
  104. ENDI
  105. N94=N90+2
  106. GOTO Main
  107. Receive:
  108. DWIN 1,0,(N99-14),79
  109. IF FLAG(1) PRINTER ON
  110. LOCA N95,N96
  111. S12=S11
  112. RGET S11 80 1
  113. CURS N95,N96
  114. IF FLAG(1) PRINTER OFF
  115. DWIN N99-12,2 N99-12,77
  116. RETU
  117. ASCII:
  118. IF FLAG(8)
  119. PRES S1
  120. TRAN S1
  121. GOTO Main
  122. ENDI
  123. IF GT (N90+2) 60
  124. SOUN 100,100
  125. GOTO Main
  126. ENDI
  127. S10(N90:N90)=S1
  128. INC N90
  129. IF STRCMP S1 "!" or STRCMP S1 "^"
  130. S10(N90:N90)=S1
  131. INC N90
  132. ENDI
  133. IF FLAG(9) GOTO Transmit
  134. GOTO KbdDisp
  135. Control:
  136. S0="0x"*S1
  137. N0=S0
  138. N0=N0+64
  139. S0="^"
  140. ITOC N0 S0(1:1)
  141. IF FLAG(8)
  142. TRAN S0
  143. GOTO Main
  144. ENDI
  145. IF (NOT FLAG(9)) and STRCMP S1 "08"
  146. GOTO Backspac
  147. ENDI
  148. IF STRCMP S1 "0D"
  149. GOTO RETURN
  150. ENDI
  151. IF GT (N90+2) 60
  152. SOUN 100,100
  153. GOTO Main
  154. ENDI
  155. S10(N90:N90+1)=S0(0:1)
  156. N90=N90+2
  157. IF FLAG(9) GOTO Transmit
  158. GOTO KbdDisp
  159. Backspac:
  160. IF ZERO N90
  161. GOTO KbdDisp
  162. ENDI
  163. DEC N90
  164. IF STRCMP S10(N90-1:N90-1) "^" or STRCMP S10(N90-1:N90) "!!"
  165. DEC N90
  166. ENDI
  167. GOTO KbdDisp
  168. Return:
  169. IF NOT ZERO N90
  170. S10=S10(0:N90-1)*"!"
  171. ELSE
  172. S10="!"
  173. ENDI
  174. N90=N90+1
  175. Transmit:
  176. GOSU Waitfor
  177. WRIT "TRANSMIT `""
  178. IF STRCMP S10(N90-1:N90-1) "!!"
  179. WRIT S10 N90-1
  180. WRIT "!!" 2
  181. ELSE
  182. WRIT S10 N90
  183. ENDI
  184. WRIT "`"!"
  185. TRAN S10(0:N90-1)
  186. N90=0
  187. CLEA (default)
  188. N94=2
  189. GOTO Main
  190. Waitfor:
  191. LJ S11
  192. S11=S11&""
  193. LENG S11 N1
  194. IF NOT ZERO N1
  195. S0=S11
  196. GOTO EmitWait
  197. ENDI
  198. LJ S12
  199. S12=S12&""
  200. LENG S12 N1
  201. IF NOT ZERO N1
  202. S0=S12
  203. GOTO EmitWait
  204. ENDI
  205. WRIT ";!"
  206. WRIT "; WAITFOR may be needed here!"
  207. WRIT ";!"
  208. RETU
  209. EmitWait:
  210. PRES S0
  211. LENG S0 N1
  212. WRIT "WAITFOR `""
  213. WRIT S0
  214. WRIT "`"!"
  215. WRIT ";*IF NOT WAITFOR GOTO ...!"
  216. S11=""
  217. S12=""
  218. RETU
  219. Function:
  220. IF FLAG(8) and NOT STRCMP S1 "4000"
  221. SOUN 100,100
  222. GOTO Main
  223. ENDI
  224. SWIT S1
  225. CASE "2E00"
  226. GOTO Clear
  227. ENDC
  228. CASE "1200"
  229. GOTO Echo
  230. ENDC
  231. CASE "2C00"
  232. GOTO Mask
  233. ENDC
  234. CASE "2600"
  235. GOTO ScrSize
  236. ENDC
  237. CASE "2300"
  238. GOTO Hangup
  239. ENDC
  240. CASE "2000"
  241. GOTO Dial
  242. ENDC
  243. CASE "1900"
  244. GOTO Parms
  245. ENDC
  246. CASE "3100"
  247. GOTO Encrypt
  248. ENDC
  249. CASE "2200"
  250. GOTO Blnkln
  251. ENDC
  252. CASE "1000"
  253. GOTO CRLF
  254. ENDC
  255. CASE "7500"
  256. GOTO Break
  257. ENDC
  258. CASE "7200"
  259. GOTO Printer
  260. ENDC
  261. CASE "4900"
  262. GOTO Upload
  263. ENDC
  264. CASE "5100"
  265. GOTO Download
  266. ENDC
  267. CASE "7800"
  268. GOTO Alt_1
  269. ENDC
  270. CASE "7900"
  271. GOTO Alt_2
  272. ENDC
  273. CASE "7A00"
  274. GOTO Alt_3
  275. ENDC
  276. CASE "7B00"
  277. GOTO Alt_4
  278. ENDC
  279. CASE "7C00"
  280. GOTO Alt_5
  281. ENDC
  282. CASE "7D00"
  283. GOTO Alt_6
  284. ENDC
  285. CASE "7E00"
  286. GOTO Alt_7
  287. ENDC
  288. CASE "7F00"
  289. GOTO Alt_8
  290. ENDC
  291. CASE "8000"
  292. GOTO Alt_9
  293. ENDC
  294. CASE "8100"
  295. GOTO Alt_0
  296. ENDC
  297. CASE "3B00"
  298. GOTO Accessry
  299. ENDC
  300. CASE "3C00"
  301. GOTO Script
  302. ENDC
  303. CASE "3D00"
  304. GOTO Chdir
  305. ENDC
  306. CASE "3E00"
  307. GOTO DlDir
  308. ENDC
  309. CASE "3F00"
  310. GOTO LineChar
  311. ENDC
  312. CASE "4000"
  313. GOTO Hold
  314. ENDC
  315. CASE "4100"
  316. GOTO Log
  317. ENDC
  318. CASE "4300"
  319. GOTO LogHold
  320. ENDC
  321. CASE "4400"
  322. GOSU Help
  323. ENDC
  324. CASE "7100"
  325. GOTO Shell
  326. ENDC
  327. DEFA
  328. SOUN 100,100
  329. ENDC
  330. ENDS
  331. GOTO Main
  332. SHELL:
  333. S16="_OFILE"
  334. FCLOSEO
  335. DWIN Clear
  336. SHEL
  337. DWIN N99-12,2 N99-12 77
  338. LEGE S19
  339. FOPENO S16 TEXT APPEND
  340. GOTO Main
  341. Clear:
  342. DWIN 1,0,(N99-14),79
  343. CLEA (default)
  344. CURS N95,N96
  345. DWIN N99-12,2 N99-12,77
  346. LOCA N93,N94
  347. S0="CLEAR"
  348. GOTO Output
  349. Echo:
  350. S0="SET DUPLEX HALF"
  351. IF STRCMP "_DUPL" "HALF"
  352. S0="SET DUPLEX FULL"
  353. ENDI
  354. PERF S0
  355. GOSU StatusLi
  356. GOTO Output
  357. Mask:
  358. S0="SET MASK ON"
  359. IF STRCMP "_MASK" "ON "
  360. S0="SET MASK OFF"
  361. ENDI
  362. PERF S0
  363. GOSU StatusLi
  364. GOTO Output
  365. ScrSize:
  366. S0="SET 43"
  367. IF GT "_SSIZ" 25
  368. S0="SET 25"
  369. ENDI
  370. PERF S0
  371. SSIZ N99
  372. GOSU Screen
  373. GOTO Output
  374. Alt_0:
  375. S0="MACRO 0"
  376. GOTO Send_Mac
  377. Alt_1:
  378. S0="MACRO 1"
  379. GOTO Send_Mac
  380. Alt_2:
  381. S0="MACRO 2"
  382. GOTO Send_Mac
  383. Alt_3:
  384. S0="MACRO 3"
  385. GOTO Send_Mac
  386. Alt_4:
  387. S0="MACRO 4"
  388. GOTO Send_Mac
  389. Alt_5:
  390. S0="MACRO 5"
  391. GOTO Send_Mac
  392. Alt_6:
  393. S0="MACRO 6"
  394. GOTO Send_Mac
  395. Alt_7:
  396. S0="MACRO 7"
  397. GOTO Send_Mac
  398. Alt_8:
  399. S0="MACRO 8"
  400. GOTO Send_Mac
  401. Alt_9:
  402. S0="MACRO 9"
  403. Send_Mac:
  404. PERF S0
  405. GOTO Output
  406. Hangup:
  407. GOSU Waitfor
  408. S0="HANGUP"
  409. PERF S0
  410. GOTO Output
  411. Break:
  412. GOSU Waitfor
  413. S0="BREAK"
  414. PERF S0
  415. GOTO Output
  416. Printer:
  417. IF FLAG(1)
  418. S0="PRINTER OFF"
  419. SET FLAG(1) OFF
  420. ELSE
  421. S0="PRINTER ON"
  422. SET FLAG(1) ON
  423. ENDI
  424. WRIT S0*"!"
  425. GOSU StatusLi
  426. GOTO Main
  427. LineChar:
  428. IF FLAG(9)
  429. SET FLAG(9) OFF
  430. ELSE
  431. SET FLAG(9) ON
  432. ENDI
  433. GOSU StatusLi
  434. GOTO Main
  435. Hold:
  436. IF FLAG(8)
  437. SET FLAG(8) OFF
  438. ELSE
  439. SET FLAG(8) ON
  440. ENDI
  441. GOSU StatusLi
  442. GOTO Main
  443. UpLoad:
  444. GOSU Ask_Meth
  445. S1="/NONAME/"
  446. SWIT S0
  447. CASE "_NULL"
  448. GOTO Main
  449. ENDC
  450. CASE "0"
  451. GOSU Ask_Name
  452. S0="SENDFILE ZMODEM S1"
  453. ENDC
  454. CASE "1"
  455. GOSU Ask_Name
  456. S0="SENDFILE WXMODEM S1"
  457. ENDC
  458. CASE "2"
  459. GOSU Ask_Name
  460. S0="SENDFILE XMODEM S1"
  461. ENDC
  462. CASE "3"
  463. GOSU Ask_Name
  464. S0="SENDFILE ASCII S1"
  465. ENDC
  466. CASE "4"
  467. GOSU Ask_Name
  468. S0="SENDFILE YMODEM S1"
  469. ENDC
  470. CASE "5"
  471. S0="SENDFILE CISB"
  472. ENDC
  473. CASE "6"
  474. S0="SENDFILE QuickB"
  475. ENDC
  476. CASE "7"
  477. GOSU Ask_Name
  478. S0="SENDFILE KERMIT S1"
  479. ENDC
  480. CASE "8"
  481. GOSU Ask_Name
  482. S0="SENDFILE BYMODEM S1"
  483. ENDC
  484. CASE "9"
  485. GOSU Ask_Name
  486. S0="SENDFILE BYMOG S1"
  487. ENDC
  488. DEFA
  489. SOUN 100,100
  490. GOTO Main
  491. ENDC
  492. ENDS
  493. Transfer:
  494. IF NULL S1 GOTO Main
  495. PERF S0
  496. IF NOT STRCMP S1 "/NONAME/"
  497. WRIT "; File transfer!"
  498. WRIT "MESS `"Enter the file name: `"!"
  499. WRIT "GET S1 60!"
  500. ENDI
  501. GOTO Output
  502. DownLoad:
  503. GOSU Ask_Meth
  504. S1="/NONAME/"
  505. SWIT S0
  506. CASE "_NULL"
  507. GOTO Main
  508. ENDC
  509. CASE "0"
  510. S0="GETFILE ZMODEM S1"
  511. ENDC
  512. CASE "1"
  513. GOSU Ask_Name
  514. S0="GETFILE WXMODEM S1"
  515. ENDC
  516. CASE "2"
  517. GOSU Ask_Name
  518. S0="GETFILE XMODEM S1"
  519. ENDC
  520. CASE "3"
  521. GOSU Ask_Name
  522. S0="GETFILE ASCII S1"
  523. ENDC
  524. CASE "4"
  525. GOSU Ask_Name
  526. S0="GETFILE YMODEM S1"
  527. ENDC
  528. CASE "5"
  529. S0="GETFILE CISB"
  530. ENDC
  531. CASE "6"
  532. S0="GETFILE QuickB"
  533. ENDC
  534. CASE "7"
  535. S0="GETFILE KERMIT"
  536. ENDC
  537. CASE "8"
  538. S0="GETFILE BYMODEM"
  539. ENDC
  540. CASE "9"
  541. S0="GETFILE BYMOG"
  542. ENDC
  543. DEFA
  544. SOUN 100,100
  545. GOTO Main
  546. ENDC
  547. ENDS
  548. GOTO Transfer
  549. Ask_Meth:
  550. WOPE 2 20 14 60 (contrast) ASK_ESC
  551. ATSA 2 22 (contrast) " Learn UpLoad/Download "
  552. ATSA 3 22 (contrast) " 1) Windowed XMODEM"
  553. ATSA 4 22 (contrast) " 2) CRC/Checksum XMODEM"
  554. ATSA 5 22 (contrast) " 3) ASCII transfer "
  555. ATSA 6 22 (contrast) " 4) YMODEM/XMODEM-1K"
  556. ATSA 7 22 (contrast) " 5) CIS-B         "
  557. ATSA 8 22 (contrast) " 6) CIS Quick-B     "
  558. ATSA 9 22 (contrast) " 7) Kermit     "
  559. ATSA 10 22 (contrast) " 8) Batch YMODEM      "
  560. ATSA 11 22 (contrast) " 9) Batch YMODEM-G "
  561. ATSA 11 22 (contrast) " 0) ZMODEM "
  562. ATSA 12 20 (contrast) "├───────────────────────────────────────┤"
  563. ATSA 13 22 (contrast) "Enter method #:"
  564. ATSA 14 30 (contrast) " Press ESC to cancel "
  565. ATGE 13 48 (contrast) 1 S0
  566. WCLO
  567. RETU
  568. Ask_Name:
  569. WOPE 10 10 13 70 (contrast) NAMEESC
  570. ATSA 10 12 (contrast) " Learn Up/Down Filename "
  571. ATSA 11 12 (contrast) "Enter a file name to be transferred:"
  572. ATSA 13 30 (contrast) " Press ESC to cancel "
  573. ATGE 12 12 (contrast) 54 S1
  574. WCLO
  575. LJ S1
  576. S1=S1&""
  577. RETU
  578. NAMEESC:
  579. S1=""
  580. RETU
  581. Dial:
  582. GOSU Ask_Dial
  583. IF NOT SUCCESS or NULL S2 GOTO Main
  584. IF FIND S2 "m"
  585. GOSU Ask_numb
  586. IF FAILED or NULL S1 GOTO Main
  587. MDIA S1
  588. ELSE
  589. DIAL S2
  590. ENDI
  591. IF FAILED GOTO Main
  592. WRIT "; Dialing!"
  593. IF FIND S2 "m"
  594. WRIT "MDIAL `""
  595. WRIT S1
  596. WRIT "`"!"
  597. WRIT "IF FAILED EXIT!"
  598. ELSE
  599. WRIT "IF NOT LINKED!"
  600. WRIT "     DIAL `""
  601. WRIT S2
  602. WRIT "`"!"
  603. WRIT "     IF FAILED EXIT!"
  604. WRIT "     ENDIF!"
  605. ENDI
  606. GOTO Main
  607. Ask_Numb:
  608. WOPE 10 10 13 70 (contrast) NAMEESC
  609. ATSA 10 12 (contrast) " Learn Manual Dial "
  610. ATSA 11 12 (contrast) "Enter the number to dial:"
  611. ATSA 13 30 (contrast) " Press ESC to cancel "
  612. ATGE 12 12 (contrast) 14 S1
  613. WCLO
  614. LJ S1
  615. S1=S1&""
  616. RETU
  617. Ask_Dial:
  618. N0=0
  619. WOPE 2 20 15 60 (contrast) ASK_ESC
  620. ATSA 2 22 (contrast) " Learn Dial  "
  621. ATSA 13 20 (contrast) "├───────────────────────────────────────┤"
  622. ATSA 14 22 (contrast) "Entry# (or m):"
  623. ATSA 15 30 (contrast) " Press ESC to cancel "
  624. Dial_Loo:
  625. SCRO 0,3,22 12,58 (contrast)
  626. FOR N1=1,10
  627. N4=N0+N1
  628. DIRE S0 N4
  629. ATSA (2+N1) 22 (contrast) N4*")"
  630. ATSA (2+N1) 27 (contrast) S0
  631. ENDF
  632. LOCA 14 37
  633. N2=37
  634. S2=""
  635. Dial_Key:
  636. KEYG S0
  637. LENG S0 N1
  638. SWIT N1
  639. CASE 1
  640. IF FIND S0 "m"
  641. S2=S0
  642. SET SUCC ON
  643. GOTO Dial_End
  644. ENDI
  645. IF NOT FIND "+-@#0123456789" S0
  646. SOUN 100,100
  647. GOTO Dial_Key
  648. ENDI
  649. S2=S2*S0
  650. ATSA 14 N2 (contrast) S0
  651. INC N2
  652. LOCA 14 N2
  653. GOTO Dial_Key
  654. ENDC
  655. CASE 2
  656. SWIT S0
  657. CASE "0D"
  658. SET SUCC ON
  659. GOTO DIAL_End
  660. ENDC
  661. CASE "08"
  662. LENG S2 N0
  663. IF GT N0 1
  664. S2=S2(0:N0-2)
  665. DEC N2
  666. LOCA 14 N2
  667. ATSA 14 N2 (contrast) " "
  668. ELSE
  669. S2=""
  670. N2=37
  671. ATSA 14 N2 (contrast) " "
  672. ENDI
  673. GOTO Dial_Key
  674. ENDC
  675. DEFA
  676. SOUN 100,100
  677. GOTO Dial_Key
  678. ENDC
  679. ENDS
  680. ENDC
  681. CASE 4
  682. SWIT S0
  683. CASE "4900"
  684. N0=N0-10
  685. IF LT N0 0
  686. N0=90
  687. ENDI
  688. GOTO Dial_Loo
  689. ENDC
  690. CASE "5100"
  691. N0=N0+10
  692. IF GE N0 100
  693. N0=0
  694. ENDI
  695. GOTO Dial_Loo
  696. ENDC
  697. CASE "4700"
  698. N0=0
  699. GOTO Dial_Loo
  700. ENDC
  701. CASE "4F00"
  702. N0=90
  703. GOTO Dial_Loo
  704. ENDC
  705. DEFA
  706. SOUN 100,100
  707. GOTO Dial_Key
  708. ENDC
  709. ENDS
  710. ENDC
  711. DEFA
  712. SET SUCC OFF
  713. ENDC
  714. ENDS
  715. Dial_End:
  716. WCLO
  717. RETU
  718. Accessry:
  719. GOSU Ask_AccN
  720. IF NOT SUCCESS or NULL S2 GOTO Main
  721. S0="WARNING: An accessory ends LEARN.  Enter Y to proceed."
  722. GOSU Ask_YN
  723. IF NOT SUCCESS GOTO Main
  724. WRIT "; Accessory!"
  725. WRIT "ACCESSORY `""
  726. LENG S2 N2
  727. WRIT S2 N2
  728. WRIT "`"!"
  729. GOSU End_Lear
  730. ACCE S2
  731. Dummy1:
  732. GOTO Main
  733. Ask_AccN:
  734. N0=0
  735. WOPE 2 10 15 70 (contrast) ASK_ESC
  736. ATSA 2 12 (contrast) " Learn Accessory "
  737. ATSA 13 10 (contrast) "├───────────────────────────────────────────────────────────┤"
  738. ATSA 14 12 (contrast) "Enter entry #:"
  739. ATSA 15 20 (contrast) " Press ESC to cancel "
  740. Acc_Loop:
  741. SCRO 0,3,12 12,68 (contrast)
  742. FOR N1=1,10
  743. N4=N0+N1
  744. ANAM S0 N4
  745. ATSA (2+N1) 12 (contrast) N4*")"
  746. ATSA (2+N1) 17 (contrast) S0
  747. ENDF
  748. LOCA 14 27
  749. N2=27
  750. S2=""
  751. Acc_Key:
  752. KEYG S0
  753. LENG S0 N1
  754. SWIT N1
  755. CASE 1
  756. IF NOT FIND "0123456789" S0
  757. SOUN 100,100
  758. GOTO Acc_Key
  759. ENDI
  760. S2=S2*S0
  761. ATSA 14 N2 (contrast) S0
  762. INC N2
  763. LOCA 14 N2
  764. GOTO Acc_Key
  765. ENDC
  766. CASE 2
  767. SWIT S0
  768. CASE "0D"
  769. SET SUCC ON
  770. GOTO Acc_End
  771. ENDC
  772. CASE "08"
  773. LENG S2 N0
  774. IF GT N0 1
  775. S2=S2(0:N0-2)
  776. DEC N2
  777. LOCA 14 N2
  778. ATSA 14 N2 (contrast) " "
  779. ELSE
  780. S2=""
  781. N2=27
  782. ATSA 14 N2 (contrast) " "
  783. ENDI
  784. GOTO Acc_Key
  785. ENDC
  786. DEFA
  787. SOUN 100,100
  788. GOTO Acc_Key
  789. ENDC
  790. ENDS
  791. ENDC
  792. CASE 4
  793. SWIT S0
  794. CASE "4900"
  795. N0=N0-10
  796. IF LT N0 0
  797. N0=40
  798. ENDI
  799. GOTO Acc_Loop
  800. ENDC
  801. CASE "5100"
  802. N0=N0+10
  803. IF GE N0 50
  804. N0=0
  805. ENDI
  806. GOTO Acc_Loop
  807. ENDC
  808. CASE "4700"
  809. N0=0
  810. GOTO Acc_Loop
  811. ENDC
  812. CASE "4F00"
  813. N0=40
  814. GOTO Acc_Loop
  815. ENDC
  816. DEFA
  817. SOUN 100,100
  818. GOTO Acc_Key
  819. ENDC
  820. ENDS
  821. ENDC
  822. DEFA
  823. SET SUCC OFF
  824. ENDC
  825. ENDS
  826. Acc_End:
  827. WCLO
  828. RETU
  829. Script:
  830. S1="Enter the script file name:"
  831. GOSU Ask_File
  832. IF NOT SUCCESS or NULL S0 GOTO Main
  833. S2=S0
  834. IF NOT ISSCFILE S2
  835. S0="Script file not found: "*S2
  836. GOSU Error
  837. GOTO Script
  838. ENDI
  839. S0="WARNING: A script call ends LEARN.    Enter Y to proceed."
  840. GOSU Ask_YN
  841. IF NOT SUCCESS GOTO Main
  842. WRIT "; Script!"
  843. WRIT "EXECUTE `""
  844. WRIT S2
  845. WRIT "`"!"
  846. GOSU End_Lear
  847. EXEC S2
  848. Dummy2:
  849. GOTO Main
  850. Chdir:
  851. S1="Enter the new drive:subdirectory:"
  852. GOSU Ask_File
  853. IF NOT SUCCESS or NULL S0 GOTO Main
  854. S0="CHDIR `""*S0&"`""
  855. PERF S0
  856. GOTO Output
  857. DlDir:
  858. S1="Enter the new download drive:subdirectory:"
  859. GOSU Ask_File
  860. IF NOT SUCCESS or NULL S0 GOTO Main
  861. S0="SET DLDIR `""*S0&"`""
  862. PERF S0
  863. GOTO Output
  864. Log:
  865. IF STRCMP "_LOGG" "OFF"
  866. S1="Enter the transcript file name:"
  867. GOSU Ask_File
  868. IF NOT SUCCESS or NULL S0 GOTO Main
  869. S0="LOG OPEN `""*S0&"`""
  870. SET FLAG(2) ON
  871. ELSE
  872. IF NOT FLAG(2)
  873. LOG CLOS
  874. GOTO Main
  875. ENDI
  876. S0="LOG CLOSE"
  877. ENDI
  878. PERF S0
  879. GOSU StatusLi
  880. GOTO Output
  881. LogHold:
  882. IF STRCMP "_LOGG" "OFF" GOTO Main
  883. IF STRCMP "_LOGH" "OFF"
  884. S0="LOG SUSPEND"
  885. ELSE
  886. S0="LOG RESUME"
  887. ENDI
  888. PERF S0
  889. GOSU StatusLi
  890. GOTO Output
  891. Parms:
  892. S0=""
  893. S1=""
  894. S2=""
  895. S3=""
  896. GOSU Ask_Parm
  897. LJ S0
  898. SWIT S0
  899. CASE "_NULL"
  900. GOTO Main
  901. ENDC
  902. CASE "1"
  903. S0="SET BAUD 300"
  904. GOTO Even_7_1
  905. ENDC
  906. CASE "2"
  907. S0="SET BAUD 1200"
  908. GOTO Even_7_1
  909. ENDC
  910. CASE "3"
  911. S0="SET BAUD 2400"
  912. GOTO Even_7_1
  913. ENDC
  914. CASE "4"
  915. S0="SET BAUD 4800"
  916. GOTO Even_7_1
  917. ENDC
  918. CASE "5"
  919. S0="SET BAUD 9600"
  920. GOTO Even_7_1
  921. ENDC
  922. CASE "6"
  923. S0="SET BAUD 19K"
  924. GOTO Even_7_1
  925. ENDC
  926. CASE "7"
  927. S0="SET BAUD 38K"
  928. GOTO Even_7_1
  929. ENDC
  930. CASE "8"
  931. S0="SET BAUD 57K"
  932. GOTO Even_7_1
  933. ENDC
  934. CASE "9"
  935. S0="SET BAUD 115K"
  936. GOTO Even_7_1
  937. ENDC
  938. CASE "10"
  939. S0="SET BAUD 300"
  940. GOTO None_8_1
  941. ENDC
  942. CASE "11"
  943. S0="SET BAUD 1200"
  944. GOTO None_8_1
  945. ENDC
  946. CASE "12"
  947. S0="SET BAUD 2400"
  948. GOTO None_8_1
  949. ENDC
  950. CASE "13"
  951. S0="SET BAUD 4800"
  952. GOTO None_8_1
  953. ENDC
  954. CASE "14"
  955. S0="SET BAUD 9600"
  956. GOTO None_8_1
  957. ENDC
  958. CASE "15"
  959. S0="SET BAUD 19K"
  960. GOTO None_8_1
  961. ENDC
  962. CASE "16"
  963. S0="SET BAUD 38k"
  964. GOTO None_8_1
  965. ENDC
  966. CASE "17"
  967. S0="SET BAUD 57k"
  968. GOTO None_8_1
  969. ENDC
  970. CASE "18"
  971. S0="SET BAUD 115K"
  972. GOTO None_8_1
  973. ENDC
  974. CASE "19"
  975. S0="SET PARITY EVEN"
  976. ENDC
  977. CASE "20"
  978. S0="SET PARITY ODD"
  979. ENDC
  980. CASE "21"
  981. S0="SET PARITY ODD"
  982. ENDC
  983. CASE "22"
  984. S0="SET DATA 7"
  985. ENDC
  986. CASE "23"
  987. S0="SET DATA 8"
  988. ENDC
  989. CASE "24"
  990. S0="SET STOP 1"
  991. ENDC
  992. CASE "25"
  993. S0="SET STOP 2"
  994. ENDC
  995. CASE "26"
  996. S0="SET PORT COM1"
  997. ENDC
  998. CASE "27"
  999. S0="SET PORT COM2"
  1000. ENDC
  1001. CASE "28"
  1002. S0="SET PORT COM3"
  1003. ENDC
  1004. CASE "29"
  1005. S0="SET PORT COM4"
  1006. ENDC
  1007. DEFA
  1008. SOUN 100,100
  1009. GOTO Parms
  1010. ENDC
  1011. ENDS
  1012. GOTO End_Parm
  1013. Even_7_1:
  1014. S1="SET PARITY EVEN"
  1015. S2="SET DATA 7"
  1016. S3="SET STOP 1"
  1017. GOTO End_Parm
  1018. None_8_1:
  1019. S1="SET PARITY NONE"
  1020. S2="SET DATA 8"
  1021. S3="SET STOP 1"
  1022. End_Parm:
  1023. IF NOT NULL S0
  1024. PERF S0
  1025. WRIT S0*"!"
  1026. ENDI
  1027. IF NOT NULL S1
  1028. PERF S1
  1029. WRIT S1*"!"
  1030. ENDI
  1031. IF NOT NULL S2
  1032. PERF S2
  1033. WRIT S2*"!"
  1034. ENDI
  1035. IF NOT NULL S3
  1036. PERF S3
  1037. WRIT S3*"!"
  1038. ENDI
  1039. GOTO Main
  1040. Ask_Parm:
  1041. WOPE 2 10 16 70 (contrast) ASK_ESC
  1042. ATSA 2 12 (contrast) " Learn Parms "
  1043. ATSA 3 12 (contrast) " 1)  300,E,7,1"
  1044. ATSA 4 12 (contrast) " 2) 1200,E,7,1"
  1045. ATSA 5 12 (contrast) " 3) 2400,E,7,1"
  1046. ATSA 6 12 (contrast) " 4) 4800,E,7,1"
  1047. ATSA 7 12 (contrast) " 5) 9600,E,7,1"
  1048. ATSA 8 12 (contrast) " 6) 19.2,E,7,1"
  1049. ATSA 9 12 (contrast) " 7) 38.4,E,7,1"
  1050. ATSA 10 12 (contrast) " 8) 57.6,E,7,1"
  1051. ATSA 11 12 (contrast) " 9) 115K,E,7,1"
  1052. ATSA 3 28 (contrast) "10)  300,N,8,1"
  1053. ATSA 4 28 (contrast) "11) 1200,N,8,1"
  1054. ATSA 5 28 (contrast) "12) 2400,N,8,1"
  1055. ATSA 6 28 (contrast) "13) 4800,N,8,1"
  1056. ATSA 7 28 (contrast) "14) 9600,N,8,1"
  1057. ATSA 8 28 (contrast) "15) 19.2,N,8,1"
  1058. ATSA 9 28 (contrast) "16) 38.4,N,8,1"
  1059. ATSA 10 28 (contrast) "16) 57.6,N,8,1"
  1060. ATSA 11 28 (contrast) "18) 115K,N,8,1"
  1061. ATSA 3 44 (contrast) "19) Even par."
  1062. ATSA 4 44 (contrast) "20) Odd parity"
  1063. ATSA 5 44 (contrast) "21) No parity"
  1064. ATSA 7 44 (contrast) "22) 7 data bits"
  1065. ATSA 8 44 (contrast) "23) 8 data bits"
  1066. ATSA 10 44 (contrast) "24) 1 stop bit"
  1067. ATSA 11 44 (contrast) "25) 2 stop bits"
  1068. ATSA 3 60 (contrast) "26) COM1"
  1069. ATSA 4 60 (contrast) "27) COM2"
  1070. ATSA 5 60 (contrast) "28) COM3"
  1071. ATSA 6 60 (contrast) "29) COM4"
  1072. ATSA 12 10 (contrast) "├───────────────────────────────────────────────────────────┤"
  1073. COMP S0
  1074. ATSA 13,12 (contrast) "Current setting: "*S0
  1075. ATSA 14 10 (contrast) "├───────────────────────────────────────────────────────────┤"
  1076. ATSA 15 12 (contrast) "Enter selection #:"
  1077. ATSA 16 30 (contrast) " Press ESC to cancel "
  1078. ATGE 15 31 (contrast) 2 S0
  1079. WCLO
  1080. RETU
  1081. Encrypt:
  1082. GOSU Ask_Encr
  1083. SWIT S0
  1084. CASE "_NULL"
  1085. GOTO Main
  1086. ENDC
  1087. CASE "1"
  1088. S2="ENCRYPT"
  1089. S3="SIMPLE"
  1090. ENDC
  1091. CASE "2"
  1092. S2="DECRYPT"
  1093. S3=""
  1094. ENDC
  1095. DEFA
  1096. SOUN 100,100
  1097. GOTO Encrypt
  1098. ENDC
  1099. ENDS
  1100. EncrSrc:
  1101. S1="Enter the file to be encrypted/decrypted:"
  1102. GOSU Ask_File
  1103. IF NOT SUCCESS or NULL S0 GOTO Main
  1104. IF NOT ISFILE S0
  1105. S0="File does not exist: "*S0
  1106. GOSU Error
  1107. GOTO EncrSrc
  1108. ENDI
  1109. S4=S0
  1110. EncrDest:
  1111. S1="Name the output of encryption/decryption:"
  1112. GOSU Ask_File
  1113. IF NOT SUCCESS or NULL S0 GOTO Main
  1114. IF ISFILE S0
  1115. S0="File exists: "*S0&".  Delete it Y/N?"
  1116. GOSU Ask_YN
  1117. IF SUCCESS
  1118. DELE S0
  1119. ELSE
  1120. GOTO EncrSrc
  1121. ENDI
  1122. ENDI
  1123. S5=S0
  1124. EncrPsw:
  1125. S1="Enter the password:"
  1126. GOSU Ask_File
  1127. IF NOT SUCCESS or NULL S0 GOTO Main
  1128. S6=S0
  1129. S0=S2&" S4 S5 S6 "*S3
  1130. PERF S0
  1131. IF NOT SUCCESS
  1132. S0="Encrypt/decrypt failed.  Nothing logged to script."
  1133. GOSU Error
  1134. Goto Main
  1135. ENDI
  1136. WRIT "; Encrypt/decrypt!"
  1137. WRIT "MESS `"Enter the encrypt/decrypt source: `"!"
  1138. WRIT "GET S1 60!"
  1139. WRIT "MESS `"Enter the encrypt/decrypt destination: `"!"
  1140. WRIT "GET S2 60!"
  1141. WRIT "MESS `"Enter the encrypt/decrypt password: `"!"
  1142. WRIT "GET S3 60!"
  1143. WRIT S2&" S1 S2 S3 "*S3*"!"
  1144. GOTO Main
  1145. Ask_Encr:
  1146. WOPE 2 20 8 60 (contrast) ASK_ESC
  1147. ATSA 2 22 (contrast) " Learn D/Encrypt "
  1148. ATSA 4 22 (contrast) " 1) Simple encryption"
  1149. ATSA 5 22 (contrast) " 2) Decrypt encrypted file"
  1150. ATSA 6 20 (contrast) "├───────────────────────────────────────┤"
  1151. ATSA 7 22 (contrast) "Enter selection #:"
  1152. ATSA 8 30 (contrast) " Press ESC to cancel "
  1153. ATGE 7 41 (contrast) 1 S0
  1154. WCLO
  1155. RETU
  1156. Blnkln:
  1157. S0="SET BSUPPRESS ON"
  1158. IF STRCMP "_BSUP" "ON "
  1159. S0="SET BSUPPRESS OFF"
  1160. ENDI
  1161. PERF S0
  1162. GOSU StatusLi
  1163. GOTO Output
  1164. CRLF:
  1165. S0="SET CR CR_LF"
  1166. IF STRCMP "_CRLF" "ON "
  1167. S0="SET CR CR"
  1168. ENDI
  1169. PERF S0
  1170. GOSU StatusLi
  1171. GOTO Output
  1172. Screen:
  1173. DWIN CLEAR
  1174. CLEA (default)
  1175. SSIZ N99
  1176. DWIN N99-12,2 N99-12 77
  1177. BOX N99-13,0,(N99-11),79 (default)
  1178. ATSA 0,0 (default) ">>───────────────────────────────────────────────────────────────────────────<<"
  1179. ATSA 0,3 (default) " Learn "
  1180. ATSA (N99-13),3 (default) " Keyboard "
  1181. ATSA N99-11,28 (default) " ESC to terminate "
  1182. ATSA N99-11,53 (default) " Press F10 for info "
  1183. ATSA N99-10,2 (default) "F1 Load accessory       Alt-Q Toggle CR/CRLF         Alt-P   Set comm parms"
  1184. ATSA N99-9,2 (default) "F2 Execute script      Alt-E Toggle echo        Alt-G   Toggle blnkln "
  1185. ATSA N99-8,2 (Default) "F3 Change drive:subdir      Alt-C Clear screen        PgUp    Upload      "
  1186. ATSA N99-7,2 (Default) "F4 Set dft dlo subdir      Alt-L Toggle 25/43        PgDn    Download      "
  1187. ATSA N99-6,2 (Default) "F5 Toggle line/char      Alt-H Hangup            Alt-F10 Shell to DOS  "
  1188. ATSA N99-5,2 (Default) "F6 Toggle learn hold      Alt-D Dial            Alt-0/9 Send macro      "
  1189. ATSA N99-4,2 (Default) "F7 Toggle logging file      Alt-N Encrypt/decrypt        Ctl-End Send break      "
  1190. ATSA N99-3,2 (Default) "F9 Toggle log hold      Alt-Z Toggle masking        Ctl-Prt Toggle print  "
  1191. SCRO 0,N99-2,0 N99-2,79 "_BAR"
  1192. GOSU StatusLi
  1193. N95=1
  1194. N96=0
  1195. N93=N99-12
  1196. N94=2
  1197. RETU
  1198. StatusLi:
  1199. IF STRCMP "_DUPL" "HALF"
  1200. ATSA N99-2,2 "_bar" "Echo"
  1201. ELSE
  1202. ATSA N99-2,2 "_bar" "     "
  1203. ENDI
  1204. IF STRCMP "_MASK" "ON"
  1205. ATSA N99-2,8 "_bar" "Mask"
  1206. ELSE
  1207. ATSA N99-2,8 "_bar" "     "
  1208. ENDI
  1209. IF STRCMP "_BSUP" "ON "
  1210. ATSA N99-2,14 "_bar" "NoBln"
  1211. ELSE
  1212. ATSA N99-2,14 "_bar" "       "
  1213. ENDI
  1214. IF STRCMP "_CRLF" "ON "
  1215. ATSA N99-2,21 "_bar" "CR_LF"
  1216. ELSE
  1217. ATSA N99-2,21 "_bar" "       "
  1218. ENDI
  1219. IF STRCMP "_LOGG" "ON "
  1220. ATSA N99-2,28 "_bar" "Logging"
  1221. IF STRCMP "_LOGH" "ON"
  1222. ATSA N99-2,37 "_bar" "Log held"
  1223. ELSE
  1224. ATSA N99-2,37 "_bar" "          "
  1225. ENDI
  1226. ELSE
  1227. ATSA N99-2,28 "_bar" "         "
  1228. ATSA N99-2,37 "_bar" "          "
  1229. ENDI
  1230. IF FLAG(1)
  1231. ATSA N99-2,47 "_bar" "Print"
  1232. ELSE
  1233. ATSA N99-2,47 "_bar" "       "
  1234. ENDI
  1235. IF FLAG(9)
  1236. ATSA N99-2,60 "_bar" "CharMode"
  1237. ELSE
  1238. ATSA N99-2,60 "_bar" "LineMode"
  1239. ENDI
  1240. IF FLAG(8)
  1241. ATSA N99-2,70 "_bar" "LearnHeld"
  1242. ELSE
  1243. ATSA N99-2,70 "_bar" "           "
  1244. ENDI
  1245. RETU
  1246. Help:
  1247. WOPE 0,0,23,79 (default) HELPESC
  1248. ATSA 0,2 (Default) " Learn Help "
  1249. ATSA 23,28 (Default) " Press any key to continue "
  1250. ATSA 1,2 (default) "   The LEARN script creates a script based upon the actions taken.    The"
  1251. ATSA 2,2 (default) "function keys that LEARN will recognize and act upon are listed on the main"
  1252. ATSA 3,2 (default) "screen.  Each function results in an addition to the script being created,"
  1253. ATSA 4,2 (default) "with the exception of Alt-F10 (which allows editing of the script while it"
  1254. ATSA 5,2 (default) "is being created... it does not add a SHELL command to the script)."
  1255. ATSA 6,2 (default) ""
  1256. ATSA 7,2 (default) "   Initially LEARN is in 'line mode'.  When characters (a-z, 1-9) are typed,"
  1257. ATSA 8,2 (default) "they echo in the keyboard box.  When RETURN is typed, the whole line is"
  1258. ATSA 9,2 (default) "transmitted, and the appropriate script line(s) are written.  The 'mode' may"
  1259. ATSA 10,2 (default) "be switched to 'character', where each keystroke is transmitted when it is"
  1260. ATSA 11,2 (default) "typed (and each keystroke generates a WAITFOR/TRANSMIT command)."
  1261. ATSA 12,2 (default) ""
  1262. ATSA 13,2 (default) "NOTE: The display doubles carets and exclamation points.  This is done to"
  1263. ATSA 14,2 (default) "allow the the keystroke to correctly transmitted.    Don't be surprised!!"
  1264. ATSA 15,2 (default) ""
  1265. ATSA 16,2 (default) "    The LEARN script may be put on HOLD with the F6 key.  When held, what"
  1266. ATSA 17,2 (default) "is typed is sent, no script is generated, and no functions are available."
  1267. ATSA 18,2 (default) ""
  1268. ATSA 19,2 (default) "    LEARN does not provide all the functionality of COM-AND.  The basic"
  1269. ATSA 20,2 (default) "set of functions required to go on-line are provided.  Additional settings"
  1270. ATSA 21,2 (default) "may be added to the output script.     Extensive editing of the output script"
  1271. ATSA 22,2 (default) "is recommended in any case."
  1272. KEYG S0
  1273. WCLO
  1274. RETU
  1275. HELPESC:
  1276. RETU
  1277. Error:
  1278. WOPE 10,10,12,70 (contrast) Err_Esc
  1279. ATSA 10,12 (contrast) " Learn Error "
  1280. ATSA 11,12 (contrast) S0(0:55)
  1281. ATSA 12,26 (contrast) " Press any key to continue "
  1282. KEYG S0
  1283. WCLO
  1284. Err_Esc:
  1285. RETU
  1286. Ask_File:
  1287. WOPE 10 10 13 70 (contrast) ASK_ESC
  1288. ATSA 10 12 (contrast) " Learn Fname "
  1289. ATSA 11 12 (contrast) S1(0:56)
  1290. ATSA 13 30 (contrast) " Press ESC to cancel "
  1291. ATGE 12 12 (contrast) 54 S0
  1292. WCLO
  1293. LJ S0
  1294. S0=S0&""
  1295. UPPE S0
  1296. IF NOT NULL S0
  1297. SET SUCC ON
  1298. ELSE
  1299. SET SUCC OFF
  1300. ENDI
  1301. RETU
  1302. Ask_Esc:
  1303. S0=""
  1304. RETU
  1305. Ask_YN:
  1306. WOPE 10 10 13 70 (contrast) ASK_ESC
  1307. ATSA 10 12 (contrast) " Learn Y/N "
  1308. ATSA 11 12 (contrast) S0(0:55)
  1309. ATSA 13 30 (contrast) " Press ESC to cancel "
  1310. ATGE 12 12 (contrast) 1 S0
  1311. WCLO
  1312. IF NULL S0 or FIND S0 "Y"
  1313. SET SUCC ON
  1314. ELSE
  1315. SET SUCC OFF
  1316. ENDI
  1317. RETU
  1318. WriteLn:
  1319. WRIT S0
  1320. WRIT "!" 1
  1321. RETU
  1322. Initial:
  1323. IF CONNECTED
  1324. S0="; -------------------------------------------------------"
  1325. GOSU WriteLn
  1326. S0="; WARNING: This script learned after connection was made "*"_Date"
  1327. GOSU WriteLn
  1328. S0="; ------------------------------------------------------- "
  1329. GOSU WriteLn
  1330. GOTO No_Init
  1331. ENDI
  1332. S0="; Initial state: "*"_Date"
  1333. GOSU WriteLn
  1334. S0="SET DUPLEX "*"_DUPL"
  1335. GOSU WriteLn
  1336. S0="EMULATE "*"_EMUL"
  1337. GOSU WriteLn
  1338. S0="SET 25"
  1339. IF GT "_SSIZ" 25
  1340. S0="SET 43"
  1341. ENDI
  1342. GOSU WriteLn
  1343. S0="SET MASK "*"_MASK"
  1344. GOSU WriteLn
  1345. S0="SET CR CR_LF"
  1346. IF STRCMP "_CRLF" "OFF"
  1347. S0="SET CR CR"
  1348. ENDI
  1349. GOSU WriteLn
  1350. COMP S1
  1351. S0="SET PORT "*S1(11:14)
  1352. GOSU WriteLn
  1353. S0="SET BAUD "*S1(0:3)
  1354. GOSU WriteLn
  1355. IF STRCMP S1(5:5) "E"
  1356. S0="SET PARITY EVEN"
  1357. ELSE
  1358. IF STRCMP S1(5:5) "O"
  1359. S0="SET PARITY ODD"
  1360. ELSE
  1361. S0="SET PARITY NONE"
  1362. ENDI
  1363. ENDI
  1364. GOSU WriteLn
  1365. S0="SET DATA "*S1(7:7)
  1366. GOSU WriteLn
  1367. S0="SET STOP "*S1(9:9)
  1368. GOSU WriteLn
  1369. No_Init:
  1370. S0="; Learned script"
  1371. GOSU WriteLn
  1372. S0="LEGEND `"Script learned: `"*`""*"_Date"*"`""
  1373. GOSU WriteLn
  1374. IF FLAG(1)
  1375. S0="PRINTER ON"
  1376. ELSE
  1377. S0="PRINTER OFF"
  1378. ENDI
  1379. GOSU WriteLn
  1380. S0="SET CHAT "*"_CHAT"
  1381. GOSU WriteLn
  1382. S0="SET KBDB "*"_KBDB"
  1383. GOSU WriteLn
  1384. RETU
  1385.