home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
hp9000basic
/
hpbker.bas
< prev
next >
Wrap
BASIC Source File
|
2020-01-01
|
207KB
|
5,758 lines
1! re-store "/KERMIT/HPKERM02"
2 !
3 ! Special Revision: No CSUBS. Requires user to
4 ! LOADSUB ALL FROM "PHYREC"
5 !
7 ! KERMIT For Hewlett-Packard Co.
8 ! Family 9000 - Series 200/300
9 ! HP-BASIC (RMB) Workstations
10 !==========================================================================
11 ! Revision History:
12 !------------------------
13 ! Revision 1.0
14 ! Original Release Mar 1 1989
15 !---------------------------------------------------------
16 ! Revision 1.01 - Mar 20 1989
17 ! Two errors in Kreceive decoding &#& and &## Binary Sequences
18 ! Implemented PROG file transfers
19 ! Problem with modem disconnecting before Send or Receive
20 ! Trap for no serial ports found
21 ! Terminal leaving stray cursors on screen
22 ! Error Check on remote S packet - non-numeric sent for blk chk type
23 ! BUGS:
24 ! Need Trap - SRM looks like 98628 Card
25 !---------------------------------------------------------
26 ! Revision 1.02 - Apr 3 1989
27 ! Fixed prob with path msi$ not DIM long enough
28 ! removed pause when remote switch is set on serial card
29 ! removed trap preventing receive of PROG file type
30 ! added trap to detect and ignore SRM interfaces
31 ! added ability to specify any filetype in CONVERT
32 !==========================================================================
33 ! To obtain a copy of this software contact:
34 !
35 ! | KERMIT Distributon
36 ! | Columbia University
37 ! | Center For Computing Activities
38 ! | 612 W. 115 St.
39 ! | New York, N.Y. 10025
40 ! or
41 ! | INTEREX - HP Users Group
42 ! | 680 Almanor Ave
43 ! | Sunnyvale, CA. 94086-3513
44 !-----------------------------------------------
45 ! Written By:
46 ! Andrew Campagnola
47 ! Hewlett-Packard Co.
48 ! Mesurement Systems Operation
49 ! P.O. Box 301
50 ! Loveland, Colorado 80539-0301
51 !
52 ! You're encouraged to write with comments, suggestions,
53 ! and bug reports.
54 !==========================================================================
55 ! KERMIT Copyright (C) 1981,1988
56 ! Trustees of Columbia University, New York City, N.Y.
57 ! Permission is granted to any individual or institution to use, copy or
58 ! redistribute this software provided it is not sold, and this copyright
59 ! is retained.
60 !==========================================================================
61 ! DISCLAIMER:
62 ! This software is provided as is.
63 ! No warantee is made of any kind with respect to this program including,
64 ! but not limited to, implied warantees of merchantability or fitness for
65 ! a particular purpose.
66 ! Neither Hewlett-Packard nor the author shall be liable for errors or
67 ! incidental damages in connection with the use of this material.
68 !==========================================================================
69 CONTROL KBD,3;4,40 ! speed up keyboard
70 COM Version$[80],K$[180],Setup$[80]
71 COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
72 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
73 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[2048] BUFFER,Com_card
74 COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
75 COM /Frame/ Flow$[10],Hshake$[10]
76 COM /Portsc/ Sports(1:10)
77 !========================================================================
78 Version:Version$="HP-9000 Kermit-RMB
Release 1.02 3 Apr 1989
"
79 Active=0
80 In_term=0
81 CONTROL CRT,21;1 ! Reset CRT
82 PRINTER IS CRT
83 GRAPHICS ON
84 WINDOW 0,80,26,0
85 CSIZE 3.5
86 KEY LABELS OFF
87 !------------------------------
88 CLEAR ERROR
89 GOSUB Config
90 CALL Kermit
91 !------------------------------
92 CONTROL CRT,21;1
93 KEY LABELS ON
94 MASS STORAGE IS Cur_msi$
95 PRINT TABXY(1,Crt_lines);"KERMIT DONE."
96 CONTROL KBD,3;6,60 ! restore kbd speed
97 STOP
98!======================================================================
99 Config: !
100 COM /Crt/ Crt_lines,Crt_width
101 STATUS CRT,9;Crt_width
102 STATUS CRT,13;Crt_lines
103 Crt_lines=Crt_lines-7
104 No_com_ports=0
105 Com_card=0
106 !
107 ! Check For BIN Files Loaded
108 !
109 Sbin=0
110 Dbin=0
111 Sbin=VAL(SYSTEM$("VERSION: SERIAL"))
112 Dbin=VAL(SYSTEM$("VERSION: DCOMM "))
113 IF Sbin=0 OR Dbin=0 THEN
114 BEEP 2000,.05
115 WAIT .05
116 BEEP 2000,.05
117 END IF
118 IF Sbin=0 THEN PRINT "SERIAL BIN not Loaded, LOAD BIN or Continue (F2)"
119 IF Dbin=0 THEN PRINT "DCOMM BIN not Loaded, LOAD BIN or Continue (F2)"
120 IF Dbin=0 OR Sbin=0 THEN PAUSE
121 !
122 ! Identify the Com Ports installed
123 !
124 ON ERROR GOSUB Sc_err
125 FOR Sc=8 TO 31
126 RESET Sc
127 STATUS Sc,0;Id
128 SELECT Id
129 CASE 2
130 Com_port=Sc
131 No_com_ports=No_com_ports+1
132 Com_card=98626 ! COULD BE 98644 IF JUMPER IS CUT
133 Sports(No_com_ports)=Sc
134 CASE 52 ! 98628 or SRM
135 STATUS Sc,3;Com_protocol ! SRM=3 Datacomm=1,2
136 IF Com_protocol<3 THEN ! Not an SRM Card
137 Com_port=Sc
138 No_com_ports=No_com_ports+1
139 Com_card=98628
140 Sports(No_com_ports)=Sc
141 END IF
142 CASE 66
143 Com_port=Sc
144 No_com_ports=No_com_ports+1
145 Com_card=98644
146 Sports(No_com_ports)=Sc
147 CASE 180
148 BEEP 2000,.05
149 PRINT "Remote Switch is set on Serial Port ";Sc;" - Port can't be used"
150 END SELECT
151 NEXT Sc
152 OFF ERROR
153 IF No_com_ports=0 THEN
154 BEEP
155 PRINT TABXY(1,Crt_lines);"No Serial Ports Found "
156 ELSE
157 REDIM Sports(1:No_com_ports)
158 END IF
159 IF No_com_ports>1 THEN
160 PRINT USING "////"
161 PRINT "Serial Ports Found at Select Codes ";
162 FOR P=1 TO No_com_ports
163 PRINT Sports(P);
164 NEXT P
165 Com_port=Sports(1)
166 PRINT
167 PRINT "Active Port is Select Code ";Com_port
168 PRINT "Use Kermit SET PORT Command to Change"
169 END IF
170 !
171 ! Identify Card Model
172 !
173 IF No_com_ports>0 THEN
174 STATUS Com_port,0;Id
175 SELECT Id
176 CASE 2
177 Com_card=98626 ! COULD BE 98644 IF JUMPER IS CUT
178 CASE 52
179 Com_card=98628
180 CASE 66
181 Com_card=98644
182 CASE ELSE
183 BEEP
184 DISP "Unknown Card Type, Reporting Card ID as: ";Id
185 PAUSE
186 END SELECT
187 !
188 ! Reset the Serial Interface
189 !
190 CALL Reset_port
191 END IF
192 RETURN
193 !------------------------------------------
194 Sc_err: !
195 Id=0
196 CLEAR ERROR
197 ERROR RETURN
198 !-----------------------------------------
199 END
200 !=========================================================================
201 Kinit:SUB Kermit_com_init
202 Kci: !
203 OPTION BASE 1
204 DIM Misc$[100]
205 ON ERROR GOSUB Kci_err
206 !
207 ! Initialize all constants here
208 !
209 COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
210 Maxp=94
211 Maxtry=10
212 Mypad=0
213 Mytmo=8 ! my timeout period
214 Mypchar=0
215 Myeol=NUM("
") ! LF
216 Myquote=NUM("#")
217 !
218 COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas
219 Size=0
220 Rpsiz=94
221 Spsiz=94
222 Pad=0
223 Ptmo=8
224 Capas=0 ! extended capabilities off
225 !
226 COM /Kerm/ INTEGER Image,Parflg,Pktdeb
227 Remote=0
228 Image=0
229 Parflg=0
230 Turn=0
231 Lecho=0
232 Debug=0
233 Pktdeb=0
234 Display=8 ! Shut Off Send and receive Packets
235 !
236 COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol
237 Filnamcnv=0
238 Filecount=0
239 Timer=1
240 Quote=NUM("#")
241 Eol=NUM("
")
242 Blk_chk=1
243 !
244 COM /Kerm2/ State$[1],Cchksum$[1],Eof_mode$[10],INTEGER Eof_mode,Timer,Ptmo
245 State$="S"
246 Eof_mode$="CTRL-Z ON"
247 Eof_mode=1
248 !
249 ! Other COM areas
250 !
251 COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
252 COM /Frame/ Baud,Data_bits,Stop_bits,On_off$,Parity_type$
253 COM /Frame/ Flow$,Hshake$
254 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
255 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[2048] BUFFER,Com_card
256 COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
257 COM /Term/ Kerm_esc$[2],S_log$[80],D_log$[80],INTEGER Remote,Lecho,Turn,Display
258 COM /Term/ Term_mode$[10]
259 COM /Path/ Cur_msi$[256],S_path$[256],S_msi$[256],D_path$[256],D_msi$[256]
260 COM /Mode/ Mode_line,Newline
261 !
262 ! Initialize Serial Port
263 Newline=1 ! Auto append Lf in terminal after Cr
264 Mode_line=1 ! baud and parity indicator line in terminal on|off
265 Lecho=1
266 Baud=9600
267 Flow$="NONE"
268 Hshake$="NONE"
269 Term_type$="VT100"
270 Term_mode$="NUMERIC"
271 Data_bits=8
272 Stop_bits=1
273 On_off$="OFF"
274 Parity_type$="NONE"
275 Filewarn=1
276 !
277 REPEAT
278 Bad_msi=1
279 Cur_msi$=SYSTEM$("MSI")
280 MASS STORAGE IS Cur_msi$
281 UNTIL Bad_msi
282 Misc=POS(Cur_msi$,"CS80")
283 IF Misc THEN Cur_msi$=Cur_msi$[1,Misc-1]&Cur_msi$[Misc+4]
284 Misc$=Cur_msi$
285 S_msi$=Misc$[POS(Misc$,":")]
286 D_msi$=Misc$[POS(Misc$,":")]
287 IF POS(Misc$,"/") THEN ! get d_path$
288 D_path$=Misc$[1,POS(Misc$,":")-1]&"/"
289 S_path$=Misc$[1,POS(Misc$,":")-1]&"/"
290 ELSE
291 D_path$=""
292 S_path$=""
293 END IF
294 !
295 S_log$=D_path$&"SES_LOG"&D_msi$
296 D_log$=D_path$&"PKT_LOG"&D_msi$
297 S_log=0
298 D_log=0
299 !
300 Remote=0
301 Kermit_exit=0
302 Kerm_esc$=" C" ! CTRL-] C
303 SUBEXIT !-----------------------------------------------------
304 Kci_err: !
305 SELECT ERRN
306 CASE 90! mass storage system error
307 RESET 7
308 CASE 76,72,52 ! bad unit code in msi, drive not found
309 DISP "Mass Storage Volume not On-line please enter a valid MSI "
310 OUTPUT KBD;Cur_msi$;" H";
311 ENTER KBD;Cur_msi$
312 DISP
313 Bad_msi=0
314 ERROR RETURN
315 CASE 163,167
316 CLEAR ERROR
317 ERROR RETURN
318 CASE ELSE
319 DISP ERRM$
320 PAUSE
321 END SELECT
322 RETURN
323 SUBEND
324 !================ End of Kermit Com Init ============================
325 Kermit:SUB Kermit
326 IF NOT Active THEN CALL Kermit_com_init
327 OPTION BASE 1
328 COM Version$,K$,Setup$
329 COM /Crt/ Crt_lines,Crt_width
330 COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
331 COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
332 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
333 COM /Frame/ Baud,Data_bits,Stop_bits,On_off$,Parity_type$
334 COM /Frame/ Flow$,Hshake$
335 COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
336 COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas
337 COM /Kerm/ INTEGER Image,Parflg,Pktdeb
338 COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol
339 COM /Kerm2/ State$,Cchksum$,Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
340 COM /Term/ Term_type$,S_log,D_log,Filewarn,Discard,@S_log,@D_log
341 COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
342 COM /Term/ Term_mode$
343 COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
344 COM /Mode/ Mode_line,Newline
345 COM /Def/ Define$(5,10)[30],No_define
346 COM /Portsc/ Sports(1:10)
347 !
348 DIM Kl$[300],Cmds$(1:80)[50]
349 DIM Init_cmd$[300],Cat$(1:1)[80]
350 DIM Def_cmd$[30],Filename$[256]
351 DIM F$[80],F_path$[80],F_msi$[80],Fp$[80],Fm$[80]
352 DIM Line$[512],Misc$[80],Msg$[80],Misc2$[80],Misc3$[80]
353 INTEGER Rc,Bdat_item
354 !
355 ! Initialize Serial Port
356 CALL Set_frame(Baud) ! Other values passed in COM
357 !
358 CONTROL CRT,10;1
359 IF NOT Active THEN ! Look for HPK_INIT File
360 Active=1
361 PRINT TABXY(1,Crt_lines-1)
362 PRINT Version$
363 PRINT "? For Help"
364 PRINT
365 Init_file=0
366 ASSIGN @File TO "HPK_INIT";RETURN Rc
367 IF NOT Rc THEN Init_file=1
368 END IF
369 Remote=0
370 Kermit_exit=0
371 Prompt$="KERMIT-RMB>"
372 DISP
373 IF Init_file THEN
374 PRINT "KERMIT Initialization: "
375 PRINT
376 Cmds$(1)="TAKE"
377 Cmds$(2)="HPK_INIT"
378 GOTO Kermit_exec
379 END IF
380 REPEAT ! Until Exit or Quit Command is given
381 ON ERROR GOSUB K_error
382 Parse1: !
383 REPEAT ! Until Kermit Command is Entered
384 OUTPUT KBD;Prompt$&Kl$; ! kl$ may have errored kermit line
385 ENTER KBD;Kl$
386 Parse_kl(Kl$,Cmds$(*),No_cmds,Prompt$) ! return Kl$ as Kl$(2..)
387 UNTIL No_cmds>0
388 DISP
389 Msg$=" Not Recognized "
390 !
391 Kermit_exec: !
392 !
393 ! Notes on Kermit Shell:
394 !
395 ! Error Levels 1,2,3,4 That command is not a kermit command
396 ! Error Levels 20,30,40 That parameter is missing
397 ! Ni=1 Valid Kermit Command Not Implemented
398 ! Err_level -1 Print Msg$
399 !
400 ON ERROR GOSUB K_error
401 SELECT Cmds$(1) ! Do a Select on the Kermit Command
402 !--------------------------------
403 A: CASE ""
404 B: CASE "BYE"
405 Ni=1
406 C: CASE "CLEAR","CLR" ! Clear Serial Buffer, cycle transfers
407 Shutdown
408 Startup
409 CASE "CLS"
410 CLEAR SCREEN
411 CASE "CLOSE","CLO"
412 SELECT Cmds$(2)
413 CASE "PACKET","PAC","P"
414 D_log=0 ! Close PKT_LOG
415 OUTPUT @D_log;END
416 ASSIGN @D_log TO *
417 CASE "SESSION","SES","S"
418 S_log=0 ! Close SES_LOG
419 OUTPUT @S_log;END
420 ASSIGN @S_log TO *
421 CASE ELSE
422 Err_level=2
423 END SELECT
424 CASE "COMMENT","COM"
425 Ni=1
426 CASE "CONNECT","C","CON"
427 IF Cmds$(1)="C" THEN Cmds$(1)="CONNECT"
428 Remote=1
429 CALL Terminal
430 PRINTER IS CRT
431 PRINT TABXY(1,Crt_lines);
432 CASE "CONVERT" ! Unique Command
433 Misc$=Cmds$(2) ! filename to convert
434 IF Cmds$(3)="TO" THEN
435 New_type$=Cmds$(4)
436 IF LEN(Cmds$(5)) THEN Flen=VAL(Cmds$(5))
437 ELSE
438 New_type$=Cmds$(3)
439 IF LEN(Cmds$(4)) THEN Flen=VAL(Cmds$(4))
440 END IF
441 IF NOT LEN(New_type$) THEN
442 PRINT "Usage: CONVERT <Filename> [TO] <Filetype> [Secors]"
443 PRINT "<Filetype> -nnnn | ASCII | HPUX | BDAT | PROG "
444 Supress_echo=1
445 ELSE
446 IF Flen THEN
447 CALL Convert(Misc$,New_type$,Rc,Flen)
448 ELSE
449 CALL Convert(Misc$,New_type$,Rc)
450 END IF
451 END IF
452 CASE "COPY"
453 IF Cmds$(3)="TO" THEN
454 Cmds$(3)=Cmds$(4) ! Normalize to cmds$(3)=destination
455 END IF
456 IF Cmds$(3)[1,1]=":" THEN ! Add name to msi
457 Misc$=Cmds$(2)
458 Parse_filename(Misc$,F_msi$,F_path$)
459 Misc2$=Misc$ ! save filename
460 Misc$=Cmds$(3)
461 Parse_filename(Misc$,F_msi$,F_path$)
462 Cmds$(3)=F_path$&Misc2$&F_msi$
463 END IF
464 !
465 COPY Cmds$(2) TO Cmds$(3)
466 CASE "MSI","CD"
467 ON ERROR GOTO Nocwd
468 MASS STORAGE IS Cmds$(2)
469 GOTO Cwdok
470 Nocwd: !
471 Msg$="Can't access: "&Cmds$(2)
472 Err_level=-1
473 Cwdok: ON ERROR GOSUB K_error
474 D: CASE "DEFINE","DEF" ! Define a command macro
475 !
476 ! determine if macro is being defined or purged
477 !
478 Def_id=0
479 FOR I=1 TO No_define
480 IF Define$(I,1)=Cmds$(2) THEN ! macro exists
481 Def_id=I
482 IF No_cmds=2 THEN ! purge macro
483 FOR X=1 TO 10
484 Define$(Def_id,X)=""
485 NEXT X
486 Def_id=-1
487 END IF
488 END IF
489 NEXT I
490 IF Def_id=0 THEN ! create a new macro
491 No_define=No_define+1
492 Def_id=No_define
493 Define$(Def_id,1)=Cmds$(2)
494 !
495 ! need to pack commands up to comma
496 !
497 I=3
498 Def_cmd=2
499 REPEAT
500 IF Cmds$(I)="," THEN
501 Define$(Def_id,Def_cmd)=Def_cmd$
502 Def_cmd=Def_cmd+1
503 Def_cmd$=""
504 ELSE
505 Def_cmd$=Def_cmd$&Cmds$(I)&" "
506 END IF
507 I=I+1
508 UNTIL I=No_cmds+1
509 Define$(Def_id,Def_cmd)=Def_cmd$
510 Def_cmd$=""
511 END IF! define macro
512 !
513 CASE "DELETE","DEL","PURGE"
514 PURGE Cmds$(2)
515 PRINT "Purged ";Cmds$(2)
516 Supress_echo=1
517 CASE "DIAL" ! Call Terminal and Dial a Modem
518 Remote=1
519 Modem_init$="AT L2 C1"
520 CALL Terminal(Cmds$(2),Modem_init$,"HAYES")
521 CASE "DO"
522 Do=0
523 FOR I=1 TO No_define
524 IF Cmds$(2)=Define$(I,1) THEN Do=I
525 NEXT I
526 IF Do THEN
527 PRINT "Executing Macro ";Define$(Do,1)
528 Shell=1
529 FOR I=2 TO 10
530 IF LEN(Define$(Do,I)) THEN
531 PRINT "<exec> ";Define$(Do,I)
532 Kl$=Prompt$&Define$(Do,I)
533 Parse_kl(Kl$,Cmds$(*),No_cmds,Prompt$)! return Kl$ as Kl$(2..)
534 GOSUB Kermit_exec
535 END IF
536 NEXT I
537 Shell=0
538 ELSE
539 PRINT "Macro: ";Cmds$(2);" not defined"
540 END IF
541 CASE "DUMP" ! Unique command to RMB
542 ON ERROR GOTO No_hexedit
543 CALL Hex_edit(Cmds$(2))
544 Supress_echo=1
545 GOTO Dump_exit
546 No_hexedit:!
547 ON ERROR GOSUB No_hexedit_file
548 Misc$="HPK_MISC"
549 DISP "Loading Hex Editor, Please Wait ..."
550 LOADSUB Hex_edit FROM Misc$
551 DISP
552 CALL Hex_edit(Cmds$(2))
553 GOTO Dump_exit
554 No_hexedit_file: !
555 DISP "Cant load Hex Editor - file: HPK_MISC not found - plese enter path and MSI "
556 OUTPUT KBD;Misc$&Source_msi$;
557 ENTER KBD;Misc$
558 DISP
559 ON ERROR GOTO Dump_exit
560 RETURN
561 Dump_exit: !
562 CASE "CAT","DIR"
563 IF LEN(Cmds$(2)) THEN
564 CAT Cmds$(2)
565 ELSE
566 CAT
567 END IF
568 Supress_echo=1
569 E: CASE "ECHO" ! Macro Command
570 PRINT Kl$
571 Supress_echo=1
572 CASE "EDIT" ! Unique command to RMB
573 GOTO No_edit_yet
574 ON ERROR GOTO Load_editor
575 Parse_filename(Cmds$(2),F_msi$,F_path$)
576 IF NOT (LEN(F_msi$)) THEN F_msi$=S_msi$
577 IF NOT (LEN(F_path$)) THEN F_path$=S_path$
578 Filename$=F_path$&Cmds$(2)&F_mai$
579 CALL Edit(Filename$)
580 GOTO Edit_there
581 Load_editor:ON ERROR GOSUB K_error
582 LOADSUB ALL FROM "HPK_EDIT"
583 CALL Edit(Cmds$(2),S_msi$,S_path$)
584 Edit_there: !
585 No_edit_yet:!
586 Ni=1
587 CASE "EXIT"
588 Kermit_exit=1
589 PRINTER IS CRT;EOL CHR$(10)
590 F: CASE "FINISH" ! Suspend Remote Server
591 Ni=1
592 G: CASE "GET" ! Receive file via Server
593 Ni=1
594 H: CASE "HANGUP" ! Disconnect Modem (lower DTR)
595 SELECT Com_card
596 CASE 98626,98644
597 STATUS Com_port,5;C5
598 CONTROL Com_port,5;BINAND(C5,254)
599 CASE 98628
600 CASE ELSE
601 DISP "UNKNOWN COM CARD ";Com_card
602 END SELECT
603 CASE "HELP","?" ! ? as first command involkes full help
604 Kh=0
605 Help_filename$="HPK_HELP"
606 REPEAT
607 ON ERROR GOTO No_help
608 CALL Kermit_help(Cmds$(*),No_cmds,Kl$)
609 Kh=1
610 GOTO Khdone
611 No_help: OFF ERROR
612 ON ERROR GOTO No_help_file
613 DISP "Loading Help File"
614 LOADSUB ALL FROM Help_filename$
615 GOTO Khdone
616 DISP
617 No_help_file:OFF ERROR
618 Help_found=0
619 DISP "Can't Find File - Give MSI "
620 OUTPUT KBD;Help_filename$;
621 ENTER KBD;Help_filename$
622 IF NOT POS(Help_filename$,":") THEN Kh=1
623 DISP
624 Khdone: !
625 UNTIL Kh
626 Supress_echo=1
627 CASE "HOST" ! Send command for HOST execution
628 Ni=1
629 I: CASE "INPUT" ! Wait on COM Port for this ascii string
630 Ni=1
631 L: CASE "LOCAL" ! Execute a local BASIC command
632 ON ERROR GOTO Local_err !Warning - doesn't trap kbd line execution
633 OUTPUT KBD;Kl$;" E";
634 GOTO Local_exit
635 Local_err: !
636 PRINT ERRM$
637 Local_exit:OFF ERROR
638 CLEAR LINE
639 CASE "LOG" ! Session Log Commands
640 ON ERROR GOSUB K_error
641 Slog_try=0 ! Attemps to open file
642 Dlog_try=0
643 SELECT Cmds$(2)
644 CASE "SESSION","S","SES" ! Activate session logging
645 S_log=1
646 IF S_log THEN
647 IF LEN(Cmds$(3)) THEN
648 Misc$=Cmds$(3)
649 Parse_filename(Misc$,Misc2$,Misc3$)
650 IF NOT LEN(Misc$) THEN Misc$="SES_LOG"
651 IF NOT LEN(Misc2$) THEN Misc2$=D_msi$
652 IF NOT LEN(Misc3$) THEN Misc3$=D_path$
653 S_log$=Misc3$&Misc$&Misc2$
654 END IF
655 END IF
656 !
657 REPEAT
658 Slog_try=Slog_try+1
659 ASSIGN @S_log TO S_log$;FORMAT ON,RETURN Rc
660 IF Rc THEN CREATE S_log$,10000
661 IF NOT Rc THEN Slog_open=1
662 IF Rc=76 THEN
663 Slog_open=0
664 Slog_try=4
665 END IF
666 UNTIL (NOT Rc) OR (Slog_try>3)
667 IF Slog_try>3 THEN
668 PRINT "CAN'T OPEN ";S_log$
669 S_log=0
670 ELSE
671 PRINT "Session Logging on to ";S_log$
672 END IF
673 !
674 CASE "PACKET","PAC","P" ! Open Packet (debug) logging
675 D_log=1
676 IF D_log THEN
677 IF LEN(Cmds$(3)) THEN
678 Misc$=Cmds$(3)
679 Parse_filename(Misc$,Misc2$,Misc3$)
680 IF NOT LEN(Misc$) THEN Misc$="PKT_LOG"
681 IF NOT LEN(Misc2$) THEN Misc2$=D_msi$
682 IF NOT LEN(Misc3$) THEN Misc3$=D_path$
683 D_log$=Misc3$&Misc$&Misc2$
684 END IF
685 END IF
686 !
687 REPEAT
688 Dlog_try=Dlog_try+1
689 ASSIGN @D_log TO D_log$;RETURN Rc
690 IF Rc THEN CREATE ASCII D_log$,100
691 IF NOT Rc THEN Dlog_open=1
692 IF Rc=76 THEN
693 Dlog_open=0
694 Dlog_try=4
695 END IF
696 UNTIL (NOT Rc) OR (Dlog_try>3)
697 IF Dlog_try>3 THEN PRINT "CAN'T OPEN ";D_log$
698 IF Dlog_try>3 THEN D_log=0
699 END SELECT
700 OFF ERROR
701 M: CASE "MU"
702 PRINT "Available Memory: ";SYSTEM$("AVAILABLE MEMORY")
703 Supress_echo=1
704 N: !
705 O: CASE "OUTPUT","OUT" ! Pipe Output to Com Port
706 OUTPUT @Out_buff;Kl$
707 P: CASE "PAUSE" !Macro command
708 WAIT VAL(Cmds$(2))
709 CASE "PRINT","TYPE","MORE" ! (filename) [device]
710 Filename$=Cmds$(2)
711 IF Cmds$(1)[1,1]="T" THEN
712 Pdev=CRT
713 ELSE ! PRINT COMMAND
714 IF No_cmds>2 THEN
715 Pdev=VAL(Cmds$(3))
716 ELSE
717 Pdev=701
718 END IF
719 END IF
720 CALL More(Filename$,Pdev,Cmds$(1))
721 CASE "PROGRAM","PRO"
722 Ni=1
723 CASE "PUSH" ! NA
724 Ni=1
725 Q: CASE "QUIT","Q","QUI"
726 Kermit_exit=1
727 R: CASE "RECEIVE","REC" ! RECeive <Filetype> <FILENAME | , >
728 SELECT Cmds$(2)
729 CASE "HP-UX","HPUX","ASCII","BDAT","PROG","SYSTM","BIN",""
730 Filetype$=Cmds$(2)
731 F$=Cmds$(3) ! Filename, MSI, and Path are all part of
732 F_msi$="" ! Cmds$(3)
733 F_path$=""
734 Rec=0 ! will be sent as "0" if not
735 Recl=0 ! specified in the command
736 !
737 IF No_cmds>3 THEN
738 IF Cmds$(4)="," THEN
739 Rec=0
740 ELSE
741 Rec=VAL(Cmds$(4))
742 END IF
743 END IF
744 IF No_cmds>4 THEN Recl=VAL(Cmds$(5))
745 !
746 ! RULES For Filespec:
747 !
748 ! 1. If Filename is given only then USE D_msi and D_path.
749 ! 2. If MSI is given with Filename then DON'T USE D_path.
750 ! 3. If PATH is given then use it with D_MSI
751 ! 4. If all three are given use all three.
752 !
753 ! Process Filename, MSI, and Path
754 !
755 IF LEN(F$) AND F$<>"," THEN
756 CALL Parse_filename(F$,F_msi$,F_path$)
757 END IF
758 !
759 IF NOT (LEN(F_msi$)) THEN ! msi given - invalidate path
760 F_msi$=D_msi$
761 F_path$=D_path$
762 END IF
763 IF Debug THEN DISP F$,F_msi$,F_path$
764 CALL K_receive(F$,F_msi$,F_path$,Filetype$,Recl,Rec)
765 CASE ELSE
766 PRINT "Syntax: RECeive [<Filetype>] [<FILENAME> | , ] [File Length] "
767 PRINT " RECeive <BDAT> [<FILENAME> | , ] [# Records | , ] [Recl] "
768 END SELECT
769 !-------------------------------------------------------------
770 Supress_echo=1
771 CASE "REMOTE","REM"
772 Ni=1
773 CASE "RENAME","REN"
774 IF Cmds$(3)="TO" THEN
775 Cmds$(3)=Cmds$(4)
776 END IF
777 RENAME Cmds$(2) TO Cmds$(3)
778 CASE "RUN"
779 Ni=1
780 S: CASE "SEND","SEN"
781 IF NOT (LEN(Cmds$(2))) THEN Cmds$(2)="?"
782 SELECT Cmds$(2)
783 CASE "?" ! Syntax Help
784 PRINT "usage: SEND <[Path] Filename [MSI]> [Bdat Item]"
785 PRINT "Bdat Item: <INTEGER | REAL>"
786 PRINT
787 CASE ELSE
788 F$=Cmds$(2)
789 SELECT Cmds$(3)
790 CASE ""
791 Bdat_item=0 ! Not specified
792 CASE "INTEGER","INT","INTEGERS"
793 Bdat_item=1
794 CASE "REAL","REALS"
795 Bdat_item=2
796 CASE ELSE
797 Bdat_item=3
798 END SELECT
799 CALL K_send(F$,Bdat_item)
800 END SELECT
801 Supress_echo=1
802 !
803 CASE "SCRIPT","SCR"
804 Ni=1
805 CASE "SERVER","SER"
806 Ni=1
807 !
808 Set: !---------------------------- SET COMMANDS ---------------------
809 !
810 CASE "SET","S"
811 Cmds$(1)="SET"
812 !
813 ! Check for proper number of params ??
814 !
815 IF No_cmds=4 THEN ! make sure all parms exist
816 ON ERROR GOSUB Valerr_4
817 ELSE
818 ON ERROR GOSUB Valerr_3
819 END IF
820 !
821 SELECT Cmds$(2)
822 CASE "?"
823 PRINT "BAUD DEBUG DEStination (DES) SOURCE DISPLAY"
824 PRINT "DUPLEX ECHO HandShake (HS) ESCAPE FILE "
825 PRINT "FLOW EOF INComplete (ON=KEEP) PORT MARK "
826 PRINT "REMOTE RETRY SEND TAKE TERM TIMER "
827 PRINT
828 PRINT
829 CASE ""
830 Err_level=20 ! missing second parm
831 CASE "BAUD","SPEED","B" ! set baud (rate)
832 IF POS(Kl$,"B ") THEN Kl$="BAUD"&Kl$[(POS(Kl$,"B"))+1]
833 Req_baud=VAL(Cmds$(3))
834 IF NOT Err_level THEN CALL Set_frame(Req_baud)
835 CASE "BLOCK-CHECK"
836 Ni=1
837 CASE "DEBUG" ! set debug (on|off)
838 Debug=1
839 IF Cmds$(3)="OFF" THEN Debug=0
840 CASE "DEFAULT","DEF"
841 Msg$="Use SET SOURCE or SET DESTINATION commands"
842 Err_level=-1
843 CASE "DELAY" ! My Delay before "S" init packet
844 Sdelay=Sval
845 Set_destination: !
846 CASE "DESTINATION","DES" !(disc drive)
847 IF NOT LEN(Cmds$(3)) THEN
848 Misc$=SYSTEM$("MSI")
849 Parse_filename(Misc$,D_msi$,D_path$)
850 D_path$=D_path$&Misc$
851 ELSE
852 REPEAT! strip off quotes from msvs
853 Qp=POS(Cmds$(3),"""""") ! check for quotes in string
854 IF Qp THEN Cmds$(3)[Qp,Qp]=""
855 UNTIL Qp=0
856 Misc$=Cmds$(3)
857 IF POS(Misc$,"/") THEN ! get d_path$
858 D_path$=Misc$[1,POS(Misc$,":")-1]&"/"
859 D_msi$=Misc$[POS(Misc$,":")]
860 ELSE
861 D_path$=""
862 D_msi$=Misc$[POS(Misc$,":")]
863 END IF
864 ON ERROR GOTO Nodmsi
865 MASS STORAGE IS D_path$&D_msi$
866 MASS STORAGE IS Cur_msi$
867 GOTO Dmsiok
868 Nodmsi: PRINT TABXY(1,Crt_lines);"Can't Access: ";D_path$&D_msi$;RPT$(" ",20)
869 Dmsiok: OFF ERROR
870 END IF
871 Set_source: !
872 CASE "SOURCE"
873 IF NOT LEN(Cmds$(3)) THEN ! SYNC WITH SYSTEM$("MSI")
874 Misc$=SYSTEM$("MSI")
875 Parse_filename(Misc$,S_msi$,S_path$)
876 IF LEN(S_path$) THEN S_path$=S_path$&Misc$&"/"
877 ELSE
878 REPEAT! strip off quotes from msvs
879 Qp=POS(Cmds$(3),"""""") ! check for quotes in string
880 IF Qp THEN Cmds$(3)[Qp,Qp]=""
881 UNTIL Qp=0
882 Misc$=Cmds$(3)
883 Parse_filename(Misc$,S_msi$,S_path$)
884 IF LEN(S_path$) THEN S_path$=S_path$&Misc$&"/"
885 ON ERROR GOTO Nosmsi
886 Cur_msi$=SYSTEM$("MSI")
887 MASS STORAGE IS S_path$&S_msi$! check for ms on line
888 MASS STORAGE IS Cur_msi$
889 GOTO Smsiok
890 Nosmsi: PRINT TABXY(1,Crt_lines);"Can't Access: ";S_path$&S_msi$;RPT$(" ",20)
891 Smsiok: OFF ERROR
892 END IF
893 CASE "DISPLAY" ! Set Display for kermit or terminal
894 SELECT Cmds$(3)
895 CASE "OFF"
896 Display=0 ! Turn off display during file transfer
897 CASE "ON","8","8 BIT"
898 Display=8 ! Show control chars on terminal screen
899 CASE "7","7 BIT"
900 Display=7
901 CASE ELSE
902 Err_level=3
903 END SELECT
904 CASE "DUPLEX" ! Set-Duplex-(HALF|FULL)
905 Duplex$="FULL"
906 SELECT Cmds$(3)
907 CASE "ON","FULL"
908 Duplex$="FULL"
909 CASE "OFF","HALF"
910 Duplex$="HALF"
911 Ni=1
912 END SELECT
913 Se: CASE "ECHO","LOCAL-ECHO" ! set echo (local | remote)
914 Lecho=1
915 SELECT Cmds$(3)
916 CASE "OFF","REMOTE"
917 Lecho=0
918 CASE "ON","LOCAL",""
919 Lecho=1
920 CASE ELSE
921 Err_level=3
922 END SELECT
923 CASE "EOF" ! Set-EndOfFile-(CTRL-Z|NONE)
924 SELECT Cmds$(3)
925 CASE "CTRL-Z","Z","ON"
926 Eof_mode$="CTRL-Z" ! Append ^Z at end of ascii file
927 Eof_mode=1
928 CASE "NONE","OFF","NO CTRL-Z"
929 Eof_mode$="NONE"
930 Eof_mode=0
931 CASE ELSE
932 Err_level=3
933 END SELECT
934 CASE "ESCAPE","ESC" ! set escape
935 Kerm_esc$[1,1]=TRIM$(UPC$(Cmds$(3)[1,1]))
936 Sfi: CASE "FILE","F" ! set file (parameters)
937 SELECT Cmds$(3) ![1,3]
938 CASE "?"
939 PRINT "NAME MODE WARNING (WARN) SUPERCEDE (SUP)"
940 PRINT
941 PRINT
942 CASE "NAME","NAM" ! Set-File-Name
943 CASE "TYPE","T","MODE" ! Set-File-Type
944 IMAGE=0
945 SELECT Cmds$(4)
946 CASE "BINARY","BIN","IMAGE","B"
947 Image=1
948 CASE ELSE
949 Image=0
950 END SELECT
951 CASE "WARNING","WARN" ! Set-File-Warning
952 Filewarn=1
953 IF Cmds$(4)="OFF" THEN Filewarn=0
954 CASE "SUPERCEDE","SUP" ! Set-File-Supercede
955 Ni=1
956 CASE ELSE
957 Err_level=3
958 END SELECT
959 CASE "FLOW-CONTROL","FLOW","FC" ! Set-FlowControl
960 SELECT Cmds$(3)
961 CASE "XON","XOFF","X"
962 Flow$="XON/XOFF"
963 CASE "ENQ","ENQ/ACK"
964 Flow$="ENQ/ACK"
965 CASE "NONE","OFF"
966 Flow$="NONE"
967 CASE ELSE
968 Err_level=3
969 END SELECT
970 Sh: CASE "HANDSHAKE","HS" ! TURNAROUND CHAR
971 Hshake$="NONE"
972 IF Cmds$(3)="ON" THEN Hshake$="ON"
973 CASE "IBM"
974 Ni=1
975 CASE "INCOMPLETE","INC" ! Set-Incomplete (KEEP|DISCARD)
976 Discard=0
977 SELECT Cmds$(3)
978 CASE "OFF","DISCARD","DIS"
979 Discard=1
980 CASE "ON","KEEP","K"
981 Discard=0
982 CASE ELSE
983 Err_level=3
984 END SELECT
985 CASE "INPUT","INP"
986 Ni=1
987 CASE "KEY"
988 Ni=1
989 Sl: !
990 Setport:CASE "PORT","LINE","LIN","POR","P" ! set port number
991 IF POS(Kl$,"P ") THEN Kl$="PORT"&Kl$[(POS(Kl$,"P"))+1]
992 IF Cmds$(3)="?" THEN
993 PRINT "Serial Ports: ";Sports(*)
994 PRINT USING "//"
995 ELSE
996 Shutdown
997 Com_port=VAL(Cmds$(3))
998 STATUS Com_port,0;Id
999 SELECT Id
1000 CASE 2
1001 Com_card=98626 ! COULD BE 98644 IF JUMPER IS CUT
1002 CASE 52
1003 Com_card=98628
1004 CASE 66
1005 Com_card=98644
1006 CASE 180
1007 BEEP
1008 INPUT "98628 - REMOTE SW IS SET - PLEASE CORRECT ",Dum$
1009 END SELECT
1010 CALL Reset_port
1011 END IF
1012 Startup
1013 Sm: CASE "MARKER","MAR","MARK" ! set start-of-packet character
1014 SELECT LEN(Cmds$(3))
1015 CASE 1
1016 Smark$=Cmds$(3)[1,1]
1017 CASE 2
1018 Smark$=CHR$(FNCtl(Cmds$(3)[2,2]))
1019 CASE >2
1020 Err_level=3
1021 END SELECT
1022 CASE "MODE-LINE","ML"
1023 SELECT Cmds$(3)
1024 CASE "OFF"
1025 Mode_line=0
1026 CASE "ON"
1027 Mode_line=1
1028 END SELECT
1029 CASE "MODEM","MOD"
1030 SELECT Cmds$(3)
1031 CASE "VT100"
1032 Term$="VT100"
1033 CASE ELSE
1034 Err_level=3
1035 END SELECT
1036 Sn: CASE "NEWLINE","NL"
1037 Newline=1
1038 SELECT Cmds$(3)
1039 CASE "ON"
1040 Newline=1
1041 CASE "OFF"
1042 Newline=0
1043 END SELECT
1044 Sp: CASE "PARITY","PAR"
1045 SELECT Cmds$(3)
1046 CASE "ODD","EVEN","ZERO","MARK","SPACE","ONE"
1047 Parity_type$=Cmds$(3)
1048 Data_bits=7
1049 On_off$="ON"
1050 CASE "NONE"
1051 Parity_type$=Cmds$(3)
1052 Data_bits=8
1053 On_off$="OFF"
1054 CASE ""
1055 Err_level=30
1056 CASE ELSE
1057 Err_level=4
1058 END SELECT
1059 ! CASE "PORT" ! same as LINE
1060 CASE "PROMPT"
1061 Prompt$=Cmds$(3)&">"
1062 !
1063 ! SET - REMOTE (receive) KERMIT PARAMETERS
1064 !
1065 Sr: CASE "RECEIVE","REC","REMOTE","REM" ! SET RECEIVE PARAMETERS
1066 ON ERROR GOSUB Valerr_4 ! CMDS$(4) MAY NEED TO BE A VALID NUMBER
1067 SELECT Cmds$(3)
1068 CASE ""
1069 Err_level=30
1070 CASE "?"
1071 PRINT "END-OF-PACKET (EOP) PACKET-LENGTH (PL)"
1072 PRINT "PAD-CHARACTER (PC) PADDING (PAD)"
1073 PRINT "START-OF-PACKET (MARK) TIMEOUT (TMO)"
1074 PRINT
1075 !
1076 CASE "END-OF-PACKET","EOP","EOL"
1077 CASE "PACKET-LENGTH","PL" ! Set-Receive-PacketLength
1078 Rpsiz=VAL(Cmds$(4))
1079 CASE "PAD-CHARACTER","PC" ! Set-Receive-PadChar
1080 Padchar$=Cmds$(4)
1081 Padchar=NUM(Padchar$)
1082 CASE "PADDING","PAD"
1083 Pad=VAL(Cmds$(4))
1084 CASE "PAUSE"
1085 CASE "START-OF-PACKET","SOP","MARK"
1086 Smark$=Cmds$(4)
1087 CASE "TIMEOUT","TMO" ! set receive timeout
1088 Ptmo=VAL(Cmds$(4))
1089 CASE ELSE
1090 Err_level=3
1091 END SELECT
1092 OFF ERROR
1093 ! End Of SET - RECEIVE commands
1094 !
1095 CASE "RETRY","RET" ! Set the max retry limit
1096 Maxtry=VAL(Cmds$(3))
1097 CASE "SERVER" ! Set Server (Timeout, etc)
1098 Ni=1
1099 !
1100 ! SET - LOCAL (SEND) KERMIT PARAMETERS ============
1101 !
1102 Ss: CASE "SEND","SEN" ! SET-SEND-[Parameter]-[value]
1103 ON ERROR GOSUB Valerr_4
1104 SELECT Cmds$(3)
1105 CASE ""
1106 Err_level=30
1107 CASE "AT","ATTRIB","ATTRIBUTE"
1108 Send_at=1
1109 IF POS(Cmds$(4),"OFF") THEN Send_at=0
1110 CASE "END-OF-PACKET","EOP","EOL" ! SET-SEND-EOP
1111 Myeol$=Cmds$(4)
1112 CASE "PACKET-LENGTH","PL","LEN" ! Set-Send-Packet Length
1113 Spsiz=VAL(Cmds$(4))
1114 CASE "PAD-CHARACTER","PC"
1115 Padchar$=Cmds$(4)
1116 CASE "PADDING","PAD"
1117 Mypad=VAL(Cmds$(4))
1118 CASE "PAUSE"
1119 Ni=1
1120 CASE "PREFIX" ! set-send-prefix-[type]
1121 SELECT Cmds$(4)
1122 CASE "CONTROL"
1123 Myquote$=Cmds$(5)
1124 CASE "8BIT"
1125 Myprefix$=Cmds$(5)
1126 CASE "REPEAT","REP"
1127 Myrepeat$=Cmds$(5)
1128 END SELECT
1129 CASE "TIMEOUT","TIM" ! set-send-timeout-[value]
1130 Mytmo=VAL(Cmds$(4))
1131 CASE "START-OF-PACKET","SOP"
1132 END SELECT ! SET - SEND options
1133 !
1134 ! END OF SET-SEND PARAMETERS =====================
1135 !
1136 St: CASE "TAKE","TAKE-ECHO"
1137 Take_echo=1
1138 IF Cmds$(3)="OFF" THEN Take_echo=0
1139 IF Cmds$(3)<>"ON" AND Cmds$(3)<>"OFF" THEN Err_level=3
1140 CASE "TERMINAL","TERM","T" ! Set-Terminal
1141 Term_type$="VT100"
1142 SELECT Cmds$(3)
1143 CASE "VT100"
1144 Term_type$="VT100"
1145 CASE "VT102"
1146 Term_type$="VT102"
1147 CASE "MODE"
1148 SELECT Cmds$(4)
1149 CASE "APPL","APPLICATION"
1150 Term_mode$="APPL"
1151 CASE "NUM","NUMERIC"
1152 Term_mode$="NUMERIC"
1153 CASE ELSE
1154 PRINT "Syntax: SET TERM MODE <APPL | NUMERIC>"
1155 Err_level=4
1156 END SELECT
1157 CASE ELSE
1158 PRINT TABXY(1,Crt_lines);"Terminal Type ";Cmds$(3);" Not Implemented - How would you like to write one ?"
1159 END SELECT
1160 CASE "TIMER","TIM" ! Set-Timer (ON|OFF)
1161 Timer=1
1162 IF Cmds$(3)="OFF" THEN Timer=0
1163 CASE "TRANSLATION","TRA","TRANS"
1164 Ni=1
1165 CASE "WINDOW","WIN"
1166 Ni=1
1167 CASE ELSE
1168 Err_level=2
1169 END SELECT ! KERMIT SET COMMAND
1170 OFF ERROR
1171 !=======================================================================
1172 ! END OF SET COMMANDS
1173 !=======================================================================
1174 Sz:!
1175 Show:CASE "SHOW","SHO" ! SHOW THE SET PARAMETERS
1176 PRINT
1177 SELECT Cmds$(2)
1178 CASE "COMMUNICATIONS","COM","COMM","TERMINAL","TERM"
1179 PRINT "TERMINAL TYPE",TAB(35);Term_type$
1180 PRINT "BAUD RATE",TAB(35);Baud
1181 PRINT "COM PORT",TAB(35);Com_port
1182 PRINT "LOCAL ECHO",TAB(35);Local_echo
1183 PRINT "HANDSHAKE",TAB(35);Hshake$
1184 PRINT "PARITY",TAB(35);Parity_type$,On_off$
1185 PRINT "FLOW CONTROL",TAB(35);Flow$
1186 PRINT "DEBUG",TAB(35);Debug
1187 PRINT "MODEM LINES ACTIVE: ";TAB(35);
1188 STATUS Com_port,11;Ml
1189 IF BIT(Ml,4) THEN PRINT "CTS ";
1190 IF BIT(Ml,5) THEN PRINT "DSR ";
1191 IF BIT(Ml,6) THEN PRINT "RI ";
1192 IF BIT(Ml,7) THEN PRINT "CD ";
1193 PRINT
1194 PRINT "TERMINAL LINES ACTIVE: ";TAB(35);
1195 STATUS Com_port,5;Ml
1196 IF BIT(Ml,0) THEN PRINT "RTS ";
1197 IF BIT(Ml,1) THEN PRINT "DTR ";
1198 PRINT
1199 CASE "FILE"
1200 PRINT "CURRENT MSI",TAB(35);Cur_msi$
1201 PRINT "DEFAULT MSI",TAB(35);D_path$,D_msi$
1202 PRINT "EOF MODE",TAB(35);Eof_mode$
1203 PRINT "INCOMPLETE FILE",TAB(35);Discard
1204 PRINT "FILE OVERWRITE",TAB(35);File_warn
1205 PRINT "TAKE ECHO",TAB(35);Take_echo
1206 PRINT "ATTRIBUTE PACKETS",TAB(35);Att_on
1207 CASE "LOGGING","LOG"
1208 PRINT "PACKET LOGGING",TAB(35);D_log
1209 PRINT "PACKET LOG FILE",TAB(35);D_log$
1210 PRINT "SESSION LOGGING",TAB(35);S_log
1211 PRINT "SESSION LOG FILE",TAB(35);S_log$
1212 CASE "MACRO","MAC"
1213 IF No_define THEN
1214 PRINT USING VAL$(No_define)&"(10(K,2(X)),/)";Define$(*)
1215 ELSE
1216 PRINT "No MACROs currently defined"
1217 END IF
1218 CASE "MODEM"
1219 PRINT "NOT IMPLEMENTED"
1220 CASE "PROTOCOL"
1221 CALL Kstatus
1222 CASE "SERVER"
1223 PRINT "NOT IMPLEMENTED"
1224 CASE ELSE
1225 PRINT "Syntax: COMM , TERMINAL , FILE , LOG , MODEM , MACRO , PROTOCOL "
1226 END SELECT
1227 PRINT
1228 Supress_echo=1
1229 !
1230 CASE "SPACE","SPA"
1231 IF NOT LEN(Cmds$(2)) THEN Cmds$(2)=D_msi$
1232 Disc_space(Cmds$(2),Total,Largest_hole,Hole_sum,Format$)
1233 Cmds$(2)=":"&Cmds$(2)[POS(Cmds$(2),",")]
1234 CLEAR SCREEN
1235 PRINT TABXY(1,Crt_lines);
1236 PRINT "Volume: ";Cmds$(2)
1237 PRINT "Format: ";Format$
1238 PRINT "Space: ";Total;TAB(35);Total*256
1239 PRINT "Frags: ";Hole_sum;TAB(35);Hole_sum*256
1240 PRINT "Largest Hole: ";Largest_hole;TAB(35);Largest_hole*256
1241 PRINT
1242 Supress_echo=1
1243 CASE "STATISTICS"
1244 Ni=1
1245 CASE "STATUS","STAT" !
1246 CALL Kstatus
1247 Supress_echo=1
1248 CASE "SUBMIT","SUB" ! BATCH PROCESS
1249 Ni=1
1250 T: CASE "TAKE","TAK" ! execute a command file
1251 ASSIGN @File TO Cmds$(2);RETURN Rc
1252 IF Rc THEN GOTO Take_done
1253 Init_file=1
1254 Shell=1
1255 IF NOT Init_file THEN PRINT TABXY(1,Crt_lines);"KERMIT Initialization File"
1256 REPEAT
1257 Init_cmd$=""
1258 ENTER @File;Init_cmd$
1259 Init_cmd$=UPC$(Init_cmd$)
1260 Init_cmd$=Init_cmd$[POS(Init_cmd$,"!")+1]
1261 Cmt=POS(Init_cmd$,"!")
1262 IF Cmt THEN Init_cmd$=Init_cmd$[1,POS(Init_cmd$,"!")-1] ! extract from line comment
1263 IF NOT LEN(TRIM$(Init_cmd$)) THEN GOTO Skip_cmd
1264 IF POS(Init_cmd$,"STOP") THEN
1265 Init_file=0
1266 Kl$=""
1267 ELSE
1268 Cmt=POS(Init_cmd$,"COMMENT")
1269 IF NOT Cmt THEN
1270 Kl$=Prompt$&Init_cmd$
1271 Parse_kl(Kl$,Cmds$(*),No_cmds,Prompt$)! return Kl$ as Kl$(2..)
1272 PRINT Cmds$(1)&" ";Kl$
1273 GOSUB Kermit_exec
1274 END IF
1275 END IF
1276 Skip_cmd: !
1277 UNTIL Init_file=0
1278 Shell=0
1279 Supress_echo=1
1280 Take_done:DISP
1281 CASE "TRANSMIT","TRANS" ! Transmit <filename> [format on/off]
1282 IF NOT LEN(Cmds$(3)) THEN
1283 IF Cmds$(3)<>"OFF" AND Cmds$(3)<>"ON" THEN
1284 INPUT "Read File with Format ON or OFF ? ",Cmds$(3)
1285 Cmds$(3)=UPC$(Cmds$(3))
1286 END IF
1287 CALL Transmit(Cmds$(2),Cmds$(3))
1288 ELSE
1289 CALL Transmit(Cmds$(2))
1290 END IF
1291 ! CASE "TYPE" ! same as PRINT
1292 V: CASE "VER","VERSION"
1293 PRINT TABXY(1,Crt_lines);Version$
1294 W: CASE "WHO"
1295 Ni=1
1296 X: CASE "XYZZY"
1297 Msg$="I see no cave here."
1298 Err_level=-1
1299 CASE ELSE
1300 Y: Err_level=1 ! invalid kermit command
1301 Z:!
1302 END SELECT ! KERMIT COMMANDS
1303 !-------------------------------------------------------------------------
1304 !
1305 ! Process Err_level or echo command
1306 !
1307 SELECT Err_level
1308 CASE 0 ! Valid command - check if implemented before echoing
1309 IF Ni THEN
1310 PRINT Cmds$(1)&" "&Kl$&" NOT IMPLEMENTED"
1311 ELSE
1312 IF (Display AND (NOT Init_file)) OR (Init_file AND Take_echo) THEN
1313 IF (NOT In_term) AND (NOT Supress_echo) THEN
1314 PRINT Cmds$(1)&" "&Kl$&RPT$(" ",80)! command executed OK
1315 END IF
1316 END IF
1317 END IF
1318 Kl$=""
1319 CASE -1
1320 PRINT Msg$
1321 CASE 1
1322 PRINT CHR$(129);Cmds$(Err_level);CHR$(128);" not a KERMIT command"
1323 CASE 2,3,4
1324 Line$=""
1325 FOR I=1 TO Err_level-1
1326 Line$=Line$&Cmds$(I)&" "
1327 NEXT I
1328 PRINT Line$&CHR$(129);Cmds$(Err_level);CHR$(128);" ";Msg$
1329 CASE 20,30,40
1330 Err_level=Err_level/10
1331 PRINT "Parameter # ";Err_level;" Required"
1332 CASE ELSE
1333 END SELECT
1334 !
1335 IF Err_level THEN
1336 IF Err_level>1 THEN Kl$=Cmds$(1)&" "
1337 IF Err_level>2 THEN Kl$=Kl$&Cmds$(2)&" "
1338 IF Err_level>3 THEN Kl$=Kl$&Cmds$(3)&" "
1339 IF Err_level=1 THEN
1340 Kl$=""
1341 END IF
1342 Err_level=0
1343 END IF
1344 Ni=0
1345 Supress_echo=0
1346 IF Shell THEN RETURN ! recursive gosub to kermit command parser
1347 UNTIL Remote OR Kermit_exit
1348 SUBEXIT
1349 !---------------------------------
1350 Valerr_4: ! BAD VALUE IN SET-RECEIVE
1351 Err_level=4
1352 IF NOT LEN(Cmds$(4)) THEN Err_level=40
1353 ERROR RETURN
1354 RETURN
1355 !------------------------------------
1356 Valerr_3:!
1357 Err_level=3
1358 IF NOT LEN(Cmds$(3)) THEN Err_level=30 ! missing third parameter
1359 ERROR RETURN
1360 RETURN
1361 !------------------------------------------
1362 K_error: !
1363 SELECT ERRN
1364 CASE 76 ! INCORRECT MSVS
1365 PRINT ERRM$
1366 Rc=76
1367 ERROR RETURN
1368 CASE 59 ! EOF
1369 Init_file=0
1370 PRINT "End OF File"
1371 ERROR RETURN
1372 CASE ELSE
1373 PRINT "KERMIT: ";ERRM$
1374 ERROR RETURN
1375 END SELECT
1376 RETURN
1377 !-----------------------------------------
1378 SUBEND
1379 ! =====================================================================
1380 Parser:SUB Parse_kl(Kl$,Cmds$(*),No_cmds,Prompt$)
1381 Parse:!
1382 Kl$=TRIM$(UPC$(Kl$))
1383 DIM Kl_return$[100]
1384 MAT Cmds$= ("")
1385 Begin_cmd=POS(Kl$,Prompt$)+LEN(Prompt$)
1386 IF Begin_cmd=LEN(Prompt$) THEN SUBEXIT
1387 Kl$=TRIM$(Kl$[Begin_cmd,LEN(Kl$)]) ! SEPARATE OFF PROMPT
1388 I=0
1389 REPEAT
1390 I=I+1
1391 Cmd_end=POS(Kl$," ")
1392 IF Cmd_end=0 THEN ! IF NO BLANKS THEN KL$= LAST COMMAND
1393 Cmds$(I)=Kl$[1,80]
1394 No_cmds=I
1395 Parse_done=1
1396 ELSE
1397 Cmds$(I)=Kl$[1,Cmd_end-1]
1398 END IF
1399 IF I=2 THEN Kl_return$=Kl$ ! No, Return Null if single cmd
1400 Kl$=TRIM$(Kl$[Cmd_end+1]) ! TRUNCATE KL$
1401 !
1402 ! Return the argument line (cmd 2-end) as Kl$
1403 !
1404 !
1405 ! Eliminate any Quote Marks in Command
1406 !
1407 REPEAT
1408 Qm=POS(Cmds$(I),"""")
1409 IF Qm THEN Cmds$(I)[Qm,Qm]=" "
1410 UNTIL Qm=0
1411 Cmds$(I)=TRIM$(Cmds$(I))
1412 !
1413 UNTIL Parse_done
1414 Kl$=Kl_return$
1415 SUBEND
1416 !=========================================================================
1417 Transmit:SUB Transmit(Filename$,OPTIONAL Fmt$)
1418 Tr:!
1419 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
1420 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
1421 DIM Line$[256],Out_buff$[512] BUFFER,K$[80],A$[1]
1422 REAL Real_no
1423 INTEGER Int_no,Slow,Abort_txmit
1424 !
1425 ! PRINTER IS CRT;EOL ("
"),WIDTH OFF
1426 ON ERROR GOSUB Txmit_err
1427 Fmt_onoff$="ON"
1428 IF NPAR>1 THEN Fmt_onoff$=Fmt$
1429 REPEAT
1430 IF Fmt_onoff$="OFF" THEN
1431 ASSIGN @File TO Filename$;FORMAT OFF,RETURN Rc
1432 ELSE
1433 ASSIGN @File TO Filename$;FORMAT ON,RETURN Rc
1434 END IF
1435 IF Rc<>0 THEN ! File Couldn't Be Opened
1436 DISP "Can't open file: ";Filename$;" (blank name to abort)"
1437 OUTPUT KBD;Filename$;" H";
1438 ENTER KBD;Filename$
1439 Filename$=TRIM$(Filename$)
1440 DISP
1441 IF NOT (LEN(Filename$)) THEN SUBEXIT
1442 END IF
1443 UNTIL Rc=0
1444 !
1445 DISP "Transmitting FILE: ";Filename$;" CTRL-C to Exit CTRL-S Screen"
1446 Get_type:STATUS @File,1;File_type
1447 SELECT File_type
1448 CASE 2 ! BDAT
1449 INPUT "ASCII / INTEGERS / REALS ? [ A / I / R ] ",Data_type$
1450 CASE 3 ! ASCII
1451 Data_type$="ASCII"
1452 CASE 4 ! HPUX
1453 Data_type$="ASCII"
1454 END SELECT
1455 ON END @File GOTO Txmit_done
1456 ON KBD,2 GOSUB K_serve
1457 Startup
1458 Scr_echo=1
1459 LOOP
1460 EXIT IF Abort_txmit=1
1461 SELECT UPC$(Data_type$[1,1])
1462 CASE "A"
1463 ENTER @File;Line$ ! Enter the line and convert to Ascii
1464 OUTPUT @Out_buff;Line$ ! Line Used for DMA Transmit
1465 IF Scr_echo THEN PRINT Line$
1466 CASE "R"
1467 DISP "Transmitting REALS from FILE: ";File_name$
1468 LOOP
1469 ENTER @File;Real_no
1470 DISP "TRANSMITTING RECORD # ";Rec,Line$
1471 OUTPUT @Out_buff;Real_no ! This Will Convert REAL to Ascii
1472 IF Scr_echo THEN PRINT Real_no
1473 END LOOP
1474 CASE "I"
1475 ENTER @File;Int_no
1476 OUTPUT @Out_buff;Int_no
1477 IF Scr_echo THEN PRINT Int_no
1478 CASE ELSE
1479 BEEP
1480 INPUT "BAD DATA TYPE - INPUT AGAIN ",Data_type$
1481 END SELECT
1482 Rec=Rec+1
1483 GOSUB Response
1484 END LOOP
1485 Txmit_done: !
1486 INPUT "Enter any End-of-file mark to send: ",Endofile$
1487 IF LEN(Endofile$) THEN
1488 OUTPUT @Out_buff;Endofile$
1489 END IF
1490 DISP "File Transfer Complete "
1491 ASSIGN @File TO *
1492 OFF ERROR
1493 OFF KBD
1494 Shutdown
1495 SUBEXIT ! Return to Kermit
1496 !-----------------------------------------------------------------------
1497 Response:!
1498 DISABLE
1499 IF Com_card=98628 THEN
1500 STATUS Com_port,5;In_length
1501 ELSE
1502 STATUS @In_buff,4;In_length
1503 END IF
1504 !
1505 WHILE In_length
1506 ENTER @In_buff USING "#,A";A$
1507 Char=NUM(A$)
1508 Handle_char: !
1509 SELECT Char
1510 CASE 32 TO 126 ! sp to ~
1511 PRINT A$;
1512 !-----------------------------------------
1513 ! SELECTED CONTROL CHARACTERS
1514 !-----------------------------------------
1515 CASE 5 !"" ! ENQ/ACK
1516 OUTPUT @Out_buff;CHR$(6);
1517 CASE 10
1518 PRINT "
";
1519 CASE 13
1520 PRINT "";
1521 CASE 7
1522 BEEP 800,.1
1523 CASE 8 ! Backspace
1524 STATUS CRT,0;Cx
1525 CONTROL CRT,0;MAX(Cx-1,1)
1526 CASE 17 !
1527 K$=KBD$
1528 ENABLE
1529 RETURN
1530 CASE ELSE
1531 WAIT .3
1532 END SELECT
1533 Skip_cp: !
1534 IF Com_card=98628 THEN
1535 STATUS Com_port,5;In_length
1536 ELSE
1537 STATUS @In_buff,4;In_length
1538 END IF
1539 END WHILE
1540 ENABLE
1541 RETURN
1542 !--------------------------------------
1543 Txmit_err: !
1544 BEEP
1545 DISP ERRM$&" PAUSED "
1546 PAUSE
1547 RETURN
1548!---------------------------------------
1549 K_serve: !
1550 K$=KBD$
1551 SELECT K$
1552 CASE " E"," E"
1553 Abort_txmit=0
1554 CASE "" ! CTRL-S
1555 IF Scr_echo THEN
1556 Scr_echo=0
1557 ELSE
1558 Scr_echo=1
1559 END IF
1560 CASE ELSE
1561 Abort_txmit=1
1562 END SELECT
1563 Ok_cont=1
1564 RETURN
1565 SUBEND
1566! ======================================================================
1567 SUB Terminal(OPTIONAL Phone$,Modinit$,Modem$)
1568 OPTION BASE 1
1569 COM Version$,K$,Setup$
1570 COM /Crt/ Crt_lines,Crt_width
1571 COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
1572 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
1573 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
1574 COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
1575 COM /Frame/ Flow$,Hshake$
1576 COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
1577 COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
1578 COM /Term/ Term_mode$
1579 COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
1580 COM /Mode/ Mode_line,Newline
1581 !
1582 DIM A$[80],Hlchar$[1],File_buff$[256],Esc_seq$[5]
1583 DIM Key1$[1],Key2$[1],Key3$[1]
1584 INTEGER Cc,Cl,Cx,Cy,Hl,Hlx,Hly,Ie,If,Il
1585 INTEGER Key1,Key2,Key3,Oe,Of,Ol,Pn
1586 INTEGER Max_buff
1587 Max_buff=MAXLEN(File_buff$)
1588 DIM Line$[256]
1589 DIM Dial_ext$[80]
1590 Term:!
1591 Blink=.2 ! cursor speed
1592 In_term=1 ! In-Terminal Flag
1593 SYSTEM PRIORITY 0 ! In case terminal is accidentally
1594 ! entered recursively form kermit
1595 !-------------------------------]
1596 ! Interrupt Levels for TERM:
1597 !
1598 ! 1- Idle Loop - Receive Char
1599 ! ON TIMEOUT - Com_port
1600 ! ON CYCLE Blink Cursor
1601 ! 3- ON KBD Send Character KBD
1602 ! 4-
1603 ! 5- ON INTR COM_PORT
1604 !--------------------------------
1605 PRINTER IS CRT;EOL (CHR$(10)),WIDTH OFF
1606 CONTROL CRT,21;1 ! clear screen and color map
1607 IF NOT Debug THEN CONTROL CRT,10;0 ! CURSOR OFF
1608 CONTROL CRT,0;1,1 ! home cursor
1609 Hlx=1 ! cursor highlight position
1610 Hly=1
1611 !------------------ SET ON-EVENTs Before TRANSFER starts
1612 CALL Shutdown !shutoff transfers if on
1613 SELECT Com_card
1614 CASE 98626,98644
1615 CONTROL Com_port,5;1+2 ! Force DTR and RTS Active
1616 IF Hshake$="NONE" THEN ! Disable Modem HS Lines
1617 CONTROL Com_port,12;128+32+16 ! 128=DTR 32=RTS 16=CTS
1618 ELSE
1619 CONTROL Com_port,12;0 ! Enable Modem HS Lines
1620 END IF
1621 ENABLE INTR Com_port;8+4
1622 CASE 98628
1623 CONTROL Com_port,8;1+2 ! RTS DTR Set Active
1624 CONTROL Com_port,13;164 ! INT MASK UART/lost car/break
1625 ! CONTROL 23; for HS Lines
1626 END SELECT
1627 !----------------------------------
1628 ON INTR Com_port,5 GOSUB Term_intr
1629 ON ERROR GOSUB Term_err
1630 ON KBD,3 GOSUB Send_char
1631 ON TIMEOUT Com_port,10 GOSUB Com_tmo
1632 IF NOT Debug THEN ON CYCLE Blink,1 GOSUB Blink
1633 CALL Startup
1634 GOSUB Disp_modeline
1635 IF NPAR THEN GOSUB Dial_modem
1636 !
1637 REPEAT
1638 SELECT Com_card
1639 CASE 98626,98644
1640 STATUS @In_buff,3;Fp,In_length,Ep
1641 CASE 98628
1642 STATUS Com_port,5;In_length
1643 END SELECT
1644 IF Debug THEN
1645 IF Com_card=98628 THEN
1646 ELSE
1647 STATUS @Out_buff,4;Out_length
1648 DISP "INBOUND: ";In_length,"OUTBOUND: ";Out_length
1649 END IF
1650 END IF
1651 !
1652 IF In_length THEN
1653 GOSUB Receive_char
1654 END IF
1655 UNTIL Remote=0 ! terminal escape seq trapped in Send_char
1656 CONTROL CRT,10;1 ! restore system cursor
1657 IF Hl THEN GOSUB Blink ! remove cursor turds
1658 In_term=0 ! notify Kermit we're out
1659 SUBEXIT
1660 !========================================================================
1661 Disp_modeline:!
1662 GCLEAR
1663 IF Mode_line THEN
1664 WINDOW 0,80,26,0
1665 MOVE 0,26
1666 CSIZE 3
1667 Kesc_char$=CHR$(NUM(Kerm_esc$[1,1])+64)
1668 LABEL "ESC: ^";Kesc_char$;"C ";Baud;Data_bits;Parity_type$;" ";On_off$
1669 END IF
1670 RETURN
1671 !-------------------------------------------------------------------------
1672 Term_intr: !
1673 CALL Com_interrupt
1674 !
1675 ! ON INTR BRANCHES Must be setup with transfers off
1676 !
1677 Shutdown
1678! ON INTR Com_port,5 GOSUB Term_intr !????????????????????????
1679 SELECT Com_card
1680 CASE 98628
1681 CONTROL Com_port,13;164 ! MASK 4=UART 32=lost carr 128=break
1682 CASE 98626,98644
1683 ON INTR Com_port,1 GOSUB Term_intr
1684 ENABLE INTR Com_port;8+4
1685 END SELECT
1686 ON ERROR GOSUB Term_err
1687 Startup
1688 RETURN
1689 !----------------------------------------------------------------------
1690 Blink:!
1691 IF NOT Hl THEN
1692 IF B THEN PAUSE
1693 !
1694 ! Produce underscore at current print position
1695 !
1696 !-----------
1697 !
1698 ! Establish the current (legal) print position
1699 ! And read the crt character at that position
1700 !
1701 DISABLE ! disable kbd interrupt
1702 STATUS CRT,0;Hlx,Hly
1703 Hly=MAX(Hly,1)
1704 IF Hly>Crt_lines THEN
1705 Need_scroll=1
1706 Hly=MIN(Crt_lines,Hly) ! hlx=20 after CR on line 19
1707 END IF
1708 !
1709 IF Hlx>80 THEN ! fixes bug with pos 81 printing in pos 80
1710 Hlx=80
1711 Wrap=1
1712 CONTROL CRT,0;Hlx,Hly ! move to 80
1713 IF Hly<=Crt_lines THEN ENTER CRT USING "#,K";Hlchar$
1714 ELSE
1715 ! leave cx and cy where they are
1716 IF Hly<=Crt_lines THEN ENTER CRT USING "#,K";Hlchar$
1717 END IF
1718 !
1719 ! If crt char is null then make it a space
1720 !
1721 IF Hlchar$="" THEN Hlchar$=" "
1722 STATUS CRT,4;Dfm ! Check Display Functions Mode
1723 IF NOT Dfm THEN ! Don't display CHR$(132) with Display functions on
1724 !
1725 ! Draw (or redraw) the character with an underscore
1726 !
1727 PRINT TABXY(Hlx,Hly);CHR$(132);Hlchar$;CHR$(128);
1728 END IF
1729 !
1730 ! Wrap flag indicates that the cursor has moved to a new line
1731 !
1732 IF Need_scroll THEN
1733 PRINT
1734 Need_scroll=0
1735 END IF
1736 !
1737 IF Wrap THEN ! wrap around, but leave hlx,hly at 81,hly
1738 CONTROL CRT,0;1,Hly+1
1739 Wrap=0
1740 ELSE
1741 CONTROL CRT,0;Hlx,Hly ! highlighting pushes cursor ahead 1 pos
1742 END IF
1743 !
1744 Hl=1
1745 ENABLE
1746 ! END IF
1747 !
1748 ELSE !============================================================
1749 Unblink: !
1750 Ub:!
1751 ! Un-blink, remove the underscore
1752 !
1753 DISABLE
1754 IF Bld THEN PAUSE
1755 !
1756 ! Record current print position
1757 ! Move to underscore highlight
1758 !
1759 STATUS CRT,0;Cx,Cy ! remember current cursor
1760 IF Ub THEN PAUSE
1761 !
1762 IF Cy>Crt_lines THEN
1763 Need_scroll=1
1764 ! Cy=Crt_lines ! leave cy=20
1765 ! Cy=MIN(Crt_lines,Cy)
1766 END IF
1767 CONTROL CRT,0;Hlx,Hly ! locate to old cursor position
1768 !
1769 ! Enter the crt char at the old underscore
1770 !
1771 IF Hly<=Crt_lines THEN ENTER CRT USING "#,K";Hlchar$ ! #A doesn't enter null
1772 !
1773 ! The underscore can't be a null (remove this code)
1774 !
1775 ! CRT space characters get entered as nulls ???
1776 !
1777 IF Hlchar$="" THEN
1778 Hlchar$=" " ! avoid null
1779 ELSE ! we have just cleared a character at the end of the line - move
1780 IF Cx=80 THEN ! wrap around
1781 IF Hlx=80 THEN
1782 Cy=MIN(Crt_lines,Cy+1)
1783 Cx=1
1784 END IF
1785 END IF
1786 END IF
1787 !
1788 ! redraw the character without the underscore
1789 !
1790 STATUS CRT,4;Dfm
1791 IF NOT Dfm THEN
1792 PRINT TABXY(Hlx,Hly);CHR$(128);Hlchar$; ! unhighlight
1793 END IF
1794 !
1795 ! Restore the current print position
1796 !
1797 IF Need_scroll THEN
1798 PRINT
1799 Need_scroll=0
1800 END IF
1801 !
1802 CONTROL CRT,0;Cx,Cy
1803 Hl=0
1804 ENABLE
1805 END IF ! hl on or not
1806 IF Debug THEN ON CYCLE Blink,1 GOSUB Blink
1807 RETURN
1808 !-----------------------------------------------------------------------
1809 Dial_modem:!
1810 STATUS Com_port,10;Uart
1811 ! Dial_ext$=",,,add your phone card # here "
1812 IF NPAR>1 THEN
1813 OUTPUT @Out_buff;Modinit$
1814 ELSE
1815 OUTPUT @Out_buff;"AT L2 C1 "
1816 END IF
1817 WAIT .5
1818 OUTPUT @Out_buff;"ATDT"&Phone$&Dial_ext$
1819 RETURN
1820 !------------------------------------------------
1821 Send_char:!
1822 Sc:!
1823 K$=KBD$
1824 K: LOOP
1825 IF NOT LEN(K$) THEN
1826 GOSUB Receive_char
1827 K$=KBD$ ! Check For any keys pressed during Receive_char
1828 IF NOT LEN(K$) THEN RETURN
1829 END IF
1830 !
1831 ! Process K$
1832 !----------------------------
1833 ! Fumction Key >
1834 ! CTRL-Function Key >
1835 ! Ascii Key a-Z
1836 ! CTRL-Ascii Key -
1837 !----------------------------
1838 Key1$=K$[1,1]
1839 Key1=NUM(Key1$)
1840 K$=K$[2]
1841 IF Key1=255 THEN ! Function Key
1842 Key2=NUM(K$)
1843 Key2$=CHR$(Key2)
1844 K$=K$[2]
1845 !
1846 IF Key2=255 THEN ! CTRL + Function Key
1847 Key3=NUM(K$)
1848 Key3$=CHR$(Key3)
1849 K$=K$[2]
1850 SELECT Key3$
1851 ! Not using any CTRL-Function Keys
1852 CASE "E" ! E
1853 IF Term_mode$="APPL" THEN OUTPUT @Out_buff;"OM";
1854 END SELECT
1855 ELSE ! Function Key >
1856 SELECT Key2$
1857 CASE "E","X" ! ENTER
1858 IF Newline THEN
1859 OUTPUT @Out_buff;"
"; ! CR-LF
1860 IF Lecho THEN
1861 IF Hl THEN GOSUB Blink
1862 PRINT "
";
1863 END IF
1864 ELSE
1865 OUTPUT @Out_buff;"";
1866 IF Lecho THEN PRINT "";
1867 END IF
1868 !-----------------------------------------------------------
1869 Vt100:! vt-100 Esc Sequences implemented here VT100
1870 !-----------------------------------------------------------
1871 CASE "B" ! Backspace (Del)
1872 OUTPUT @Out_buff;CHR$(8);
1873 IF Lecho THEN PRINT "";
1874 CASE "<" ! Left Arrow
1875 OUTPUT @Out_buff;"D";
1876 STATUS CRT,0;Px,Py
1877 CONTROL CRT,0;MAX(1,Px-1),Py
1878 CASE ">" ! Right Arrow
1879 OUTPUT @Out_buff;"C";
1880 STATUS CRT,0;Px,Py
1881 CONTROL CRT,0;MIN(Crt_width,Px+1),Py
1882 CASE "^"
1883 OUTPUT @Out_buff;"A";
1884 STATUS CRT,0;Px,Py
1885 CONTROL CRT,0;Px,MAX(1,Py-1)
1886 CASE "V" ! Down Arrow
1887 OUTPUT @Out_buff;"B";
1888 STATUS CRT,0;Px,Py
1889 CONTROL CRT,0;Px,Py+1
1890 CASE "\" ! home
1891 OUTPUT @Out_buff;"H";
1892 CONTROL CRT,0;1,1
1893 CASE "%" ! clr-end
1894 OUTPUT @Out_buff;"";
1895 IF Lecho THEN
1896 STATUS CRT,9;Crt_width
1897 STATUS CRT,0;Cx
1898 PRINT RPT$(" ",Crt_width-Cx)
1899 END IF
1900 CASE "#" ! clr-line
1901 OUTPUT @Out_buff;"";
1902 IF Lecho THEN
1903 CONTROL CRT,0;1
1904 STATUS CRT,9;Crt_width
1905 PRINT RPT$(" ",Crt_width)
1906 END IF
1907 CASE "K" ! cls
1908 OUTPUT @Out_buff;""
1909 IF Lecho THEN CLEAR SCREEN
1910 CASE "U" ! caps lock
1911 STATUS KBD,0;Capstat
1912 IF Capstat THEN
1913 CONTROL KBD,0;0
1914 ELSE
1915 CONTROL KBD,0;1
1916 END IF
1917 ! OUTPUT KBD;" U E";
1918 CASE ELSE
1919 BEEP 300,.01 ! this function key not implemented
1920 END SELECT
1921 END IF ! CTRL - Function Key
1922 END IF ! Fuunction Key
1923 !
1924 !---------------- Ascii and CTRL-Ascii Processing a-Z -
1925 !
1926 Ak:!
1927 SELECT Key1
1928 Kesc:CASE NUM(Kerm_esc$[1,1]) ! KERMIT Escape CTRL-]
1929 DISP "C: Exit B:Break K:Kermit Q:Stop Log R:Resume Log M: Modeline E: Echo"
1930 Esc_seq$=K$[1,1]
1931 WHILE LEN(Esc_seq$)<1 ! Wait for Kermit Escape Completion
1932 K$=KBD$
1933 Esc_seq$=K$[1,1]
1934 END WHILE
1935 SELECT UPC$(Esc_seq$) ! Second Sequence of Kermit Escape
1936 CASE "C" ! cancel - exit
1937 Remote=0
1938 OFF KBD
1939 IF Mode_line THEN GCLEAR
1940 CLEAR SCREEN
1941 CASE "B" ! send break
1942 IF Com_card=98628 THEN
1943 BREAK Com_port
1944 ELSE
1945 Shutdown
1946 BREAK Com_port
1947 Startup
1948 END IF
1949 OUTPUT @Out_buff;"" ! work around for FIDO Bulletin Board
1950 CASE "S" ! stat
1951 CASE "Q" ! stop logging
1952 IF S_log THEN
1953 OUTPUT @S_log;File_buff$;END
1954 File_buff$=""
1955 END IF
1956 S_log=0
1957 CASE "R" ! resume logging
1958 S_log=1
1959 CASE "O","0" ! transmit null
1960 OUTPUT @Out_buff;" ";
1961 CASE "?" ! help
1962 CASE "K" ! Kermit Shell
1963 PRINTER IS CRT
1964 CALL Kermit
1965 Remote=1 ! (stay in emulator)
1966 Kermit_exit=0
1967 CONTROL CRT,10;0
1968 PRINTER IS CRT;EOL (CHR$(10)),WIDTH OFF
1969 GOSUB Disp_modeline
1970 CASE "E"
1971 IF Lecho THEN
1972 Lecho=0
1973 ELSE
1974 Lecho=1
1975 END IF
1976 CASE "M" ! Toggle Mode Line
1977 IF Mode_line THEN
1978 Mode_line=0
1979 ELSE
1980 Mode_line=1
1981 END IF
1982 GOSUB Disp_modeline
1983 CASE ELSE
1984 END SELECT ! second char of kermit terminal escape
1985 DISP
1986 !----------------------------------------------
1987 Text:CASE 32 TO 126 ! printable
1988 IF Lecho THEN PRINT Key1$; ! ascii character
1989 OUTPUT @Out_buff;Key1$;
1990 !----------------------------------------------
1991 CASE 0 TO 31
1992 IF Term_mode$="APPL" THEN ! vt100 keypad
1993 OUTPUT @Out_buff;"O"&CHR$(Key1+96);
1994 ELSE
1995 OUTPUT @Out_buff;Key1$;
1996 IF Lecho THEN
1997 DISPLAY FUNCTIONS ON
1998 PRINT Key1$;
1999 DISPLAY FUNCTIONS OFF
2000 END IF
2001 END IF
2002 END SELECT
2003 !------------------------------------------------
2004 EXIT IF Remote=0
2005 K$=KBD$ ! flush keyboard buffer
2006 END LOOP
2007 RETURN
2008!======================================================================
2009 Receive_char: !
2010 Rc:!
2011 GOSUB Get_inlength ! find In_length of Inbound Buffer
2012 !
2013 WHILE In_length
2014 ENTER @In_buff USING "#,A";A$
2015 Char=NUM(A$)
2016 IF S_log THEN
2017 File_buff$=File_buff$&A$
2018 IF Char=13 AND Newline THEN File_buff$=File_buff$&"
"
2019 Fblen=LEN(File_buff$)
2020 IF (Char=13 AND Fblen>=Max_buff-80) OR (Fblen>=Max_buff-10) THEN
2021 DISP CHR$(129);" ";CHR$(128)
2022 OUTPUT @S_log;File_buff$;
2023 File_buff$=""
2024 END IF
2025 END IF
2026 Handle_char: !
2027 SELECT Char
2028 CASE 32 TO 126 ! sp to ~
2029 PRINT A$;
2030 !-----------------------------------------
2031 ! SELECTED CONTROL CHARACTERS
2032 !-----------------------------------------
2033 CASE 127 ! backspace "del"
2034 STATUS CRT,0;Cx,Cy
2035 IF Cx>1 THEN
2036 CONTROL CRT,0;Cx-1,Cy
2037 OUTPUT CRT;" ";
2038 CONTROL CRT,0;Cx-1,Cy
2039 END IF
2040 CASE 5 !"" ! ENQ/ACK
2041 OUTPUT @Out_buff;CHR$(6);
2042 IF Flow$="ENQ/ACK" THEN
2043 OUTPUT @Out_buff;CHR$(6);
2044 END IF
2045 CASE 10 ! LF
2046 IF Hl THEN GOSUB Blink
2047 PRINT "
";
2048 IF S_log THEN OUTPUT @S_log;File_buff$
2049 File_buff$=""
2050 CASE 13
2051 PRINT "";
2052 CASE 7
2053 BEEP 800,.1
2054 CASE 8 ! Backspace
2055 STATUS CRT,0;Cx
2056 CONTROL CRT,0;MAX(Cx-1,1)
2057 CASE 17 TO 20
2058 ! DISP " RESPONSE ? "
2059 ! ENTER KBD;Line$
2060 ! IF LEN(TRIM$(Line$)) THEN OUTPUT @Out_buff;Line$
2061 CASE 27 ! Escape
2062 !------------------------
2063 ! VT-100 SEQUENCES
2064 !------------------------
2065 ! need to check for buffer length here to avoid end of buffer
2066 REPEAT
2067 GOSUB Get_inlength
2068 UNTIL In_length
2069 ENTER @In_buff USING "#,A";A$
2070 IF A$="[" THEN ! vt100 escape
2071 !
2072 ! The next char is either an argument or numeric
2073 !
2074 ! A or A
2075 !
2076 Wait_esc:!
2077 SELECT Com_card
2078 CASE 98628
2079 STATUS Com_port,5;In_length
2080 CASE ELSE
2081 STATUS @In_buff,4;In_length
2082 END SELECT
2083 IF NOT In_length THEN GOTO Wait_esc
2084 ENTER @In_buff USING "#,A";A$
2085 Pn=NUM(A$)
2086 SELECT Pn
2087 CASE 48 TO 57 ! 0 to 9
2088 Pn=VAL(A$)
2089 CASE ELSE
2090 Pn=0
2091 STATUS CRT,0;Cc,Cl ! current cursor
2092 SELECT A$
2093 CASE "A"
2094 CONTROL CRT,0;MAX(1,Cc),MAX(1,Cl-1)
2095 CASE "B"
2096 CONTROL CRT,0;MAX(1,Cc),MAX(1,Cl+1)
2097 CASE "C"
2098 CONTROL CRT,0;MAX(1,Cc+1),MAX(1,Cl)
2099 CASE "D"
2100 CONTROL CRT,0;MAX(1,Cc-1),MAX(1,Cl)
2101 CASE "H"
2102 CONTROL CRT,0;1,1
2103 CASE "J"
2104 SELECT Pn
2105 !
2106 ! Need to know number of lines on screen
2107 !
2108 CASE 0 ! erase to end of scr
2109 CASE 1 ! erase up to cursor
2110 CASE 2 ! CLS
2111 CLEAR SCREEN
2112 END SELECT
2113 CASE "K"
2114 SELECT Pn
2115 CASE 0 ! clear to end
2116 OUTPUT CRT;" %"; ! clr-end
2117 CASE 1 ! clr to cursor
2118 CASE 2 ! clr line
2119 OUTPUT CRT;" #";
2120 END SELECT
2121 CASE "x" ! request report frame (parity,data bits etc)
2122 ! IF Pn=0 THEN
2123 ! IF Pn=1 THEN
2124 CASE "n" ! request report on terminal status
2125 IF Pn=5 THEN OUTPUT @Out_buff;"n"
2126 IF Pn=6 THEN
2127 STATUS CRT,0;Cc,Cl
2128 OUTPUT @Out_buff;""&VAL$(Cc)&","&VAL$(Cl)&","&"R"
2129 END IF
2130 CASE "?" ! shift numeric keypad to application/numeric mode
2131 Misc$=""
2132 REPEAT
2133 GOSUB Get_inlength
2134 UNTIL In_length>=2
2135 ENTER @In_buff USING "#,2A";Misc$
2136 IF Misc$="1h" OR Misc$="1l" THEN
2137 IF Term_mode$="APPL" THEN
2138 Term_mode$="NUMERIC"
2139 ELSE
2140 Term_mode$="APPL"
2141 END IF
2142 END IF
2143 CASE ELSE
2144 END SELECT ! of esc-VT100 argument
2145 END SELECT ! VT-100 NUMERIC OR COMMAND
2146 ELSE ! not an sequence
2147 DISPLAY FUNCTIONS ON
2148 PRINT "";A$;
2149 DISPLAY FUNCTIONS OFF
2150 END IF ! - vt100 sequence
2151 !-------------------------------------------------------------------
2152 ! END VT-100 SEQUENCES
2153 !-------------------------------------------------------------------
2154 CASE 0 TO 31 ! Control Char
2155 IF Debug THEN
2156 PRINT "^"&CHR$(NUM(A$)+32);
2157 END IF
2158 CASE 128 TO 255
2159 IF Debug THEN
2160 PRINT "^&"&CHR$(NUM(A$)-128);
2161 END IF
2162 CASE ELSE
2163 IF Debug THEN PRINT A$;
2164 END SELECT
2165 !
2166 GOSUB Get_inlength
2167 END WHILE
2168 RETURN
2169 Rc2: !
2170 !-------------------------------------------
2171 Get_inlength:!
2172 IF Com_card=98628 THEN
2173 STATUS Com_port,5;In_length
2174 ELSE
2175 STATUS @In_buff,4;In_length
2176 END IF
2177 RETURN
2178 !-------------------------------------------
2179 Com_tmo:!
2180 DISP "COMM PORT TIMEOUT : PAUSED "
2181 PAUSE
2182 DISP
2183 RETURN
2184 !-------------------------------------------
2185 Term_err:!
2186 PRINT ERRM$
2187 SELECT ERRN
2188 CASE 167 ! IO STATUS ERROR
2189 GOSUB Term_intr
2190 CASE 314 ! RECEIVE BUFFER OVERFLOW
2191 BEEP
2192 DISP ERRM$,"PAUSED IN TERM_ERR"
2193 PAUSE
2194 DISP
2195 CASE ELSE
2196 BEEP
2197 DISP ERRM$,"PAUSED"
2198 PAUSE
2199 DISP
2200 END SELECT
2201 RETURN
2202 !--------------------------------------------------------------------
2203 SUBEND
2204 ! ====================================================================
2205 Kstatus:SUB Kstatus
2206 OPTION BASE 1
2207 COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
2208 COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
2209 COM /Frame/ Flow$,Hshake$
2210 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
2211 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[2048] BUFFER,Com_card
2212 COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
2213 COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas
2214 COM /Kerm/ INTEGER Image,Parflg,Pktdeb
2215 COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol
2216 COM /Kerm2/ State$[1],Cchksum$[1],Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
2217 COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
2218 COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
2219 COM /Term/ Term_mode$
2220 COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
2221 DIM D_log_stat$[40],S_log_stat$[40]
2222 PRINT RPT$("=",15)&" S T A T U S "&RPT$("=",15)
2223 !
2224 PRINT CHR$(132);"COMMUNICATIONS PORT";CHR$(128);
2225 PRINT TAB(50);CHR$(132);"TERMINAL";CHR$(128)
2226 !
2227 PRINT "Baud Rate ";TAB(20);Baud;
2228 PRINT TAB(50);"Terminal Type ";TAB(70);Term_type$
2229 !
2230 PRINT "COM Port ";TAB(20);Com_port;
2231 PRINT TAB(50);" ";TAB(70);" "
2232 !
2233 PRINT "Parity ";TAB(20);Parity_type$;
2234 PRINT TAB(50);CHR$(132);"LOCAL TRANSFER PARAMETERS";CHR$(128)
2235 !
2236 Lecho$="REMOTE"
2237 IF Lecho THEN Lecho$="LOCAL"
2238 PRINT "ECHO ";TAB(20);Lecho$;
2239 PRINT TAB(50);"Packet Timeout ";TAB(70);Mytmo
2240 !
2241 PRINT "Flow Control";TAB(20);Flow$;
2242 PRINT TAB(50);"Control Quote";TAB(70);CHR$(Myquote)
2243 !
2244 PRINT "Handshake ";TAB(20);Hshake$;
2245 PRINT TAB(50);"Packet Size ";TAB(70);Spsiz
2246 !
2247 PRINT "Source MSI ";TAB(20);S_path$&S_msi$;
2248 PRINT TAB(50);"Padding Character";
2249 DISPLAY FUNCTIONS ON
2250 PRINT TAB(70);CHR$(Mypad);
2251 DISPLAY FUNCTIONS OFF
2252 PRINT
2253 !
2254 PRINT "Destination MSI ";TAB(20);D_path$&D_msi$;
2255 PRINT TAB(50);" ";TAB(70);" "
2256 !
2257 Filewarn$="OVERWRITE"
2258 IF Filewarn THEN Filewarn$="AVOID OVERWRITE"
2259 PRINT "Overwrite Warn. ";TAB(20);Filewarn$;
2260 PRINT TAB(50);CHR$(132);"REMOTE TRANSFER PARAMETERS";CHR$(128)
2261 !
2262 Discard$="KEEP "
2263 IF Discard THEN Discard$="DISCARD"
2264 PRINT "Incomplete File ";TAB(20);Discard$;
2265 PRINT TAB(50);"Packet Timeout";TAB(70);Ptmo
2266 !
2267 PRINT "EOF Mode ";TAB(20);Eof_mode$;
2268 PRINT TAB(50);"Packet Size ";TAB(70);Rpsiz
2269 !
2270 S_log_stat$="OFF "
2271 IF S_log THEN S_log_stat$=S_log$
2272 PRINT "Session Log ";TAB(20);S_log_stat$;
2273 !
2274 PRINT TAB(50);"Padding Character";
2275 DISPLAY FUNCTIONS ON
2276 PRINT TAB(70);CHR$(Pad);
2277 DISPLAY FUNCTIONS OFF
2278 PRINT
2279 !
2280 D_log_stat$="OFF"
2281 IF D_log THEN D_log_stat$=D_log$
2282 PRINT "Packet Log ";TAB(20);D_log_stat$;
2283 PRINT TAB(50);"Control Quote ";TAB(70);CHR$(Quote)
2284 !
2285 Timeron$="ON"
2286 IF NOT Timer THEN Timeron$="OFF"
2287 PRINT "Timer ";TAB(20);Timeron$;
2288 PRINT TAB(50);"EOL Char ";
2289 DISPLAY FUNCTIONS ON
2290 PRINT TAB(70);CHR$(Eol);
2291 DISPLAY FUNCTIONS OFF
2292 PRINT
2293 !
2294 Debug$="OFF"
2295 IF Debug THEN Debug$="ON "
2296 PRINT "Debug Mode ";TAB(20);Debug$;
2297 PRINT TAB(50);"Pkt. Retry Limit ";TAB(70);Maxtry
2298 !
2299 PRINT "Kermit Escape ";
2300 PRINT TAB(20);"^"&CHR$(NUM(Kerm_esc$[1,1])+64)&Kerm_esc$[2,2];
2301 PRINT TAB(50);"Block Check Type ";TAB(70);Blk_chk
2302 !
2303 Filetype$="ASCII"
2304 IF Image THEN Filetype$="BINARY"
2305 PRINT "File Mode ";TAB(20);Filetype$;
2306 PRINT TAB(50);" ";TAB(70)
2307 PRINT
2308 SUBEND
2309 ! =======================================================================
2310 DEF FNTochar$(INTEGER C)
2311 RETURN CHR$(C+32) ! +" "
2312 FNEND
2313 !------------------------------------------------------------------------
2314 DEF FNUnchar(C$)
2315 RETURN NUM(C$)-32
2316 FNEND
2317 !------------------------------------------------------------------------
2318 DEF FNCtl(C$)
2319 C=NUM(C$)
2320 C=BINEOR(C,64) ! toggle bit 7
2321 RETURN C
2322 FNEND
2323 ! ----------------------------------------------------------------------
2324 Ksend:SUB K_send(F$,OPTIONAL INTEGER Bdat_item)
2325 !
2326 ! Kermit Send File Protocol
2327 !
2328 OPTION BASE 1
2329 COM Version$,K$,Setup$
2330 COM /Crt/ Crt_lines,Crt_width
2331 COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
2332 COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
2333 COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas
2334 COM /Kerm/ INTEGER Image,Parflg,Pktdeb
2335 COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol
2336 COM /Kerm2/ State$[1],Cchksum$[1],Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
2337 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
2338 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[2048] BUFFER,Com_card
2339 COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
2340 COM /Frame/ Flow$,Hshake$
2341 COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
2342 COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
2343 COM /Term/ Term_mode$
2344 COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
2345 !
2346 INTEGER Chksum,Rc,Plen,Dlen,Cchksum,Qbin,Rep_ch
2347 INTEGER Ftype,Volnum,Prot,Recsize,Sec_data(1:256),Lsb,Msb
2348 INTEGER Npak,Numtry,Oldtry,Rseq
2349 INTEGER Com_err,User_break
2350 INTEGER Spacks,Fpacks,Apacks,Dpacks,Zpacks,Bpacks,Epacks
2351 INTEGER Atl
2352 INTEGER Bdat_int
2353 REAL File_st,F_sec,File_length,At_rec,At_recl,At_len
2354 DIM Misc$[80],Filename$[80]
2355 DIM A$[1],File_buff$[1024],File_get$[256],Wmsg$[80],Emsg$[80]
2356 DIM Myquote$[1],Qbin$[1]
2357 DIM File_eol$[2],Cat$(10)[80],Cat_entry$[80],Sav_msi$[256]
2358 !
2359 Sav_msi$=SYSTEM$("MSI")
2360 File_eol$=CHR$(13)&CHR$(10)
2361 ALLOCATE Rcvpkt$[Maxp],Sndpkt$[Spsiz+2],Packet$[Spsiz+2],Rdata$[Maxp]
2362 Com_err=0
2363 Shutdown ! Shut off transfers while doing ON-EVENTS
2364 SELECT Com_card
2365 CASE 98626,98644
2366 CONTROL Com_port,12;128+32+16 ! ELIMINATE HANDSHAKE
2367 CONTROL Com_port,5;1+2 ! force dtr,rts
2368 CASE 98628
2369 CONTROL Com_port,13;164 ! INT MASK 4=UART 32=lost car 128=break
2370 END SELECT
2371 ON ERROR GOSUB Send_err
2372 ON INTR Com_port,15 GOSUB Send_intr
2373 Startup
2374 !
2375 CLEAR SCREEN
2376 IF Display THEN
2377 PRINT TABXY(1,2);Version$
2378 PRINT TABXY(15,5);"Filename: ";F$ ! LINE 5
2379 PRINT TAB(6);"Bytes Transferred: ";TAB(25);Kbx ! 6
2380 PRINT TAB(6);" % Transferred: ";TAB(25);Kbx ! 7
2381 PRINT TAB(16);"SENDING: In Progress " ! 8
2382 PRINT ! 9
2383 PRINT TAB(6);"Number of Packets: ";TAB(25);Npak ! 10
2384 PRINT TAB(6);"Number of Retries: ";TAB(25);Oldtry ! 11
2385 PRINT TAB(13);"Last Error: " ! 12
2386 PRINT TAB(11);"Last Message: " ! 13
2387 ! 14 blank
2388 IF Debug THEN
2389 PRINT TABXY(11,15);"REC. PACKET : " ! 15
2390 PRINT TABXY(11,16);"SEND PACKET : " ! 16
2391 END IF
2392 ELSE
2393 DISP "Sending ";F$;" ... "
2394 END IF
2395 !--------------------------------------------------------------------
2396 ! The filename in whatever form is passed in as F$
2397 !
2398 ! 1. If msi not specified then
2399 ! use Source Msi
2400 ! use source path
2401 !
2402 ! 2. If msi is specified dont use source path
2403 !
2404 IF NOT POS(F$,":") THEN
2405 F_msi$=S_msi$
2406 IF NOT POS(F$,"/") THEN F_path$=S_path$
2407 F$=F_path$&F$&F_msi$
2408 END IF
2409 Parse_filename(F$,F_msi$,F_path$)
2410 Filename$=F_path$&F$&F_msi$
2411 IF F_path$&F$="/T" THEN GOTO Test_send
2412 !
2413 ! Catalog File entry on F_path$ and F_msi$
2414 ! Get File's parameters Cat_entry$,At_length,At_type$
2415 !
2416 GOSUB Get_file_entry ! F$,F_msi$,F_path$,File_found,Cat_entry$,Filetype$
2417 !
2418 ! If a ramdisc is required call init_ramdisc
2419 !
2420 IF At_type$="PROG" OR At_type$="BIN" OR At_type$="SYSTM" THEN
2421 Image=1
2422 !
2423 ! PROG Files must use a ramdisc
2424 ! Create one now in case we need it later
2425 !
2426 Ram_msi$=":,0,0"
2427 GOSUB Check_for_rdisc ! set ramdisc flag
2428 IF NOT Ramdisc THEN
2429 CALL Init_ramdisc(Kbytes) ! Init_ramdisc sizes the Kbytes
2430 IF Kbytes THEN Ramdisc=1
2431 ELSE ! Existing one large enough ?
2432 IF Kbytes<(File_length/1000) THEN
2433 Avm=VAL(SYSTEM$("AVAILABLE MEMORY"))
2434 Avl_kbytes=(Avm-100000)/1000
2435 IF Avl_kbytes>(File_length/1000) THEN ! can recreate
2436 DISP "Can I re-create the Ram Disc ?"
2437 OUTPUT KBD;"Y";" H";
2438 ENTER KBD;Ans$
2439 IF POS(UPC$(Ans$),"Y") THEN
2440 CALL Init_ramdisc(Kbytes)
2441 END IF
2442 END IF
2443 END IF
2444 END IF
2445 !
2446 IF Kbytes<(File_length/1000) THEN
2447 BEEP
2448 PRINT TABXY(1,Crt_lines);"Cannot create sufficient ramdisc - aborting SEND"
2449 SUBEXIT
2450 END IF
2451 !
2452 DISP "copying image file to ramdisc... "
2453 !
2454 ! Try to assign to a PROG type file - if file exists error 58 will result
2455 !
2456 ASSIGN @Test TO F$&Ram_msi$;RETURN Rc
2457 IF Rc=0 THEN Rc=58
2458 SELECT Rc
2459 CASE 0
2460 ! File was assignable - This is probably the second time
2461 ! trying to send this PROG file - It's already on the ram disc
2462 ! Rc is set to 58 to prompt for purging of existing file
2463 CASE 58 ! improper filetype error - file exists
2464 Prompt("Overwrite File On Ramdisc ? ","Y",Ans$,Flag)
2465 IF Flag THEN
2466 ASSIGN @Test TO *
2467 PURGE F$&Ram_msi$
2468 COPY Filename$ TO F$&Ram_msi$
2469 END IF
2470 CASE ELSE ! file not found
2471 COPY Filename$ TO F$&Ram_msi$
2472 END SELECT ! file is on ramdisc or not
2473 F_path$=""
2474 F_msi$=Ram_msi$
2475 Convert(F$&Ram_msi$,"HP-UX",Rc)
2476 GOSUB Get_file_entry ! update file attributes
2477 END IF ! if file is un-assignable (PROG or BIN)
2478 !-----------------------------------------------------
2479 Filename$=F_path$&F$&F_msi$
2480 !
2481 SELECT Bdat_item
2482 CASE 0
2483 ASSIGN @File TO Filename$;FORMAT ON
2484 CASE ELSE
2485 ASSIGN @File TO Filename$;FORMAT OFF
2486 END SELECT
2487 STATUS @File,1;File_type
2488 Test_send: !
2489 !------------------------------------- send init
2490 Spacks=0 ! retry counters
2491 Fpacks=0
2492 Apacks=0
2493 Dpacks=0
2494 Zpacks=0
2495 Bpacks=0
2496 Oldtry=0
2497 File_buff$="" ! file buffer to be quoted
2498 File_get$="" ! file enter buffer
2499 Sdata_done=0 ! sending data done
2500 At_eof=0 ! EOF reached on file read
2501 Max_buff=MAXLEN(File_buff$)
2502 !------------------------------------------------------------------------
2503 Ksends:State$="S"
2504 REPEAT
2505 SELECT State$
2506 CASE "S"
2507 GOSUB Spar ! Set our Init Parameters
2508 Spack(Packet$,State$,Npak,Sndpkt$)
2509 IF NOT Spacks THEN PRINT TABXY(25,13);"Exchanging Initialization Packets"
2510 OUTPUT @Out_buff;Sndpkt$
2511 IF Debug THEN PRINT TABXY(25,16);Sndpkt$&RPT$(" ",100)
2512 IF D_log THEN OUTPUT @D_log;Sndpkt$
2513 !
2514 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Spacks,User_break,Emsg$)
2515 IF Debug THEN PRINT TABXY(25,15);Rcvpkt$&" "
2516 IF D_log THEN OUTPUT @D_log;Rcvpkt$
2517 SELECT Pktype$
2518 CASE "N"
2519 CASE "Y"
2520 GOSUB Rpar ! Decode remote parameters
2521 State$="F"
2522 Oldtry=Oldtry+Spacks
2523 CASE "E"
2524 Emsg$=Rdata$
2525 State$="E"
2526 CASE "T"
2527 Wmsg$="Packet Timeout"
2528 CASE "Q"
2529 Wmsg$="Bad Checksum or Sequence"
2530 !
2531 ! If Pktype$="X" then local Kermit interrupted file sending. User_break
2532 ! flag is set to determine which side is erroring (in case of ^E).
2533 ! Rdata$ can be used to determine ^X or ^Z.
2534 !
2535 CASE "X"
2536 State$="Z" ! jump to end of file
2537 Wmsg$="User abort of Send File"
2538 CASE ELSE
2539 Wmsg$="Unknown Packet Type: "&Pktype$
2540 END SELECT
2541 !
2542 IF Pktype$="Y" THEN
2543 Npak=Npak+1
2544 ELSE
2545 Spacks=Spacks+1
2546 END IF
2547 !
2548 IF Spacks>Maxtry THEN
2549 State$="E"
2550 Emsg$="Can't Receive (S) Ack from Host"
2551 END IF
2552 !
2553 PRINT TABXY(25,10);Npak
2554 PRINT TABXY(25,11);Oldtry+Spacks
2555 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
2556 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
2557 IF State$<>"S" THEN Oldtry=Oldtry+Spacks
2558 !--------------------------------------------------------------------
2559 Ksendf:CASE "F" ! Send File Header 'F'
2560 !
2561 Packet$=F$ ! just send filename part
2562 Spack(Packet$,State$,Npak,Sndpkt$)
2563 PRINT TABXY(25,13);"Sending Filename"&RPT$(" ",28)
2564 OUTPUT @Out_buff;Sndpkt$
2565 PRINT TABXY(25,10);Npak
2566 PRINT TABXY(25,11);Oldtry+Fpacks
2567 !
2568 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Fpacks,User_break,Emsg$)
2569 IF Debug THEN
2570 PRINT TABXY(25,15);Rcvpkt$&" "
2571 PRINT TABXY(25,16);Sndpkt$&" "
2572 END IF
2573 IF D_log THEN OUTPUT @D_log;Sndpkt$,Rcvpkt$
2574 !
2575 SELECT Pktype$
2576 CASE "N"
2577 CASE "Y"
2578 Npak=Npak+1
2579 Oldtry=Oldtry+Fpacks
2580 IF R_capas THEN ! if remote can use attribute packets
2581 State$="A"
2582 ELSE
2583 State$="D"
2584 END IF
2585 CASE "E"
2586 Emsg$=Rdata$
2587 State$="E"
2588 CASE "T"
2589 Wmsg$="Packet Timeout"
2590 CASE "Q"
2591 Wmsg$="Bad Checksum or Sequence"
2592 CASE "X"
2593 State$="Z" ! jump to end of file
2594 Wmsg$="User abort of Send File"
2595 CASE ELSE
2596 Wmsg$="Unknown Packet Type: "&Pktype$
2597 END SELECT
2598 !
2599 IF Pktype$="N" THEN
2600 Fpacks=Fpacks+1
2601 IF Fpacks>Maxtry THEN
2602 Emsg$="Can't Receive (F) Ack from Host"
2603 State$="E"
2604 END IF
2605 END IF
2606 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
2607 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
2608 PRINT TABXY(25,5);Filename$
2609 IF State$="D" THEN Ft_start=TIMEDATE ! START SEND CLOCK
2610 !------------------------------------------------------
2611 Ksenda:CASE "A"
2612 IF Debug THEN PRINT TABXY(47,8);State$
2613 Packet$=""
2614 GOSUB Set_at ! Form Attribute Data into Packet$
2615 Spack(Packet$,State$,Npak,Sndpkt$)
2616 PRINT TABXY(25,13);"Sending File Attributes"&RPT$(" ",32)
2617 OUTPUT @Out_buff;Sndpkt$
2618 IF D_log THEN OUTPUT @D_log;Sndpkt$
2619 !
2620 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Apacks,User_break,Emsg$)
2621 PRINT TABXY(25,10);Npak
2622 PRINT TABXY(25,11);Oldtry+Apacks
2623 IF Debug THEN
2624 PRINT TABXY(25,15);Rcvpkt$&" "
2625 PRINT TABXY(25,16);Sndpkt$&" "
2626 END IF
2627 IF D_log THEN OUTPUT @D_log;Rcvpkt$
2628 !
2629 SELECT Pktype$
2630 CASE "N"
2631 CASE "Y"
2632 Npak=Npak+1
2633 State$="D"
2634 CASE "E"
2635 Emsg$=Rdata$
2636 State$="E"
2637 CASE "T"
2638 Wmsg$="Packet Timeout"
2639 CASE "Q"
2640 Wmsg$="Bad Checksum or Sequence"
2641 CASE "X"
2642 State$="Z" ! jump to end of file
2643 Wmsg$="User abort of Send File"
2644 CASE ELSE
2645 Wmsg$="Unknown Packet Type: "&Pktype$
2646 END SELECT
2647 !
2648 IF Pktype$="Y" THEN
2649 ELSE
2650 Apacks=Apacks+1
2651 IF Apacks>Maxtry THEN
2652 Emsg$="Can't Receive (A) Ack from Host"
2653 State$="E"
2654 END IF
2655 END IF
2656 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
2657 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
2658 IF State$<>"A" THEN Oldtry=Oldtry+Apacks
2659 IF State$="D" THEN Ft_start=TIMEDATE ! START SEND CLOCK
2660 !--------------------------------------------------------------------
2661 Ksendd:CASE "D" ! Send File Data 'D'
2662 !
2663 ! The way in which characters are fed into the File_buff$ variable
2664 ! is dependent on file type (At_type$), and the value of Image flag.
2665 !
2666 ! ASCII: Image is ignored and interpreted as Image=0
2667 ! HP-UX: Image=1 transmits file as is.
2668 ! Image=0 appends Cr-Lf on each text line
2669 ! BDAT: Image=1 transmits as-is
2670 ! *** Image=0 Kermit tries to read file and covert # to ascii
2671 !
2672 IF NOT Dstate_init THEN
2673 ON END @File GOTO At_eof
2674 Dstate_init=1
2675 PRINT TABXY(25,13);"Sending File Data"&RPT$(" ",27)
2676 END IF
2677 !
2678 Fill_buff: !
2679 Bl=LEN(File_buff$) ! Bl Buffer Length
2680 Fg=LEN(File_get$) ! Fg = File Get (buffer)
2681 !
2682 ! First Append Residue File_get$ and refresh File_get$
2683 !
2684 IF (Bl<Spsiz) AND (NOT At_eof) AND (Bl+Fg<Max_buff) THEN
2685 !
2686 ! If Bl<Spsiz [not enough in buffer to fill a packet] AND
2687 ! Bl+Fg<Max_buff [if adding Fget to buffer wont overflow] THEN
2688 ! append Fget to buffer.
2689 !
2690 IF Fg THEN ! Otherwise DON'T Because EOL gets stuffed Each Loop
2691 IF Image THEN
2692 File_buff$=File_buff$&File_get$ ! IMAGE FILL
2693 ELSE
2694 File_buff$=File_buff$&File_get$&File_eol$
2695 END IF
2696 File_get$=""
2697 END IF
2698 !
2699 ! Then refill File_get$
2700 !
2701 ! #,-K Fills File_get$ to dimensioned length, or EOF
2702 !
2703 REPEAT ! Until Buff_full
2704 SELECT File_type
2705 Bdat: CASE 2 !bdat
2706 IF Image THEN
2707 ENTER @File USING "#,-K";File_get$ ! Enter bytes
2708 ELSE
2709 !
2710 ! ** Enter: INTEGER
2711 ! REAL
2712 ! STRING (w/Format Off)
2713 !
2714 ! Bdat_item spec as OPTIONAL parameter
2715 !
2716 REPEAT
2717 Bdat_item_ok=1
2718 SELECT Bdat_item
2719 CASE 1 ! integer
2720 ! DISP "Converting Integers to Ascii"
2721 ENTER @File;Bdat_int
2722 File_get$=VAL$(Bdat_int)
2723 CASE 2 ! reals
2724 ! DISP "Converting Reals to Ascii"
2725 ENTER @File;Bdat_real
2726 File_get$=VAL$(Bdat_real)
2727 CASE ELSE ! not spec - best effort
2728 ENTER @File;File_get$
2729 END SELECT
2730 UNTIL Bdat_item_ok
2731 END IF
2732 CASE 4 ! hp-ux
2733 IF Image THEN
2734 ENTER @File USING "#,-K";File_get$
2735 ELSE
2736 PAUSE
2737 !
2738 ENTER @File;File_get$
2739 END IF
2740 CASE 3 ! ascii
2741 ENTER @File;File_get$
2742 CASE ELSE
2743 BEEP
2744 DISP "FILE TYPE = ";File_type;" Not implemented "
2745 PAUSE
2746 END SELECT
2747 DISP
2748 GOTO Fill_it
2749 !-------------------------------------------------------------------
2750 ! Enter here ON END @File ...
2751 ! If EOF then combine last file_get$ to buffer and set buff_full
2752 ! Prog wont return to this loop because at_eof is set.
2753 !
2754 At_eof: At_eof=1
2755 IF Debug THEN PRINT TABXY(1,Crt_lines);"AT EOF","BUFF LEN = ";LEN(File_buff$)
2756 Buff_full=1 ! avoid looping and appending CR-LF
2757 IF Image THEN
2758 File_buff$=File_buff$&File_get$
2759 ELSE
2760 File_buff$=File_buff$&File_get$&File_eol$
2761 END IF
2762 File_get$=""
2763 GOTO Full
2764 !-------------------------------------------------------------------
2765 Fill_it:!
2766 Bl=LEN(File_buff$)
2767 Fg=LEN(File_get$)
2768 IF Bl+Fg+2>Max_buff THEN
2769 Buff_full=1 ! leave File_get$ in tact
2770 ELSE
2771 IF Image THEN
2772 File_buff$=File_buff$&File_get$
2773 ELSE
2774 File_buff$=File_buff$&File_get$&File_eol$ !<<<<<<<<< WILL CORRUPT A BINARY FILE
2775 END IF
2776 File_get$=""
2777 END IF
2778 Full: UNTIL Buff_full
2779 DISP
2780 END IF ! buffer smaller than next packet Bl<Spsiz
2781 !-------------------------------------------------------------------
2782 Buff_full=0 ! allow buffer to fill next time
2783 Bl=LEN(File_buff$) ! file buffer length
2784 !
2785 ! Debug: Buffer should not get to this point unless it contains at
2786 ! least a packet full of data (if not EOF)
2787 ! IF (Bl<Spsiz) AND (NOT At_eof) THEN
2788 ! BEEP
2789 ! DISP "BUFFER IS ";Bl;" LONG","SPSIZ = ";Spsiz
2790 ! END IF
2791 !----------------------------------------------------------------------
2792 IF State$="E" THEN GOTO Ksendd_exit
2793 B=1 ! because buff has been truncated
2794 P=1 ! new packet
2795 Packet$="" ! flush packet
2796 Pack_full=0
2797 Encode_pack: !
2798 Bytes_a=LEN(File_buff$)
2799 Encode_pack(File_buff$,Packet$,Myquote,Qbin,Rep_ch,Spsiz)
2800 Bytes_b=LEN(File_buff$)
2801 Bytes_x=Bytes_x+(Bytes_a-Bytes_b)
2802 Bytes_old=Bytes_x
2803 IF At_eof AND (LEN(File_buff$)=0) THEN Sdata_done=1
2804 !
2805 Spack(Packet$,State$,Npak,Sndpkt$)
2806 IF Debug THEN
2807 PRINT TABXY(25,6);Bytes_old,INT(Bytes_x/(TIMEDATE-Ft_start));" B/SEC"
2808 ELSE
2809 PRINT TABXY(25,6);Bytes_old
2810 END IF
2811 PRINT TABXY(25,7);INT((Bytes_x/File_length)*100)
2812 PRINT TABXY(25,10);Npak
2813 PRINT TABXY(25,11);Oldtry+Dpacks
2814 !
2815 ! Send Packet Until Ack
2816 !
2817 REPEAT
2818 OUTPUT @Out_buff;Sndpkt$
2819 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Dpacks,User_break,Emsg$)
2820 IF Debug THEN
2821 PRINT TABXY(25,15);Rcvpkt$&" "
2822 PRINT TABXY(25,16);Sndpkt$&" "
2823 END IF
2824 IF D_log THEN OUTPUT @D_log;Sndpkt$,Rcvpkt$
2825 !
2826 SELECT Pktype$
2827 CASE "N"
2828 CASE "Y"
2829 Npak=Npak+1
2830 IF Sdata_done THEN
2831 State$="Z"
2832 PRINT TABXY(25,13);"Sending End of File"&RPT$(" ",27)
2833 END IF
2834 CASE "E"
2835 Emsg$=Rdata$
2836 State$="E"
2837 CASE "T"
2838 Wmsg$="Packet Timeout"
2839 CASE "Q"
2840 Wmsg$="Bad Checksum or Sequence"
2841 CASE "X"
2842 State$="Z"! jump to end of file
2843 Wmsg$="User abort of Send File"
2844 CASE ELSE
2845 Wmsg$="Unknown Packet Type "&Pktype$
2846 END SELECT
2847 Ksendd_exit: ! File access errors jump and exit here
2848 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
2849 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
2850 !
2851 IF Pktype$="Y" THEN
2852 Old_try=Old_try+Dpacks
2853 ELSE
2854 Dpacks=Dpacks+1
2855 IF Dpacks>Maxtry THEN
2856 State$="E"
2857 Emsg$="Can't Receive (D) Ack from Host"
2858 END IF
2859 END IF
2860 !
2861 UNTIL Pktype$="Y" OR State$="E"
2862 !----------------------------------------------------------------------
2863 Ksendz:CASE "Z"
2864 !
2865 ! This state might be entered from local user interrruption.
2866 ! Check User_break to determine. Rdata$= "X" or "Z" depending on intr.
2867 ! Packet$="D" for user break discard.
2868 !
2869 IF Debug THEN PRINT TABXY(47,8);State$
2870 IF User_break THEN
2871 Packet$="D"
2872 ELSE
2873 Packet$=""
2874 END IF
2875 IF NOT POS(Rdata$,"^C") THEN ! Ok to notify host
2876 Spack(Packet$,State$,Npak,Sndpkt$)
2877 OUTPUT @Out_buff;Sndpkt$
2878 IF Debug THEN PRINT TABXY(25,16);Sndpkt$&" "
2879 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Zpacks,User_break,Emsg$)
2880 ELSE
2881 ! fall thru and process State$="X" for ^C event
2882 END IF
2883 IF Debug THEN PRINT TABXY(25,15);Rcvpkt$&" "
2884 IF D_log THEN OUTPUT @D_log;Sndpkt$,Rcvpkt$
2885 SELECT Pktype$
2886 CASE "N"
2887 CASE "Y"
2888 Npak=Npak+1
2889 State$="B"
2890 CASE "E"
2891 Emsg$=Rdata$
2892 State$="E"
2893 CASE "T"
2894 Wmsg$="Packet Timeout"
2895 CASE "Q"
2896 Wmsg$="Bad Checksum"
2897 CASE "X"
2898 State$="B"
2899 IF Rdata$="^C" THEN
2900 State$="X" ! Dont notify host just exit
2901 END IF
2902 CASE ELSE
2903 Wmsg$="Unknown Packet Type "
2904 END SELECT
2905 !
2906 IF Pktype$="Y" THEN
2907 ELSE
2908 Zpacks=Zpacks+1
2909 IF Zpacks>Maxtry THEN
2910 State$="E"
2911 Emsg$="Can't receive (Z) Acknowledge from host"
2912 END IF
2913 END IF
2914 PRINT TABXY(25,10);Npak
2915 PRINT TABXY(25,11);Oldtry+Zpacks
2916 IF State$<>"Z" THEN Oldtry=Oldtry+Zpacks
2917 !---------------------------------------------------------------------
2918 Ksendb:CASE "B"
2919 IF Debug THEN PRINT TABXY(47,8);State$
2920 Packet$=""
2921 Spack(Packet$,State$,Npak,Sndpkt$)
2922 PRINT TABXY(25,10);Npak
2923 PRINT TABXY(25,11);Oldtry
2924 PRINT TABXY(25,13);RPT$(" ",55)
2925 OUTPUT @Out_buff;Sndpkt$
2926 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Bpacks,User_break,Emsg$)
2927 IF Debug THEN
2928 PRINT TABXY(25,16);Sndpkt$&" "
2929 PRINT TABXY(25,15);Rcvpkt$&" "
2930 END IF
2931 IF D_log THEN OUTPUT @D_log;Sndpkt$
2932 IF D_log THEN OUTPUT @D_log;Rcvpkt$
2933 !
2934 SELECT Pktype$
2935 CASE "N"
2936 CASE "Y"
2937 Oldtry=Oldtry+Bpacks
2938 Npak=Npak+1
2939 State$="C"
2940 CASE "E"
2941 Emsg$=Rdata$
2942 State$="E"
2943 CASE "T"
2944 Wmsg$="Packet Timeout"
2945 CASE "Q"
2946 Wmsg$="Bad Checksum or Sequence"
2947 CASE "X"
2948 CASE ELSE
2949 Wmsg$="Unknown Packet Type"
2950 END SELECT
2951 !
2952 IF Pktype$="Y" THEN
2953 ELSE
2954 Bpacks=Bpacks+1
2955 IF Bpacks>Maxtry THEN
2956 State$="E"
2957 Emsg$="Can't receive (B) Acknowledge from host"
2958 END IF
2959 END IF
2960 PRINT TABXY(25,10);Npak
2961 PRINT TABXY(25,11);Oldtry+Bpacks
2962 IF State$<>"B" THEN Oldtry=Oldtry+Bpacks
2963 !------------------------------------------------------------------------
2964 Ksende:CASE "E" !
2965 !
2966 ! Need to know if this is a local error or host error
2967 ! User_break=Local Error
2968 !
2969 IF User_break THEN
2970 Packet$=Emsg$
2971 Spack(Packet$,State$,Npak,Sndpkt$)
2972 OUTPUT @Out_buff;Sndpkt$
2973 IF D_log THEN OUTPUT @D_log;Sndpkt$
2974 IF Debug THEN PRINT TABXY(25,16);Sndpkt$&" "
2975 ELSE! host error
2976 END IF
2977 !
2978 PRINT TABXY(25,10);Npak
2979 PRINT TABXY(25,11);Oldtry
2980 State$="X"
2981 END SELECT
2982 !---------------------------------------------------------------------
2983 UNTIL State$="C" OR State$="X" ! Complete or Abort
2984 PRINT TABXY(1,Crt_lines);RPT$(" ",80)
2985 IF State$="C" THEN
2986 PRINT "SEND FILE COMPLETE"
2987 ELSE
2988 IF State$="X" THEN
2989 PRINT "User Abort"
2990 ELSE
2991 PRINT "SEND FILE FAILED - Host Error";Emsg$
2992 END IF
2993 END IF
2994 MASS STORAGE IS Sav_msi$
2995 SUBEXIT
2996 !========================================================================
2997 Check_for_rdisc:!
2998 Ramdisc=1
2999 Check_rdisc:MASS STORAGE IS ":,0,0" ! err 76 incorrect unit code ?
3000 RETURN
3001 !--------------------------------------------------------------------------
3002 Get_file_entry: !
3003 REPEAT
3004 Get_cat_entry(F$,F_msi$,F_path$,Filename$,File_found,Cat_entry$)
3005 IF NOT File_found THEN
3006 DISP "File not Found - reenter file spec - blank to abort "
3007 OUTPUT KBD;Filename$;" H";
3008 ENTER KBD;Misc$
3009 DISP
3010 IF NOT LEN(Misc$) THEN SUBEXIT
3011 Parse_filename(Misc$,F_msi$,F_path$)
3012 F$=Misc$
3013 Filename$=F_path$&F$&F_msi$
3014 END IF
3015 UNTIL File_found
3016 IF NOT File_found THEN SUBEXIT
3017 At_file$=TRIM$(Cat_entry$[1,21])
3018 At_type$=TRIM$(Cat_entry$[32,36])
3019 At_rec=VAL(Cat_entry$[37,45])
3020 At_recl=VAL(Cat_entry$[46,54])
3021 At_time$=TRIM$(Cat_entry$[56,71])
3022 File_length=At_rec*At_recl*1.00
3023 RETURN
3024 !------------------------------------------------------------------------
3025 Set_at: ! FORM FILE ATTRIBUTES PACKET DATA
3026 !
3027 ! Put File Attributes for F$ into Packet$
3028 ! Packet$ is in form: ATTRIBUTE(char), LENGTH(unchar), DATA(char)
3029 !
3030 ! ! or 1 File length (Bytes)
3031 ! " Data Type
3032 ! # Creation Date
3033 ! . Machine and OS
3034 ! / Format Of Data File_format$,File_type,File_delim$
3035 !
3036 ! CAT F_path$&F_msi$ TO Cat$(*);SELECT F$ ! FILE IS ELMENT 8
3037 !
3038 ! LIF: TYPE 32-36 [5]
3039 ! REC 37-45 [9]
3040 ! RECL 46-54 [9]
3041 ! TIME 56-71 [22]
3042 !
3043 At_length$=VAL$(File_length) ! BYTES
3044 At_os$="H4" ! Machine and OS ! H4=hp9000 RMB
3045 SELECT At_type$
3046 CASE "HP-UX" ! w/ format on
3047 At_fmt$="A"
3048 CASE "ASCII"
3049 At_fmt$="D"
3050 CASE "BDAT" ! w/ format off ! M=recl status reg 4
3051 At_fmt$="F"
3052 STATUS @File,4;At_recl
3053 END SELECT
3054 !------------ start attribute packet
3055 Next_at=1
3056 Packet$[Next_at;1]="1" !1 file length (bytes)
3057 Atl=LEN(At_length$)
3058 Packet$[Next_at+1;1]=FNTochar$(Atl)
3059 Packet$[Next_at+2;Atl]=At_length$
3060 Next_at=Next_at+2+Atl
3061 !
3062 ! Data Format (use file type)
3063 !
3064 Packet$[Next_at;1]="""" !" file (data) type
3065 Atl=LEN(At_type$)
3066 Packet$[Next_at+1;1]=FNTochar$(Atl)
3067 Packet$[Next_at+2;Atl]=At_type$
3068 Next_at=Next_at+2+Atl
3069 !
3070 Packet$[Next_at;1]="/" !/ data format on/off
3071 Atl=LEN(At_fmt$)
3072 Packet$[Next_at+1;1]=FNTochar$(Atl)
3073 Packet$[Next_at+2;Atl]=At_fmt$
3074 Next_at=Next_at+2+Atl
3075 !
3076 ! Creation Date [yy]yymmdd[ hh:mm[ :ss]
3077 Packet$[Next_at;1]="#" !# timedate
3078 Atl=LEN(At_time$)
3079 Packet$[Next_at+1;1]=FNTochar$(Atl)
3080 Packet$[Next_at+2;Atl]=At_time$
3081 Next_at=Next_at+2+Atl
3082 !
3083 Packet$[Next_at;1]="." !. Machine and Operating System
3084 Atl=LEN(At_os$)
3085 Packet$[Next_at+1;1]=FNTochar$(Atl)
3086 Packet$[Next_at+2;Atl]=At_os$
3087 Next_at=Next_at+2+Atl
3088 !
3089 RETURN
3090 !-----------------------------------------------------------------------
3091 Send_intr: ! ! COMM PORT INTERRUPT HANDLER
3092 CALL Com_interrupt
3093 Shutdown
3094 ON INTR Com_port,15 GOSUB Send_intr
3095 SELECT Com_card
3096 CASE 98628
3097 CONTROL Com_port,13;164 ! MASK 4=UART 32=lost carr 128=break
3098 CASE 98626,98644
3099 ENABLE INTR Com_port;4
3100 END SELECT
3101 ON ERROR GOSUB Send_err
3102 Startup
3103 RETURN
3104 !-----------------------------------------------
3105 Send_err: !
3106 SELECT ERRN
3107 CASE 29 ! illegal floating point number
3108 Wmsg$="Illegal Floating Point Number"
3109 Emsg$="File I/O Error - cannot continue"
3110 State$="E"
3111 User_break=1
3112 ERROR RETURN
3113 CASE 52,73,76 ! Improper MSVS,device type,Unit Number
3114 !
3115 ! Checking for existance of Ramdisc
3116 !
3117 IF ERRL(Check_rdisc) THEN
3118 Ramdisc=0
3119 ERROR RETURN
3120 ELSE
3121 DISP ERRM$
3122 END IF
3123 CASE 53 ! improper filename
3124 DISP "Improper filename, please correct "
3125 OUTPUT KBD;Filename$;" H";
3126 ENTER KBD;F$
3127 Parse_filename(F$,F_msi$,F_path$)
3128 Filename$=F_path$&F$&F_msi$
3129 DISP
3130 CASE 54 ! Duplicate File Name
3131 ASSIGN @Test TO *
3132 PRINT TABXY(25,13);"Purged and Overwrite ";F$&Ram_msi$
3133 PURGE F$&Ram_msi$
3134 CASE 56 ! Filename Undefined
3135 DISP "Cannot Access FILE - blank Filename will exit"
3136 OUTPUT KBD;Filename$;
3137 ENTER KBD;F$
3138 Parse_filename(F$,F_msi$,F_path$)
3139 DISP
3140 IF NOT LEN(F$) THEN SUBEXIT
3141 Filename$=F_path$&F$&F_msi$
3142 CASE 58 ! Improper File Type
3143 DISP "Improper filename, please correct "
3144 OUTPUT KBD;Filename$;" H";
3145 ENTER KBD;Misc$
3146 Parse_filename(Misc$,F_msi$,F_path$)
3147 F_path$=F_path$&Misc$
3148 DISP
3149 CASE 90 ! Mass Storage System Error
3150 RESET 7
3151 CASE 157 ! No ENTER Terminator found
3152 !
3153 ! If sending BDAT files, exit
3154 ! if the ascii terminator not found
3155 !
3156 IF NOT Image THEN
3157 Wmsg$="File contents not ASCII"
3158 Emsg$="File I/O Error - cannot continue"
3159 State$="E"
3160 User_break=1
3161 ERROR RETURN
3162 END IF
3163 CASE 167,168
3164 CALL Com_interrupt ! Trap previous activity at com port
3165 CASE ELSE
3166 BEEP
3167 DISP ERRM$&" PAUSED"
3168 PAUSE
3169 END SELECT
3170 !
3171 DISP
3172 RETURN
3173 !-------------------------------------------------------------------------
3174 Spar: ! Form Initialization Packet
3175 !
3176 ! Packet$=", S~( *#&1 *"
3177 !
3178 Packet$="" ! PACKET MARK
3179 ! , 44-32=12 PKT LENGTH
3180 ! sp 32-32=0 SEQUENCE
3181 ! S PACKET TYPE (INIT)
3182 Packet$[1,1]=FNTochar$(Maxp) ! ~ 126-32=94
3183 Packet$[2,2]=FNTochar$(Mytmo) ! ( 40-32=8
3184 Packet$[3,3]=FNTochar$(Mypad) ! sp 32-32=0
3185 Packet$[4,4]=FNTochar$(Mypchar) ! sp 32-32=0
3186 Packet$[5,5]=FNTochar$(Myeol) ! * 42-32=10
3187 Packet$[6,6]=CHR$(Myquote) ! # CONTROL QUOTE (0-31)
3188 Packet$[7,7]="&" ! & 8TH BIT PREFIX
3189 Packet$[8,8]="1" ! 1 CHECK TYPE
3190 Packet$[9,9]=" " ! sp NO REPEAT COUNT PROCESS
3191 Packet$[10,10]="*" ! FNTochar$(Capas)
3192 !-----------------------------------!------------------------------
3193 ! EXTENDED PACKET SIZE ! sp sp ~
3194 RETURN
3195 !------------------------------------------------------------------------
3196 Rpar: ! Receive Packet Initialization FROM REMOTE
3197 ! Rdata$[] DATA STRIPPED FROM INCOMING PACKET
3198 Rpsiz=FNUnchar(Rdata$[1])
3199 Ptmo=FNUnchar(Rdata$[2])
3200 Pad=FNUnchar(Rdata$[3])
3201 Padchar=FNUnchar(Rdata$[4])
3202 Eol=FNUnchar(Rdata$[5])
3203 IF Eol=0 THEN Eol=Myeol
3204 Myquote=NUM(Rdata$[6,6])
3205 Myquote$=CHR$(Myquote)
3206 IF LEN(Rdata$)>6 THEN Qbin=NUM(Rdata$[7,7])
3207 Qbin$=CHR$(Qbin)
3208 IF Qbin=89 THEN Qbin=38 ! 89=Y , 38=&
3209 IF Qbin=0 THEN Qbin=38
3210 IF LEN(Rdata$)>7 THEN R_bchk=VAL(Rdata$[8,8])
3211 IF LEN(Rdata$)>8 THEN Rep_char=NUM(Rdata$[9,9])
3212 IF LEN(Rdata$)>9 THEN R_capas=FNUnchar(Rdata$[10,10])
3213 IF BIT(R_capas,1) THEN ! extended length packets
3214 Rcap_lp=1
3215 R_windo=FNUnchar(Rdata$[11,11])
3216 R_maxl1=FNUnchar(Rdata$[12,12])
3217 R_maxl2=FNUnchar(Rdata$[13,13])
3218 R_maxl=R_maxl1*95+R_maxl2
3219 END IF
3220 IF BIT(R_capas,3) THEN Rcap_a=1
3221 RETURN
3222 !-----------------------------------------------------------------
3223 SUBEND ! END OF KERMIT SEND
3224 ! =======================================================================
3225 SUB Set_frame(Req_baud)
3226 Sf: !
3227 !
3228 ! Resets HW and SW Handshake registers, does not reset INT MASK
3229 !
3230 COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
3231 COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
3232 COM /Frame/ Flow$,Hshake$
3233 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
3234 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[2048] BUFFER,Com_card
3235 INTEGER Transfer_on
3236 !
3237 SELECT Req_baud
3238 CASE <301
3239 Baud=300
3240 CASE <1201
3241 Baud=1200
3242 CASE <2401
3243 Baud=2400
3244 CASE <4801
3245 Baud=4800
3246 CASE <9601
3247 Baud=9600
3248 CASE ELSE
3249 Baud=19200
3250 END SELECT
3251 IF Active THEN
3252 Shutdown(Transfer_on)
3253 END IF
3254 SELECT Com_card
3255 CASE 98626,98644
3256 GOSUB Sf26
3257 CASE 98628
3258 GOSUB Sf28
3259 CASE ELSE
3260 BEEP
3261 DISP "com card = ";Com_card,"unknown (paused)"
3262 PAUSE
3263 END SELECT
3264 IF Transfer_on THEN
3265 Startup
3266 END IF
3267 SUBEXIT
3268 !----------------------
3269 Sf28: ! SET FRAME ON 98628 DATACOMM CARD
3270 SELECT Baud
3271 CASE 300
3272 Bd=7
3273 CASE 1200
3274 Bd=9
3275 CASE 2400
3276 Bd=11
3277 CASE 4800
3278 Bd=13
3279 CASE 9600
3280 Bd=14
3281 CASE 19200
3282 Bd=15
3283 CASE ELSE
3284 BEEP
3285 DISP "BAUD RATE: ";Baud;" NOT IMPLEMENTED "
3286 PAUSE
3287 END SELECT
3288 SELECT Data_bits
3289 CASE 7
3290 B=2
3291 CASE 8
3292 B=3
3293 END SELECT
3294 SELECT Stop_bits
3295 CASE 1
3296 S=0
3297 CASE 2
3298 S=2
3299 END SELECT
3300 SELECT TRIM$(UPC$(On_off$))
3301 CASE "ON"
3302 Pt=5
3303 CASE "OFF"
3304 Pt=0
3305 END SELECT
3306 Set_pt: !
3307 IF Pt THEN ! IF PARITY IS ON THEN
3308 SELECT UPC$(Parity_type$)
3309 CASE "NONE","OFF"
3310 Pt=0
3311 CASE "ODD"
3312 Pt=1
3313 CASE "EVEN"
3314 Pt=2
3315 CASE "MARK","1"
3316 Pt=4
3317 CASE "SPACE","0"
3318 Pt=3
3319 END SELECT
3320 END IF
3321 IF Pt>4 THEN
3322 BEEP
3323 INPUT "WHAT PARITY TYPE ? [NONE,ODD,EVEN,1,0] ",Parity_type$
3324 IF TRIM$(UPC$(Parity_type$))="NONE" THEN Pt=0
3325 GOTO Set_pt
3326 END IF
3327 CONTROL Com_port,20;Bd ! SET BAUD RATE
3328 CONTROL Com_port,21;Bd ! SET Rec RATE
3329 CONTROL Com_port,34;B,S,Pt ! SET DATA BITS, STOP, PARITY
3330 CONTROL Com_port,8;1+2 ! RTS DTR Set Active
3331 CONTROL Com_port,22;0 ! Protocol (sw) off 2:enq/ack 5/XON-XOFF
3332 CONTROL Com_port,23;0 ! Handshake Off
3333 RETURN
3334 !----------------------------------
3335 Sf26: ! SET FRAME FOR 98626/98644
3336 SELECT Data_bits
3337 CASE 7
3338 B=2
3339 CASE 8
3340 B=3
3341 END SELECT
3342 SELECT Stop_bits
3343 CASE 1
3344 S=0
3345 CASE 2
3346 S=4
3347 END SELECT
3348 SELECT TRIM$(UPC$(On_off$))
3349 CASE "ON"
3350 P=8
3351 CASE "OFF"
3352 P=0
3353 END SELECT
3354 SELECT UPC$(Parity_type$)
3355 CASE "ODD"
3356 Pt=0
3357 CASE "EVEN"
3358 Pt=16
3359 CASE "MARK","1"
3360 Pt=32
3361 CASE "SPACE","0"
3362 Pt=48
3363 END SELECT
3364 CONTROL Com_port,3;Baud,B+S+P+Pt ! set reg 3 and 4
3365 CONTROL Com_port,5;1+2 ! set RTS and DTR
3366 CONTROL Com_port,12;128+32+16 ! Ignore CTS,DSR,CD
3367 RETURN
3368 !--------------------------
3369 SUBEND
3370 ! ========================================================================
3371 Ci:SUB Com_interrupt ! transfers may be running
3372 !
3373 OPTION BASE 1
3374 DISP CHR$(129);"CI"
3375 ! uses:
3376 ! Com_card, Com_port, Debug
3377 !
3378 !
3379 !
3380 COM /Crt/ Crt_lines,Crt_width
3381 COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
3382 ! COM /Frame/ Baud,Data_bits,Stop_bits,On_off$,Parity_type$
3383 ! COM /Frame/ Flow$,Hshake$
3384 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
3385 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[2048] BUFFER,Com_card
3386 !
3387 ON ERROR GOSUB Local_err
3388 Errno=ERRN
3389 IF Errno=0 THEN
3390 Errno=167 ! INCASE THIS IS A REAL INTERRUPT NOT ERROR
3391 END IF
3392 GOSUB Local_err ! PROCESS ERROR 167 - UART
3393 DISP CHR$(128)
3394 SUBEXIT
3395 !-------------------------------------
3396 Local_err: !
3397 SELECT Errno
3398 CASE 167 ! process interrupt as error 167
3399 SELECT Com_card
3400 CASE 98644,98626
3401 GOSUB Com_intr_26
3402 CASE 98628
3403 GOSUB Com_intr_28
3404 CASE ELSE
3405 END SELECT
3406 CASE 163 ! io interace driver not present
3407 DISP ERRM$
3408 PAUSE
3409 CASE 59 ! end of buffer found
3410 ! do nothing -
3411 CLEAR ERROR
3412 CASE ELSE
3413 DISP ERRM$;" Com_interrupt "
3414 PAUSE
3415 END SELECT
3416 !-----------------------------------------------------------------------
3417 Com_intr_26: !
3418 !
3419 ! Reg. 9: Bit 0 Set when all conditions are clear
3420 ! Bit 1,2 Interrupt Cuase
3421 !
3422 STATUS Com_port,9;Int_cause
3423 REPEAT
3424 Ic=BINAND(Int_cause,7) ! Look at bits 0-1-2
3425 SELECT Ic
3426 CASE 0 ! change in modem status lines
3427 STATUS Com_port,11;Mc ! Modem Change
3428 IF (BIT(Mc,4)) OR (BIT(Mc,5)) OR (BIT(Mc,6)) OR (BIT(Mc,7)) THEN
3429 IF Debug THEN PRINT TABXY(1,Crt_lines);"Serial Interrupt: Modem Line Disconnect"
3430 ELSE
3431 IF Debug THEN PRINT TABXY(1,Crt_lines);"Serial Interrupt: Modem Line Change "
3432 END IF
3433 CASE 2
3434 CASE 4
3435 IF Debug THEN PRINT "RECEIVE BUFFER FULL"
3436 STATUS Com_port,6;Rec ! Clear Interrupt
3437 CASE 6 ! UART Error
3438 STATUS Com_port,10;Uart_err ! Clear UART Interrupt
3439 IF Debug THEN
3440 PRINT "UART ERROR: ";Uart_err
3441 IF BIT(Uart_err,0) THEN PRINT "REC. BUFF FULL"; ! (1)
3442 IF BIT(Uart_err,1) THEN PRINT "BUFF OVERRUN"; ! (2)
3443 IF BIT(Uart_err,2) THEN PRINT "PARITY "; ! (4)
3444 IF BIT(Uart_err,3) THEN PRINT "Framing Error"; ! (8)
3445 IF BIT(Uart_err,4) THEN PRINT "Break Received "; ! (16)
3446 IF BIT(Uart_err,5) THEN PRINT "Trans. Hold. Reg ";! (32)
3447 IF BIT(Uart_err,6) THEN PRINT "Trans. Shift Reg ";! (64)
3448 PRINT
3449 END IF
3450 END SELECT
3451 STATUS Com_port,9;Int_cause ! BIT 0= SET when all intr are clear
3452 UNTIL Int_cause=1
3453 RETURN
3454 !======================================================================
3455 Com_intr_28: !
3456 Rc28: !
3457 !
3458 STATUS Com_port,4;Int_bits ! RESET INTERRUPT
3459 IF Debug THEN
3460 PRINT "INTERRUPT CAUSE: "
3461 IF BIT(Int_bits,0) THEN PRINT "DATA";
3462 IF BIT(Int_bits,1) THEN PRINT "PROMPT REC.";
3463 IF BIT(Int_bits,2) THEN PRINT "PARITY ERROR ";
3464 IF BIT(Int_bits,3) THEN PRINT "MODEM LINE CHANGE ";
3465 IF BIT(Int_bits,4) THEN PRINT "NO ACTIVITY TIMEOUT ";
3466 IF BIT(Int_bits,5) THEN PRINT "LOST CARRIER ";
3467 IF BIT(Int_bits,6) THEN PRINT "EOL RECEIVED ";
3468 IF BIT(Int_bits,7) THEN PRINT "BREAK RECEIVED ";
3469 PRINT
3470 END IF
3471 RETURN
3472 SUBEND ! Comm Interrupt-98628
3473 ! ======================================================================
3474 Krec:SUB K_receive(Filename$,F_msi$,F_path$,Ftype$,Recl,File_length)
3475 !
3476 ! Kermit Receive File Protocol
3477 !
3478 ! File_length: Bytes if Filetype HPUX
3479 ! Records if Filetype BDAT
3480 ! Sectors if Filetype ASCII,SYSTM,BIN,PROG
3481 !
3482 ! Recl Record length (BDAT ONLY)
3483 !
3484 OPTION BASE 1
3485 COM Version$,K$,Setup$
3486 COM /Crt/ Crt_lines,Crt_width
3487 COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
3488 COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
3489 COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas
3490 COM /Kerm/ INTEGER Image,Parflg,Pktdeb
3491 COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol
3492 COM /Kerm2/ State$[1],Cchksum$[1],Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
3493 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
3494 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[2048] BUFFER,Com_card
3495 COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
3496 COM /Frame/ Flow$,Hshake$
3497 COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
3498 COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
3499 COM /Term/ Term_mode$
3500 COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
3501 !
3502 ! Local Vars
3503 !
3504 INTEGER Qbin,Rep_ch ! not in kermit COM
3505 INTEGER Chksum,Rc,Plen,Dlen,Cchksum,Rseq
3506 INTEGER Ftype,Volnum,Prot,Recsize,Sec_data(1:256),Sectors
3507 INTEGER File_open
3508 INTEGER Npak,Oldtry,Spacks,Fpacks,Apacks,Dpacks,Zpacks,Bpacks,Epacks
3509 INTEGER R_maxl1,R_maxl2,R_maxl
3510 INTEGER User_break,Spillfile
3511 REAL File_st,F_sec
3512 ALLOCATE Rcvpkt$[1024],Sndpkt$[Spsiz],Rdata$[1024],A$[1],Packet$[Spsiz]
3513 ALLOCATE File_buff$[4096],Sector$[256]
3514 DIM Emsg$[100],Wmsg$[100],Pkt$[1] !,Cat$(10)[80]
3515 DIM Asc_eol$[2]
3516 DIM F$[80],Sav_msi$[256]
3517 !--------------------------------------------
3518 ON ERROR GOSUB Rec_err
3519 Spillfile=0 ! indicates that a spillfile was needed
3520 Asc_eol$=CHR$(13)&CHR$(10)
3521 Buff_len=MAXLEN(File_buff$)
3522 Sav_msi$=SYSTEM$("MSI")
3523 Ramdisc=0
3524 Check_ramdisc:MASS STORAGE IS ":,0,0" ! check in rec_err
3525 IF Kbytes=0 THEN
3526 Disc_space(":,0,0",Total,Largest_hole,Hole_sum,Format$)
3527 IF Largest_hole>0 THEN Ramdisc=1
3528 Kbytes=Largest_hole*256
3529 END IF
3530 CALL Shutdown
3531 !
3532 ! 98626 overrun error cannot be trapped during transfers - therefore
3533 ! they only show up as error 167 IO status error
3534 !
3535 SELECT Com_card
3536 CASE 98626,98644
3537 ! CALL Reset_port ! Accidentally Disconnects Modem
3538 ENABLE INTR Com_port;8+4 ! 8=modem 4=UART or Overrun
3539 CASE 98628 ! 2=tx reg 1=rec buff full
3540 ! CALL Reset_port
3541 CONTROL Com_port,13;164 ! INT MASK 4=UART 32=lost car 128=break
3542 END SELECT
3543 !
3544 ON INTR Com_port,5 GOSUB Rec_intr
3545 ON TIMEOUT 7,.5 GOSUB No_printer
3546 ON KBD,3 GOSUB Kbr_int
3547 CLEAR SCREEN
3548 IF Display THEN
3549 PRINT TABXY(1,2);Version$
3550 PRINT TABXY(15,5);"Filename: " ! LINE 5
3551 PRINT TAB(6);"Bytes Transferred: ";TAB(25);Kbx ! 6
3552 PRINT
3553 PRINT TAB(16);"RECEIVE: In Progress" ! 8
3554 PRINT ! 9
3555 PRINT TAB(6);"Number of Packets: ";TAB(25);Npak ! 10
3556 PRINT TAB(6);"Number of Retries: ";TAB(25);Oldtry ! 11
3557 PRINT TAB(13);"Last Error: " ! 12
3558 PRINT TAB(11);"Last Warning: " ! 13
3559 ! 14
3560 IF Debug THEN
3561 PRINT TABXY(11,15);"SPACK: " ! 15
3562 PRINT TABXY(11,16);"RPACK: " ! 16
3563 END IF
3564 END IF
3565 CALL Startup ! re-activate transfers
3566 Krecs: !------------------------------------- Receive
3567 Input_buffer$=""
3568 Npak=0
3569 State$="S"
3570 !
3571 !------------------------ Receive Sequence --------------------------
3572 !
3573 REPEAT ! Until State$="X","C" receive done
3574 SELECT State$ ! state switcher
3575 CASE "S"
3576 Sinit: !
3577 Packet$="" ! Packet Data
3578 Pkt$="N" ! Nak unless expected packet arives
3579 PRINT TABXY(25,13);"Exchanging Initialization Packets"
3580 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Spacks,User_break,Emsg$)
3581 IF (Debug) THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",20)
3582 IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
3583 SELECT Pktype$
3584 CASE "S"
3585 GOSUB Rrpar ! Get remote Parameters
3586 GOSUB Rspar ! Form Packet$ with our parameters
3587 Pkt$="Y"
3588 State$="F"
3589 CASE "E" ! Either received or user abort E
3590 IF NOT User_break THEN Emsg$=Rdata$
3591 State$="E"
3592 CASE "T"
3593 Wmsg$="Packet Timeout"
3594 CASE "Q"
3595 Wmsg$="Bad Checksum"
3596 CASE "F","A","D"
3597 ! just Nak the expected packet number
3598 CASE "Z","B"
3599 State$=Pktype$ ! jump to eof or break state
3600 CASE "X" ! User Quit
3601 Pkt$="Y"
3602 Packet$=Rdata$ ! X or Z in ack packet will abort sender
3603 State$="Z" ! let Z state process closure
3604 END SELECT
3605 !
3606 Spack(Packet$,Pkt$,Npak,Sndpkt$)
3607 OUTPUT @Out_buff;Sndpkt$
3608 !
3609 IF Spacks>Maxtry THEN
3610 State$="E"
3611 User_break=1
3612 Emsg$="Unable to receive initiate"
3613 Packet$=Emsg$
3614 END IF
3615 IF Pkt$="Y" THEN
3616 ! State$="F" ! could be X if aborting
3617 Npak=Npak+1
3618 Oldtry=Oldtry+Spacks
3619 ELSE
3620 Spacks=Spacks+1
3621 END IF
3622 !
3623 PRINT TABXY(25,10);Npak
3624 PRINT TABXY(25,11);Oldtry+Spacks
3625 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
3626 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
3627 IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-(LEN(Sndpkt$)))
3628 IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
3629 !----------------------------------- Receive File Header (F)
3630 Krecf:CASE "F" ! Enter Npak=1
3631 Packet$=""
3632 IF Debug THEN PRINT TABXY(25,4);State$
3633 Pkt$="N"
3634 PRINT TABXY(25,13);"Receiving Filename"&RPT$(" ",26)
3635 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Fpacks,User_break,Emsg$)
3636 IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",80-LEN(Rcvpkt$))
3637 IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
3638 SELECT Pktype$
3639 CASE "S"
3640 OUTPUT @Out_buff;Sndpkt$ ! S Packet Sndpkt$ still in tact
3641 IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
3642 CASE "E"
3643 Emsg$=Rdata$
3644 State$="E"
3645 CASE "T"
3646 Wmsg$="Packet Timeout"
3647 CASE "Q"
3648 Wmsg$="Bad Checksum"
3649 CASE "A","D"
3650 ! Just Nak ! probably should abort here
3651 CASE "Z","B"
3652 State$=Pktype$
3653 CASE "X"
3654 Pkt$="Y"
3655 Packet$=Rdata$
3656 State$="Z"
3657 CASE "F"
3658 Pkt$="Y"
3659 Oldtry=Oldtry+Spacks
3660 IF Rcap_a THEN ! Attribute Packets in use
3661 State$="A"
3662 ELSE
3663 State$="D"
3664 END IF
3665 GOSUB Verify_fname ! Create F_path$, F_msi$, Filename$
3666 END SELECT
3667 Spack(Packet$,Pkt$,Npak,Sndpkt$)
3668 OUTPUT @Out_buff;Sndpkt$
3669 !
3670 IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
3671 IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
3672 IF Fpacks>Maxtry THEN
3673 State$="E"
3674 User_break=1
3675 Packet$="Unable to receive filename"
3676 END IF
3677 PRINT TABXY(25,10);Npak
3678 PRINT TABXY(25,11);Oldtry+Fpacks
3679 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
3680 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
3681 !
3682 IF Pkt$="Y" THEN
3683 Npak=Npak+1
3684 ELSE
3685 Fpacks=Fpacks+1
3686 END IF
3687 !-------------------------------------- File Attributes
3688 CASE "A"
3689 Kreca: !
3690 Packet$=""
3691 IF Debug THEN PRINT TABXY(25,4);State$
3692 Pkt$="N"
3693 PRINT TABXY(25,13);"Receiving File Attributes"&RPT$(" ",19)
3694 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Apacks,User_break,Emsg$)
3695 IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",60-LEN(Rcvpkt$))
3696 IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
3697 SELECT Pktype$
3698 CASE "A"
3699 GOSUB Get_at
3700 Pkt$="Y"
3701 IF File_length THEN
3702 PRINT TABXY(10,7);"% Transferred:"
3703 END IF
3704 State$="D"
3705 CASE "Z","B"
3706 State$=Pktype$
3707 CASE "E"
3708 Emsg$=Rdata$
3709 State$="E"
3710 CASE "T"
3711 Wmsg$="Packet Timeout"
3712 CASE "Q"
3713 Wmsg$="Bad Checksum"
3714 CASE "X"
3715 Pkt$="Y"
3716 Packet$=Rdata$
3717 State$="Z"
3718 END SELECT
3719 !
3720 Spack(Packet$,Pkt$,Npak,Sndpkt$)
3721 OUTPUT @Out_buff;Sndpkt$
3722 IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
3723 IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
3724 PRINT TABXY(25,10);Npak
3725 PRINT TABXY(25,11);Oldtry+Apacks
3726 IF Apacks>Maxtry THEN
3727 State$="E"
3728 User_break=1
3729 Packet$="Unable to receive attribute packet"
3730 END IF
3731 IF Pkt$="Y" THEN
3732 Npak=Npak+1
3733 Oldtry=Oldtry+Spacks
3734 ELSE
3735 Apacks=Apacks+1
3736 END IF
3737 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
3738 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
3739 !-------------------------------------- Receive File Data "D"
3740 CASE "D"
3741 Krecd: !
3742 Packet$=""
3743 Rdata$=""
3744 Pkt$="N"
3745 !
3746 IF NOT Dinit THEN
3747 PRINT TABXY(25,13);"Receiving File Data"&RPT$(" ",25)
3748 Dinit=1
3749 END IF
3750 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Dpacks,User_break,Emsg$)
3751 IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",20)
3752 IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
3753 SELECT Pktype$
3754 CASE "F","S","A"
3755 Emsg$="Packets out of sequence"
3756 State$="E"
3757 User_break=1
3758 CASE "Z","B" ! Process State Z here
3759 PRINT TABXY(25,13);"Receiving End of File"&RPT$(" ",25)
3760 !
3761 ! Write Remaining File Lines
3762 !
3763 IF File_open THEN
3764 SELECT Filetype$
3765 CASE "ASCII"
3766 OUTPUT @File;File_buff$
3767 CASE "HPUX","BDAT"
3768 OUTPUT @File USING "#,K";File_buff$
3769 CASE ELSE
3770 OUTPUT @File;File_buff$;
3771 END SELECT
3772 OUTPUT @File;END
3773 ASSIGN @File TO *
3774 File_open=0
3775 END IF! file open
3776 Pkt$="Y"
3777 State$="B" ! Skip over Z state (done here )
3778 Oldtry=Oldtry+Spacks
3779 CASE "E"
3780 Emsg$=Rdata$
3781 State$="E"
3782 CASE "T"
3783 Wmsg$="Packet Timeout"
3784 CASE "Q"
3785 Wmsg$="Bad Checksum or Sequence"
3786 CASE "X"
3787 Pkt$="Y"
3788 Packet$=Rdata$
3789 State$="Z"
3790 User_break=1
3791 !--------------------------------------- File Data Received
3792 CASE "D"
3793 Pkt$="Y"
3794 CASE ELSE
3795 END SELECT
3796 !
3797 Spack(Packet$,Pkt$,Npak,Sndpkt$)
3798 OUTPUT @Out_buff;Sndpkt$
3799 IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
3800 IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
3801 PRINT TABXY(25,10);Npak
3802 PRINT TABXY(25,11);Oldtry+Dpacks
3803 IF Dpacks>Maxtry THEN
3804 State$="E"
3805 User_break=1
3806 Packet$="Unable to receive file data packet"
3807 END IF
3808 !
3809 IF Pkt$="Y" THEN
3810 Npak=Npak+1
3811 ELSE
3812 Dpacks=Dpacks+1
3813 END IF
3814 IF Display THEN
3815 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
3816 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
3817 END IF
3818 IF (User_break) OR (State$<>"D") THEN GOTO Krecd_exit
3819 !
3820 IF Pkt$="Y" THEN !- PACKET IS "Y" - RECEIVE DATA
3821 IF User_break THEN GOTO Krecd_exit ! Avoid Data Packet
3822 DISABLE
3823 Of: ! ---- Create and Open File
3824 IF NOT File_open THEN
3825 !
3826 IF NOT (LEN(Ftype$)) THEN Ftype$="HPUX"
3827 !
3828 ! Process Filelength
3829 !
3830 IF File_length=0 THEN ! Attribute Packet Not Used
3831 SELECT Ftype$
3832 CASE "HPUX","PROG"
3833 IF Hfs_disc THEN
3834 File_length=1
3835 ELSE
3836 IF Ramfile THEN File_length=Kbytes
3837 IF NOT Ramfile THEN File_length=50000 ! bytes
3838 END IF
3839 CASE ELSE
3840 IF Hfs_disc THEN
3841 File_length=1
3842 ELSE
3843 IF Ramfile THEN File_length=Kbytes
3844 IF NOT Ramfile THEN File_length=50000
3845 END IF
3846 END SELECT
3847 ELSE ! file length spec in attribute packet
3848 IF Ramdisc THEN
3849 IF File_length>(Kbytes*1000) THEN ! ramdisc too small
3850 Wmsg$="File larger than Mass Storage"
3851 Emsg$="Mass Storage Overflow"
3852 State$="E"
3853 User_break=1
3854 GOTO Krecd_exit
3855 END IF
3856 END IF
3857 END IF ! File Length = 0
3858 !
3859 ! Code to check for residual file not working add an extra sector
3860 !
3861 ! Res=File_length MOD 256
3862 ! IF NOT Res THEN
3863 ! Sectors=MAX(1,INT(File_length/256))
3864 ! ELSE
3865 Sectors=MAX(1,INT(File_length/256)+1)
3866 ! END IF
3867 !
3868 SELECT Ftype$
3869 CASE "HP-UX","HPUX"
3870 CREATE F_path$&Filename$&F_msi$,File_length+1
3871 CASE "BDAT"
3872 IF Recl>0 THEN
3873 CREATE BDAT F_path$&Filename$&F_msi$,Sectors,Recl
3874 ELSE
3875 CREATE BDAT F_path$&Filename$&F_msi$,Sectors
3876 END IF
3877 CASE "ASCII"
3878 CREATE ASCII F_path$&Filename$&F_msi$,Sectors
3879 CASE ELSE ! "SYSTM","BIN","PROG"
3880 CREATE F_path$&Filename$&F_msi$,File_length ! Use HP-UX then convert later
3881 END SELECT
3882 !
3883 IF State$="E" THEN ! Mass Storage Overflow ?
3884 User_break=1
3885 GOTO Krecd_exit
3886 END IF
3887 ASSIGN @File TO F_path$&Filename$&F_msi$;FORMAT OFF
3888 File_open=1
3889 ! --------------------------------- Init Process Rdata$
3890 P=1 ! packet contents pointer
3891 Qon=0 ! quoting on flag
3892 Biton=0 ! 8 bit prefixing flag
3893 Rept=0 ! repeat prefix flag
3894 END IF ! file not open
3895 END IF ! D Packet and File Not open
3896 !--------------------------------------------- Pack File_buff$(*)
3897 Decode: !
3898 IF Pktype$="D" THEN
3899 ! strip parity bits here ????????????
3900 CALL Decode_pack(Rdata$,Quote,Qbin,Rep_ch)
3901 File_buff$=File_buff$&Rdata$
3902 Pl=LEN(Rdata$) ! Pl = Packet Length
3903 P=P+Pl ! P = Buffer Pointer (File_buff$)
3904 END IF ! D Packet
3905 !
3906 Kbx=Kbx+Pl ! Kbx = Bytes Transferred
3907 PRINT TABXY(25,6);Kbx !INT(Kbx/1000)
3908 IF At_filelength THEN
3909 PRINT TABXY(25,7);INT((Kbx*100)/File_length);"%"
3910 END IF
3911 !
3912 ! Check Buffer Length and write File
3913 !
3914 IF P>Buff_len-100 THEN !write file
3915 IF Debug THEN DISP "Writing File ";F_path$&Filename$&F_msi$
3916 SELECT Ftype$
3917 CASE "ASCII"
3918 !
3919 ! The File_buff$ is parsed for CR-LF (Ascii_eol$)
3920 ! The Eol$ is removed, and each line is written to the Ascii
3921 ! File creating Length-header delimited data.
3922 !
3923 Ascii_eol$="
"
3924 Eol_l=LEN(Ascii_eol$)
3925 REPEAT
3926 Eolpos=POS(File_buff$,Ascii_eol$)
3927 IF Eolpos THEN
3928 Sector$=File_buff$[1,Eolpos]
3929 ELSE ! the last fragment has no eol in the packet
3930 Sector$=File_buff$
3931 END IF
3932 OUTPUT @File;Sector$;
3933 File_buff$=File_buff$[Eolpos+Eol_l] ! truncate and remove eol
3934 UNTIL Eolpos=0
3935 CASE ELSE
3936 OUTPUT @File USING "#,K";File_buff$ ! supress <null> eol
3937 END SELECT
3938 File_buff$=""
3939 P=0
3940 END IF
3941 Krecd_exit: !ENABLE
3942 !----------------------------------------------------------------------
3943 Krecz:CASE "Z"
3944 !
3945 ! State Z is normally processed in D State Handling -
3946 ! Rdata$ in tact
3947 !---------------------------------------------------------------------
3948 ! This state is entered in 2 situations -
3949 !
3950 ! 1. Sender sends a Z packet prematurely
3951 ! 2. User (receiver) abort
3952 ! This state may be entered forom a user-abort sequence ^X ^Z
3953 ! If so, then the user_break flag will be set, and Rdata$ will be
3954 ! X if ^X was invoked, or Z if ^Z was invoked.
3955 !--------------------------------------------------------------------
3956 ! Variables set after user break conditions
3957 !
3958 ! Pktype$ Rdata$ State$
3959 ! ^X X X --
3960 ! ^Z X Z --
3961 ! ^E E -- E
3962 ! ^C X ^C X (unless changed in other states)
3963 !
3964 !
3965 IF User_break THEN
3966 IF NOT POS(Rdata$,"^C") THEN ! Ok to notify host
3967 !
3968 ! ^X and ^Z: send ack with X or Z in data field
3969 !
3970 Packet$=Rdata$
3971 Spack(Packet$,State$,Npak,Sndpkt$)
3972 OUTPUT @Out_buff;Sndpkt$
3973 IF Debug THEN PRINT TABXY(25,16);Sndpkt$&" "
3974 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Zpacks,User_break,Emsg$)
3975 ELSE ! ^C processing just abort
3976 ! fall thru to check pktype
3977 END IF
3978 ELSE
3979 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Bpacks,User_break,Emsg$)
3980 END IF
3981 IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",60-LEN(Rcvpkt$))
3982 IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
3983 Pkt$="N"
3984 Check_z:!
3985 SELECT Pktype$
3986 CASE "Z"
3987 ! ** Should inspect Rdata$ for a "D)iscard" instruction"
3988 ! if Rdata$="D" then discard file.
3989 !
3990 ! Write Remaining File Lines **
3991 !
3992 IF Rdata$="D" THEN
3993 ! discard file here
3994 DISP "Received Abort from Sender and signal to discard file - purge file ? "
3995 OUTPUT KBD;"Y";" H";
3996 ENTER KBD;Ans$
3997 DISP
3998 IF UPC$(Ans$)="Y" THEN
3999 DISP "Purging File: ";Filename$
4000 PURGE Filename$
4001 END IF
4002 ELSE ! close file normally
4003 IF File_open THEN
4004 Bl=LEN(File_buff$)
4005 SELECT Filetype$
4006 CASE "HPUX","BDAT"
4007 OUTPUT @File;File_buff$;END
4008 PRINT File_buff$
4009 CASE "ASCII"
4010 OUTPUT @File;File_buff$;END
4011 END SELECT
4012 ASSIGN @File TO *
4013 File_open=0
4014 DISP
4015 ELSE
4016 Wmsg$="(Z) File not Open "
4017 END IF! file open
4018 END IF
4019 Pkt$="Y"
4020 State$="B"
4021 Oldtry=Oldtry+Zpacks
4022 CASE "B"
4023 State$="C" ! File Transfer Complete
4024 Pkt$="Y"
4025 CASE "E"
4026 Emsg$=Rdata$
4027 State$="E"
4028 CASE "T"
4029 Wmsg$="Packet Timeout"
4030 CASE "Q"
4031 Wmsg$="Bad Checksum"
4032 CASE "X"
4033 State$="X" ! abort
4034 END SELECT
4035 !
4036 Spack(Packet$,Pkt$,Npak,Sndpkt$) !?????????????????????
4037 OUTPUT @Out_buff;Sndpkt$
4038 IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
4039 IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
4040 !
4041 IF Zpacks>Maxtry THEN
4042 State$="E"
4043 User_break=1
4044 Packet$="Unable to receive EOF (Z) packet"
4045 Emsg$="Unable to receive EOF (Z) packet"
4046 END IF
4047 !
4048 IF Pkt$="Y" THEN
4049 Npak=Npak+1
4050 ELSE
4051 Zpacks=Zpacks+1
4052 END IF
4053 !
4054 Krecz_exit:!
4055 PRINT TABXY(25,10);Npak
4056 PRINT TABXY(25,11);Oldtry+Bpacks
4057 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4058 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4059 !---------------------------------------------------------------------
4060 Krecb:CASE "B"
4061 !
4062 Packet$=""
4063 IF Debug THEN PRINT TABXY(25,4);State$
4064 Pkt$="N"
4065 PRINT TABXY(25,13);RPT$(" ",55)
4066 Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Bpacks,User_break,Emsg$)
4067 IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",60-LEN(Rcvpkt$))
4068 IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
4069 SELECT Pktype$
4070 CASE "Z"
4071 Pkt$="Y"
4072 State$="B" ! Skip over Z state (done here )
4073 Oldtry=Oldtry+Zpacks
4074 CASE "B"
4075 State$="C" ! File Transfer Complete
4076 Pkt$="Y"
4077 CASE "E"
4078 Emsg$=Rdata$
4079 State$="E"
4080 CASE "T"
4081 Wmsg$="Packet Timeout"
4082 CASE "Q"
4083 Wmsg$="Bad Checksum"
4084 CASE "X"
4085 END SELECT
4086 !
4087 Spack(Packet$,Pkt$,Npak,Sndpkt$)
4088 OUTPUT @Out_buff;Sndpkt$
4089 IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
4090 IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
4091 PRINT TABXY(25,10);Npak
4092 PRINT TABXY(25,11);Oldtry+Bpacks
4093 !
4094 IF Bpacks>Maxtry THEN
4095 State$="E"
4096 User_break=1
4097 Packet$="Unable to receive break packet"
4098 Emsg$="Unable to receive break packet"
4099 END IF
4100 !
4101 IF Pkt$="Y" THEN
4102 IF User_break THEN
4103 State$="X"
4104 ELSE
4105 State$="C"
4106 END IF
4107 Npak=Npak+1
4108 ELSE ! pkt$="N"
4109 Bpacks=Bpacks+1
4110 END IF
4111 !
4112 PRINT TABXY(25,10);Npak
4113 PRINT TABXY(25,11);Oldtry+Bpacks
4114 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4115 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4116 !
4117 IF Ftype$="PROG" THEN
4118 CALL Convert(F_path$&Filename$&F_msi$,"PROG",Rc)
4119 PRINT TABXY(1,18);"PROG File exists on Ram Disc - Copy file to disc before leaving Kermit"
4120 END IF
4121 !------------------------------------------------------------------------
4122 Krece:CASE "E" !
4123 !
4124 ! Enter E state on:
4125 !
4126 ! 1. Received E Packet from Host (User_break=0)
4127 ! Erm$ (and Rdata$) contains the host error message
4128 ! 2. User Abort - User_break=1
4129 ! Packet$ (rdata$ ? )contains the error message being sent
4130 !
4131 ! Emsg$ must contain data mesage for packet
4132 !
4133 BEEP
4134 IF User_break THEN ! User abort
4135 Pkt$="E" ! Nak unless expected packet arives
4136 Packet$=Emsg$
4137 Spack(Packet$,Pkt$,Npak,Sndpkt$)
4138 OUTPUT @Out_buff;Sndpkt$
4139 IF D_log THEN OUTPUT @D_log;"SPACK: ";Sndpkt$
4140 State$="X" ! indicate User Abort
4141 ELSE ! Host Error - E packet Received
4142 State$="X"
4143 END IF
4144 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4145 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4146 PRINT TABXY(1,Crt_lines);
4147 !----------------------------------------------------------------
4148 END SELECT ! Receive State Switch
4149 UNTIL (State$="X") OR (State$="C") ! Don't put "E" here !
4150 !========================================================================
4151 IF D_log THEN ASSIGN @D_log TO *
4152 ASSIGN @File TO *
4153 !
4154 IF Com_card=98628 THEN
4155 ! Do Nothing
4156 ELSE ! 98626
4157 REPEAT
4158 STATUS @Out_buff,4;Bl ! Finish sending last packet
4159 UNTIL Bl=0
4160 !
4161 STATUS @In_buff,4;Bl
4162 WHILE Bl
4163 OUTPUT @Out_buff;"
"
4164 IF Bl THEN ENTER @In_buff;Misc$
4165 IF Debug THEN PRINT Misc$
4166 STATUS @In_buff,4;Bl ! Finish sending last packet
4167 END WHILE
4168 ! CALL Shutdown ! << this could be screwing things
4169 END IF
4170 !
4171 Krec_exit: !
4172 !
4173 PRINTER IS CRT
4174 PRINT TABXY(1,16);
4175 SELECT State$
4176 CASE "C"
4177 PRINT TABXY(16,8);"RECEIVE: Completed " ! 8
4178 CASE "X"
4179 IF NOT User_break THEN
4180 PRINT TABXY(16,8);"RECEIVE: Aborted by host " ! 8
4181 ELSE
4182 PRINT TABXY(16,8);"RECEIVE: Aborted by user " ! 8
4183 ! PRINT Emsg$
4184 END IF
4185 ! process incomplete file here - save or discard
4186 IF Discard THEN
4187 DISP "Discard File: ";F_path$&Filename$&F_msi$;" ?"
4188 OUTPUT KBD;"Yes";
4189 ENTER KBD;Ans$
4190 DISP
4191 ON ERROR GOTO No_discard
4192 IF POS(UPC$(Ans$),"Y") THEN PURGE F_path$&Filename$&F_msi$
4193 No_discard:DISP ERRM$
4194 OFF ERROR
4195 END IF
4196 END SELECT
4197 PRINT TABXY(1,Crt_lines);
4198 MASS STORAGE IS Sav_msi$
4199 SUBEXIT
4200 !-----------------------------------------------------------------------
4201 Verify_fname: ! called from State "F"
4202 Vf: !
4203 ! 1. If filename was not specified locally, then use the incomming
4204 ! filename. Make sure name is legal and < 10 chars
4205 ! 2. Check for :MSI. If none specified, then append the
4206 ! local default_msi$. If Ramdisc make sure it exists.
4207 ! 3. Parse filename and create F_path$, F_msi$, Filename$
4208 ! 4. If PROG Filetype then make F_msi$=ram disc
4209 !
4210 IF NOT LEN(Filename$) OR Filename$="," THEN !use incomming file name.
4211 IF Debug THEN DISP "Using the incomming filename"
4212 Filename$=TRIM$(Rdata$)
4213 Sav_filename$=Filename$
4214 CALL Parse_filename(Filename$,F_msi$,F_path$)
4215 IF NOT LEN(Filename$) THEN Filename$="K_DEFAULT"
4216 IF Filnamcnv THEN Filename$=UPC$(Filename$)
4217 END IF
4218 !
4219 ! Check Filename Length = 10 characters or less
4220 !
4221 WHILE LEN(Filename$)>10
4222 DISP "filename too long - shorten "
4223 OUTPUT KBD;Filename$;" H";
4224 ENTER KBD;Filename$
4225 DISP
4226 END WHILE
4227 !
4228 ! Check if ramdisc msi and if ramdisc is available. If not
4229 ! Change :MSI to a physical disc.
4230 !
4231 IF Filetype$="PROG" THEN F_msi$=":,0,0"
4232 IF (POS(F_msi$,":,0") OR POS(F_msi$,":MEMORY")) AND (Ramdisc=1) THEN
4233 Ramfile=1
4234 IF Debug THEN PRINT "using ramdisc"
4235 ELSE
4236 IF POS(F_msi$,":,0") AND (Ramdisc=0) THEN
4237 BEEP
4238 DISP "Change MSI - Ramdisc not available"
4239 OUTPUT KBD;F_path$&Filename$&F_msi$;
4240 ENTER KBD;Filename$
4241 CALL Parse_filename(Filename$,F_msi$,F_path$)
4242 END IF
4243 END IF
4244 PRINT TABXY(25,5);" As ";F_path$&Filename$&F_msi$
4245 RETURN
4246 !------------------------------------------------------------------------
4247 Create_unique: ! ! Filewarn=1 Don't Purge File - create a unique name
4248 F$=Filename$
4249 Unq_made=0
4250 !
4251 ! Get a catalog of a duplicate filenames upto "_" character
4252 !
4253 !
4254 IF LEN(F$)<9 THEN
4255 Find$=F$&"_"
4256 ELSE
4257 Find$=F$[1,8]&"_"
4258 END IF
4259 ALLOCATE Cat$(30)[80]
4260 CAT F_msi$ TO Cat$(*);SELECT Find$,COUNT Dupnames,NO HEADER
4261 !---------------------------------------------
4262 ! Find the next unique suffix
4263 ! Find$ = The base filename without sufix
4264 !
4265 IF Dupnames THEN ! INCR NEXT_UNIQUE UNTIL UNIQUE
4266 Next_unique=47 ! STARTING PLACE IN ASCII TABLE "0"
4267 REPEAT
4268 Next_unique=Next_unique+1
4269 IF (Next_unique>57) AND (Next_unique<65) THEN Next_unique=65
4270 IF (Next_unique>90) AND (Next_unique<97) THEN Next_unique=97
4271 IF Next_unique>126 THEN
4272 DISP "Can't Create a unique name - all ascii chars used"
4273 PAUSE
4274 END IF
4275 !
4276 Nu_found=1
4277 FOR Df=1 TO Dupnames
4278 IF POS(Cat$(Df),Find$&CHR$(Next_unique)) THEN ! UNIQUE
4279 Nu_found=0
4280 END IF
4281 NEXT Df
4282 UNTIL Nu_found
4283 ELSE
4284 Next_unique=48 ! IF NO DUPES THEN - DEFAULT TO 48 "_0"
4285 END IF
4286 DEALLOCATE Cat$(*)
4287 !---------------------------------------------
4288 REPEAT ! until a unique name is made
4289 !
4290 ! Make sure filename is unique
4291 !
4292 Ftest$=Find$&CHR$(Next_unique)
4293 ASSIGN @Test TO F_path$&Ftest$&F_msi$;RETURN Rc
4294 IF Rc THEN ! assume filename is unique
4295 Unq_made=1
4296 Next_unique=(Next_unique+1) MOD 10
4297 F$=Ftest$
4298 ELSE
4299 DISP "Unique name not obtained "
4300 PAUSE
4301 Next_unique=Next_unique+1
4302 END IF
4303 UNTIL Unq_made
4304 !
4305 Filename$=F$
4306 Wmsg$="Changed filename to "&Filename$
4307 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4308 PRINT TABXY(25,5);" As ";F_path$&Filename$&F_msi$
4309 RETURN
4310 !----------------------------------------------
4311 Get_at: ! Decode File Attribute Packet
4312 !
4313 ! Rdata$ is in form: ATTRIBUTE(char), LENGTH(unchar), DATA(char)
4314 ! Returns:
4315 !
4316 ! ! or 1 File length (Bytes) File_length
4317 ! "
4318 ! # Creation Date File_date$
4319 ! . Machine and OS File_os$
4320 ! / Format Of Data File_format$,File_type,File_delim$
4321 !
4322 I=1 ! data pointer
4323 REPEAT
4324 Attrib$=Rdata$[I,I]
4325 Dl=FNUnchar(Rdata$[I+1,I+1])
4326 SELECT Attrib$
4327 CASE "!" ! Length (Kb)
4328 IF NOT At_filelength THEN
4329 File_length=VAL(Rdata$[I+2;Dl])
4330 IF Attrib$="!" THEN File_length=(File_length+1)*1000
4331 At_filelength=1
4332 END IF
4333 CASE "1" ! Exact File Length
4334 File_length=VAL(Rdata$[I+2;Dl])
4335 IF Attrib$="!" THEN File_length=(File_length+1)*1000
4336 At_filelength=1
4337 CASE """" ! Data Type
4338 CASE "#" ! Creation Date [yy]yymmdd[ hh:mm[ :ss]
4339 File_date$=Rdata$[I+2;Dl]
4340 CASE "." ! Machine and OS ! H4=hp9000 RMB
4341 File_os$=Rdata$[I+2;Dl] ! U8=DOS
4342 CASE "/" ! Format of data
4343 File_format$=Rdata$[I+2;Dl]
4344 SELECT File_format$[1,1]
4345 CASE "A" ! Var Length Delim Records - HP-UX FORMAT ON
4346 File_delim$=File_format$[2;Dl-1]
4347 File_type=4
4348 CASE "D" ! Var Len Undelim Records - ASCII File $
4349 File_type=3
4350 CASE "F" ! Fix Len Undelim Records - BDAT FORMAT OFF
4351 File_type=2
4352 CASE "R" ! Record Oriented Placement of record
4353 CASE "M" ! Maximum Rec Length for above record
4354 END SELECT
4355 END SELECT
4356 I=I+Dl+2
4357 IF Debug THEN PRINT "file_attribute ";Attrib$
4358 UNTIL I>LEN(Rdata$)
4359 RETURN
4360 !-----------------------------------------------------------------------
4361 Kbr_int: !(k receive)
4362 ! Cancels: ^X (file) ^Z (Batch) ^E (Protocol) ^C(Quit) <ent> Retry
4363 !
4364 ! To Interrupt File Receive:
4365 !
4366 ! ACK Packet with: X in data field to abort single file
4367 ! Z in data field to abort entire batch
4368 ! E Packet with Error Msg if Sender doesn't recognize file interruption.
4369 !
4370 User_break=1
4371 K$=KBD$
4372 SELECT K$[1,1]
4373 CASE " ","" ! ?
4374 PRINT TABXY(1,Crt_lines);
4375 PRINT "Cancels: ^X (file) ^Z (Batch) ^E (Protocol) ^C(Quit) <Ent> Retry"
4376 CASE "" ! ^X ! Cancel File
4377 Pktype$="X"
4378 Rdata$="X" ! discard file
4379 Emsg$="Single File Cancelled by Client"
4380 RETURN
4381 CASE CHR$(26) !^Z ! No Batch Process Yet (wildcard send/rec ?)
4382 Pktype$="X"
4383 Rdata$="Z"
4384 Emsg$="Batch Receive Cancelled by Client"
4385 RETURN
4386 CASE "" ! ^E ! Goto Error (Abort) State
4387 State$="E"
4388 Pktype$="E"
4389 Emsg$="File Aborted by Client (E Packet)"
4390 RETURN
4391 CASE "" ! ^C ! Quit without Notifying Remote Kermit
4392 State$="X"
4393 Pktype$="X"
4394 Rdata$=""
4395 Emsg$="Transfer Aborted by Client - Host Not Notified"
4396 RETURN
4397 CASE " " ! CTRL-ENTER resend - no abort
4398 User_break=0
4399 SELECT K$[2,2]
4400 CASE "E"
4401 OUTPUT @Out_buff;Sndpkt$
4402 Retry_count=Retry_count+1
4403 PRINT TABXY(25,11);Retry_count
4404 END SELECT
4405 CASE ELSE
4406 User_break=0
4407 END SELECT
4408 ON KBD,2 GOSUB Kbr_int
4409 RETURN
4410 !----------------------------------------------------------------------
4411 Rec_err: ! Error Handling for Kermit Receive
4412 IF Debug THEN DISP ERRM$
4413 SELECT ERRN
4414 CASE 53 ! improper filename - probably a . in the name
4415 Xd=POS(Filename$,".")
4416 IF Xd THEN Filename$[Xd,Xd]="_"
4417 IF LEN(Filename$)>10 THEN Filename$=Filename$[1,10]
4418 CASE 76,52 ! INVALID DRIVE
4419 IF ERRL(Check_ramdisc) THEN
4420 Init_ramdisc(Kbytes)
4421 IF NOT Kbytes THEN
4422 DISP "Not enough memory for ramdisc"
4423 WAIT 1
4424 DISP
4425 ERROR RETURN
4426 ELSE
4427 Ramdisc=1
4428 END IF
4429 ELSE
4430 DISP ERRM$&" - Change MSI "
4431 OUTPUT KBD;F_msi$;" H";
4432 ENTER KBD;F_msi$
4433 DISP
4434 END IF
4435 CASE 64 ! Mass Storage Medium Overflow
4436 Emsg$="Err 64: Mass Storage Medium Overflow"
4437 State$="E"
4438 ERROR RETURN
4439 CASE 54 ! Duplicate File Name
4440 IF Filewarn THEN ! create a unique filename
4441 GOSUB Create_unique
4442 ELSE ! filewarn=0 - overwrite file
4443 ASSIGN @File TO *
4444 PURGE Filename$
4445 Wmsg$="Overwriting file "&Filename$
4446 END IF
4447 CLEAR ERROR
4448 CASE 167,168
4449 CALL Com_interrupt ! Serial Port Erro
4450 CASE 59 ! END OF FILE FOUND @FILE - Filename$
4451 ASSIGN @File TO *
4452 Spillfile=Spillfile+1
4453 Filename$="SPILLFILE"&VAL$(Spillfile)
4454 F$=F_path$&Filename$&F_msi$
4455 ASSIGN @File TO F$;FORMAT ON,RETURN Rc
4456 IF Rc THEN
4457 SELECT Filetype$
4458 CASE "ASCII"
4459 CREATE ASCII F$,200 ! 51 Kb
4460 ASSIGN @File TO F$;FORMAT OFF
4461 CASE "HPUX"
4462 CREATE F$,50000
4463 ASSIGN @File TO F$;FORMAT OFF
4464 CASE ELSE
4465 CREATE BDAT F$,200
4466 ASSIGN @File TO F$;FORMAT OFF
4467 END SELECT
4468 END IF
4469 Wmsg$="File Overflow - Spillfile Created"
4470 CASE ELSE
4471 DISP ERRM$&" Paused in Rec_err"
4472 PAUSE
4473 END SELECT
4474 !
4475 DISP
4476 ON ERROR GOSUB Rec_err
4477 PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4478 PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4479 RETURN
4480 !----------------------------------------------
4481 Rec_intr: ! ! COMM PORT INTERRUPT HANDLER
4482 CALL Com_interrupt
4483 Shutdown
4484 ON INTR Com_port,15 GOSUB Rec_intr
4485 SELECT Com_card
4486 CASE 98628
4487 CONTROL Com_port,13;164 ! MASK 4=UART 32=lost carr 128=break
4488 CASE 98626,98644
4489 ENABLE INTR Com_port;4
4490 END SELECT
4491 ON ERROR GOSUB Rec_err
4492 Startup
4493 RETURN
4494 !-----------------------------------------------
4495 No_printer:RETURN
4496 Flush_buff: !
4497 RETURN
4498 !---------------------------------------------
4499 Rspar: ! Form Initialization Packet
4500 Packet$=""
4501 Packet$[1]=FNTochar$(Maxp)
4502 Packet$[2]=FNTochar$(Mytmo)
4503 Packet$[3]=FNTochar$(Mypad)
4504 Packet$[4]=FNTochar$(Mypchar)
4505 Packet$[5]=FNTochar$(Myeol)
4506 Packet$[6]=CHR$(Myquote)
4507 Packet$[7]="&" ! 8TH BIT PREFIX
4508 Packet$[8]="1" ! CHECK TYPE
4509 Packet$[9]=" " ! NO REPEAT COUNT PROCESS
4510 IF Rptflag THEN
4511 Packet$[9,9]=CHR$(Rep_char)
4512 END IF
4513 !
4514 IF Rcap_a THEN
4515 Capas=IVAL("001000",2) ! File attributes = (8)
4516 Packet$[10]=FNTochar$(Capas) ! CAPAS MASK
4517 END IF
4518 !
4519 ! Extended Length Packets (m=desired length - <= 9024)
4520 ! If bit 1 of capas is set: 000010
4521 !
4522 IF Rcap_lp THEN
4523 Packet$[11,11]=FNTochar$(0) ! Windo - not used
4524 Packet$[12,12]=FNTochar$(R_maxl1)
4525 Packet$[13,13]=FNTochar$(R_maxl2)
4526 END IF
4527 !
4528 RETURN
4529 !================================
4530 Rrpar: ! Receive Packet Initialization
4531 ! Rdata$[] DATA STRIPPED FROM INCOMING PACKET
4532 IF Debug THEN DISP "INIT REc len = ";LEN(Rdata$)
4533 FOR S=1 TO LEN(Rdata$)
4534 SELECT S
4535 CASE 1
4536 Rpsiz=FNUnchar(Rdata$[1]) ! remote packet size
4537 CASE 2
4538 Ptmo=FNUnchar(Rdata$[2]) ! remote packet timeout
4539 CASE 3
4540 Pad=FNUnchar(Rdata$[3]) ! remote padding
4541 CASE 4
4542 Padchar=FNUnchar(Rdata$[4]) ! padding char to use
4543 CASE 5
4544 Eol=FNUnchar(Rdata$[5])
4545 IF Eol=0 THEN Eol=Myeol ! eol to use
4546 CASE 6
4547 Quote=NUM(Rdata$[6,6]) ! remote quote char
4548 CASE 7
4549 Qbin=NUM(Rdata$[7,7])
4550 IF Qbin=89 THEN Qbin=38 ! 89=Y , 38=& ! Y= Yes I do it
4551 CASE 8
4552 R_bchk=NUM(Rdata$[8,8]) ! remote block check type
4553 R_bchk=R_bchk-48 ! 1=49 2=50 3=51
4554 IF R_bchk<1 OR R_bchk>3 THEN
4555 R_bchk=1
4556 END IF
4557 CASE 9
4558 Rep_char=NUM(Rdata$[9,9])
4559 CASE 10
4560 R_capas=FNUnchar(Rdata$[10,10])
4561 IF BIT(R_capas,1) THEN ! extended length packets
4562 Rcap_lp=1
4563 R_windo=FNUnchar(Rdata$[11,11])
4564 R_maxl1=FNUnchar(Rdata$[12,12])
4565 R_maxl2=FNUnchar(Rdata$[13,13])
4566 R_maxl=R_maxl1*95+R_maxl2
4567 END IF
4568 !
4569 IF BIT(R_capas,3) THEN Rcap_a=1
4570 END SELECT
4571 NEXT S
4572 RETURN
4573 SUBEND
4574 !======================================================================
4575 SUB Rpack(Pktype$,Rdata$,INTEGER Rseq,Rcvpkt$,Sndpkt$,INTEGER Npak,Retry_count,User_break,Emsg$)
4576 Rpack: !
4577 ! Pktype$ Packet Type S,A,F,D,Z,B N,Y
4578 ! Rdata$ Packet Data Area. or User Abort Message
4579 ! Rseq Incomming Packet Sequence Number
4580 ! Rcvpkt$ Raw Packet Received
4581 ! Sndpkt$ Previous Packet Sent - required for resend on kbd interrupt
4582 ! Npak Expected packet sequence number
4583 ! Retry_count
4584 ! user_break=1 if user client interrupts file transfer
4585 ! Emsg$ Error Msg created by receive packet, or client interrupt
4586 !
4587 OPTION BASE 1
4588 COM /Crt/ Crt_lines,Crt_width
4589 COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
4590 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
4591 COM /Kerm2/ State$,Cchksum$,Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
4592 !
4593 DIM A$[1],K$[256],Rcvchksum$[20],Misc$[80]
4594 INTEGER Chksum,Rc,Plen,Dlen,Cchksum
4595 INTEGER Endl,Chkpos,Chk
4596 !------------------------------------------------------------------------
4597 ON ERROR GOSUB Rp_err
4598 K$=""
4599 ENABLE
4600 ON KBD,2 GOSUB Kbd_int
4601 Get_packet: !
4602 IF Timer THEN ON DELAY Ptmo,10 GOTO R_tmo
4603 Rdata$=""
4604 Rcvpkt$=""
4605 !
4606 REPEAT ! Until a Packet Header (mark) is found
4607 IF Com_card=98628 THEN
4608 STATUS Com_port,5;B_len
4609 ELSE
4610 STATUS @In_buff,4;B_len
4611 END IF
4612 IF B_len THEN ENTER @In_buff USING "#,K";A$
4613 IF LEN(A$) THEN A$=CHR$(BINAND(NUM(A$),127)) ! strip parity
4614 UNTIL A$=""
4615 Rcvpkt$[1,1]=A$ ! store packet mark
4616 !
4617 ! MARK FOUND - ENTER THE REST OF THE PACKET
4618 !
4619 ! ## If Comm Interrupt Occurs and buffer is flushed, an end of buffer occurs here
4620 !
4621 !
4622 I=2
4623 LOOP
4624 ENTER @In_buff USING "#,K";A$
4625 Rcvpkt$[I,I]=A$
4626 IF I=2 THEN
4627 Plen=FNUnchar(Rcvpkt$[2,2])! Packet Length
4628 END IF
4629 I=I+1
4630 EXIT IF I>Plen+3 ! mark+len+plen+eol = plen+3
4631 END LOOP
4632 OFF DELAY
4633 !
4634 ! Kermit Packet Received ----------------------
4635 !
4636 Beginl=POS(Rcvpkt$,"")
4637 Rcvpkt$=Rcvpkt$[Beginl]
4638 Endl=POS(Rcvpkt$,"")
4639 IF (Endl=0) THEN Endl=POS(Rcvpkt$,"
") ! if no CR then use LF
4640 IF NOT Endl THEN
4641 Endl=LEN(Rcvpkt$)
4642 END IF
4643 Rcvpkt$=Rcvpkt$[Beginl,Endl]
4644 Plen=FNUnchar(Rcvpkt$[2,2]) ! Packet Length
4645 Dlen=Plen-3 ! Data Length
4646 Chkpos=Plen+2 ! Position of checksum char
4647 Rseq=FNUnchar(Rcvpkt$[3,3]) ! Rec Sequence Number
4648 Pktype$=Rcvpkt$[4,4] ! Packet Type
4649 !
4650 ! Check Sequence
4651 ! If Local Kermit was paused, there could be multiple packets
4652 ! buffered with a sequence number < the current Npak.
4653 !
4654 ! Check buffer - if there is a packet, go get it, else ack this packet
4655 ! and force the next packet to be sent.
4656 !
4657 IF (Rseq<Npak MOD 64) THEN ! loop back and receive next packet
4658 !
4659 ! PRINT TABXY(1,Crt_lines);"Rseq<Npak: Loop to get another packet "
4660 IF Com_card=98628 THEN
4661 STATUS Com_port,5;B_len
4662 ELSE
4663 STATUS @In_buff,4;B_len
4664 END IF
4665 !
4666 IF B_len THEN
4667 GOTO Get_packet
4668 ELSE
4669 ! PRINT TABXY(1,Crt_lines);"Acking packet=Rseq (rseq<npak) to force next packet: rseq=npak"
4670 Spack("","Y",Rseq,Sndpkt$) ! ack current (Rseq) packet
4671 OUTPUT @Out_buff;Sndpkt$
4672 GOTO Get_packet ! Go get expected (Npak) packet
4673 END IF
4674 END IF
4675 !
4676 PRINT TABXY(1,Crt_lines);RPT$(" ",80)
4677 IF Rseq>Npak THEN ! exit rpack with a "Q" pktype$
4678 Pktype$="Q"
4679 PRINT TABXY(1,Crt_lines);"Packet out of sequence - ahead of expected packet ";Rseq,Npak,"subexit"
4680 SUBEXIT
4681 END IF
4682 !-------------------------------------------------------------------
4683 ! A good packet in the required sequence has been received
4684 ! Flush the input buffer
4685 !
4686 IF Com_card=98628 THEN
4687 STATUS Com_port,5;B_len
4688 WHILE B_len
4689 ENTER @In_buff;Misc$
4690 STATUS Com_port,5;B_len
4691 END WHILE
4692 ELSE
4693 STATUS @In_buff,3;Fp
4694 ! CONTROL @In_buff,5;Fp ! Set empty pointer to fill pointer
4695 END IF
4696 !
4697 ! Extract Data from Packet into Rdata$
4698 !
4699 IF Dlen THEN ! If Packet Has Data
4700 ON ERROR GOTO Nodl
4701 Rdata$[1,Dlen]=Rcvpkt$[5,Plen+1]
4702 GOTO Dldone
4703 Nodl:OFF ERROR
4704 FOR I=1 TO Dlen
4705 Rdata$[I,I]=Rcvpkt$[4+I]
4706 NEXT I
4707 END IF
4708 Dldone:OFF ERROR
4709 !
4710 ! Check for Good Packet Checksum
4711 !
4712 Chk=0
4713 FOR I=2 TO Plen+1
4714 Chk=Chk+NUM(Rcvpkt$[I,I])
4715 NEXT I
4716 Cchksum=BINAND(Chk+(BINAND(Chk,192)/64),63) ! Computed Checksum
4717 Cchksum$=FNTochar$(Cchksum)
4718 Rcvchksum$=Rcvpkt$[Chkpos;1]
4719 IF Rcvchksum$<>Cchksum$ THEN Pktype$="Q"
4720 SUBEXIT
4721 !---------------------------------
4722 R_tmo: !
4723 BEEP 2000,.01
4724 OFF DELAY
4725 OFF TIMEOUT
4726 Pktype$="T"
4727 DISP
4728 SUBEXIT
4729 !---------------------------------
4730 Kbd_int: !(rpack)
4731 ! Cancels: ^X (file) ^Z (Batch) ^E (Err Quit) ^C(Quit) <ent> Retry
4732 !
4733 ! To Interrupt File Receive:
4734 !
4735 ! ACK Packet with: X in data field to abort single file
4736 ! Z in data field to abort entire batch
4737 ! E Packet with Error Msg if Sender doesn't recognize file interruption.
4738 !
4739 BEEP 300,.02
4740 User_break=1
4741 K$=KBD$
4742 SELECT K$[1,1]
4743 CASE " ","" ! ^?
4744 PRINT TABXY(1,Crt_lines);
4745 PRINT "Cancels: ^X (file) ^Z (Batch) ^E (Protocol) ^C(Quit) <Ent> Retry"
4746 CASE "" ! ^X ! Cancel File
4747 Pktype$="X"
4748 Rdata$="X" ! discard file
4749 Emsg$="Single File Cancelled by Client"
4750 SUBEXIT
4751 CASE CHR$(26) ! ^Z ! No Batch Process Yet (wildcard send/rec ?)
4752 Pktype$="X"
4753 Rdata$="Z"
4754 Emsg$="Batch Receive Cancelled by Client"
4755 SUBEXIT
4756 CASE "" ! ^E ! Goto Error (Abort) State
4757 State$="E"
4758 Pktype$="E"
4759 Emsg$="File Aborted by Client (E Packet)"
4760 SUBEXIT
4761 CASE "" ! ^C ! Quit without Notifying Remote Kermit
4762 State$="X"
4763 Pktype$="X"
4764 Rdata$="^C" ! Notify sendz not to notify host
4765 Emsg$="Transfer Aborted by Client - Host Not Notified"
4766 SUBEXIT
4767 CASE " " ! CTRL-ENTER resend - no abort
4768 User_break=0
4769 SELECT K$[2,2]
4770 CASE "E"
4771 OUTPUT @Out_buff;Sndpkt$
4772 ! Retry_count=Retry_count+1 ! gets incr if SUBEXIT is used
4773 PRINT TABXY(25,11);Retry_count
4774 SUBEXIT
4775 CASE ELSE
4776 ! OUTPUT KBD;K$&" E"
4777 END SELECT
4778 CASE ELSE
4779 User_break=0
4780 END SELECT
4781 RETURN
4782 !--------------------------------------
4783 Rp_err: !
4784 SELECT ERRN
4785 CASE 59 ! end of buffer found
4786 ! DISP "end of buffer error in Rpak - calling CI "
4787 Pktype$="T"
4788 SUBEXIT
4789 ! CALL Com_interrupt
4790 CASE ELSE
4791 DISP ERRM$
4792 PAUSE
4793 END SELECT
4794 RETURN
4795 !------------------------------------------
4796 SUBEND
4797 !=======================================================================
4798 Init_ramdisc:SUB Init_ramdisc(Kbytes,OPTIONAL Clear$,Sectors)
4799 !
4800 ! This routine cannot check for existance of a RAM Disc before
4801 ! initializing because of nested ON ERROR conflicts. If this routine
4802 ! is called from an ON ERROR routine,then an error in this routine
4803 ! cannot be trapped.
4804 !
4805! Initialize Ram Disc
4806!
4807 DIM Sav_msi$[256]
4808 Cat_msi$=":,0,0"
4809 INTEGER Sector(1:128)
4810 Sav_msi$=SYSTEM$("MSI")
4811 INITIALIZE ":,0,0",0 ! destroy any existing ram disc
4812 DISP "Creating RAM Volume - please wait"
4813 Avm=VAL(SYSTEM$("AVAILABLE MEMORY"))
4814 Bytes=Avm-100000 ! SAVE 100 KB
4815 Kbytes=Bytes/1000
4816 Kbytes=MAX(Kbytes,0)
4817 Kbytes=MIN(Kbytes,3000) ! 3 Mb Max
4818 IF Kbytes>0 THEN
4819 Size=INT(Kbytes*4) ! 4 sectors PER kB
4820 INITIALIZE ":,0,0",Size
4821 !------------------------------------------
4822 IF NPAR>1 THEN
4823 IF Clear$="CLEAR" THEN
4824 MASS STORAGE IS ":,0,0"
4825 Get_volinfo(Dir_st,Dir_len,Vol_lbl$)
4826 Cl_sect=Size
4827 IF NPAR>2 THEN Cl_sect=MIN(Sectors,500)
4828 DISP "Clearing";Cl_sect;" Disc Sectors"
4829 FOR Sect=Dir_st+Dir_len-1 TO Cl_sect
4830 Phywrite(Sect,Sector(*))
4831 NEXT Sect
4832 END IF
4833 END IF
4834 END IF
4835 MASS STORAGE IS Sav_msi$
4836 DISP
4837 SUBEND
4838 !-----------------------------------------------------------------------
4839 Shutdown:SUB Shutdown(OPTIONAL INTEGER Transfer_on) ! Shutdown Serial Transfers
4840 !
4841 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
4842 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[2048] BUFFER,Com_card
4843 !
4844 IF Com_card=98628 THEN SUBEXIT
4845 !
4846 STATUS Com_port,10;Uart ! clear frame errors
4847 !
4848 ! Check if transfer is running
4849 !
4850 STATUS @Out_buff,0;O_stat ! IS PATH VALID ?
4851 IF O_stat<3 THEN
4852 IF NPAR THEN Transfer_on=0
4853 SUBEXIT
4854 END IF
4855 !
4856 STATUS @Out_buff,11;O_stat
4857 IF BIT(O_stat,6) THEN
4858 IF NPAR THEN Transfer_on=1
4859 CONTROL @Out_buff,9;0 ! non-continuous
4860 WAIT FOR EOT @Com_out ! normal transfer shutoff
4861 END IF
4862 !
4863 STATUS @In_buff,10;I_stat
4864 IF BIT(I_stat,6) THEN
4865 CONTROL @In_buff,8;0 ! non-continuous
4866 ABORTIO @Com_in ! shutoff
4867 END IF
4868 STATUS Com_port,10;Uart ! clear any frame errors
4869 SUBEND
4870 !-----------------------------------------------------------------------
4871 SUB Startup
4872 Startup: !
4873 !
4874 !
4875 COM /Port/ @Out_buff,@Com_out,Output_buffer$[2048] BUFFER
4876 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[2048] BUFFER,Com_card
4877 !
4878 ON ERROR GOSUB Startup_err
4879 ON TIMEOUT Com_port,.5 GOSUB Startup_err
4880 !
4881 ! CHECK IF TRANSFERS RUNNING
4882 !
4883 Retry_xfer: !
4884 STATUS @In_buff,0;Valid_path
4885 IF Valid_path=3 THEN ! buffer
4886 STATUS @In_buff,10;I_stat
4887 IF BIT(I_stat,6) THEN
4888 CALL Shutdown
4889 END IF
4890 END IF
4891 !
4892 !
4893 IF Com_card=98628 THEN
4894 ASSIGN @Out_buff TO Com_port ! no xfer buffers required
4895 ASSIGN @In_buff TO Com_port
4896 SUBEXIT
4897 ELSE
4898 STATUS Com_port,10;Dummy ! CLEAR ERRORS
4899 ASSIGN @Com_in TO Com_port
4900 ASSIGN @Com_out TO Com_port
4901 ASSIGN @In_buff TO BUFFER Input_buffer$
4902 ASSIGN @Out_buff TO BUFFER Output_buffer$
4903 END IF
4904 !
4905 ! START OUTBOUND TRANSFER FIRST
4906 !
4907 STATUS Com_port,10;Uart ! clear errors - prevent error 167
4908 TRANSFER @Out_buff TO @Com_out;CONT
4909 REPEAT
4910 STATUS @Out_buff,11;Out_status
4911 UNTIL BIT(Out_status,6)=1
4912 !
4913 OUTPUT @Out_buff;""; ! kickstart transfer
4914 !
4915 ! Inbound may receive buffer overrun error 167 - io status error
4916 ! due to an abortive interrupt (ie buff overrun) in the interface.
4917 ! An abortive interrupt will shut off a transfer.
4918 !
4919 TRANSFER @Com_in TO @In_buff;CONT
4920 REPEAT
4921 STATUS @In_buff,10;Inb_status
4922 UNTIL BIT(Inb_status,6)=1
4923 !
4924 ! CHECK FOR ANY TRANSFER ERROR
4925 !
4926 STATUS @In_buff,10;I_stat
4927 STATUS @Out_buff,11;O_stat
4928 !
4929 IF (BIT(I_stat,4)) OR (BIT(O_sta,4)) THEN
4930 GOTO Retry_xfer
4931 END IF
4932 SUBEXIT
4933 !=-------------------------------
4934 Startup_err: !
4935 SELECT ERRN
4936 CASE 167,168,0 ! IO Status Error
4937 CALL Com_interrupt
4938 STATUS Com_port,10;Uart ! clear errors - prevent error 167
4939 ! DISP "UART: ";Uart,"startup"
4940 ON ERROR GOSUB Startup_err
4941 ON TIMEOUT Com_port,.5 GOSUB Startup_err
4942 CASE ELSE
4943 BEEP
4944 DISP ERRM$
4945 PAUSE
4946 END SELECT
4947 RETURN
4948 SUBEND
4949 !-----------------------------------------------------------------------
4950 SUB Reset_port
4951 Reset_port: !
4952 !
4953 COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
4954 COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
4955 COM /Frame/ Baud,Data_bits,Stop_bits,On_off$,Parity_type$
4956 COM /Frame/ Flow$,Hshake$
4957 !
4958 SELECT Com_card
4959 CASE 98626
4960 STATUS Com_port,10;Uart ! clear any frame errors
4961 CONTROL Com_port,0;1 ! RESET PORT - DISCONNECT MODEM
4962 CONTROL Com_port,5;1+2 ! force dtr,rts active
4963 CONTROL Com_port,12;128+32+16 ! Disable modem handshake
4964 CASE 98628
4965 CONTROL Com_port,0;1 ! Reset and read config switches
4966 CONTROL Com_port,3;1 ! async protocol after next reset
4967 ! control Com_port,5;0 ! terminate trans and turnaround if half-duplex
4968 ! control Com_port,6;1 ! BREAK
4969 CONTROL Com_port,8;1+2! RTS DTR Set Active
4970 ! CONTROL Com_port,12;2 ! 2 = start autodial 1=connect (dtr,rts)
4971 CONTROL Com_port,13;164 ! INT MASK 4=UART 32=lost car 128=break
4972 CONTROL Com_port,14;0 ! Control Blocks Disabled (queued with data)
4973 CONTROL Com_port,15;0 ! MODEM INT MASK
4974 ! CONTROL Com_port,16;25 ! Connect Timeout (reset=25 sec)
4975 ! CONTROL Com_port,17;10 ! No activity Timeout (reset=10 min )
4976 ! CONTROL Com_port,18;40 ! Lost Carrier Timeout 10xMS (reset=40)
4977 ! CONTROL Com_port,19;10 ! CTS (send) Timeout (reset=10 sec)
4978 ! CONTROL Com_port,20;9 ! BAUD RATE 9=1200 11=2400 14=9600
4979 ! CONTROL Com_port,21;9 ! REC RATE 9=1200 11=2400 14=9600
4980 !
4981 SELECT Flow$
4982 CASE "NONE" ! Protocol (SW) Handshake
4983 CONTROL Com_port,22;0 ! 0:none 1:enq-host 2:enq-term
4984 CASE "XON/XOFF" ! 3-5: xon/off host/term/both
4985 CONTROL Com_port,22;5
4986 CASE "ENQ/ACK"
4987 CONTROL Com_port,22;2
4988 CASE ELSE
4989 CONTROL Com_port,22;0
4990 END SELECT
4991 !
4992 IF Hshake$="ON" THEN
4993 CONTROL Com_port,23;3! HDWR HNDSHK: 0=off/non-modem 1:full
4994 ELSE ! 2=hlf dup mod 3=CTS/DCD
4995 CONTROL Com_port,23;0
4996 END IF
4997 CONTROL Com_port,24;127! Control Char Mask: pass null,eol,proto,del,rub
4998 ! change uart err to underscore (127-pass all)
4999 CONTROL Com_port,26;17! First Protocol Hndshk 6=ack (17=dc1/XON)
5000 CONTROL Com_port,27;19! First Protocol Hndshk 5=enq (19=dc3/XOFF)
5001 CONTROL Com_port,28;1 ! length of inbound EOL (reset=2)
5002 CONTROL Com_port,29;13! first EOL (13=Cr)
5003 CONTROL Com_port,30;10! second EOL (10=Lf)
5004 ! CONTROL Com_port,31;1 ! prompt$ length (1)
5005 ! CONTROL Com_port,32;17 ! first prompt$ char (17=dc1)
5006 ! CONTROL Com_port,33;0 ! second prompt$ char (0=null)
5007 !
5008 ! CONTROL Com_port,34;3 ! frame length (databits=card dip switch)
5009 ! 2=7 3=8 (parity must be none,even,odd)
5010 ! CONTROL Com_port,35;0 ! Stop Bits: (0=1) 1=1.5 2=2
5011 ! CONTROL Com_port,36;0 ! Parity 0=none 1=odd 2=even 3="0" 4="1"
5012 CONTROL Com_port,37;0 ! Inter-char time gap (0=none) <255 char times
5013 CONTROL Com_port,39;4 ! Set BREAK char time (4) 2-255
5014 CALL Set_frame(Baud)
5015 END SELECT
5016 !-------------------------
5017 SUBEND
5018 !========================================================================
5019 SUB Parse_filename(F$,F_msi$,F_path$)
5020 Parse_filename: !
5021 ! F$ is consumed and filename is returned in its place
5022 !
5023 DIM Misc$[256]
5024 INTEGER Sl_pos
5025 !
5026 IF LEN(F_msi$) THEN
5027 IF NOT POS(F$,":") THEN F$=F$&F_msi$
5028 END IF
5029 !
5030 Filename$=""
5031 F_msi$=""
5032 F_path$=""
5033 !
5034 ! If MSI exists strip it off of F$
5035 !
5036 IF POS(F$,":") THEN ! MSI SPECIFIED
5037 F_msi$=F$[POS(F$,":")]
5038 F$=F$[1,POS(F$,":")-1] ! Strip MSI
5039 END IF
5040 !
5041 ! Strip PATH from F$, keep last slash on pathname
5042 !
5043 IF POS(F$,"/") THEN
5044 Misc$=REV$(F$)
5045 Sl_pos=POS(Misc$,"/") ! SLASH POSITION
5046 F$=REV$(Misc$[1,Sl_pos-1])
5047 F_path$=REV$(Misc$[Sl_pos])
5048 END IF
5049 SUBEND
5050 !=========================================================================
5051 SUB Get_volinfo(Dir_st,Dir_len,Vol_lbl$)
5052 Gvi: !
5053 ! Returns the starting sector of the volume directory, its length
5054 !
5055 INTEGER I,Msb,Lsb,X
5056 Dir_st=0
5057 Dir_len=0
5058 Vol_lbl$=""
5059 COM /Sctr/ INTEGER Sctr(0:127)
5060 Phyread(0,Sctr(*)) ! read LIF Volume Header
5061 Dir_st=(Sctr(4)*2^16)+Sctr(5)
5062 Dir_len=(Sctr(8)*2^16)+Sctr(9)
5063 ! DISP "DIR START: ";Dir_st,"DIR LENGTH : ";Dir_len
5064 FOR I=1 TO 3
5065 Temp=Sctr(I)
5066 IF Sctr(I)<0 THEN Temp=Sctr(I)+65536
5067 Msb=Temp DIV 256
5068 Lsb=Temp MOD 256
5069 Vol_lbl$=Vol_lbl$&CHR$(Msb)&CHR$(Lsb)
5070 NEXT I
5071 Done:!
5072 SUBEND
5073 !-------------------------------------------------------------------------
5074 SUB Get_fileinfo(Filename$,REAL Fs,Fl,Dir_entry_sec,Dir_entry,OPTIONAL INTEGER T,V,P,R)
5075 Gfi: !
5076 ! Pass-in Parameters:
5077 ! Filename$ File Name Only - no msi
5078 !
5079 ! Return Parameters
5080 !
5081 ! Fs Start Sector of File
5082 ! Fl Number of sectors in file
5083 ! Dir_entry_sec Directory Sector Containing File Entry
5084 ! Dir_entry Dir Entry Number in that Sector (0-7 per sector)
5085 ! T File Type Number
5086 ! V Volume number
5087 ! P,R Protection Numbers
5088 !----------------------------------------------
5089 INTEGER I,Fword,Msb,Lsb,X
5090 COM /Sctr/ INTEGER Sctr(0:127)
5091 DIM Entryname$[10],Vol_lbl$[6]
5092 Get_volinfo(Ds,Dl,Lbl$) ! Get Dir Start, Dir Length, Vol Label
5093 !
5094 IF POS(Filename$,":") THEN CALL Parse_filename(Filename$,F_msi$,F_path$)
5095 FOR Sector=Ds TO Ds+Dl-1 ! Search Directory for File Match
5096 Phyread(Sector,Sctr(*))
5097 FOR Entry=0 TO 7 ! 8 File entries per sector
5098 Entryname$=""
5099 Fword=Entry*16
5100 IF Sctr(Fword+5)=-1 THEN
5101 Next_open_entry=Entry ! Gives Next open Dir entry
5102 Next_open_sec=Sector
5103 GOTO Done_find
5104 END IF
5105 IF Sctr(Fword+5)=0 THEN Nexte ! 0 = null entry
5106 FOR I=0 TO 4 ! 5 words = 10 Char Name
5107 Word_2char(Sctr(Fword+I),Msb,Lsb)
5108 Entryname$=Entryname$&CHR$(Msb)&CHR$(Lsb)
5109 NEXT I
5110 IF TRIM$(Entryname$)=TRIM$(Filename$) THEN
5111 Dir_entry_sec=Sector ! dir entry position
5112 Dir_entry=Entry
5113 ! PRINT Dir_entry_sec,Dir_entry,Fword,Filename$
5114 GOTO Found_it
5115 END IF
5116 Nexte:NEXT Entry
5117 NEXT Sector
5118 Done_find:S=-1
5119 GOTO Done
5120 !
5121 Found_it: !
5122 ! PRINT USING "8(K,X),/";Sctr(*)
5123 Fs=(Sctr(Fword+6)*2^16)+Sctr(Fword+7) ! S=Start sector of file
5124 Fl=(Sctr(Fword+8)*2^16)+Sctr(Fword+9) ! L=Number of sectors
5125 !
5126 IF NPAR>5 THEN T=Sctr(Fword+5) ! File Type
5127 IF NPAR>8 THEN V=Sctr(Fword+13) ! Volume Number
5128 IF NPAR>9 THEN P=Sctr(Fword+14) ! Protect Code for file
5129 IF NPAR>10 THEN R=Sctr(Fword+15)!
5130 Done:!
5131 SUBEND
5132 !------------------------------------------------------------------------
5133 SUB Word_2char(INTEGER N,Msb,Lsb)
5134 !
5135 ! Extracts 2 Character Bytes from an integer (word)
5136 ! Returns the characters as Msb and Lsb integers
5137 !
5138 !
5139 Temp=N
5140 IF N<0 THEN Temp=N+65536
5141 Msb=Temp DIV 256
5142 Lsb=Temp MOD 256
5143 SUBEND
5144 !----------------------------------------------------------------------
5145 Convert:SUB Convert(Sf$,Type$,INTEGER Rc,OPTIONAL Flen,Df$)
5146 !
5147 ! Sf$: complete filespec for source file to change
5148 ! Df$: Filespec or destination msi$ for converted file
5149 ! Convert Sf$ to the Type$ specified and copy result to D_msi$
5150 !
5151 COM /Crt/ Crt_width,Crt_lines
5152 Debug=1
5153 ON ERROR GOSUB Cnvt_err
5154 REAL S,L,Dir_entry_sec
5155 INTEGER T,V,R,P,Asector(0:127)
5156 DIM Filename$[80],Sav_msi$[256],S_msi$[256]
5157 !
5158 Sav_msi$=SYSTEM$("MSI")
5159 Parse_filename(Sf$,S_msi$,S_path$)
5160 Filename$=S_path$&Sf$&S_msi$
5161 IF FNHfs_disc(S_msi$) THEN ! HFS - must copy to ramdisc
5162 S_path$=""
5163 IF S_msi$=":,0,0" THEN
5164 ! file already on ramdisc
5165 ELSE
5166 Init_ramdisc(Kbytes)
5167 S_msi$=":,0,0"
5168 DISP "Copying ";Filename$;" TO ";Sf$&S_msi$
5169 COPY Filename$ TO Sf$&S_msi$
5170 END IF
5171 END IF
5172 !
5173 Filename$=S_path$&Sf$&S_msi$
5174 MASS STORAGE IS S_msi$
5175 Pcode=32*256+32 ! protect code for non-ascii files
5176 Get_fileinfo(Sf$,S,L,Dir_entry_sec,Dir_entry,T,V,P,R)
5177 IF Dir_entry_sec=0 THEN
5178 DISP "Cant find ";Sf$;" In Disc Directory "
5179 SUBEXIT
5180 END IF
5181 !
5182 Phyread(Dir_entry_sec,Asector(*))
5183 Fword=Dir_entry*16
5184 Cur_type=Asector(Fword+5) ! File Type
5185 !
5186 SELECT Cur_type
5187 CASE 1
5188 Cur_type$="ASCII"
5189 CASE -5791
5190 Cur_type$="BDAT"
5191 CASE -5808
5192 Cur_type$="PROG"
5193 CASE -5813
5194 Cur_type$="HP-UX"
5195 CASE -5775
5196 Cur_type$="BIN"
5197 CASE -5822
5198 Cur_type$="SYSTM"
5199 CASE ELSE ! Pascal ?
5200 Cur_type$="FOREIGN"
5201 END SELECT
5202 ! DISP "Current file type is ";Cur_type$
5203 New_type$=Type$
5204 Get_type_num: !
5205 SELECT New_type$
5206 CASE "ASCII"
5207 New_type=1
5208 CASE "BDAT"
5209 New_type=-5791
5210 CASE "PROG"
5211 New_type=-5808
5212 CASE "HP-UX","HPUX"
5213 New_type=-5813
5214 CASE "BIN"
5215 New_type=-5775
5216 CASE "SYSTM","SYSTEM"
5217 New_type=-5822
5218 CASE ELSE
5219 New_type=VAL(New_type$)
5220 DISP "Change Type to ";New_type
5221 OUTPUT KBD;"Y";" H";
5222 ENTER KBD;Ans$
5223 IF UPC$(Ans$[1,1])="Y" THEN
5224 ELSE
5225 SUBEXIT
5226 END IF
5227 END SELECT
5228 !
5229 DISP "Changing File Type to ";New_type$,New_type
5230 WAIT .5
5231 Asector(Fword+5)=New_type
5232 !
5233 IF New_type$<>"ASCII" THEN Asector(Fword+14)=Pcode
5234 IF New_type$="BDAT" THEN Asector(Fword+15)=128 ! 128=256 Bytes per rec
5235 IF New_type$="PROG" THEN
5236 GOTO Skip_adj_prog
5237 !
5238 ! Make sure EOF is on a sector boundary (256 byte)
5239 ! Therefore the low-byte should always be 00x
5240 !
5241 Hibyte=Asector(Fword+6)
5242 Lobyte=Asector(Fword+7)
5243 IF Lobyte>0 THEN
5244 DISP "Adjusting EOF to a sector boundary"
5245 PAUSE
5246 Asector(Fword+6)=Hibyte+1
5247 Asector(Fword+7)=0
5248 END IF
5249 Skip_adj_prog: !
5250 !
5251 ! Set Record size to 0080x for PROG Files
5252 !
5253 Asector(Fword+15)=128 ! x0080
5254 END IF
5255 !
5256 IF NPAR>3 THEN ! File-length Flen was specified
5257 IF New_type$="PROG" THEN
5258 Asector(Fword+8)=INT(Flen/256)
5259 Asector(Fword+9)=Flen MOD 256
5260 END IF
5261 END IF
5262 Phywrite(Dir_entry_sec,Asector(*))
5263 Rc=1
5264 !
5265 IF New_type$="HP-UX" THEN ! Reset EOF pointer
5266 ASSIGN @T TO Filename$
5267 STATUS @T,3;Defr
5268 CONTROL @T,7;Defr
5269 END IF
5270 !
5271 IF Napr>4 THEN
5272 Df$=D_msi$
5273 Parse_filename(Df$,D_msi$,D_path$)
5274 IF NOT LEN(Df$) THEN Df$=Sf$
5275 COPY Filename$ TO D_path$&Df$&D_msi$
5276 END IF
5277 MASS STORAGE IS Sav_msi$
5278 DISP
5279 SUBEXIT !-------------------------------------------------------------
5280 Cnvt_err: !
5281 DISP ERRM$
5282 SELECT ERRN
5283 CASE 54 ! duplicate filename
5284 DISP "Purging: ";Sf$&S_msi$
5285 PURGE Sf$&S_msi$
5286 WAIT 1
5287 DISP
5288 CASE ELSE
5289 DISP ERRM$;" in Convert"
5290 END SELECT
5291 RETURN
5292 SUBEND
5293 !========================================================================
5294 DEF FNHfs_disc(Msi$)
5295 ALLOCATE Cat$(0:3)[80] ! 0:MSI 1:LABEL 2:FORMAT 3:SPACE
5296 IF NOT LEN(Msi$) THEN Msi$=SYSTEM$("MSI")
5297 CAT Msi$ TO Cat$(*)
5298 IF POS(Cat$(2),"HFS") THEN
5299 RETURN 1
5300 ELSE
5301 RETURN 0
5302 END IF
5303 FNEND
5304 !------------------------------------------------------------------------
5305 Disc_space:SUB Disc_space(Msi$,Total,Largest_hole,Hole_sum,Format$)
5306 !
5307 ! Format$ HFS,LIF
5308 ! All amounts in Sectors
5309 !
5310 INTEGER Recsz,Num_files,Cat_size
5311 REAL Flen
5312 !
5313 Cat_size=150
5314 ALLOCATE Cat$(1:Cat_size)[80] ! 1:MSI 2:LABEL 3:FORMAT 4:SPACE
5315 ON ERROR GOSUB Space_err
5316 CAT Msi$ TO Cat$(*);COUNT Num_files ! 7 LINE HEADER
5317 REDIM Cat$(1:Num_files)
5318 Num_files=Num_files-7
5319 ENTER Cat$(4);Total ! SECTORS
5320 Format$=TRIM$(Cat$(3)[POS(Cat$(3),":")+1])
5321 Hole_sum=0
5322 Hole=0
5323 Largest_hole=0
5324 !
5325 DEALLOCATE Cat$(*)
5326 IF Num_files>=Cat_size THEN GOSUB Get_count
5327 IF Num_files=0 THEN
5328 Largest_hole=Total
5329 SUBEXIT
5330 END IF
5331 IF NOT POS(Format$,"HFS") THEN
5332 ALLOCATE Cat$(1:Num_files)[80]
5333 CAT Msi$ TO Cat$(*);NO HEADER,EXTEND
5334 FOR I=1 TO Num_files-1
5335 Start_sec=VAL(Cat$(I)[40,47])
5336 Flen=VAL(Cat$(I)[20,28])
5337 Recsz=VAL(Cat$(I)[33,39])
5338 IF Recsz=1 THEN Flen=Flen/256
5339 Next_sec=VAL(Cat$(I+1)[40,47])
5340 Del_sec=Next_sec-Start_sec
5341 Hole=Del_sec-Flen
5342 Hole_sum=Hole_sum+Hole
5343 IF Hole>Largest_hole THEN
5344 Largest_hole=Hole
5345 END IF
5346 NEXT I
5347 Last_contig=Total-Hole_sum
5348 IF Last_contig>Largest_hole THEN Largest_hole=Last_contig
5349 ELSE
5350 Largest_hole=Total
5351 END IF
5352 SUBEXIT !---------------------------------------------------
5353 Get_count: !
5354 Num_try=100
5355 REPEAT
5356 Num_try=Num_try+25
5357 ALLOCATE Cat$(1:Num_try)[80]
5358 CAT Msi$ TO Cat$(*);NAMES,COUNT Num_files,NO HEADER ! HEADER NOT INC
5359 DEALLOCATE Cat$(*)
5360 UNTIL Num_files<Num_try
5361 RETURN
5362 !---------------------------
5363 Space_err: !
5364 SELECT ERRN
5365 CASE 76 ! INCORRECT UNIT CODE
5366 SUBEXIT
5367 CASE ELSE
5368 DISP ERRM$
5369 PAUSE
5370 END SELECT
5371 RETURN
5372 SUBEND
5373 !------------------------------------------------------------------------
5374 SUB Get_cat_entry(F$,F_msi$,F_path$,Filename$,File_found,Cat_entry$)
5375 Get_cat_entry: !
5376 ON ERROR GOSUB Gce_err
5377 ALLOCATE Cat$(1:50)[80],Misc$[256]
5378 File_found=0
5379 REPEAT
5380 DISP "Checking File Access"
5381 !
5382 ! Warning, CAT;SELECT may find more than one file
5383 !
5384 CAT F_path$&F_msi$ TO Cat$(*);SELECT F$,COUNT Num_files !FILE IS ELMENT 8
5385 FOR I=8 TO Num_files
5386 IF POS(Cat$(I),F$) THEN
5387 Cat_entry$=Cat$(I)
5388 Misc$=TRIM$(Cat_entry$[1,21])
5389 IF Misc$=F$ THEN
5390 File_found=1
5391 I=Num_files
5392 END IF
5393 END IF
5394 NEXT I
5395 IF NOT File_found THEN
5396 GOSUB Get_filename
5397 END IF
5398 UNTIL File_found>0
5399 DISP
5400 SUBEXIT
5401 Get_filename:!
5402 DISP "File not found in catalog - please check name & path, (blank to abort) "
5403 OUTPUT KBD;F_path$&F$&F_msi$;" H";
5404 ENTER KBD;Filename$
5405 IF NOT LEN(TRIM$(Filename$)) THEN SUBEXIT
5406 F$=Filename$
5407 Parse_filename(F$,F_msi$,F_path$)
5408 Filename$=F_path$&F$&F_msi$
5409 RETURN
5410 !--------------------------------------
5411 Gce_err: !
5412 SELECT ERRN
5413 CASE 53 ! improper file name
5414 GOSUB Get_filename
5415 CASE ELSE
5416 END SELECT
5417 File_found=0
5418 RETURN
5419 SUBEND
5420 !-----------------------------------------------------------------------
5421 Prompt:SUB Prompt(Prompt$,Init$,Ans$,Flag)
5422 DISP Prompt$
5423 OUTPUT KBD;Init$;" H";
5424 ENTER KBD;Ans$
5425 DISP
5426 Ans$=TRIM$(UPC$(Ans$))
5427 A_len=LEN(Ans$)
5428 IF NOT A_len THEN Flag=0
5429 IF A_len=1 AND Ans$="N" THEN Flag=0
5430 IF A_len=1 AND Ans$="Y" THEN Flag=1
5431 IF POS(Ans$,"YES") THEN Flag=1
5432 IF POS(Ans$,"NO") THEN Flag=0
5433 SUBEND
5434 !------------------------------------------------------------------------
5435 More:SUB More(Filename$,Pdev,Cmds$)
5436 !
5437 OPTION BASE 1
5438 DIM Line$[256],Misc$[256],K$[256]
5439 INTEGER Pline,Paging,Rc,File_type,Crt_lines,Print_abort
5440 !-------------------------------------------------------
5441 Sav_prt$=SYSTEM$("PRINTER IS")
5442 PRINTER IS CRT
5443 REPEAT
5444 ASSIGN @File TO Filename$;FORMAT ON,RETURN Rc
5445 IF (NOT LEN(Filename$)) OR (Rc) THEN
5446 BEEP 150,.1
5447 DISP "Print Which File ? - Blank to Exit"
5448 OUTPUT KBD;Filename$;
5449 ENTER KBD;Filename$
5450 IF TRIM$(Filename$)="" THEN GOTO Exit_print
5451 END IF
5452 UNTIL NOT Rc
5453 PRINT USING "/,5(K),/";Cmds$;" FILE: ";Filename$;" To Device: ";Pdev
5454 ON ERROR GOTO Print_err
5455 STATUS @File,1;File_type
5456 ON END @File GOTO Exit_print
5457 ON KBD,2 GOSUB Kbd_abort
5458 DISP "Space Bar: Pause/Continue P: Toggle Paging Esc: Quit"
5459 Print_wait=0
5460 STATUS CRT,13;Crt_lines
5461 Crt_lines=Crt_lines-7
5462 Paging=1
5463 One_line=0
5464 !--------------------------------
5465 LOOP
5466 SELECT File_type
5467 CASE 1 !
5468 CASE 2 ! Bdat
5469 ENTER @File;Line$
5470 CASE 3 ! Ascii
5471 ENTER @File;Line$
5472 CASE 4 ! hp-ux
5473 ENTER @File USING "#,K";Line$
5474 END SELECT
5475 !
5476 Pline=Pline+1 ! paging
5477 IF Debug THEN DISP Pline,Crt_lines
5478 IF Pdev=1 AND Paging=1 THEN
5479 IF Pline>=Crt_lines THEN
5480 OUTPUT KBD;" "; ! simulate a "space bar press"
5481 GOSUB Kbd_abort
5482 Pline=1
5483 END IF
5484 END IF
5485 !
5486 IF Pdev>1 THEN
5487 OUTPUT Pdev;Line$ ! to printer
5488 DISP "printer: ",Pdev
5489 END IF
5490 !
5491 IF POS(Line$," ") THEN ! avoid FF to screen
5492 Line$[(POS(Line$," "));1]=" "
5493 END IF
5494 PRINT Line$
5495 IF One_line THEN
5496 OUTPUT KBD;" ";
5497 GOSUB Kbd_abort
5498 END IF
5499 !
5500 WAIT Print_wait
5501 EXIT IF Print_abort=1
5502 END LOOP
5503 Print_err:DISP ERRM$
5504 Exit_print:!
5505 OFF ERROR
5506 OFF KBD
5507 ASSIGN @File TO *
5508 PRINTER IS VAL(Sav_prt$)
5509 DISP
5510 SUBEXIT
5511 Kbd_abort:! Routine to interrupt TYPE/PRINT of file
5512 Misc$=SYSTEM$("KBD LINE")
5513 K$=KBD$
5514 CLEAR LINE ! clear KBD LINE
5515 One_line=0 ! clear single line mode
5516 Ka_2:!
5517 IF NOT LEN(K$) THEN K$=Misc$
5518 K$=UPC$(K$)
5519 Misc$=KBD$
5520 ON KBD,3 GOTO Exit_abort
5521 SELECT K$[1,1]
5522 CASE " "
5523 LOOP ! wait here for next space bar
5524 END LOOP
5525 CASE "" ! = Abort
5526 Print_abort=1
5527 CASE "P" ! P = Toggle Paging Breaks
5528 IF Paging THEN
5529 Paging=0
5530 DISP "paging off"
5531 ELSE
5532 Paging=1
5533 DISP "paging on "
5534 END IF
5535 K$=" "
5536 WAIT .1 ! dwell to lift finger
5537 CASE " "
5538 SELECT K$[2,2]
5539 CASE "^" ! faster
5540 BEEP 300,.01
5541 Print_wait=MAX(0,Print_wait-.1)
5542 CASE "V" ! slower
5543 BEEP 300,.01
5544 Print_wait=Print_wait+.1
5545 CASE "E" ! <ENTER> One Line Feed
5546 One_line=1
5547 END SELECT
5548 IF Debug THEN DISP Print_wait
5549 END SELECT
5550 Exit_abort:ON KBD,2 GOSUB Kbd_abort
5551 K$=KBD$
5552 IF LEN(K$) THEN
5553 K$=UPC$(K$)
5554 IF NOT (K$[1,1]=" ") THEN GOTO Ka_2
5555 END IF
5556 RETURN
5557 SUBEND
5558 !===================== END OF HPKERMIT
5560 SUB Decode_pack(Rdata$,INTEGER Quote,Qbin,Rep_ch)
5561 Decode_pack: !
5562 Dp: !
5563 !
5564 ! Receive Rdata$ (Kermit Packet)
5565 ! Decode all &,#,~ and stuff results into Rdata$
5566 !
5567 INTEGER B,P,Stuff,Qon,Biton,Reps
5568 !
5569 ALLOCATE File_buff$[100] ! use file_buff$ as a local here
5570 !------------------------------------------------------------------
5571 P=1
5572 FOR B=1 TO LEN(Rdata$)
5573 Stuff$=Rdata$[B,B] ! get next byte
5574 Stuff=NUM(Stuff$)
5575 IF Debug THEN DISP "P= ";P,"B= ";B,Stuff$,File_buff$[1,P]
5576 SELECT Stuff
5577 CASE Quote ! Control Quoting #
5578 IF Qon=1 THEN
5579 IF (NOT Biton) THEN
5580 File_buff$[P,P]=Stuff$ ! ## = #
5581 ELSE
5582 File_buff$[P,P]=CHR$(Stuff+128) ! &## = '#
5583 Biton=0
5584 END IF
5585 P=P+1
5586 Qon=0
5587 ELSE
5588 Qon=1
5589 END IF
5590 CASE Qbin ! 8 bit prefix & (Biton)
5591 IF Qon=1 THEN
5592 IF Biton=1 THEN
5593 File_buff$[P,P]=CHR$(Stuff+128) ! &#& = '&
5594 P=P+1
5595 Biton=0
5596 ELSE
5597 File_buff$[P,P]=Stuff$ ! #& = &
5598 P=P+1
5599 END IF
5600 Qon=0
5601 ELSE
5602 Biton=1
5603 END IF
5604 CASE Rep_ch ! Repeat Processing ~
5605 IF (NOT Qon) AND (NOT Biton) THEN
5606 BEEP
5607 DISP "Repeat Process";Rdata$[B-1;4]
5608 B=B+1
5609 Reps=FNUnchar(Rdata$[B,B]) ! number of repeats this char
5610 B=B+1
5611 IF NUM(Rdata$[B,B])=Quote THEN ! ~#()
5612 Qon=1
5613 B=B+1
5614 END IF
5615 !
5616 IF NUM(Rdata$[B,B])=Qbin THEN ! ~&()
5617 Biton=1
5618 B=B+1
5619 END IF
5620 !
5621 Ch2rep=NUM(Rdata$[B,B]) ! Char to Repeat
5622 IF Qon THEN Ch2rep=Ch2rep-64
5623 IF Biton THEN Ch2rep=Ch2rep+128
5624 Ch2rep$=CHR$(Ch2rep)
5625 File_buff$[P;Reps]=RPT$(Ch2rep$,Reps)
5626 P=P+Reps
5627 ELSE ! #~
5628 IF Biton THEN Stuff=Stuff+128
5629 IF Qon THEN Stuff=Stuff-64
5630 File_buff$[P,P]=CHR$(Stuff)
5631 P=P+1
5632 END IF
5633 !
5634 CASE 32 TO 127 ! printable characters
5635 IF (Qon) AND (Biton) THEN ! &#() Binary File
5636 File_buff$[P,P]=CHR$(FNCtl(Stuff$)+128)
5637 P=P+1
5638 END IF
5639 !
5640 IF (Biton) AND (NOT Qon) THEN ! &
5641 File_buff$[P,P]=CHR$(NUM(Stuff$)+128)
5642 P=P+1
5643 END IF
5644 !
5645 IF (Qon) AND (NOT Biton) THEN ! #
5646 File_buff$[P,P]=CHR$(FNCtl(Stuff$))
5647 P=P+1
5648 END IF
5649 IF (NOT Qon) AND (NOT Biton) THEN ! normal char
5650 File_buff$[P,P]=Stuff$
5651 P=P+1
5652 END IF
5653 !
5654 Qon=0
5655 Biton=0
5656 !
5657 CASE 128 TO 255
5658 PRINT TABXY(25,12);"Invalid Char: Extended Ascii # ";Stuff
5659 END SELECT
5660 NEXT B
5661 Rdata$=File_buff$
5662 SUBEND
5663 !------------------------------------------------------------------------
5670 SUB Encode_pack(File_buff$,Packet$,INTEGER Myquote,Qbin,Rep_ch,Spsiz)
5671 Encode_pack_s: !
5672 Ep: !
5673 !
5674 DIM Stuff$[1],Myquote$[1],Qbin$[1]
5675 INTEGER Pack_full,P,B,Sdata_done,Bl
5676 !
5677 Myquote$=CHR$(Myquote)
5678 Qbin$=CHR$(Qbin)
5679 Bl=LEN(File_buff$)
5680 Pack_full=0
5681 P=1
5682 B=1
5683 !------------------------------------------------------
5684 REPEAT ! Until Pack_full=1
5685 Stuff:Stuff$=File_buff$[B,B]
5686 Stuff=NUM(Stuff$)
5687 SELECT Stuff
5688 CASE 0 TO 31,127 TO 255,Myquote,Qbin ! ,Rep_ch !add quoting
5689 SELECT Stuff
5690 CASE 0 TO 31 ! # Prefix. (38=& 35=#)
5691 Packet$[P;2]=Myquote$&CHR$(FNCtl(Stuff$))
5692 P=P+2
5693 CASE Myquote,Qbin
5694 Packet$[P;2]=Myquote$&Stuff$
5695 P=P+2
5696 CASE 127 ! #?
5697 Packet$[P;2]=Myquote$&CHR$(Stuff-64)
5698 P=P+2
5699 CASE 128 TO 159 ! &# prefixing
5700 Packet$[P;3]=Qbin$&Myquote$&CHR$(Stuff-64)
5701 P=P+3
5702 CASE 128+35,128+38
5703 Packet$[P;3]=Qbin$&Myquote$&CHR$(Stuff)
5704 P=P+3
5705 CASE 160 TO 254 ! & Prefixing
5706 Packet$[P;2]=Qbin$&CHR$(Stuff-128)
5707 P=P+2
5708 CASE 255 ! &#?
5709 Packet$[P;3]=Qbin$&Myquote$&"?"
5710 P=P+3
5711 END SELECT
5712 CASE ELSE ! printable - no quoting is needed
5713 Packet$[P,P]=Stuff$
5714 P=P+1
5715 END SELECT
5716 !
5717 IF P>=Spsiz-4 THEN Pack_full=1
5718 ! IF At_eof AND B=Bl THEN
5719 IF B=Bl THEN
5720 Pack_full=1
5721 END IF
5722 B=B+1
5723 UNTIL Pack_full
5724 !
5725 File_buff$=File_buff$[B] ! truncate
5726 B=1
5727 SUBEND
5728 !------------------------------------------------------------------------
5730 Spack:SUB Spack(Packet$,Pkt$,INTEGER Npak,Sndpkt$)
5731 Sspack: ! Form Send Packet Contents from Packet$ data
5732 ! IN
5733 ! Packet$[],Pkt$,Npak
5734 ! OUT
5735 ! Sndpkt$[]
5736 INTEGER Plen,Cchksum
5737 Sndpkt$=""
5738 Dlen=LEN(Packet$)
5739 Plen=LEN(Packet$)+3
5740 Ckpos=Plen+2
5741 Sndpkt$[1;1]="" ! packet mark ^A
5742 Sndpkt$[2;1]=FNTochar$(Plen) ! length
5743 Sndpkt$[3;1]=FNTochar$(Npak MOD 64) ! packet sequence
5744 Sndpkt$[4;1]=Pkt$ ! packet type
5745 Sndpkt$[5;LEN(Packet$)]=Packet$ ! Stuff Data
5746 Chk=0
5747 FOR Ch=2 TO Plen+1
5748 Chk=Chk+NUM(Sndpkt$[Ch,Ch])
5749 NEXT Ch
5750 Cchksum=BINAND(Chk+(BINAND(Chk,192)/64),63) ! Computed Checksum
5751 Sndpkt$[Ckpos;1]=FNTochar$(Cchksum)
5755 SUBEND
5756 !=======================================================================
