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