home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic 4 Power Pack / Visual_Basic4_Power_Pack.bin / vb4files / ppl4vb20 / process.bas < prev    next >
Encoding:
BASIC Source File  |  1996-11-20  |  4.0 KB  |  147 lines
  1.  '
  2.  ' Process ^Z commands
  3.  '
  4.  
  5.  DEFINT A-Z
  6.  
  7. '$INCLUDE: 'PROCESS.BI'
  8. '$INCLUDE: 'PCL4VB.BI'
  9. '$INCLUDE: 'VB_IO.BI'
  10. '$INCLUDE: 'XYZ_IO.BI'
  11. '$INCLUDE: 'XYMODEM.BI'
  12. '$INCLUDE: 'ZMODEM.BI'
  13.  
  14. CONST FALSE = 0, TRUE = NOT FALSE
  15. CONST NAK = &H15
  16. CONST WHITE = 7
  17. CONST BLACK = 0
  18.  
  19. DIM SHARED ThePort   AS INTEGER
  20. DIM SHARED Protocol  AS STRING
  21. DIM SHARED OneKflag  AS INTEGER
  22. DIM SHARED NCGbyte   AS INTEGER
  23. DIM SHARED BatchFlag AS INTEGER
  24. DIM SHARED BaudRate  AS STRING
  25. DIM SHARED Filename  AS STRING
  26. DIM SHARED Streaming AS INTEGER
  27. DIM SHARED DebugFlag AS INTEGER
  28. DIM SHARED Logname   AS STRING
  29. DIM SHARED FreeSpace AS INTEGER
  30.  
  31. SUB InitProcess(BYVAL Port AS INTEGER,Baud AS STRING)
  32.   ThePort = Port
  33.   BaudRate = Baud
  34.   Protocol = "X"
  35.   OneKflag = FALSE
  36.   NCGbyte = NAK
  37.   BatchFlag = FALSE
  38.   Logname = "TERM.LOG" + CHR$(0)
  39.   CALL xyzDefine(24,36,43,&H0070)
  40.   CALL xyzOpenLog(SADD(Logname),SSEG(Logname))
  41. END SUB
  42.  
  43. SUB WriteLeft(TheString AS STRING)
  44. DIM MainRow AS INTEGER
  45. DIM MainCol AS INTEGER
  46. MainRow = CSRLIN
  47. MainCol = POS(0)
  48. VIEW PRINT 25 TO 25
  49. COLOR BLACK, WHITE
  50. LOCATE 25, 1, 1
  51. PRINT TheString;
  52. VIEW PRINT 1 TO 24
  53. COLOR WHITE, BLACK
  54. LOCATE MainRow, MainCol, 1
  55. END SUB
  56.  
  57. SUB ShowStatus
  58. DIM P AS STRING
  59. DIM Msg AS STRING
  60. P = STR$(1+ThePort)
  61. Msg = " COM" + RIGHT$(P,LEN(P)-1) + " " + BaudRate + " " + Protocol + " ^Z for menu"
  62. CALL WriteLeft(Msg)
  63. END SUB
  64.  
  65. FUNCTION Process
  66.   DIM C AS STRING
  67.   DIM P AS STRING
  68.   DIM KeyChar AS INTEGER
  69.   PROCESS = FALSE
  70.   IF TRUE THEN
  71.   'quit if user types ^Z  IF TRUE THEN
  72.     CALL ShowStatus
  73.     CALL vbPutEOL
  74.     CALL vbPutString(" Q)uit P)rotocol S)end R)eceive D)ebug: ")
  75.     KeyChar = vbGetKey
  76.     CALL vbPutChar(KeyChr)
  77.     SELECT CASE UCASE$(CHR$(KeyChar))
  78.       CASE "D"   'DEBUG
  79.         DebugFlag = 1 - DebugFlag
  80.         CALL xyParms(DebugFlag,18,3)
  81.         CALL zmParms(DebugFlag,18)
  82.         CALL vbDebug(DebugFlag)
  83.         CALL vbPutEOLstr(" Debug =")
  84.         CALL vbPutInteger(DebugFlag)
  85.       CASE "Q"   'QUIT
  86.         PRINT
  87.         PRINT (" TERMINATING: User quitting.")
  88.         RetCode = SioDone(ThePort)
  89.         PROCESS = TRUE
  90.         EXIT FUNCTION
  91.       CASE "P"   'PROTOCOL
  92.         CALL vbPutEOLstr(" X)modem Y)modem Z)modem: ")
  93.         KeyChar = vbGetKey
  94.         CALL vbPutChar(KeyChr)
  95.         SELECT CASE UCASE$(CHR$(KeyChar))
  96.           CASE "X"  'XMODEM
  97.             Protocol = "X"
  98.             OneKflag = FALSE
  99.             NCGbyte = NAK
  100.             BatchFlag = FALSE
  101.             CALL vbPutEOLstr(" Protocol = XMODEM")
  102.           CASE "Y"  'YMODEM
  103.             Protocol = "Y"
  104.             OneKflag = TRUE
  105.             NCGbyte = ASC("C")
  106.             BatchFlag = TRUE
  107.             CALL vbPutEOLstr(" Protocol = YMODEM")
  108.           CASE "Z"  'ZMODEM
  109.             Protocol = "Z"
  110.             IF BaudCode <= Baud19200 THEN
  111.                Streaming = TRUE
  112.             ELSE
  113.                Streaming = FALSE
  114.             END IF
  115.             CALL vbPutEOLstr(" Protocol = ZMODEM")
  116.           CASE ELSE
  117.             CALL vbPutEOLstr(" Must Answer Z, Y or Z")
  118.         END SELECT
  119.         CALL ShowStatus
  120.       CASE "R"  'Receive
  121.         Filename = STRING$(15,0)
  122.         FreeSpace = FRE(Filename)
  123.         SELECT CASE LEFT$(Protocol,1)
  124.           CASE "X"
  125.             Flag = XmodemRx(ThePort, SADD(Filename), SSEG(Filename), NCGbyte)
  126.           CASE "Y"
  127.             Flag = YmodemRx(ThePort, NCGbyte)
  128.           CASE "Z"
  129.             Flag = ZmodemRx(ThePort, Streaming)
  130.         END SELECT
  131.       CASE "S"  'Send
  132.         Filename = STRING$(15,0)
  133.         FreeSpace = FRE(Filename)
  134.         SELECT CASE LEFT$(Protocol,1)
  135.           CASE "X"
  136.             Flag = XmodemTx(ThePort, SADD(Filename), SSEG(Filename), OneKflag)
  137.           CASE "Y"
  138.             Flag = YmodemTx(ThePort, SADD(Filename), SSEG(Filename))
  139.           CASE "Z"
  140.             Flag = ZmodemTx(ThePort, SADD(Filename), SSEG(Filename), Streaming)
  141.         END SELECT
  142.       CASE ELSE
  143.         CALL vbPutEOLstr(" Bad response")
  144.      END SELECT
  145.    END IF
  146.  END FUNCTION
  147.