home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a081 / 2.ddi / CTFXX.EXE / FOXCOM07.PRG < prev    next >
Encoding:
Text File  |  1993-05-12  |  8.5 KB  |  298 lines
  1. *.............................................................................
  2. *   Program Name: FOXCOM07         Copyright: Magna Carta Software, Inc.
  3. *   Date Created: 06-24-91         Language:  FoxPro 2.0
  4. *.............................................................................
  5. * Description: FOXCOM06 plus...
  6. * a) Transmit interrupts;
  7. * b) ASCII file send;
  8. * c) XON/XOFF flow control;
  9. *.............................................................................
  10. CLEAR ALL
  11. SET TALK OFF
  12. SET ESCAPE OFF
  13.  
  14. * Load the right library
  15. foxid = VERS()
  16. IF "2.0" $ foxid
  17.     SET LIBR TO ctf                 && Identified FoxPro 2.0
  18. ELSE
  19.     IF "2.5" $ VERS()
  20.         IF "Windows" $ foxid        && Identified FoxPro 2.5 for Windows
  21.             SET LIBR TO ctfw
  22.         ELSE
  23.             SET LIBR TO ctf25       && Identified FoxPro 2.5 for DOS
  24.         ENDIF
  25.     ENDIF
  26. ENDIF
  27.  
  28. SET COLOR OF SCHEME 17 TO SCHEME 1  && save default color scheme
  29. SET COLOR OF SCHEME 18 TO SCHEME 2
  30.  
  31. DO ctfhdr
  32. DO ctfutil
  33. SET PROCEDURE TO CTFUTIL
  34. version = 7
  35. portid  = 0
  36.  
  37. ACTIVATE WINDOW w_status
  38. ACTIVATE WINDOW w_term
  39.  
  40. ret = u8250_init(portid, COM1, 2400, 8, PARITY_NONE, 1)
  41. IF ret < 0
  42.     ? ret
  43.     =INKEY(0)
  44.     CANCEL
  45. ENDIF
  46. =CT_SET_WIN(portid)
  47. ret =install_ipr(portid, RECEIVE, NULL, 2048)
  48. IF ret < 0
  49.     ? ret-1
  50.     =INKEY(0)
  51.     CANCEL
  52. ENDIF
  53. ret =install_ipr(portid, TRANSMIT, NULL, 2048)
  54. IF ret < 0
  55.     ? ret-1
  56.     =INKEY(0)
  57.     CANCEL
  58. ENDIF
  59. ret =install_isr(portid, 4, NULL)               && IRQ4 (use 3 for COM2)
  60. IF ret < 0
  61.     ? ret-2
  62.     =INKEY(0)
  63.     CANCEL
  64. ENDIF
  65.  
  66.  
  67. @ 00,00 SAY "CommTools Terminal Version " +;
  68.     ALLTRIM(STR(version)) + ": Press ESC to return to main menu"
  69. =set_rx_xlat(0, LOCAL_ECHO, TRUE)           && turn on RX echo
  70. =set_tx_xlat(0, FLOWCTL, XONXOFF)           && assert XON/XOFF flow control
  71. =set_warpdrive(4)                           && allow high speed
  72.  
  73. DEFINE PAD p_ct_modem  OF main_menu PROMPT "\<Modem Command" AT 00, 37
  74.     ON SELECTION PAD p_ct_modem OF main_menu DO ct_modem WITH portid, 37 IN CTFMODEM.PRG
  75.  
  76. DEFINE PAD p_ct_fsend  OF main_menu PROMPT "S\<end a File" AT 00, 52
  77.     ON SELECTION PAD p_ct_fsend  OF main_menu =do_file_send(portid)
  78.  
  79. ACTIVATE MENU main_menu
  80.  
  81.  
  82.  
  83. FUNCTION ct_online
  84.     PARAMETERS portid
  85.  
  86.     ACTIVATE WINDOW w_term
  87.     =c_term(portid)                 && switch to dumb terminal mode
  88. RETURN (0)
  89.  
  90.  
  91.  
  92. *
  93. * DO_FILE_SEND(expN portid)
  94. * Show a menu to invoke file transmission.
  95. * Called from mainmenu()
  96. *
  97. FUNCTION do_file_send
  98.     PARAMETERS portid
  99.     PUBLIC xfer_row
  100.     PRIVATE fname, ret
  101.  
  102.     ret   = -1
  103.     fname = get_filnam(.T.)
  104.     IF LEN(fname) != 0
  105.         * USE XONXOFF FLOW CONTROL (THIS LETS THE RECEIVER WRITE TO DISK) *
  106.         =set_rx_xlat(portid, FLOWCTL, XONXOFF)  && accept flow control if > 2400 bps
  107.         =set_rx_xlat(portid, RX_BUF_HWM, 65) && adjust RX buffer high water mark low
  108. *       =set_tx_xlat(portid, LOCAL_ECHO, TRUE)  && optionally turn on TX local echo
  109.         ret = fqueue(fname)
  110.         IF ret == 0
  111.             xfer_row = 0
  112.             =status_msg(0, "Sending: " + fname)
  113.             * SEND THE FILE AS ASCII
  114.             ret =fsend(portid, ASCII, 5*1024, "xfer_progress")
  115.             IF ret == CT_EOF)
  116.                 =status_msg(0, STR(get_xfer_error()))
  117.             ELSE
  118.                 =status_msg(0, "Finished")
  119.             ENDIF
  120.         ELSE
  121.             =status_msg(0, "Error Queueing File: " + STR(ret))
  122.         ENDIF
  123.     ENDIF
  124. RETURN (ret)
  125.  
  126.  
  127.  
  128. *.............................................................................
  129. *
  130. * GET_FILNAM -- Get a file name from the user.
  131. * Parameters:
  132. *   status -- Flag indicating whether file is to be sent (.T.) or received (.F.)
  133. * Return Value:
  134. *   The file name
  135. *.............................................................................
  136. FUNCTION get_filnam
  137.     PARAMETERS status
  138.     PRIVATE scr, fnam, done, direct, i
  139.     PUBLIC getlist, def_colors
  140.  
  141.     done = .F.
  142.     direct = IIF(status,"Send:","Receive:")
  143.     SET SCOREBOARD off
  144.  
  145.     * Define Window for File Name
  146.     DEFINE WINDOW w_fname FROM 10,20 TO 16,70 TITLE 'File Select Window' ;
  147.         SHADOW
  148.     ACTIVATE WINDOW w_fname
  149.  
  150.     @ 1,1 SAY "Enter name of file to"
  151.     @ 1,23 say direct
  152.  
  153.     DO WHILE !DONE
  154.         fnam = SPACE(80)
  155.         @ 1,30 GET fnam PICTURE "@!S16"
  156.         READ
  157.  
  158.         IF LASTKEY() = ESC
  159.             fnam = ""
  160.             done = .T.
  161.         ELSE
  162.             fnam = ALLTRIM(fnam)
  163.             IF valid_nam(fnam,status)
  164.                 done = .T.
  165.             ELSE
  166.                 @ 2,2 say "Invalid/Not Found"
  167.                 @ 3,2 say "Press ESC to abort"
  168.                 i = 0
  169.                 DO WHILE i = 0
  170.                     i = inkey()
  171.                 ENDDO
  172.                 IF i = ESC
  173.                     fnam = ""
  174.                     done = .T.
  175.                 ENDIF
  176.                 @ 2,2 say "                 "
  177.                 @ 3,2 say "                  "
  178.             ENDIF
  179.         ENDIF
  180.     ENDDO
  181.     DEACTIVATE WINDOW w_fname
  182. RETURN fnam
  183.  
  184.  
  185.  
  186. *
  187. * VALID_NAM -- Determine whether a file exists or whether a string is a
  188. * valid file name.
  189. * Parameters:
  190. *   nam     -- file name;
  191. *   exist   -- flag, determine if the file exists;
  192. *
  193. * Return Value:
  194. *   .T.     --
  195. *   .F.     --
  196. *
  197. FUNCTION valid_nam
  198.     PARAMETERS nam,exist
  199.     PRIVATE e,ret,r
  200.  
  201.     ret = .F.
  202.     e = FILE(nam)
  203.     IF exist                    && must exist
  204.         IF e                    && does exist
  205.             ret = .t.
  206.         ENDIF
  207.     ELSE                        && just valid name
  208.         IF e                    && file exists and will be overwritten
  209.             ret = .t.           && may want to ask here
  210.         ELSE                    && no existing file, can we make one?
  211.             r = FCREATE(nam, 0)
  212.             IF r >= 0           && yes, valid name
  213.                 ret = .T.
  214.                 =FCLOSE(r)
  215.                 ERASE &nam
  216.             ENDIF
  217.         ENDIF
  218.     ENDIF
  219. RETURN ret
  220.  
  221.  
  222. FUNCTION xfer_progress
  223.     PARAMETERS status, parm
  224.     PRIVATE parm1, str, file_name, file_size, ro
  225.  
  226.     ro = xfer_row
  227.     DO CASE
  228.         CASE status = CONNECTION_LOST
  229.             str = "Connection lost at " + ALLTRIM(STR(parm)) + "bytes"
  230.         CASE status = CT_ACK
  231.             str = "0             "
  232.         CASE status = CT_CAN
  233.             str = "CAN received!"
  234.         CASE status = CT_DISK_FULL
  235.             str = "I/O Error Writing to Disk"
  236.         CASE status = CT_EOF
  237.             str = "No character received"
  238.         CASE status = CT_GARBAGE_RECEIVED
  239.             str = "Junk Received"
  240.         CASE status = CT_FILE_LENGTH_ERROR
  241.             str = "File Length Error"
  242.         CASE status = CT_FILE_SOURCE
  243.             IF parm == DISK
  244.                 str = "Sending from DISK"
  245.             ELSE
  246.                 str = "Sending from RAM"
  247.             ENDIF
  248.         CASE status = CT_MAX_ERRORS_REACHED
  249.             str = "Max. Errors Reached"
  250.         CASE status = CT_NO_RX_START
  251.             str = "Receiver Did Not Start"
  252.         CASE status = CT_NO_TX_START
  253.             str = "Transmitter did not start. Attempt " + ALLTRIM(STR(parm))
  254.         CASE status = CT_RX_CANCELLED
  255.             str = "Receiver Cancelled"
  256.         CASE status = CT_RX_DATA_ERROR
  257.             str = "Receive Data Error"
  258.         CASE status = CT_RX_TIMEOUT
  259.             str = "Receiver Timeout"
  260.         CASE status = CT_TX_CANCELLED
  261.             str = "Transmitter Cancelled"
  262.         CASE status = CT_UNSPECIFIED
  263.             str = "Unspecified Error"
  264.         CASE status = CT_XFER_POSITION
  265.             str = "Bytes " + ALLTRIM(STR(parm))
  266.         CASE status = USER_CANCELLED
  267.             str = "Keyboard cancel received"
  268.         OTHERWISE
  269.             str = STR(status)
  270.     ENDCASE
  271.     =status_msg(0, str)
  272. RETURN (NIL)
  273.  
  274.  
  275.  
  276. *
  277. * C_TERM -- This is a dumb terminal loop in FoxPro.
  278. * Alternately poll the serial input buffer and the keyboard for data.
  279. *
  280. FUNCTION c_term
  281.     PARAMETERS portid
  282.     PRIVATE c
  283.  
  284.     ?
  285.     DO WHILE .T.
  286.         * CHECK SERIAL PORT FOR BYTE *
  287.         =c_getc(portid)                      && check the serial port for a byte
  288.         * CHECK KEYBOARD FOR A KEY PRESS *
  289.         c = INKEY()                             && check keyboard for a key
  290.         DO CASE                                 && evaluate the received key
  291.             CASE c == ESC                       && ESC was pressed
  292.                 RETURN (0)
  293.             CASE c <> 0
  294.                 =c_putc(portid, c)
  295.         ENDCASE
  296.     ENDDO                                       && do while .t.
  297. RETURN (0)
  298.