Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * WXMODEM.MOD - COMMS Toolkit file protocols * 5 * * 6 * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 IMPLEMENTATION MODULE WXModem; 12 IMPORT CommUtil,FIO,FTSupport,Lib,RS232,Str; 13 FROM FTSupport IMPORT ACK,NAK,SOH,EOT,CAN,SYN,WNDREQ; ***** ^ duplicate identifier 14 15 CONST 16 DLE = CHR(16); ***** ^ undeclared identifier ***** ^ not supported yet 17 XON = CHR(17); ***** ^ undeclared identifier ***** ^ not supported yet 18 XOFF = CHR(19); ***** ^ undeclared identifier ***** ^ not supported yet 19 20 VAR 21 f : FIO.File; ***** ^ not supported yet 22 Response : ARRAY[0..1] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 23 LastBlockNo,BlockNo, 24 BlockSize : CARDINAL; 25 26 (*..................................................*) 27 28 PROCEDURE InitVars(VAR Filename:ARRAY OF CHAR); ***** ^ not supported yet 29 BEGIN 30 FTSupport.Errors:=0; ***** ^ not supported yet ***** ^ not supported yet 31 FTSupport.LastMessage:=''; ***** ^ not supported yet ***** ^ not supported yet 32 FTSupport.XferMode := 'CRC'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 33 FTSupport.Transferred:=0; ***** ^ not supported yet ***** ^ not supported yet 34 FTSupport.Aborted := FALSE; ***** ^ not supported yet ***** ^ not supported yet 35 FTSupport.SizeInBytes:=0; ***** ^ not supported yet ***** ^ not supported yet 36 Str.Copy(FTSupport.FileSpec,Filename); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 37 BlockNo:=1; 38 LastBlockNo:=0FFFFH; 39 BlockSize:=128; 40 END InitVars; ***** ^ not supported yet 41 42 (*...............................................*) 43 44 PROCEDURE SendResponse; 45 BEGIN 46 IF (Response[0]=ACK) OR (Response[0]=NAK) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 47 Response[1] := CHR(ORD(Response[1]) MOD 4); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 48 RS232.SerialWrite(Response,2) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 49 ELSIF Response[0]<>0C THEN ***** ^ not supported yet ***** ^ not supported yet 50 RS232.SerialWrite(Response,1) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 51 END; 52 END SendResponse; ***** ^ not supported yet 53 54 (*...............................................*) 55 56 PROCEDURE RcvNoDLE(VAR c:CHAR; Timeout:CARDINAL):BOOLEAN; 57 (* Strip DLE sequences from incoming data *) 58 BEGIN 59 IF RS232.SerialRead(c,Timeout) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 IF c=DLE THEN 61 IF RS232.SerialRead(c,Timeout) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 62 c := CHR(CARDINAL(BITSET(ORD(c))/BITSET(64))) ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 63 ELSE 64 RETURN FALSE; 65 END; 66 END; 67 RETURN TRUE; 68 ELSE 69 RETURN FALSE; 70 END; 71 END RcvNoDLE; ***** ^ not supported yet 72 73 (*...............................................*) 74 75 PROCEDURE ReceiveData():CARDINAL; 76 (* Attempt to receive a single packet, returning an error code. Zero *) 77 (* means that a packet was successfully received. *) 78 VAR 79 c : CHAR; 80 RxBlk,CRC,RxCRC, 81 Result,Cnt, 82 CRCIndex : CARDINAL; 83 RxState : (Start,Blk,Compl,Data,CRCH,CRCL); ***** ^ not supported yet 84 BEGIN 85 (* Already had the first character - SYN *) 86 RxState:=Start; ***** ^ not supported yet ***** ^ not supported yet 87 CRC:=0; 88 Cnt:=0; 89 Result:=0; 90 LOOP 91 IF FTSupport.AbortRequested() THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 92 RETURN(128+6); 93 END; 94 IF NOT RcvNoDLE(c,50) THEN ***** ^ not supported yet ***** ^ not supported yet 95 FTSupport.LastMessage := 'Timeout'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 96 RETURN(3); 97 END; 98 CASE RxState OF ***** ^ not supported yet 99 Start : IF c=SOH THEN ***** ^ not supported yet ***** ^ not supported yet 100 RxState:=Blk; ***** ^ not supported yet ***** ^ not supported yet 101 BlockSize:=128 102 ELSIF c=EOT THEN ***** ^ not supported yet 103 RETURN 127; 104 END; | 105 Blk : RxBlk := ORD(c); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 106 RxState := Compl; | ***** ^ not supported yet ***** ^ not supported yet 107 Compl : IF 255-ORD(c)<>RxBlk THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 108 FTSupport.LastMessage:='Bad Block No'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 109 RETURN 11; 110 ELSIF RxBlk=BlockNo THEN 111 RxState := Data; ***** ^ not supported yet ***** ^ not supported yet 112 ELSE 113 Result := 15; 114 FTSupport.LastMessage := 'Block Resent'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 115 RxState := Data; ***** ^ not supported yet ***** ^ not supported yet 116 END; | 117 Data : FTSupport.FBuff[Cnt] := c; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 118 CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c))); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 119 CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8)); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 120 INC(Cnt); ***** ^ undeclared identifier ***** ^ not supported yet 121 IF Cnt=BlockSize THEN 122 RxState:=CRCH; ***** ^ not supported yet ***** ^ not supported yet 123 END; | 124 CRCH : RxCRC := ORD(c)<<8; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ arithmetic operand must be numeric 125 RxState := CRCL; | ***** ^ not supported yet ***** ^ not supported yet 126 CRCL : RxCRC := RxCRC+ORD(c); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 127 IF CRC=RxCRC THEN 128 RETURN Result 129 ELSE 130 FTSupport.LastMessage := 'Bad CRC'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 131 RETURN 9; 132 END; | 133 END; (* case *) 134 END; (* loop *) 135 END ReceiveData; ***** ^ not supported yet 136 137 (*...............................................*) 138 139 PROCEDURE WXMReceive():CARDINAL; 140 VAR 141 c : CHAR; 142 Result : CARDINAL; 143 IncomingData, 144 Negotiating, 145 EndOfFile : BOOLEAN; 146 BEGIN 147 Negotiating:=TRUE; 148 EndOfFile:=FALSE; 149 REPEAT 150 IncomingData := FALSE; 151 REPEAT 152 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 153 IF FTSupport.AbortRequested() THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 154 RETURN(6); 155 END; 156 LOOP 157 SendResponse; ***** ^ not supported yet 158 IF RS232.SerialRead(c,150) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 159 IF (c=SYN) OR (c=EOT) THEN ***** ^ not supported yet ***** ^ not supported yet 160 FTSupport.LastMessage:=''; ***** ^ not supported yet ***** ^ not supported yet 161 Negotiating:=FALSE; 162 IncomingData := TRUE; 163 EXIT; 164 END 165 ELSE 166 FTSupport.LastMessage := 'Timeout'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 167 INC(FTSupport.Errors); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 168 IF (FTSupport.Errors>1) THEN ***** ^ not supported yet ***** ^ not supported yet 169 IF Negotiating THEN 170 RETURN(1); 171 ELSE 172 RETURN(2); 173 END; 174 END; 175 EXIT; 176 END; 177 END; 178 UNTIL IncomingData; 179 IF c=EOT THEN ***** ^ not supported yet 180 Result := 127 181 ELSE 182 Result := ReceiveData(); ***** ^ not supported yet ***** ^ not supported yet 183 END; 184 IF Result=127 (* end of file *) THEN 185 FTSupport.LastMessage := 'End of File'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 186 EndOfFile := TRUE; 187 Response[0]:=ACK; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 188 RS232.SerialWrite(Response,1) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 189 ELSIF Result=0 THEN (* good block received *) 190 Response[0]:=ACK; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 191 Response[1]:=CHR(BlockNo); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 192 LastBlockNo := BlockNo; 193 BlockNo := (BlockNo+1) MOD 100H; 194 FIO.WrBin(f,FTSupport.FBuff,BlockSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 195 IF FIO.IOresult()<>0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 196 FTSupport.LastMessage := 'Disk Write Error'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 197 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 198 RETURN(4); 199 END; 200 FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 201 FTSupport.Errors:=0; ***** ^ not supported yet ***** ^ not supported yet 202 FTSupport.LastMessage:=''; ***** ^ not supported yet ***** ^ not supported yet 203 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 204 ELSIF Result=15 THEN (* Sender resent a block - ignore *) 205 Response[0] := 0C; ***** ^ not supported yet ***** ^ not supported yet 206 FTSupport.Errors := 0; ***** ^ not supported yet ***** ^ not supported yet 207 FTSupport.LastMessage := ''; ***** ^ not supported yet ***** ^ not supported yet 208 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 209 ELSE (* protocol error of some kind *) 210 INC(FTSupport.Errors); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 211 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 212 IF Result>127 (* fatal *) THEN 213 FTSupport.Aborted := TRUE; ***** ^ not supported yet ***** ^ not supported yet 214 RETURN(Result MOD 100H) 215 END; 216 Response[0]:=NAK; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 217 Response[1]:=CHR(BlockNo); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 218 IF FTSupport.Errors>5 (* too many *) THEN RETURN(Result) END; ***** ^ not supported yet ***** ^ not supported yet 219 END; 220 UNTIL EndOfFile OR FTSupport.Aborted; ***** ^ not supported yet ***** ^ not supported yet 221 IF FTSupport.Aborted THEN ***** ^ not supported yet ***** ^ not supported yet 222 RETURN(6); 223 ELSE 224 RETURN(0); 225 END; 226 END WXMReceive; ***** ^ not supported yet 227 228 (*...............................................*) 229 230 PROCEDURE WXModemReceive(VAR Filename:ARRAY OF CHAR):CARDINAL; ***** ^ not supported yet 231 VAR 232 Result : CARDINAL; 233 BEGIN 234 InitVars(Filename); ***** ^ not supported yet ***** ^ not supported yet 235 FTSupport.CompleteFilename; ***** ^ not supported yet ***** ^ not supported yet 236 f := FIO.Create(Filename); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 237 IF FIO.IOresult()=0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 238 FTSupport.OpenStatusWindow('WXModem Download'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 239 FTSupport.NewFilename; ***** ^ not supported yet ***** ^ not supported yet 240 Response := WNDREQ; ***** ^ not supported yet ***** ^ not supported yet 241 Result := WXMReceive(); ***** ^ not supported yet ***** ^ not supported yet 242 FIO.Close(f); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 243 IF FTSupport.Aborted THEN ***** ^ not supported yet ***** ^ not supported yet 244 FTSupport.Cancel; ***** ^ not supported yet ***** ^ not supported yet 245 END; 246 FTSupport.CloseStatusWindow; ***** ^ not supported yet ***** ^ not supported yet 247 RETURN Result 248 ELSE 249 CommUtil.ErrorMessage('Could not open file!'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 250 RETURN 12; 251 END; 252 END WXModemReceive; ***** ^ not supported yet 253 254 (*..................................................*) 255 256 PROCEDURE GetResponse(VAR c:CHAR):CARDINAL; 257 VAR 258 CANCount : CARDINAL; 259 GotResponse : BOOLEAN; 260 BEGIN 261 CANCount := 0; 262 REPEAT 263 IF FTSupport.AbortRequested() THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 264 RETURN(6); 265 END; 266 GotResponse := RS232.SerialRead(c,100); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 267 IF GotResponse THEN 268 IF c=CAN THEN ***** ^ not supported yet 269 INC(CANCount); ***** ^ undeclared identifier ***** ^ not supported yet 270 IF CANCount=3 THEN 271 RETURN(13); 272 END; 273 END 274 ELSE 275 FTSupport.LastMessage := 'Timeout'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 276 INC(FTSupport.Errors); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 277 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 278 IF FTSupport.Errors=5 THEN ***** ^ not supported yet ***** ^ not supported yet 279 RETURN(2); 280 END; 281 END; 282 UNTIL GotResponse AND ((c=NAK) OR (c=ACK) OR (c=WNDREQ)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 283 FTSupport.LastMessage := ''; ***** ^ not supported yet ***** ^ not supported yet 284 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 285 RETURN 0; 286 END GetResponse; ***** ^ not supported yet 287 288 (*..................................................*) 289 290 PROCEDURE SendBlock(VAR Block:ARRAY OF CHAR; BlockNo:CARDINAL); ***** ^ not supported yet 291 (* Send a block out the serial port while calculating a CRC in *) 292 (* parallel, then send the CRC. *) 293 VAR 294 i,TxCRC,CRC : CARDINAL; 295 296 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 297 298 PROCEDURE Send(c:CHAR); 299 VAR 300 CRCIndex : CARDINAL; 301 BEGIN 302 CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c))); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 303 CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8)); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 304 IF (c=DLE) OR (c=SYN) OR (c=XON) OR (c=XOFF) THEN ***** ^ not supported yet 305 RS232.SerialWrite(DLE,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 306 c := CHR(CARDINAL(BITSET(ORD(c))/BITSET(64))) ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 307 END; 308 RS232.SerialWrite(c,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 309 END Send; ***** ^ not supported yet 310 311 (*. . . . . . . . . . . . . . . . . . . . . . . .*) 312 313 BEGIN (* SendBlock *) 314 RS232.SerialWrite(SYN,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 315 RS232.SerialWrite(SYN,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 316 RS232.SerialWrite(SOH,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 317 Send(CHR(BlockNo)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 318 Send(CHR(255-BlockNo)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 319 CRC := 0; 320 FOR i:=0 TO 127 DO 321 Send(Block[i]); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 322 END; 323 TxCRC := CRC; 324 Send(CHR(TxCRC DIV 100H)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 325 Send(CHR(TxCRC MOD 100H)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 326 END SendBlock; ***** ^ not supported yet 327 328 (*..................................................*) 329 330 PROCEDURE GetStartChar(VAR c:CHAR):CARDINAL; 331 VAR 332 Result : CARDINAL; 333 BEGIN 334 REPEAT 335 Result := GetResponse(c); ***** ^ not supported yet ***** ^ not supported yet 336 IF Result<>0 THEN 337 RETURN(Result); 338 END; 339 UNTIL (c=WNDREQ); ***** ^ not supported yet 340 RS232.FlushInBuf; ***** ^ not supported yet ***** ^ not supported yet 341 RETURN 0; 342 END GetStartChar; ***** ^ not supported yet 343 344 (*..................................................*) 345 346 PROCEDURE WXMSend():CARDINAL; 347 CONST 348 WindowSize = 4; 349 VAR 350 c,Resp : CHAR; 351 Result,BytesRead, 352 BlockNo,LastAcked : CARDINAL; 353 Buffer : ARRAY[0..127] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 354 355 (*. . . . . . . . . . . . . . . . . . . . . . . . .*) 356 357 PROCEDURE CheckWindow(Resp,c:CHAR):CARDINAL; 358 VAR 359 Temp : CARDINAL; 360 BEGIN 361 Temp := LastAcked; 362 WHILE ((LastAcked+1) MOD 4)<>ORD(c) DO ***** ^ undeclared identifier ***** ^ not supported yet 363 INC(LastAcked); ***** ^ undeclared identifier ***** ^ not supported yet 364 END; 365 IF Resp=ACK THEN ***** ^ not supported yet 366 INC(LastAcked); ***** ^ undeclared identifier ***** ^ not supported yet 367 END; 368 IF LastAcked>BlockNo THEN 369 (* got ACK for block I havent sent yet!! (eg double ack), forget it *) 370 LastAcked := Temp; 371 RETURN 0; 372 END; 373 IF Resp=NAK THEN ***** ^ not supported yet 374 FTSupport.LastMessage := 'Got NAK'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 375 BlockNo:=LastAcked+1; 376 FIO.Seek(f,128*LONGCARD(BlockNo-1)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 377 INC(FTSupport.Errors); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 378 IF FTSupport.Errors=10 THEN ***** ^ not supported yet ***** ^ not supported yet 379 FTSupport.Aborted := TRUE; ***** ^ not supported yet ***** ^ not supported yet 380 RETURN(6) 381 END; 382 ELSE 383 FTSupport.Errors := 0; ***** ^ not supported yet ***** ^ not supported yet 384 FTSupport.LastMessage := ''; ***** ^ not supported yet ***** ^ not supported yet 385 END; 386 FTSupport.Transferred := LONGCARD(LastAcked)*128; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 387 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 388 RETURN 0; 389 END CheckWindow; ***** ^ not supported yet 390 391 (*. . . . . . . . . . . . . . . . . . . . . . . . .*) 392 393 BEGIN (* WXMSend *) 394 Result := GetStartChar(c); ***** ^ not supported yet ***** ^ not supported yet 395 IF Result<>0 THEN 396 RETURN(Result); 397 END; 398 LastAcked := 0; 399 BlockNo := 1; 400 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 401 WHILE NOT FIO.EOF DO ***** ^ not supported yet ***** ^ not supported yet 402 WHILE BlockNo-LastAcked>=WindowSize DO 403 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 404 REPEAT 405 REPEAT 406 Result := GetResponse(c); ***** ^ not supported yet ***** ^ not supported yet 407 IF (Result<>0) AND (Result<>2) THEN 408 RETURN(Result); (* dont return on timeout *) 409 END; 410 UNTIL (c=ACK) OR (c=NAK) OR (Result=2); ***** ^ not supported yet ***** ^ not supported yet 411 IF Result=0 THEN 412 Resp:=c; 413 IF NOT RS232.SerialRead(c,150) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 414 Result:=2; 415 END; 416 END; 417 UNTIL (ORD(c)>=0) AND (ORD(c)<=3) OR (Result=2); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 418 IF Result=0 THEN 419 Result := CheckWindow(Resp,c); ***** ^ not supported yet ***** ^ not supported yet 420 IF Result<>0 THEN 421 RETURN(Result); 422 END; 423 ELSE 424 (* handle timeout by resending last block *) 425 DEC(BlockNo); ***** ^ undeclared identifier ***** ^ not supported yet 426 FIO.Seek(f,128*LONGCARD(BlockNo-1)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 427 END; 428 END; 429 BytesRead := FIO.RdBin(f,Buffer,128); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 430 IF FIO.IOresult()<>0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 431 RETURN(5); 432 END; 433 IF BytesRead<128 THEN 434 Lib.Fill(ADR(Buffer[BytesRead]),128-BytesRead,CHR(26)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 435 END; 436 SendBlock(Buffer,BlockNo MOD 100H); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 437 INC(BlockNo); ***** ^ undeclared identifier ***** ^ not supported yet 438 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 439 LOOP 440 IF (RS232.SerialRead(c,0)) AND ((c=ACK) OR (c=NAK)) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 441 Resp := c; 442 IF (RS232.SerialRead(c,150)) AND (c>=0C) AND (c<=3C) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 443 Result := CheckWindow(Resp,c); ***** ^ not supported yet ***** ^ not supported yet 444 IF Result<>0 THEN 445 RETURN(Result); 446 END; 447 ELSE 448 EXIT; 449 END; 450 ELSE 451 EXIT; 452 END; 453 END; 454 END; 455 FTSupport.LastMessage := 'End of File'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 456 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 457 REPEAT 458 REPEAT 459 RS232.SerialWrite(EOT,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 460 Result := GetResponse(c); ***** ^ not supported yet ***** ^ not supported yet 461 IF Result<>0 THEN 462 RETURN(Result); 463 END; 464 UNTIL (c=NAK) OR (c=ACK); ***** ^ not supported yet ***** ^ not supported yet 465 UNTIL c=ACK; ***** ^ not supported yet 466 RETURN 0; 467 END WXMSend; ***** ^ not supported yet 468 469 (*..................................................*) 470 471 PROCEDURE WXModemSend(VAR Filename:ARRAY OF CHAR):CARDINAL; ***** ^ not supported yet 472 VAR 473 Result : CARDINAL; 474 BEGIN 475 IF FIO.Exists(Filename) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 476 InitVars(Filename); ***** ^ not supported yet ***** ^ not supported yet 477 f := FIO.Open(Filename); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 478 FIO.EOF := FALSE; ***** ^ not supported yet ***** ^ not supported yet 479 FTSupport.SizeInBytes := FIO.Size(f); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 480 FTSupport.OpenStatusWindow('WXModem Upload'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 481 FTSupport.NewFilename; ***** ^ not supported yet ***** ^ not supported yet 482 Result := WXMSend(); ***** ^ not supported yet ***** ^ not supported yet 483 FTSupport.CloseStatusWindow; ***** ^ not supported yet ***** ^ not supported yet 484 FIO.Close(f); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 485 RETURN Result; 486 ELSE 487 CommUtil.ErrorMessage('Could not open file!'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 488 RETURN 7; 489 END; 490 END WXModemSend; ***** ^ not supported yet 491 492 (*..................................................*) 493 494 END WXModem. ***** ^ not supported yet 495 496 errors