Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * KERMIT.MOD - COMMS Toolkit KERMIT file protocol * 5 * * 6 * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 IMPLEMENTATION MODULE Kermit; 12 IMPORT ComSetup,Filenames,FIO,FTSupport,Lib,RS232,SPRINTF,Str; 13 14 CONST 15 TooMany = "Too many retries"; ***** ^ not supported yet 16 UserAbort = "User Abort"; ***** ^ not supported yet 17 FileOpened = "File Opened"; ***** ^ not supported yet 18 FileClosed = "File Closed"; ***** ^ not supported yet 19 EndSession = "Session Ends"; ***** ^ not supported yet 20 XParams = "Exchanging Params"; ***** ^ not supported yet 21 OK = 0; 22 SOH = 1; 23 CHKLNTH = 1; 24 YES = ORD("Y"); ***** ^ undeclared identifier ***** ^ not supported yet 25 NO = ORD("N"); ***** ^ undeclared identifier ***** ^ not supported yet 26 MAXTRIES = 5; 27 MAXPACK = 512; (* My maximum extended-length packet size *) 28 MAXWINDO = 6; (* My window size *) 29 (* Kermit Packet Types *) 30 DATA = 100H+ORD('D'); ***** ^ undeclared identifier ***** ^ not supported yet 31 ACK = 100H+ORD('Y'); ***** ^ undeclared identifier ***** ^ not supported yet 32 NAK = 100H+ORD('N'); ***** ^ undeclared identifier ***** ^ not supported yet 33 SENDINIT = 100H+ORD('S'); ***** ^ undeclared identifier ***** ^ not supported yet 34 ENDSESS = 100H+ORD('B'); ***** ^ undeclared identifier ***** ^ not supported yet 35 FILEHDR = 100H+ORD('F'); ***** ^ undeclared identifier ***** ^ not supported yet 36 EOFILE = 100H+ORD('Z'); ***** ^ undeclared identifier ***** ^ not supported yet 37 ERROR = 100H+ORD('E'); ***** ^ undeclared identifier ***** ^ not supported yet 38 QRSRVD = 100H+ORD('Q'); ***** ^ undeclared identifier ***** ^ not supported yet 39 TIMEOUT = 100H+ORD('T'); ***** ^ undeclared identifier ***** ^ not supported yet 40 ATTR = 100H+ORD('A'); ***** ^ undeclared identifier ***** ^ not supported yet 41 (* flags = Bit Numbers for Capability mask *) 42 XLPKTS = 1; (* True if extended length packets are supported *) 43 WINDOWS = 2; (* True if sliding windows are supported *) 44 ATTPKTS = 3; (* True if attribute packets are supported *) 45 46 TYPE 47 DefaultRec = RECORD 48 MaxL : CARDINAL; (* The max length packet to send *) 49 Time : CARDINAL; (* The timeout while waiting for a pkt *) 50 NPad : CARDINAL; (* The number of pad characters to send *) 51 PadC : CARDINAL; (* The pad character to use *) 52 Eoln : CARDINAL; (* The end of line character to use *) 53 QCtl : CARDINAL; (* The char to use as Ctrl-Quote *) 54 QBin : CARDINAL; (* The char used for 8th bit quoting *) 55 Chkt : CARDINAL; (* The frame check type to use *) 56 Rept : CARDINAL; (* The char used for repeat encoding *) 57 Capa : BITSET; (* Remote's capability mask *) ***** ^ undeclared identifier 58 WSiz : CARDINAL; (* Window Size *) 59 XLen : CARDINAL; (* Extended Packet Length *) 60 END; ***** ^ not supported yet 61 Buffer = ARRAY[0..MAXPACK-1] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 62 TableEntry = RECORD 63 PacketNo : CARDINAL; (* seq no of this packet *) 64 Acked : BOOLEAN; (* true if this entry is ok *) 65 Sent : CARDINAL; (* number of times this pkt sent *) 66 Data : Buffer; (* the actual packet contents *) 67 Lenth : CARDINAL; (* Bytes of data in this pkt *) 68 FilePos : LONGCARD; (* the new file pointer *) ***** ^ undeclared identifier 69 END; ***** ^ not supported yet 70 71 VAR 72 Tries : CARDINAL; (* Number of attempts to send/receive *) 73 SeqNo : CARDINAL; (* The sequence number I use/expect next *) 74 WindowSize : CARDINAL; (* The current window size *) 75 SizeToSend : CARDINAL; (* Maximum size packet I can send *) 76 Default : DefaultRec; (* Settings for various protocol options *) ***** ^ not supported yet 77 f : FIO.File; (* The file being sent/received *) ***** ^ not supported yet 78 79 (*...............................................*) 80 81 PROCEDURE InitVars; 82 BEGIN 83 FTSupport.Errors:=0; ***** ^ not supported yet ***** ^ not supported yet 84 FTSupport.LastMessage:=''; ***** ^ not supported yet ***** ^ not supported yet 85 FTSupport.XferMode := 'CHK'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 86 FTSupport.Transferred:=0; ***** ^ not supported yet ***** ^ not supported yet 87 FTSupport.Aborted := FALSE; ***** ^ not supported yet ***** ^ not supported yet 88 FTSupport.SizeInBytes:=0; ***** ^ not supported yet ***** ^ not supported yet 89 WindowSize := MAXWINDO; 90 END InitVars; ***** ^ not supported yet 91 92 (*...............................................*) 93 94 PROCEDURE Min(a,b:CARDINAL):CARDINAL; 95 BEGIN 96 IF ab THEN 108 RETURN(a); 109 ELSE 110 RETURN(b); 111 END; 112 END Max; ***** ^ not supported yet 113 114 (*...............................................*) 115 116 PROCEDURE ToChar(x:CARDINAL):CARDINAL; 117 BEGIN 118 RETURN x+20H; 119 END ToChar; ***** ^ not supported yet 120 121 (*...............................................*) 122 123 PROCEDURE UnChar(x:CARDINAL):CARDINAL; 124 BEGIN 125 RETURN x-20H; 126 END UnChar; ***** ^ not supported yet 127 128 (*...............................................*) 129 130 PROCEDURE Ctrl(x:CARDINAL):CARDINAL; 131 BEGIN 132 RETURN CARDINAL(BITSET(x) / BITSET(40H)); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 133 END Ctrl; ***** ^ not supported yet 134 135 (*...............................................*) 136 137 PROCEDURE Receive(TLimit:CARDINAL):CARDINAL; 138 VAR 139 c : CHAR; 140 BEGIN 141 LOOP 142 IF RS232.SerialRead(c,TLimit*10) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 143 IF (ORD(c)=SOH) OR (c>=' ') THEN ***** ^ undeclared identifier ***** ^ not supported yet 144 RETURN ORD(c); ***** ^ undeclared identifier ***** ^ not supported yet 145 END; 146 ELSE 147 RETURN TIMEOUT; 148 END; 149 END; 150 END Receive; ***** ^ not supported yet 151 152 (*...............................................*) 153 154 PROCEDURE Msg(s:ARRAY OF CHAR); ***** ^ not supported yet 155 VAR 156 Lnth : CARDINAL; 157 BEGIN 158 Lnth := Str.Length(s); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 159 Lib.Move(ADR(s),ADR(FTSupport.LastMessage),Lnth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 160 FTSupport.LastMessage[Lnth] := 0C; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 161 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 162 END Msg; ***** ^ not supported yet 163 164 (*...............................................*) 165 166 PROCEDURE Error(s:ARRAY OF CHAR); ***** ^ not supported yet 167 BEGIN 168 INC(FTSupport.Errors); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 169 Msg(s); ***** ^ not supported yet ***** ^ not supported yet 170 END Error; ***** ^ not supported yet 171 172 (*...............................................*) 173 174 PROCEDURE SendPacket(tipe,SeqNo,DataLnth:CARDINAL); 175 VAR 176 i,p,CheckSum : CARDINAL; 177 Buff : ARRAY[0..MAXPACK+15] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 178 Extended : BOOLEAN; 179 180 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 181 182 PROCEDURE sPutChar(c:CARDINAL); 183 BEGIN 184 Buff[p] := CHR(c); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 185 CheckSum := (CheckSum+c) MOD 100H; 186 INC(p); ***** ^ undeclared identifier ***** ^ not supported yet 187 END sPutChar; ***** ^ not supported yet 188 189 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 190 191 BEGIN (* SendPacket *) 192 i:=0; 193 p:=1; 194 CheckSum:=0; 195 WITH Default DO ***** ^ not supported yet 196 Extended := (XLPKTS IN Capa) AND (DataLnth>MaxL-(2+CHKLNTH)); ***** ^ not supported yet ***** ^ not supported yet 197 END; ***** ^ not supported yet 198 Buff[0]:=CHR(SOH); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 199 IF Extended THEN 200 sPutChar(ToChar(0)) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 201 ELSE 202 sPutChar(ToChar(DataLnth+2+CHKLNTH)) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 203 END; 204 sPutChar(ToChar(SeqNo)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 205 sPutChar(tipe-100H); ***** ^ not supported yet ***** ^ not supported yet 206 IF Extended THEN 207 sPutChar(ToChar((DataLnth+CHKLNTH) DIV 95)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 208 sPutChar(ToChar((DataLnth+CHKLNTH) MOD 95)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 209 sPutChar(ToChar((CheckSum+(CheckSum>>6)) MOD 64)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 210 END; 211 WHILE i>6)) MOD 64)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 215 Buff[p+1] := CHR(Default.Eoln); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 216 RS232.SerialWrite(Buff,p+2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 217 END SendPacket; ***** ^ not supported yet 218 219 (*...............................................*) 220 221 (* Read a packet and return the packet type. *) 222 PROCEDURE ReadPacket(VAR SeqNo,Lnth:CARDINAL; SkipSOH:BOOLEAN):CARDINAL; 223 CONST 224 BadChecksum = "Bad Checksum"; ***** ^ not supported yet 225 TYPE 226 RdStates = (Mark,Len,Seq,Type,LenX1,LenX2,HChk,Data,Check,Err); 227 VAR 228 Extended : BOOLEAN; 229 Timeout,rslt, 230 PacketType,Cnt, 231 HCheck,CheckSum : CARDINAL; 232 RdState : RdStates; ***** ^ not supported yet 233 BEGIN 234 RdState:=Mark; ***** ^ not supported yet ***** ^ not supported yet 235 Timeout:=Default.Time; ***** ^ not supported yet ***** ^ not supported yet 236 Timeout := Max(Timeout,10); ***** ^ not supported yet ***** ^ not supported yet 237 LOOP 238 IF SkipSOH THEN 239 rslt:=SOH; 240 ELSE 241 rslt:=Receive(Timeout); ***** ^ not supported yet ***** ^ not supported yet 242 END; 243 IF rslt = TIMEOUT THEN 244 Error("Timeout"); ***** ^ not supported yet ***** ^ not supported yet 245 RETURN TIMEOUT; 246 ELSIF rslt = SOH THEN 247 SkipSOH:=FALSE; 248 RdState:=Len; ***** ^ not supported yet ***** ^ not supported yet 249 CheckSum:=0; 250 Cnt:=0; 251 Extended:=FALSE; 252 ELSE 253 IF RdState # Check THEN ***** ^ not supported yet ***** ^ not supported yet 254 CheckSum := CARDINAL(BITSET(CheckSum+rslt)*BITSET(0FFH)); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 255 END; 256 CASE RdState OF ***** ^ not supported yet 257 Mark : (* do nothing, as SOH should have been trapped above *)| ***** ^ not supported yet 258 Len : Lnth:=UnChar(rslt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 259 Extended:=(Lnth=0); 260 IF NOT Extended THEN 261 DEC(Lnth,2+CHKLNTH); ***** ^ undeclared identifier ***** ^ not supported yet 262 END; 263 RdState:=Seq; | ***** ^ not supported yet ***** ^ not supported yet 264 Seq : SeqNo:=UnChar(rslt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 265 RdState:=Type; | ***** ^ not supported yet ***** ^ not supported yet 266 Type : PacketType := 100H+rslt; ***** ^ not supported yet 267 IF Extended THEN 268 RdState := LenX1 ***** ^ not supported yet ***** ^ not supported yet 269 ELSIF Lnth>0 THEN 270 RdState:=Data ***** ^ not supported yet ***** ^ not supported yet 271 ELSE 272 RdState:=Check ***** ^ not supported yet ***** ^ not supported yet 273 END; | 274 LenX1 : Lnth:=UnChar(rslt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 275 RdState:=LenX2; | ***** ^ not supported yet ***** ^ not supported yet 276 LenX2 : Lnth := (Lnth*95+UnChar(rslt)) - CHKLNTH; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 277 HCheck:=CheckSum; 278 RdState := HChk; | ***** ^ not supported yet ***** ^ not supported yet 279 HChk : IF rslt=ToChar((HCheck+(HCheck>>6)) MOD 64) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 280 IF Lnth>0 THEN 281 RdState:=Data; ***** ^ not supported yet ***** ^ not supported yet 282 ELSE 283 RdState:=Check; ***** ^ not supported yet ***** ^ not supported yet 284 END; 285 ELSE 286 Error(BadChecksum); ***** ^ not supported yet ***** ^ not supported yet 287 RETURN TIMEOUT; 288 END; | 289 Data : FTSupport.FBuff[Cnt] := CHR(rslt); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 290 INC(Cnt); ***** ^ undeclared identifier ***** ^ not supported yet 291 IF Cnt=Lnth THEN 292 RdState:=Check; ***** ^ not supported yet ***** ^ not supported yet 293 END; | 294 Check : IF rslt=ToChar((CheckSum+(CheckSum>>6)) MOD 64) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 295 IF PacketType=ERROR THEN 296 Msg("Error Packet received"); ***** ^ not supported yet ***** ^ not supported yet 297 END; 298 RETURN PacketType; 299 ELSE 300 Error(BadChecksum); RETURN TIMEOUT; ***** ^ not supported yet ***** ^ not supported yet 301 END; | 302 Err : (* purge modem buffer *); ***** ^ not supported yet 303 END; 304 END; 305 END; 306 END ReadPacket; ***** ^ not supported yet 307 308 (*...............................................*) 309 310 PROCEDURE NxtPktNo(SeqNo:CARDINAL):CARDINAL; 311 BEGIN 312 RETURN CARDINAL(BITSET(SeqNo+1) * BITSET(3FH)); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 313 END NxtPktNo; ***** ^ not supported yet 314 315 (*...............................................*) 316 317 PROCEDURE SendInitParms(tipe:CARDINAL); 318 VAR 319 MyCapas : BITSET; ***** ^ undeclared identifier 320 BEGIN 321 (* This line says that I can use attribute and extended length packets *) 322 MyCapas := {WINDOWS,XLPKTS,ATTPKTS}; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 323 WITH Default DO ***** ^ not supported yet 324 WindowSize := Min(MAXWINDO,WSiz); ***** ^ not supported yet ***** ^ not supported yet 325 FTSupport.FBuff[ 0] := CHR(ToChar(MaxL)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 326 FTSupport.FBuff[ 1] := CHR(ToChar(Time)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 327 FTSupport.FBuff[ 2] := CHR(ToChar(0)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 328 FTSupport.FBuff[ 3] := CHR(Ctrl(0)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 329 FTSupport.FBuff[ 4] := CHR(ToChar(Eoln)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 330 FTSupport.FBuff[ 5] := CHR(QCtl); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 331 FTSupport.FBuff[ 6] := 'Y'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 332 FTSupport.FBuff[ 7] := '1'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 333 FTSupport.FBuff[ 8] := CHR(Rept); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 334 FTSupport.FBuff[ 9] := CHR(ToChar(CARDINAL(MyCapas))); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 335 FTSupport.FBuff[10] := CHR(ToChar(WindowSize)); (* Window Size *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 336 FTSupport.FBuff[11] := CHR(ToChar(MAXPACK DIV 95)); (* pkt lnth - High bits *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 337 FTSupport.FBuff[12] := CHR(ToChar(MAXPACK MOD 95)); (* pkt lnth - Low bits *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 338 END; ***** ^ not supported yet 339 SendPacket(tipe,SeqNo,13); ***** ^ not supported yet ***** ^ not supported yet 340 END SendInitParms; ***** ^ not supported yet 341 342 (*...............................................*) 343 344 PROCEDURE GetInitParams():CARDINAL; 345 TYPE 346 InitStates = (maxl,time,npad,padc,eol,qctl,qbin,chkt,rept,capas,capas2,windo,maxlx1,maxlx2,done); 347 VAR 348 rslt,p,c,Seq,Lnth : CARDINAL; 349 temp : BITSET; ***** ^ undeclared identifier 350 State : InitStates; ***** ^ not supported yet 351 BEGIN 352 IF Tries=MAXTRIES THEN 353 Error(TooMany); ***** ^ not supported yet ***** ^ not supported yet 354 RETURN(ERROR); 355 END; 356 INC(Tries); ***** ^ undeclared identifier ***** ^ not supported yet 357 rslt := ReadPacket(Seq,Lnth,FALSE); ***** ^ not supported yet ***** ^ not supported yet 358 IF (rslt # SENDINIT) AND (rslt # ACK) THEN 359 RETURN(rslt); 360 END; 361 (* Set defaults *) 362 WITH Default DO ***** ^ not supported yet 363 Capa:={}; ***** ^ not supported yet ***** ^ not supported yet 364 p:=0; 365 State:=maxl; ***** ^ not supported yet ***** ^ not supported yet 366 LOOP 367 IF p31 THEN ***** ^ not supported yet 437 XLen := XLen+(UnChar(c)<<6); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ arithmetic operand must be numeric 438 END; 439 State:=done; | ***** ^ not supported yet ***** ^ not supported yet 440 done : EXIT; | ***** ^ not supported yet 441 END; 442 END; 443 END; ***** ^ not supported yet 444 RETURN rslt; 445 END GetInitParams; ***** ^ not supported yet 446 447 (*...............................................*) 448 449 PROCEDURE WriteData(Lnth:CARDINAL;VAR FBuff,Buff:ARRAY OF CHAR;WriteIt:BOOLEAN):CARDINAL; ***** ^ not supported yet 450 (* Get data from an incoming packet into a file. *) 451 VAR 452 i,rep,c,BuffPtr : CARDINAL; 453 SetBit8 : BOOLEAN; 454 455 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 456 457 PROCEDURE wPutChar(c:CARDINAL); 458 BEGIN 459 IF WriteIt AND (BuffPtr=MAXPACK) THEN 460 INC(FTSupport.Transferred,MAXPACK); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 461 FIO.WrBin(f,Buff,MAXPACK); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 462 BuffPtr := 0; 463 END; 464 Buff[BuffPtr] := CHR(c); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 465 INC(BuffPtr); ***** ^ undeclared identifier ***** ^ not supported yet 466 END wPutChar; ***** ^ not supported yet 467 468 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 469 470 PROCEDURE Low(In:CARDINAL):CARDINAL; 471 BEGIN 472 RETURN CARDINAL(BITSET(In) - BITSET{7}); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 473 END Low; 474 475 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 476 477 BEGIN (* WriteData *) 478 BuffPtr:=0; 479 i:=0; 480 WITH Default DO 481 WHILE i0 DO 507 wPutChar(c); 508 DEC(rep); (* Put the char in the file *) 509 END; 510 END; 511 END; 512 IF (WriteIt) AND (BuffPtr>0) THEN 513 FIO.WrBin(f,Buff,BuffPtr); 514 INC(FTSupport.Transferred,LONGCARD(BuffPtr)); 515 END; 516 IF WriteIt THEN 517 FTSupport.UpdateStatus 518 END; 519 RETURN BuffPtr; 520 END WriteData; 521 522 (*...............................................*) 523 524 PROCEDURE GetFileHeader():CARDINAL; 525 VAR 526 rslt,Seq,Lnth : CARDINAL; 527 BEGIN 528 LOOP 529 IF Tries=MAXTRIES THEN 530 Error(TooMany); 531 RETURN(ERROR); 532 END; 533 INC(Tries); 534 rslt := ReadPacket(Seq,Lnth,FALSE); 535 CASE rslt OF 536 FILEHDR : Lnth := WriteData(Lnth,FTSupport.FBuff,FTSupport.FileSpec,FALSE); 537 FTSupport.FileSpec[Lnth] := 0C; 538 FTSupport.CompleteFilename; 539 FTSupport.NewFilename; 540 f := FIO.Create(FTSupport.FileSpec); 541 IF FIO.IOresult() # 0 THEN 542 Error("File Create Error"); RETURN ERROR 543 END; 544 Msg(FileOpened); RETURN rslt; | 545 TIMEOUT : SendPacket(NAK,NxtPktNo(SeqNo),0); | 546 ERROR, 547 SENDINIT, 548 EOFILE, 549 ENDSESS : RETURN rslt; | 550 ELSE 551 RETURN ERROR; 552 END; 553 END; 554 END GetFileHeader; 555 556 (*...............................................*) 557 558 PROCEDURE GetFileAttributes(Lnth:CARDINAL); 559 VAR 560 attr : CHAR; 561 p,rslt,len : CARDINAL; 562 BEGIN 563 (* Run along attribute data looking for "Size in Bytes" attribute. *) 564 (* This is the only attribute we can actually use. *) 565 p:=0; 566 WHILE p0 DO 574 FTSupport.SizeInBytes := FTSupport.SizeInBytes*10+LONGCARD(ORD(FTSupport.FBuff[p])-48); 575 INC(p); 576 DEC(len); 577 END; 578 FTSupport.UpdateStatus; 579 ELSE 580 INC(p,len); 581 END; 582 END; 583 END GetFileAttributes; 584 585 (*...............................................*) 586 587 PROCEDURE GetFileData():CARDINAL; 588 VAR 589 i,p,rslt,Seq,Lnth, 590 first,last : CARDINAL; 591 RcvTable : ARRAY[0..MAXWINDO-1] OF TableEntry; 592 WriteBuff : Buffer; 593 594 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 595 596 PROCEDURE NAKit(Seq:CARDINAL); 597 BEGIN 598 SendPacket(NAK,Seq,0); 599 END NAKit; 600 601 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 602 603 PROCEDURE InitReceiveTable(FirstSeqNo:CARDINAL); 604 VAR 605 i : CARDINAL; 606 BEGIN 607 first:=0; 608 last:=WindowSize-1; 609 FOR i:=0 TO WindowSize-1 DO 610 WITH RcvTable[i] DO 611 PacketNo := CARDINAL(BITSET(FirstSeqNo+i+1)*BITSET(3FH)); 612 Acked := FALSE; 613 Lenth := 0; 614 END; 615 END; 616 END InitReceiveTable; 617 618 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 619 620 PROCEDURE Duplicate(Seq:CARDINAL; VAR Index:CARDINAL):BOOLEAN; 621 VAR 622 i : CARDINAL; 623 BEGIN 624 FOR i:=0 TO WindowSize-1 DO 625 IF Seq=RcvTable[i].PacketNo THEN 626 Index:=i; 627 RETURN(TRUE) 628 END; 629 END; 630 RETURN FALSE; 631 END Duplicate; 632 633 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 634 635 PROCEDURE MostWanted():CARDINAL; 636 VAR 637 i,p : CARDINAL; 638 BEGIN 639 p:=first; 640 FOR i:=0 TO WindowSize-1 DO 641 IF NOT RcvTable[p].Acked THEN 642 RETURN(p); 643 END; 644 p := (p+1) MOD WindowSize; 645 END; 646 RETURN NxtPktNo(RcvTable[last].PacketNo); 647 END MostWanted; 648 649 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 650 651 PROCEDURE RotateTable():CARDINAL; 652 VAR 653 i,NextPkt :CARDINAL; 654 BEGIN 655 NextPkt := NxtPktNo(RcvTable[last].PacketNo); 656 (* Ok, now rotate the window. Not physically, just adjust the *) 657 (* first and last pointers. *) 658 last:=first; 659 first:=(first+1) MOD WindowSize; 660 WITH RcvTable[last] DO (* write old contents then clear entry *) 661 IF NOT Acked THEN 662 RETURN(ERROR); 663 END; 664 IF Lenth>0 THEN 665 i:=WriteData(Lenth,Data,WriteBuff,TRUE); 666 END; 667 Acked:=FALSE; 668 PacketNo:=NextPkt; 669 Lenth:=0; 670 END; 671 RETURN OK; 672 END RotateTable; 673 674 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 675 676 PROCEDURE StoreData(Index,Lnth:CARDINAL); 677 BEGIN 678 WITH RcvTable[Index] DO 679 IF Acked THEN 680 Msg("Duplicate Packet"); 681 END; 682 Acked:=TRUE; 683 Lenth:=Lnth; 684 Lib.Move(ADR(FTSupport.FBuff),ADR(Data),Lenth); 685 END; 686 END StoreData; 687 688 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 689 690 BEGIN (* GetFileData *) 691 InitReceiveTable(SeqNo); (* initialise receive table *) 692 LOOP 693 IF FTSupport.AbortRequested() THEN 694 Msg(UserAbort); 695 RETURN ERROR; 696 END; 697 IF Tries=MAXTRIES THEN 698 Msg(TooMany); 699 RETURN(ERROR); 700 END; 701 INC(Tries); 702 rslt := ReadPacket(Seq,Lnth,FALSE); 703 CASE rslt OF 704 DATA : Tries := 0; 705 IF Duplicate(Seq,i) THEN 706 SendPacket(ACK,Seq,0); 707 StoreData(i,Lnth); 708 ELSE (* new packet *) 709 i:=0; 710 SendPacket(ACK,Seq,0); 711 REPEAT 712 INC(i); 713 IF RotateTable()=ERROR THEN 714 Error("Out of Sequence!"); 715 RETURN ERROR; 716 END; 717 UNTIL Seq=RcvTable[last].PacketNo; 718 StoreData(last,Lnth); 719 IF i>1 THEN (* NAK any packets skipped *) 720 p:=first; 721 FOR i:=0 TO WindowSize-1 DO 722 WITH RcvTable[p] DO 723 IF NOT Acked THEN 724 Error("NAK: Packets Skipped"); 725 NAKit(PacketNo); 726 END; 727 END; 728 p := (p+1) MOD WindowSize; 729 END; 730 END; 731 END; | 732 ATTR : Tries := 0; 733 SendPacket(ACK,Seq,0); 734 GetFileAttributes(Lnth); 735 InitReceiveTable(Seq); | 736 TIMEOUT : Error("NAK: Timeout"); 737 NAKit(MostWanted()); | 738 ERROR : RETURN rslt; | 739 FILEHDR : RETURN rslt; | 740 EOFILE : p:=first; 741 FOR i:=0 TO WindowSize-1 DO 742 WITH RcvTable[p] DO 743 IF Acked AND (Lenth>0) THEN 744 Lnth := WriteData(Lenth,Data,WriteBuff,TRUE); 745 END; 746 END; 747 p := (p+1) MOD WindowSize; 748 END; 749 RETURN EOFILE; | 750 ELSE 751 RETURN ERROR; 752 END; 753 SeqNo := Seq; 754 END; 755 END GetFileData; 756 757 (*...............................................*) 758 759 PROCEDURE RxStateMachine():CARDINAL; 760 TYPE 761 RxStates = (rSendInit,rFHeader,rFData); 762 VAR 763 rslt : CARDINAL; 764 RxState : RxStates; 765 BEGIN 766 RxState := rSendInit; 767 SeqNo := 0; (* Start Sequence Number *) 768 Default.Time := 15; (* default timeout for Send-Init packet *) 769 Default.Eoln := 13; 770 Tries := 0; 771 LOOP 772 CASE RxState OF 773 rSendInit : rslt := GetInitParams(); 774 IF rslt=ERROR THEN 775 RETURN ERROR 776 ELSIF rslt=SENDINIT THEN 777 SendInitParms(ACK); 778 Tries := 0; 779 RxState:=rFHeader; 780 ELSE (* timeout *) 781 SendPacket(NAK,SeqNo,0); 782 END; | 783 rFHeader : InitVars; 784 rslt := GetFileHeader(); 785 IF rslt=ERROR THEN 786 RETURN ERROR 787 ELSIF rslt=SENDINIT THEN 788 SendInitParms(ACK); 789 ELSIF rslt=EOFILE THEN 790 SendPacket(ACK,SeqNo,0); 791 ELSIF rslt=ENDSESS THEN 792 SeqNo := NxtPktNo(SeqNo); 793 SendPacket(ACK,SeqNo,0); 794 Msg(EndSession); 795 RETURN OK; 796 ELSIF rslt=FILEHDR THEN 797 SeqNo := NxtPktNo(SeqNo); 798 SendPacket(ACK,SeqNo,0); 799 Tries := 0; 800 RxState := rFData; 801 END; | 802 rFData : rslt := GetFileData(); 803 IF rslt=ERROR THEN 804 RETURN ERROR 805 ELSIF rslt=FILEHDR THEN 806 SendPacket(ACK,SeqNo,0); 807 ELSIF rslt=EOFILE THEN 808 SeqNo := NxtPktNo(SeqNo); 809 SendPacket(ACK,SeqNo,0); 810 Msg(FileClosed); 811 FIO.Close(f); 812 Tries := 0; 813 RxState := rFHeader; 814 END; | 815 END; 816 END; 817 END RxStateMachine; 818 819 (*...............................................*) 820 821 PROCEDURE KermitReceive():CARDINAL; 822 VAR 823 rslt:CARDINAL; 824 BEGIN 825 InitVars; 826 FTSupport.OpenStatusWindow('SuperKermit Download'); 827 rslt := RxStateMachine(); 828 IF rslt=ERROR THEN 829 SendPacket(ERROR,SeqNo,0); 830 END; 831 FIO.Close(f); 832 FTSupport.CloseStatusWindow; 833 RETURN rslt; 834 END KermitReceive; 835 836 (*...............................................*) 837 838 PROCEDURE GetPath(Wild:ARRAY OF CHAR; VAR Path:ARRAY OF CHAR):BOOLEAN; 839 VAR 840 Drive,Ext : ARRAY[0..4] OF CHAR; 841 Name : ARRAY[0..12] OF CHAR; 842 BEGIN 843 IF NOT Filenames.ParseFilename(Wild,Drive,Path,Name,Ext) THEN 844 RETURN(FALSE); 845 END; 846 Name := ''; 847 Ext:=''; 848 Filenames.MakeFilename(Drive,Path,Name,Ext,Path); 849 RETURN TRUE; 850 END GetPath; 851 852 (*...............................................*) 853 854 PROCEDURE SendMyParams():CARDINAL; 855 VAR 856 rslt : CARDINAL; 857 BEGIN 858 Msg(XParams); 859 WITH Default DO 860 WITH ComSetup.Setup.Kermit DO 861 MaxL:=90; 862 Time:=15; 863 NPad:=NumPadChars; 864 PadC:=ORD(PadChar); 865 Eoln:=ORD(EolChar); 866 QCtl:=ORD(CtlQuote); 867 QBin:=ORD(EightBitQuote); 868 Chkt:=1; 869 Rept:=ORD(ReptPrefix); 870 Capa:={WINDOWS,XLPKTS,ATTPKTS}; 871 WSiz:=MAXWINDO; 872 XLen:=MAXPACK; 873 END; 874 END; 875 Tries:=0; 876 LOOP 877 SendInitParms(SENDINIT); 878 rslt := GetInitParams(); 879 CASE rslt OF 880 ACK : (* this is what I want*) 881 WITH Default DO 882 IF WINDOWS IN Capa THEN 883 WindowSize := Max(1,Min(WSiz,MAXWINDO)); 884 ELSE 885 WindowSize := 1; 886 END; 887 IF (QBin=YES) OR (QBin=NO) THEN 888 QBin:=0; 889 END; 890 IF XLPKTS IN Capa THEN 891 SizeToSend := Min(MAXPACK,XLen-CHKLNTH) 892 ELSE 893 SizeToSend := MaxL-(CHKLNTH+2) 894 END; 895 END; 896 SeqNo := NxtPktNo(SeqNo); 897 RS232.FlushInBuf; 898 RETURN ACK; | 899 TIMEOUT : (* loop again *) | 900 ELSE 901 RETURN ERROR; 902 END; 903 END; 904 END SendMyParams; 905 906 (*...............................................*) 907 908 PROCEDURE SendMessage(tipe,DataLnth:CARDINAL):CARDINAL; 909 VAR 910 rslt,Seq,Lnth : CARDINAL; 911 BEGIN 912 Tries := 0; 913 LOOP 914 SendPacket(tipe,SeqNo,DataLnth); 915 rslt := ReadPacket(Seq,Lnth,FALSE); 916 IF (rslt=ERROR) OR (rslt=ACK) THEN 917 SeqNo := NxtPktNo(SeqNo); 918 RETURN(rslt); 919 END; 920 END; 921 END SendMessage; 922 923 (*...............................................*) 924 925 PROCEDURE SendFileHeader(VAR Path:ARRAY OF CHAR):CARDINAL; 926 (* send file header and lnth attribute *) 927 VAR 928 rslt,Lnth : CARDINAL; 929 BEGIN 930 Lnth:=Str.Length(FTSupport.FileSpec); 931 Str.Copy(FTSupport.FBuff,FTSupport.FileSpec); 932 rslt := SendMessage(FILEHDR,Lnth); 933 IF rslt # ACK THEN 934 RETURN(rslt); 935 END; 936 IF Path[0] # 0C THEN 937 Str.Concat(FTSupport.FileSpec,Path,FTSupport.FileSpec); 938 END; 939 f := FIO.Open(FTSupport.FileSpec); 940 IF FIO.IOresult() # 0 THEN 941 RETURN(ERROR); 942 END; 943 IF NOT (ATTPKTS IN Default.Capa) THEN 944 RETURN(ACK); 945 END; 946 FTSupport.SizeInBytes := FIO.Size(f); 947 SPRINTF.SPrintF1("1$%u",FTSupport.SizeInBytes,FTSupport.FBuff); 948 Lnth := Str.Length(FTSupport.FBuff); 949 FTSupport.FBuff[1] := CHR(ToChar(Lnth-2)); 950 FTSupport.NewFilename; 951 Msg(FileOpened); 952 RETURN SendMessage(ATTR,Lnth); 953 END SendFileHeader; 954 955 (*...............................................*) 956 957 PROCEDURE SendFileData():CARDINAL; 958 TYPE 959 SetOfChar = SET OF CHAR; 960 VAR 961 rslt,rptr, 962 bytesread, 963 NextToSend,first, 964 last,pbstack : CARDINAL; 965 Stack : ARRAY[0..1] OF CARDINAL; 966 CtrlChars : SetOfChar; 967 RxPos : LONGCARD; 968 SndTable : ARRAY[0..MAXWINDO-1] OF TableEntry; 969 ReadBuff : Buffer; 970 971 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 972 973 PROCEDURE PushBack(c:CARDINAL); 974 BEGIN 975 Stack[pbstack]:=c; 976 INC(pbstack); 977 END PushBack; 978 979 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 980 981 PROCEDURE GetChar(VAR c:CARDINAL):CARDINAL; 982 BEGIN 983 IF pbstack>0 THEN 984 DEC(pbstack); 985 c:=Stack[pbstack]; 986 ELSE 987 WHILE rptr=bytesread DO 988 IF bytesread0 THEN (* are we allowed repeated chars? *) 1018 (* count repeated chars *) 1019 WHILE (rep<94) AND (GetChar(nextc)=c) DO 1020 INC(rep); 1021 END; 1022 IF rep<94 THEN 1023 PushBack(nextc); 1024 END; 1025 IF rep>1 THEN 1026 IF rep=2 THEN (* not worth compressing *) 1027 PushBack(c); 1028 ELSE 1029 Data[wptr]:=CHR(Default.Rept); 1030 INC(wptr); 1031 Data[wptr]:=CHR(ToChar(rep)); 1032 INC(wptr); 1033 END; 1034 END; 1035 END; 1036 c2 := CARDINAL(BITSET(c)*BITSET(127)); 1037 IF (Default.QBin>0) AND (c>127) THEN 1038 c:=c2; 1039 Data[wptr]:=CHR(Default.QBin); 1040 INC(wptr); 1041 END; 1042 IF CHR(c) IN CtrlChars THEN 1043 Data[wptr]:=CHR(Default.QCtl); 1044 INC(wptr); 1045 IF (c2<32) OR (c2=127) THEN 1046 c:=Ctrl(c); 1047 END; 1048 END; 1049 Data[wptr]:=CHR(c); 1050 INC(wptr); 1051 END; 1052 Lenth := wptr; 1053 FilePos := RxPos; 1054 END; 1055 END FillBuffer; 1056 1057 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 1058 1059 PROCEDURE InitSndTable; 1060 VAR 1061 i : CARDINAL; 1062 BEGIN 1063 CtrlChars := SetOfChar{0C..CHR(31),CHR(127),CHR(128)..CHR(159),CHR(255)}; 1064 INCL(CtrlChars,CHR(Default.Rept)); 1065 INCL(CtrlChars,CHR(Default.QBin)); 1066 INCL(CtrlChars,CHR(Default.QCtl)); 1067 pbstack:=0; 1068 rptr:=0FFFFH; 1069 bytesread:=rptr; 1070 first:=0; 1071 last:=WindowSize-1; 1072 RxPos := 0; 1073 FOR i:=0 TO WindowSize-1 DO 1074 WITH SndTable[i] DO 1075 PacketNo:=(SeqNo+i) MOD 64; 1076 Acked:=FALSE; 1077 Sent := 0; 1078 END; 1079 FillBuffer(i); 1080 END; 1081 END InitSndTable; 1082 1083 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 1084 1085 PROCEDURE SendIt(Index:CARDINAL):CARDINAL; 1086 BEGIN 1087 WITH SndTable[Index] DO 1088 IF Lenth=0 THEN 1089 RETURN(OK); 1090 END; 1091 IF Sent=MAXTRIES THEN 1092 RETURN(ERROR); 1093 END; 1094 INC(Sent); 1095 Lib.Move(ADR(Data),ADR(FTSupport.FBuff),Lenth); 1096 SendPacket(DATA,PacketNo,Lenth); 1097 END; 1098 RETURN OK; 1099 END SendIt; 1100 1101 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 1102 1103 PROCEDURE WindowClosed():BOOLEAN; 1104 (* Try and find the next packet to send by searching for the next *) 1105 (* packet which has not yet been sent and which has length>0. If *) 1106 (* one is found then the window has not yet closed, otherwise it *) 1107 (* is closed. *) 1108 VAR 1109 i,p : CARDINAL; 1110 BEGIN 1111 p:=NextToSend; 1112 FOR i:=0 TO WindowSize-1 DO 1113 WITH SndTable[p] DO 1114 IF (Sent=0) AND (Lenth>0) THEN 1115 NextToSend:=p; 1116 RETURN(FALSE); 1117 END; 1118 END; 1119 p := (p+1) MOD WindowSize; 1120 END; 1121 RETURN TRUE; 1122 END WindowClosed; 1123 1124 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 1125 1126 PROCEDURE Done():BOOLEAN; 1127 VAR 1128 i : CARDINAL; 1129 BEGIN 1130 FOR i:=0 TO WindowSize-1 DO 1131 IF SndTable[i].Lenth>0 THEN 1132 RETURN(FALSE); 1133 END; 1134 END; 1135 RETURN TRUE; 1136 END Done; 1137 1138 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 1139 1140 PROCEDURE TestReply():CARDINAL; 1141 VAR 1142 next,rslt,Seq, 1143 Lnth,i,ptr : CARDINAL; 1144 GotSOH : BOOLEAN; 1145 c : CHAR; 1146 BEGIN 1147 LOOP 1148 IF FTSupport.AbortRequested() THEN 1149 Msg(UserAbort); 1150 RETURN(ERROR); 1151 END; 1152 IF Done() THEN 1153 RETURN(OK); 1154 END; 1155 Tries:=0; 1156 GotSOH:=FALSE; 1157 IF WindowClosed() THEN 1158 (* force a wait for a reply *) 1159 rslt := ReadPacket(Seq,Lnth,FALSE); 1160 ELSE 1161 (* Flush input buffer, looking out for a reply *) 1162 IF RS232.SerialRead(c,0) THEN 1163 REPEAT 1164 UNTIL (ORD(c)=SOH) OR (NOT RS232.SerialRead(c,0)); 1165 GotSOH := (ORD(c)=SOH); 1166 END; 1167 IF GotSOH THEN 1168 rslt := ReadPacket(Seq,Lnth,TRUE); 1169 ELSE 1170 RETURN OK; 1171 END 1172 END; 1173 CASE rslt OF 1174 ACK : ptr:=first; 1175 FOR i:=0 TO WindowSize-1 DO 1176 WITH SndTable[ptr] DO 1177 IF PacketNo=Seq THEN 1178 Acked:=TRUE; 1179 END; 1180 END; 1181 ptr := (ptr+1) MOD WindowSize; 1182 END; 1183 (* Rotate the table *) 1184 WHILE SndTable[first].Acked DO 1185 FTSupport.Transferred := SndTable[first].FilePos; 1186 FTSupport.UpdateStatus; 1187 next := NxtPktNo(SndTable[last].PacketNo); 1188 last:=first; 1189 first:=(first+1) MOD WindowSize; 1190 WITH SndTable[last] DO 1191 PacketNo:=next; 1192 Acked:=FALSE; 1193 Sent:=0; 1194 END; 1195 FillBuffer(last); 1196 END; 1197 IF WindowSize=1 THEN 1198 RETURN(OK); 1199 END; | 1200 NAK : ptr:=first; 1201 FOR i:=0 TO WindowSize-1 DO 1202 WITH SndTable[ptr] DO 1203 IF PacketNo=Seq THEN 1204 IF SendIt(ptr)=ERROR THEN 1205 RETURN(ERROR); 1206 END; 1207 END; 1208 END; 1209 ptr := (ptr+1) MOD WindowSize; 1210 END; | 1211 TIMEOUT : (* resend the oldest UnAcked packet *) 1212 IF SendIt(first)=ERROR THEN 1213 RETURN(ERROR); 1214 END; | 1215 ELSE 1216 RETURN ERROR; 1217 END; 1218 END; 1219 END TestReply; 1220 1221 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 1222 1223 BEGIN (* SendFileData *) 1224 InitSndTable; 1225 NextToSend:=0; 1226 rslt:=OK; 1227 LOOP 1228 IF Done() THEN 1229 EXIT; 1230 END; 1231 rslt := SendIt(NextToSend); 1232 IF rslt=ERROR THEN 1233 EXIT; 1234 END; 1235 NextToSend := (NextToSend+1) MOD WindowSize; 1236 rslt := TestReply(); 1237 IF rslt=ERROR THEN 1238 EXIT; 1239 END; 1240 END; 1241 SeqNo := SndTable[first].PacketNo; 1242 IF rslt # ERROR THEN 1243 rslt:=OK; 1244 END; 1245 RETURN rslt; 1246 END SendFileData; 1247 1248 (*...............................................*) 1249 1250 PROCEDURE TxStateMachine(VAR Wild:ARRAY OF CHAR):CARDINAL; 1251 TYPE 1252 TxStates = (TxInit,TxSendInit,TxSendHdr,TxSendData,TxSendEOF,TxEndSess); 1253 VAR 1254 State : TxStates; 1255 GotFile : BOOLEAN; 1256 rslt : CARDINAL; 1257 Path : ARRAY[0..80] OF CHAR; 1258 Dir : FIO.DirEntry; 1259 BEGIN 1260 State := TxInit; 1261 SeqNo := 0; 1262 LOOP 1263 IF FTSupport.AbortRequested() THEN RETURN(ERROR) END; 1264 CASE State OF 1265 TxInit : IF NOT GetPath(Wild,Path) THEN 1266 RETURN(ERROR); 1267 END; 1268 GotFile := FIO.ReadFirstEntry(Wild,FIO.FileAttr{},Dir); 1269 IF NOT GotFile THEN 1270 Error("No Matching Files"); 1271 RETURN ERROR; 1272 END; 1273 Str.Copy(FTSupport.FileSpec,Dir.Name); 1274 State:=TxSendInit; | 1275 TxSendInit : IF SendMyParams() # ACK THEN 1276 RETURN(ERROR); 1277 END; 1278 State:=TxSendHdr; | 1279 TxSendHdr : FTSupport.Transferred:=0; 1280 IF SendFileHeader(Path) # ACK THEN 1281 RETURN(ERROR); 1282 END; 1283 State := TxSendData; | 1284 TxSendData : IF SendFileData()=ERROR THEN 1285 RETURN(ERROR); 1286 END; 1287 State := TxSendEOF; | 1288 TxSendEOF : IF SendMessage(EOFILE,0) # ACK THEN 1289 RETURN(ERROR); 1290 END; 1291 FIO.Close(f); 1292 Msg(FileClosed); 1293 GotFile := FIO.ReadNextEntry(Dir); 1294 IF GotFile THEN 1295 State:=TxSendHdr; 1296 ELSE 1297 State:=TxEndSess; 1298 END; 1299 Str.Copy(FTSupport.FileSpec,Dir.Name); | 1300 TxEndSess : IF SendMessage(ENDSESS,0) # ACK THEN 1301 RETURN(ERROR); 1302 END; 1303 Msg(EndSession); 1304 RETURN OK; | 1305 END; 1306 END; 1307 END TxStateMachine; 1308 1309 (*...............................................*) 1310 1311 PROCEDURE KermitSend(wild:ARRAY OF CHAR):CARDINAL; 1312 VAR 1313 rslt : CARDINAL; 1314 BEGIN 1315 InitVars; 1316 FTSupport.OpenStatusWindow('SuperKermit Upload'); 1317 rslt := TxStateMachine(wild); 1318 IF rslt=ERROR THEN 1319 SendPacket(ERROR,SeqNo,0); 1320 END; 1321 FIO.Close(f); 1322 FTSupport.CloseStatusWindow; 1323 RETURN rslt; 1324 END KermitSend; 1325 1326 (*...............................................*) 1327 1328 END Kermit. 1329 467 errors