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