home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / dmetd4fp.zip / TERMINAL.PRG < prev   
Text File  |  1991-05-10  |  16KB  |  470 lines
  1. ****************************  TERMINAL.PRG  **********************************
  2. *
  3. * This version runs under:  FoxPro and  DbaseIV
  4. *                           -------------------
  5. *
  6. * This is a sample program which demonstrates a number of the COMETMP library
  7. * commands used to emulate a simple terminal program.
  8. *
  9. * Command keys while in TERMINAL:
  10. *   F2 - Clears the screen
  11. *   F3 - Send a file or group of files(if Ymodem specified for protocol)
  12. *   F4 - Receive a file or files(if Ymodem)
  13. *   ESC - Suspends TERMINAL program or CANCEL an active file transfer
  14. *******************************************************************************
  15. *
  16. SET ESCAPE OFF
  17. SET TALK OFF
  18. SET BELL OFF
  19. SET STATUS OFF
  20. SET SCOREBOARD OFF
  21. SET SAFETY OFF
  22. PUBLIC Event, LF, Msg, ChkCmd, Thresh, Fox, FoxPro, LastMsg, TranHow
  23. PUBLIC ComPort, ComAddr, ComIRQn, ComBaud, ComPrty, ComDBts, ComFlow, ComPhon
  24. TranHow = ' '
  25.  
  26. DEFINE WINDOW TERMINAL FROM 0,0 TO 23,79 none
  27. ACTIVATE WINDOW TERMINAL
  28. CLEAR
  29.  
  30. * Let's find out if COMETMP has been LOADed by CALLing without 1st LOADing
  31. * and trapping any "File was not LOADed" (error 91) errors.
  32. DoLoad = .F.
  33. ON ERROR DoLoad = .T.
  34. CALL COMETMP
  35. IF DoLoad
  36.   IF FoxPro
  37.     Nul = MEMORY()                       && Prevents FPro from LOADing into EMS frame
  38.   ENDIF
  39.     LOAD COMETMP                          && Loads COMETMP.BIN communications library
  40. ENDIF
  41.  
  42. ON ERROR
  43.  
  44. Vers = 'VERS' + SPACE(15)
  45. CALL COMETMP WITH Vers              && Get version #
  46. Vers = SUBSTR(Vers, 6)              && Strip off "VERS " leaving only version info
  47.  
  48. * Display sign-on message
  49. @ 5, 13 TO 13,65 DOUBLE
  50. @ 7,15 SAY 'TERMINAL - A Terminal Emulation Program Using ...'
  51. @ 9,28 SAY '*** ' + Vers + ' ***'
  52. @ 11,15 SAY 'The  B A C K G R O U N D  Communication Library'
  53. Msg = 'COPYRIGHT(c) 1989 by  CompuSolve,  Rockaway, NJ  (201)983-9429'
  54. NULL = ShowOn24(Msg)
  55.  
  56. * Wait loop 
  57. NULL = INKEY(5)
  58.  
  59. CLEAR
  60.  
  61. * Get default settings from TERMINAL.MEM file, if present
  62. IF FILE('TERMINAL.MEM')
  63.  RESTORE FROM TERMINAL ADDITIVE
  64. ELSE
  65.  ComPort = '1'
  66.  ComAddr = 'x03F8'
  67.  ComIRQn = '4'
  68.  ComBaud = '2400 '
  69.  ComPrty = 'E'
  70.  ComDBts = '7'
  71.  ComStop = '1'
  72.  ComFlow = 'N'
  73. *
  74.  ComPhon = SPACE(20)
  75. ENDIF
  76.  
  77. @ 6,8 TO 15, 72
  78. @ 7,10 SAY 'COM Port # (1-5) ?' GET ComPort PICTURE '9' VALID  ComPort $ '12345' ERROR 'VALID CHOICES: 1 - 5'
  79. @ 8,10 SAY "I/O Address (x#### = heX) ?" GET ComAddr VALID .NOT. '?' $ ComAddr ERROR 'NEED TO SPECIFY PORT ADDRESS IN heX OR DECIMAL'
  80. @ 9,10 SAY "IRQ # (2-7) ?" GET ComIRQn PICTURE '9' VALID ComIRQn $ '234567' ERROR 'VALID CHOICES: 2 - 7'
  81. @10,10 SAY "BAUD Rate (300-38400) ?" GET ComBaud PICTURE 'X9999' VALID VAL(ComBaud) >= 300 .AND. VAL(ComBaud) <=38400 ERROR 'VALID CHOICES: 300 - 38400'
  82. @11,10 SAY "Parity (None, Odd or Even) ?" GET ComPrty PICTURE '!' VALID ComPrty $ 'NEO' ERROR 'VALID CHOICES: None, Even or Odd (N, E or O)'
  83. @12,10 SAY "# Data Bits (7 or 8) ?" GET ComDBts PICTURE '9' VALID ComDBts $ '78' ERROR 'VALID CHOICES: 7 or 8'
  84. @13,10 SAY "Flow Control (Xon/xoff, Rts/cts or None) ?" GET ComFlow PICTURE "!" VALID ComFlow $ 'XRN' ERROR 'VALID CHOICES: Xon/Xoff, Rts/cts or None (X, R or N)'
  85. @14,10 SAY "# Stop Bits (1 or 2) ?" GET ComStop VALID ComStop $ '12' ERROR 'VALID CHOICES: 1 or 2'
  86. READ
  87.  
  88. RKey = READKEY()
  89. IF MOD(RKey,256) = 12    && ESCape 
  90.  SUSPEND
  91. ENDIF
  92.  
  93. Msg = 'Enter a telephone # to dial (ENTER = local mode) ?'
  94. NULL = ShowOn24(Msg)
  95. @0,0
  96. * Init variables
  97. ChkCmd = ''
  98.  
  99. * Function keys used to invoke local commands
  100. F1 = 28
  101. F2 = -1                             && Clear Screen
  102. F3 = -2                             && Send file
  103. F4 = -3                             && Receive file
  104. F5 = -4
  105.  
  106. SET FUNC 'F2' TO ''
  107. SET FUNC 'F3' TO ''
  108. SET FUNC 'F4' TO ''
  109. SET FUNC 'F5' TO ''
  110.  
  111. * INKEY() values
  112. Up = 5
  113. Dn = 24
  114. Rgt = 4
  115. Lft = 19
  116. BkSpc = 127
  117.  
  118. * Build OPEN command for COMET
  119. Open = "OPEN COM" + ComPort + "," + ComAddr + "," + ComIRQn + ":" ;
  120.  + ComBaud + "," + ComPrty + "," + ComDBts + ",1," + ComFlow
  121.  
  122. ClsPort = 'CLOSE #' + ComPort          && In case port is being redefined ...
  123. CALL COMETMP WITH ClsPort
  124.  
  125. CALL COMETMP WITH Open                && Now OPEN it for use, that was easy!
  126.  
  127.  
  128. *** Must set FLAVOR if using dBASEIV ***
  129. IF .NOT. FoxPro                    && Must be dBASEIV
  130.     Flavor = 'FLAVOR D4'
  131.     CALL COMETMP WITH Flavor
  132. ENDIF
  133.  
  134. * Now we'll dial a phone#
  135. * Request # to dial 1st
  136. PhoneNo = SPACE(20)
  137. @16,10 SAY "Phone # to Dial (ENTER = direct/local) ?" GET ComPhon
  138. READ
  139.  
  140. *Save settings
  141. SAVE TO TERMINAL ALL LIKE Com????
  142.  
  143.  
  144. IF LEN(TRIM(ComPhon)) > 0
  145.  
  146.  * The ATTD is output to instruct HAYES compatible modems to dial a #
  147.  Dial = "OUTPUT #" + ComPort + ",ATTD" + TRIM(ComPhon) + CHR(13)  && Build OUTPUT command
  148.  CALL COMETMP WITH Dial                && Have modem dial #
  149.  
  150.  * Now, wait till we sense Data Carrier Detect(DCD) from our COM port.
  151.  Msg = "CHECKING FOR MODEM'S DATA CARRIER DETECT (DCD) ..."
  152.  NULL = ShowOn24(Msg)
  153.  Elapsed = 0                         && Simple timer for our DO .. WHILE loop
  154.  LastTime = TIME()                   && Also used for timing purposes
  155.  MdmStat = "MSTAT #" + ComPort + "," + SPACE(25)        && Build MSTAT command
  156.  DO WHILE Elapsed <= 45  .AND. (.NOT. "+DCD" $ MdmStat)
  157.     CALL COMETMP WITH MdmStat         && Get COM port's modem status
  158.  
  159.     IF LastTime <> TIME()           && Test if we need to updated timer count
  160.         Elapsed = Elapsed+1         && Another second has gone by ..
  161.         LastTime = TIME()
  162.         ACTIVATE SCREEN
  163.         @ 24, 66 SAY STR(45-Elapsed,2,0) COLOR W/N  && Display #secs till abort
  164.         ACTIVATE WINDOW TERMINAL
  165.     ENDIF
  166.  
  167.    IF INKEY() = 27
  168.      EXIT
  169.    ENDIF
  170.  
  171.  ENDDO
  172.  
  173.  * Check if we timed out
  174.  IF Elapsed > 45
  175.     ??CHR(7)
  176.     Null = ShowOn24("Sorry, can't establish phone connection. Aborting ...")
  177.     SUSPEND
  178.  ENDIF
  179.  
  180. ENDIF                       && If phone # was entered
  181.  
  182.  
  183.  
  184. * Now that we have a call established we have 2 things to do:
  185. *  1) Check COMETMP's receive buffer and display any incoming characters
  186. *  2) Detect any keystrokes and determine if local command or data to output
  187.  
  188. * #2 is simple, use an ONKEY approach
  189. ON KEY DO GotAkey with .f.
  190.  
  191. SET ESCAPE ON
  192. ON ESCAPE DO GotAKey WITH .t.        && 27 = INKEY() value of ESC key
  193.  
  194.  
  195. CLEAR
  196.  
  197. * Display status message on line 24
  198. Msg = "F2 - Clear | F3 - Send | F4 - Recv | TERM"
  199. LastMsg = Msg
  200. NULL =ShowOn24(Msg)
  201.  
  202. ***************************************************************************
  203. * This is main loop for testing for and displaying any incoming data
  204. DO WHILE .T.
  205.     Inp = "INPUT #" + ComPort + ","  + SPACE(100)  && Build INPUT command
  206.     CALL COMETMP WITH Inp   && Read COMET's COM port data buffer
  207.  
  208.     AmtRetd = VAL(SUBSTR(Inp,10,5))  && Determine how many chars were returned, if any
  209.     COMactive = IIF(AmtRetd > 0, .T., .F.)
  210.  
  211.     IF AmtRetd > 0
  212.       ComData = SUBSTR(Inp, 15, AmtRetd)  && Get just the COM data from <expC>
  213.       ?? ComData
  214.     ENDIF
  215.  ENDDO
  216.  
  217. ***************************************************************************
  218.  
  219. ***************************** GotAKey *************************************
  220. * Anytime a key gets pressed, we jump here
  221. *
  222. PROCEDURE GotAKey
  223. PARAMETERS EscKey
  224.  
  225. ON KEY                     && Disable ON KEY & ON ESCAPE
  226. ON ESCAPE
  227.  
  228. IF EscKey
  229.  Key = 27
  230. ELSE
  231.  Key = INKEY()
  232. ENDIF
  233.  
  234. DO CASE                     && Decide whether key is data to output or local command
  235.     CASE Key > 0 .AND. Key <> 27    && data to output ?
  236.         IF .NOT. 'ACTIVE' $ ChkCmd .OR. TranHow = 'A'   && Output if: no xfers active  OR  ASEND/ARECV active
  237.             Output = "OUTPUT #" + ComPort + "," + CHR(Key)   && Build OUTPUT command
  238.             CALL COMETMP WITH Output          && Output char to COM port
  239.         ELSE
  240.             CLEAR
  241.             ?? CHR(7)
  242.             @ 4,0 TO 12,76 DOUBLE
  243.             @ 6,2 SAY "Sorry but we're busy " + event + "ing a file now!"
  244.             @ 7,2 SAY "But, that fact that I can display this alert box "
  245.             @ 8,2 say "proves COMET is running in the background."
  246.             @ 9,2 say "Hit the 'D' key and I'll do a !DIR command in DOS."
  247.             @10,2 say "Hit any key ..."
  248.             * Wait loop using INKEY(n) if FoxBase+ otherwise Do .. While
  249.             Ky = INKEY(5)
  250.             IF ky = ASC('D') .OR. ky = ASC('d')
  251.                 !DIR
  252.             ENDIF
  253.         ENDIF
  254.  
  255.     CASE Key = 27           && ESC hit ?
  256.         IF 'ACTIVE' $ ChkCmd        && File transfer active ?
  257.             FlshPort = 'FLUSH #' + ComPort
  258.             CALL COMETMP WITH FlshPort && If so, user wants to cancel it
  259.         ELSE
  260.             CALL COMETMP WITH 'ONTIME '
  261.             DEACTIVATE WINDOW TERMINAL
  262.             ACTIVATE SCREEN
  263.             SUSPEND             && If no active file transfer, then quit
  264.         ENDIF
  265.     OTHERWISE                   && If INKEY() < 0, then a function key was hit
  266.         DO Local
  267. ENDCASE
  268.  
  269. ON KEY DO GotAKey  WITH .F.      && Enable ON KEY again
  270. ON ESCAPE DO GotAKey WITH .T.
  271. RETURN
  272.  
  273.  
  274. ****************************** Local ***************************************
  275. * Support for function keys (ie. local commands like send and receive)
  276. PROCEDURE Local
  277.  
  278. DO CASE
  279.     CASE Key = F2               && Clear screen ?
  280.         CLEAR
  281.     CASE Key = F3               && Send file ?
  282.         DO TranFile WITH 'SEND'
  283.     CASE Key = F4               && Receive file ?
  284.         DO TranFile WITH 'RECV'
  285.     CASE Key = F5              && ONTIME command requesting STATUS update ?
  286.         DO Status
  287. ENDCASE
  288.  
  289. RETURN
  290.  
  291. ************************ TranFile *******************************************
  292. PROCEDURE TranFile
  293. PARAMETERS Action
  294. IF 'ACTIVE' $ ChkCmd        && We're good, but not that good that we can have two transfers simultaneously!
  295.     Msg = 'Request denied !  There is a file transfer ACTIVE'
  296.     NULL = ShowOn24(Msg)
  297.     NULL = INKEY(3)
  298.     Msg = LastMsg
  299.     NULL = ShowOn24(Msg)
  300.     RETURN
  301. ENDIF
  302.  
  303. ExitFlg = .F.
  304. DEFINE WINDOW INPUT FROM 15,5 TO 20,75
  305. ACTIVATE WINDOW INPUT
  306.  
  307. * Prompt for transfer protocol desired (Ascii, Xmodem, Xmodem-1K or Ymodem)
  308. * We don't use a VALID clause since DBASE doesn't support
  309. TranHow = '  '
  310. Null = ShowOn24("CHOOSE FILE PROTOCOL: A=Ascii, X=Xmodem, X1=Xmodem(1K) or Y=Ymodem")
  311. DO WHILE .NOT. (ExitFlg .OR. LTRIM(RTRIM(TranHow)) $ 'AX1Y')
  312.     @ 1, 0 SAY 'Protocol(A,X,X1 or Y) ?' GET TranHow PICTURE '@! A9'
  313.     READ                            && Get protocol
  314.     ExitFlg = IIF(READKEY()=12 .OR. READKEY()=268, .T., ExitFlg)
  315.     ?? IIF(.NOT. LTRIM(RTRIM(TranHow)) $ 'AX1Y', CHR(7), '')   && Beep if invalid
  316. ENDDO
  317.  
  318. TranHow = LTRIM(RTRIM(TranHow))
  319.  
  320. * Prompt for filename except for YRECV since filename gets transmitted w/data
  321. TranFil = SPACE(40)
  322. IF .NOT. ExitFlg .AND. (TranHow <> 'Y' .OR. Action = 'SEND')
  323.     Null = ShowOn24("ENTER FILENAME TO " + IIF(Action = 'RECV', 'RECEIVE', 'SEND'))
  324.     @ 1, 29 SAY 'Filename ?' GET TranFil PICTURE '@S25'
  325.     READ
  326.     ExitFlg = IIF(READKEY()=12 .OR. READKEY()=268, .T., ExitFlg)
  327. ENDIF
  328.  
  329. * Prompt for timeout in seconds if ARECV, default is 60 secs
  330. TimeOut = 60
  331. IF .NOT. ExitFlg .AND. TranHow = 'A' .AND. Action = 'RECV'
  332.     Null = ShowOn24("ENTER RECEIVER IDLE TIME IN SECONDS BEFORE AUTO-CLOSING OF FILE")
  333.     @ 2, 20 SAY 'ARECV timeout in seconds ?' GET TimeOut PICTURE "999"
  334.     READ
  335.     ExitFlg = IIF(READKEY()=12 .OR. READKEY()=268, .T., ExitFlg)
  336. ENDIF
  337.  
  338. RELEASE WINDOW INPUT
  339.  
  340. IF ExitFlg                    && Look for ESC key
  341.     Null = ShowOn24(Msg)
  342.     RETURN
  343. ENDIF
  344.  
  345. *Now build COMETMP SEND or RECV command
  346. TranCmd = TranHow + Action + ' #' + ComPort + ',' + TRIM(TranFil)
  347. IF 'ARECV' $ TranCmd .AND. TimeOut <> 60 && Test if we need ARECV timeout option
  348.     TranCmd = TranCmd + ',' + STR(TimeOut,3,0)
  349. ENDIF
  350.  
  351.   * If X/YModem, port must be set to 8 data bits/No parity
  352. IF TranHow # 'A'        && ASCII file xfer?
  353.   DBits7 = AT(',7,', Open)              && Currently OPENed for 7 data bits ?
  354.  IF DBits7 > 0
  355.   OpnN8 = STUFF(Open,DBits7-1,3,"N,8")  && Create modified version of original Open
  356.   CALL COMETMP WITH OpnN8
  357.  ENDIF
  358. ENDIF
  359.  
  360. * Issue command to COMETMP
  361. CALL COMETMP WITH TranCmd         && Startup background file transfer
  362.  
  363. *Check that file transfer was able to start
  364. ChkCmd = 'FCHK #' + ComPort + ',' + SPACE(80)
  365. CALL COMETMP WITH ChkCmd
  366. IF .NOT. 'ACTIVE' $ ChkCmd       && Should be active if command started!
  367.     LBracAt = AT('[',ChkCmd)     && Find start of FCHK failure description, if any
  368.     IF LBracAt > 0               && If [ present, we have a failure description
  369.         RBracAt = AT(']', ChkCmd)  && Find ] which is end of description
  370.         Reason = SUBSTR(ChkCmd, LBracAt+1, RBracAt-LBracAt-1)
  371.     ELSE
  372.         Reason = 'GENERAL ERROR'
  373.     ENDIF
  374.     ?? CHR(7)                    && If wasn't successful at starting SEND, alert operator
  375.     Msg = LEFT(Msg,37) + Action + ' Command Failed - ' + Reason
  376.     NULL = ShowOn24(Msg)
  377.     NULL = INKEY(3)
  378.     Msg = LastMsg
  379.     NULL = ShowOn24(Msg)
  380.     CALL COMETMP WITH Open        && Restore original COM port OPEN params
  381.     RETURN
  382. ENDIF
  383.  
  384. Event = TranHow + Action            && This will be used by Status procedure
  385. Thresh = 0
  386. DO Status
  387.  
  388. *File Send or Recv in progress, now use ONTIME command to update status every 3 secs
  389. *STATUS procedure will now execute every 5 seconds
  390. OnTime = 'ONTIME 5,0,63'        && #secs=5, ASCII cd=0 , Aux Byte=63 (F5 key)
  391. CALL COMETMP WITH OnTime
  392.  
  393. RETURN                          && All done, returns back to Local proc
  394.  
  395.  
  396. *************************** Status ************************************
  397. * F10 key or COMETMP's ONTIME command brings us here
  398. * Updates bottom line on screen with file transfer status
  399. *
  400. PROCEDURE Status
  401. PRIVATE CurR, CurC
  402.  
  403. CurR = ROW()            && Save TERMINAL window's cursor loc
  404. CurC = COL()
  405.  
  406. ChkCmd = 'FCHK #' + ComPort + ',' + SPACE(80)
  407. CALL COMETMP WITH ChkCmd          && Get current file transfer status
  408.  
  409.  * Now extract the status info we want; FCHK's status, size and filename
  410. FCHKstat = SUBSTR(ChkCmd,25,8)  && Status - ACTIVE, COMPLETE or FAILED
  411. FCHKsize = SUBSTR(ChkCmd,34,7)  && Size in bytes - #######
  412. FCHKfile = SUBSTR(ChkCmd,42)    && Filename - path\filename (variable length)
  413.  
  414. * Adjust filename if necessary
  415. SpcAt = AT(' ',FCHKfile)        && Look for end of path\filename
  416. FCHKfile = IIF(SpcAt > 0, SUBSTR(FCHKfile,1,SpcAt-1), FCHKfile)
  417. FCHKfile = IIF(LEN(FCHKfile) > 12, RIGHT(FCHKfile,12), FCHKfile)
  418.  
  419. * Append failure description to FCHKstat - if FAILED
  420. IF 'FAILED' $ FCHKstat
  421.     LBracAt = AT('[',ChkCmd)     && Find start of FCHK failure description, if any
  422.     RBracAt = AT(']', ChkCmd)  && Find ] which is end of description
  423.     Reason = SUBSTR(ChkCmd, LBracAt+1, RBracAt-LBracAt-1)
  424.     FCHKstat = FCHKstat + Reason
  425.     FCHKfile = ""               && Need the room to display failure description
  426. ENDIF
  427.  
  428.  
  429.  
  430. * Display extracted status
  431. Msg = LEFT(Msg,37) + Event + ' | ' + FCHKstat + ' | ' + FCHKsize + ' | ' + FCHKfile
  432. NULL = ShowOn24(Msg)
  433.  
  434. IF .NOT. 'ACTIVE' $ ChkCmd    && COMPLETEd or FAILED ?
  435.     Thresh = Thresh + 1
  436.     IF Thresh > 1               && Don't want to redisplay old stat msg till 1 cycle
  437.         Ontime = 'ONTIME'
  438.         CALL COMETMP WITH Ontime      && If so, turn off timer event trapping
  439.         Msg = LastMsg
  440.         NULL = ShowOn24(Msg)
  441.     ELSE
  442.  
  443.         ?? CHR(7)               && Call attention to COMPLETE or FAILED status
  444.         IF TranHow # 'A'
  445.             CALL COMETMP WITH Open        && Restore original COM port OPEN params
  446.         ENDIF
  447.         
  448.     ENDIF
  449. ENDIF
  450.  
  451. @ CurR, CurC SAY ''
  452.  
  453. RETURN
  454.  
  455. FUNCTION ShowOn24
  456. PARAMETERS MsgToOut
  457. PRIVATE WindFunc, NowWind
  458.  
  459. WindFunc = IIF(FoxPro, 'WOUTPUT()', 'WINDOW()')
  460. NowWind = &WindFunc
  461.  
  462. ACTIVATE SCREEN
  463. Strt =  INT( (80 - LEN(MsgToOut))/2 )
  464. @ 24,0 SAY SPACE(80) COLOR N/W
  465. @ 24, Strt SAY MsgToOut COLOR N/W
  466. ACTIVATE WINDOW &NowWind
  467.  
  468. RETURN ''
  469.  
  470.