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