home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / boo / kermit.bas < prev    next >
BASIC Source File  |  2020-01-01  |  3KB  |  105 lines
  1. 001 ' KERMIT.BAS - Receive-only Kermit Protocol implementation for
  2. 002 ' bootstrapping a real Kermit program onto the PC.  Requires MS BASIC.
  3. 003 ' Start Basic, type in this program (you can leave out the comments),
  4. 004 ' SAVE, and then RUN.  Have the Kermit program on the other end of the 
  5. 005 ' COM port connection send the desired file at a speed of 1200bps
  6. 006 ' with no flow control.
  7.  
  8. 010 ' Author: Frank da Cruz, October 1986.
  9.  
  10. 100  RESET : RESET : RESET
  11. 110  ON ERROR GOTO 9000
  12. 120  DEFINT A-Z
  13.  
  14. 1010 N = 0 : SNDBUF$ = CHR$(1)+"# N3"+CHR$(13)
  15. 1020 OPEN "COM1:1200,N,8,,CS,DS" AS #1
  16.  
  17. 2000 ' Get Send Initialization packet, exchange parameters.
  18. 2010 PRINT "Waiting..."
  19. 2020 GOSUB 5000
  20. 2030 IF TYP$ <> "S" THEN D$ = TYP$+" Packet in S State" : GOTO 9500
  21. 2040 IF LEN(PKTDAT$) > 4 THEN EOL=ASC(MID$(PKTDAT$,5,1))-32 ELSE EOL=13
  22. 2050 IF LEN(PKTDAT$) > 5 THEN CTL=ASC(MID$(PKTDAT$,6,1)) ELSE CTL=ASC("#")
  23. 2070 D$ = "H* @-#N1" : GOSUB 8020
  24.  
  25. 3000 ' Get a File Header packet.  If a B packet comes, we're all done.
  26. 3010 GOSUB 5000
  27. 3020 IF TYP$ = "B" THEN GOSUB 8000 : GOTO 9900
  28. 3030 IF TYP$ <> "F" THEN D$ = TYP$+" Packet in F State" : GOTO 9500
  29. 3040 PRINT "Receiving "; MID$(PKTDAT$,1,L);
  30. 3050 OPEN MID$(PKTDAT$,1,L) FOR OUTPUT AS #2
  31. 3060 GOSUB 8000
  32.  
  33. 4000 ' Get Data packets.  If a Z packet comes, the file is complete.
  34. 4010 GOSUB 5000
  35. 4020 IF TYP$ = "Z" THEN CLOSE #2 : GOSUB 8000 : PRINT "(OK)" : GOTO 3000
  36. 4030 IF TYP$ <> "D" THEN D$ = TYP$+" Packet in D State" : GOTO 9500
  37. 4040 PRINT #2, MID$(PKTDAT$,1,P);
  38. 4060 GOSUB 8000
  39. 4070 GOTO 4000
  40.  
  41. 5000 ' Try to get a valid packet with the desired sequence number.
  42. 5010 GOSUB 7000
  43. 5020 FOR TRY = 1 TO 5
  44. 5030   IF SEQ = N AND TYP$ <> "Q" THEN RETURN
  45. 5040   PRINT #1, SNDBUF$;
  46. 5050   PRINT "%";
  47. 5060   GOSUB 7000
  48. 5070 NEXT TRY
  49. 5080 TYP$ = "T" : RETURN
  50.  
  51. 6000 ' Send a packet with data D$ of length L, type TYP$, sequence #N.
  52. 6010 SNDBUF$ = CHR$(1)+CHR$(L+35)+CHR$(N+32)+TYP$+D$+" "+CHR$(EOL)
  53. 6020 CHKSUM = 0
  54. 6030 FOR I = 2 TO L+4
  55. 6040   CHKSUM = CHKSUM + ASC(MID$(SNDBUF$,I,1))
  56. 6050 NEXT I
  57. 6060 CHKSUM = (CHKSUM + ((CHKSUM AND 192) \ 64)) AND 63
  58. 6070 MID$(SNDBUF$,L+5) = CHR$(CHKSUM + 32)
  59. 6080 PRINT #1, SNDBUF$;
  60. 6100 RETURN
  61.  
  62. 7000 ' Routine to Read and Decode a Packet.
  63. 7010 LINE INPUT #1, RCVBUF$
  64. 7020 I = INSTR(RCVBUF$,CHR$(1))
  65. 7030 IF I = 0 THEN TYP$ = "Q" : RETURN
  66.  
  67. 7100 CHK   = ASC(MID$(RCVBUF$,I+1,1)) : L   = CHK - 35
  68. 7110 T     = ASC(MID$(RCVBUF$,I+2,1)) : SEQ = T - 32 : CHK = CHK + T
  69. 7120 TYP$  =     MID$(RCVBUF$,I+3,1)  : CHK = CHK + ASC(TYP$)
  70.  
  71. 7130 P = 0 : FLAG = 0 : PKTDAT$ = STRING$(100,32)
  72. 7200 FOR J = I+4 TO I+3+L
  73. 7210   T = ASC(MID$(RCVBUF$,J,1))
  74. 7220   CHK = CHK + T
  75. 7240   IF TYP$ = "S" THEN 7300
  76. 7250     IF FLAG = 0 AND T = CTL THEN FLAG = 1 : GOTO 7400
  77. 7260     T7 = T AND 127
  78. 7270     IF FLAG THEN FLAG = 0 : IF T7 > 62 AND T7 < 96 THEN T = T XOR 64
  79. 7300   P = P + 1
  80. 7310   MID$(PKTDAT$,P,1) = CHR$(T)
  81. 7400 NEXT J
  82. 7420 CHK = (CHK + ((CHK AND 192) \ 64)) AND 63
  83. 7430 CHKSUM = ASC(MID$(RCVBUF$,J,1)) - 32
  84. 7450 IF CHKSUM <> CHK THEN TYP$ = "Q"
  85. 7460 RETURN
  86.  
  87. 8000 ' Routine to send an ACK and increment the packet number...
  88. 8010 D$ = ""
  89. 8020 TYP$ = "Y" : L = LEN(D$) : GOSUB 6000
  90. 8030 N = (N + 1) AND 63
  91. 8040 IF (N AND 3) = 0 THEN PRINT ".";
  92. 8050 RETURN
  93.  
  94. 9000 ' Error handler, nothing fancy...
  95. 9010 D$ = "Error " + STR$(ERR) + " at Line" + STR$(ERL)
  96. 9020 PRINT D$
  97.  
  98. 9500 ' Error packet sender...
  99. 9520 L = LEN(D$) : TYP$ = "E" : GOSUB 6000
  100.  
  101. 9900 ' Normal exit point
  102. 9910 CLOSE
  103. 9920 PRINT CHR$(7);"(Done)"
  104. 9999 END
  105.