Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * YMODEM.MOD - COMMS Toolkit YMODEM file protocol * 5 * * 6 * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 IMPLEMENTATION MODULE YModem; 12 IMPORT CommUtil,Filenames,FIO,FTSupport,Lib,RS232,SPRINTF,Str; 13 FROM FTSupport IMPORT ACK,CAN,CRCREQ,EOT,NAK,SOH,STX; ***** ^ duplicate identifier 14 (* This module is basically just a modified XModem module - simple *) 15 (* Ymodem especially is just Xmodem with 1k blocks. The Seperate *) 16 (* Xmodem is just for clarity.. *) 17 18 VAR 19 f : FIO.File; ***** ^ not supported yet 20 Response : CHAR; 21 CRCCheck, 22 ResponseWaiting, 23 NoACKS : BOOLEAN; 24 LastBlockNo,BlockNo, 25 BlockSize : CARDINAL; 26 27 (*..................................................*) 28 29 PROCEDURE InitVars(VAR Filename:ARRAY OF CHAR); ***** ^ not supported yet 30 BEGIN 31 FTSupport.Errors:=0; ***** ^ not supported yet ***** ^ not supported yet 32 FTSupport.LastMessage:=''; ***** ^ not supported yet ***** ^ not supported yet 33 FTSupport.XferMode := 'CRC'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 34 FTSupport.Transferred:=0; ***** ^ not supported yet ***** ^ not supported yet 35 FTSupport.Aborted := FALSE; ***** ^ not supported yet ***** ^ not supported yet 36 FTSupport.SizeInBytes:=0; ***** ^ not supported yet ***** ^ not supported yet 37 Str.Copy(FTSupport.FileSpec,Filename); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 38 BlockNo:=1; 39 LastBlockNo:=0FFFFH; 40 BlockSize:=128; 41 CRCCheck:=TRUE; 42 END InitVars; ***** ^ not supported yet 43 44 (*...............................................*) 45 46 PROCEDURE ReceiveData():CARDINAL; 47 VAR 48 c : CHAR; 49 RxBlk,CRC,RxCRC, 50 CheckSum,Result, 51 Cnt,CRCIndex : CARDINAL; 52 RxState : (Blk,Compl,Data,Chk,CRCH,CRCL,Flushing); ***** ^ not supported yet 53 BEGIN 54 (* Already had the first character SOH or STX *) 55 RxState:=Blk; ***** ^ not supported yet ***** ^ not supported yet 56 CRC:=0; 57 CheckSum:=0; 58 Cnt:=0; 59 Result:=0; 60 LOOP 61 IF FTSupport.Aborted THEN ***** ^ not supported yet ***** ^ not supported yet 62 RETURN(128+6); 63 END; 64 IF NOT RS232.SerialRead(c,50) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 65 IF RxState=Flushing THEN ***** ^ not supported yet ***** ^ not supported yet 66 RETURN(Result); 67 ELSE 68 FTSupport.LastMessage := 'Timeout'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 69 RETURN(3); 70 END; 71 END; 72 CASE RxState OF ***** ^ not supported yet 73 Blk : RxBlk := ORD(c); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 74 RxState := Compl; | ***** ^ not supported yet ***** ^ not supported yet 75 Compl : IF 255-ORD(c)<>RxBlk THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 76 Result:=11; 77 FTSupport.LastMessage:='Bad Block No'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 RxState:=Flushing; ***** ^ not supported yet ***** ^ not supported yet 79 ELSIF RxBlk=LastBlockNo THEN 80 Result := 15; 81 RxState := Data; ***** ^ not supported yet ***** ^ not supported yet 82 ELSIF RxBlk<>BlockNo THEN 83 Result := 128+10; 84 FTSupport.LastMessage := 'Sequence Error'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 85 RxState := Flushing; ***** ^ not supported yet ***** ^ not supported yet 86 ELSE 87 RxState := Data; ***** ^ not supported yet ***** ^ not supported yet 88 END; | 89 Data : FTSupport.FBuff[Cnt] := c; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 90 IF CRCCheck THEN 91 CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c))); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 92 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 93 ELSE 94 CheckSum := (CheckSum+ORD(c)) MOD 100H; ***** ^ undeclared identifier ***** ^ not supported yet 95 END; 96 INC(Cnt); ***** ^ undeclared identifier ***** ^ not supported yet 97 IF Cnt=BlockSize THEN 98 IF CRCCheck THEN 99 RxState:=CRCH; ***** ^ not supported yet ***** ^ not supported yet 100 ELSE 101 RxState:=Chk; ***** ^ not supported yet ***** ^ not supported yet 102 END; 103 END; | 104 Chk : IF ORD(c)=CheckSum THEN ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 105 RETURN Result; 106 ELSE 107 Result := 8; 108 FTSupport.LastMessage := 'Bad Checksum'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 109 RxState := Flushing; ***** ^ not supported yet ***** ^ not supported yet 110 END; | 111 CRCH : RxCRC := ORD(c)<<8; ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ arithmetic operand must be numeric 112 RxState := CRCL; | ***** ^ not supported yet ***** ^ not supported yet 113 CRCL : RxCRC := RxCRC+ORD(c); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 114 IF CRC=RxCRC THEN 115 RETURN Result; 116 ELSE 117 Result := 9; 118 FTSupport.LastMessage := 'Bad CRC'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 119 RxState := Flushing; ***** ^ not supported yet ***** ^ not supported yet 120 END; | 121 Flushing : (* do nothing *) | ***** ^ not supported yet 122 END; (* case *) 123 END; (* loop *) 124 END ReceiveData; ***** ^ not supported yet 125 126 (*...............................................*) 127 128 PROCEDURE YMReceive(OneBlockOnly:BOOLEAN):CARDINAL; 129 VAR 130 c : CHAR; 131 EOTCount,Result : CARDINAL; 132 IncomingData, 133 Negotiating, 134 EndOfFile,Skippit : BOOLEAN; 135 BEGIN 136 Negotiating:=TRUE; 137 EOTCount:=0; 138 Skippit:=FALSE; 139 EndOfFile:=FALSE; 140 REPEAT 141 IncomingData := FALSE; 142 REPEAT 143 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 144 IF FTSupport.Aborted THEN ***** ^ not supported yet ***** ^ not supported yet 145 RETURN(6); 146 END; 147 IF (NOT Skippit) AND ((Response<>ACK) OR (NOT NoACKS)) THEN ***** ^ not supported yet 148 RS232.SerialWrite(Response,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 149 END; 150 Skippit := FALSE; 151 LOOP 152 IF RS232.SerialRead(c,100) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 153 IF (c=SOH) OR (c=EOT) OR (c=STX) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 154 FTSupport.LastMessage:=''; ***** ^ not supported yet ***** ^ not supported yet 155 Negotiating:=FALSE; 156 IncomingData := TRUE; 157 EXIT; 158 END; 159 ELSE 160 Response := NAK; ***** ^ not supported yet 161 IF NOT NoACKS THEN 162 RS232.SerialWrite(Response,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 163 END; 164 FTSupport.LastMessage := 'Timeout'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 165 INC(FTSupport.Errors); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 166 IF (NoACKS) OR (FTSupport.Errors>1) THEN ***** ^ not supported yet ***** ^ not supported yet 167 IF Negotiating THEN 168 RETURN(1); 169 ELSE 170 RETURN(2); 171 END; 172 END; 173 EXIT; 174 END; 175 END; 176 UNTIL IncomingData; 177 IF c=EOT THEN ***** ^ not supported yet 178 FTSupport.LastMessage := 'End of File'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 179 INC(EOTCount); ***** ^ undeclared identifier ***** ^ not supported yet 180 IF (EOTCount=2) OR (NoACKS) THEN 181 EndOfFile := TRUE; 182 Response:=ACK; ***** ^ not supported yet 183 RS232.SerialWrite(Response,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 184 ELSE 185 Response:=NAK ***** ^ not supported yet 186 END; 187 ELSE 188 EOTCount:=0; 189 IF (c=SOH) THEN ***** ^ not supported yet 190 BlockSize:=128; 191 ELSE 192 BlockSize:=1024; 193 END; 194 Result := ReceiveData(); ***** ^ not supported yet ***** ^ not supported yet 195 IF Result=0 THEN 196 (* ACK good blocks immediately so that the background receiver can*) 197 (* be getting the next packet while we write this one to disk. *) 198 Response := ACK; ***** ^ not supported yet 199 IF NOT NoACKS THEN 200 RS232.SerialWrite(Response,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 201 END; 202 Skippit := TRUE; 203 LastBlockNo := BlockNo; 204 BlockNo := (BlockNo+1) MOD 100H; 205 IF OneBlockOnly THEN 206 RETURN(0); 207 END; 208 IF FTSupport.SizeInBytes>0 THEN ***** ^ not supported yet ***** ^ not supported yet 209 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 210 BlockSize := CARDINAL(FTSupport.SizeInBytes-FTSupport.Transferred); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 211 END; 212 END; 213 FIO.WrBin(f,FTSupport.FBuff,BlockSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 214 IF FIO.IOresult()<>0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 215 FTSupport.LastMessage := 'Disk Write Error'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 216 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 217 RETURN(4); 218 END; 219 FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 220 FTSupport.Errors:=0; ***** ^ not supported yet ***** ^ not supported yet 221 FTSupport.LastMessage:=''; ***** ^ not supported yet ***** ^ not supported yet 222 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 223 ELSIF Result=15 THEN 224 (* Sender resent previous block - ACK and ignore *) 225 Response := ACK; ***** ^ not supported yet 226 FTSupport.Errors := 0; ***** ^ not supported yet ***** ^ not supported yet 227 FTSupport.LastMessage := ''; ***** ^ not supported yet ***** ^ not supported yet 228 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 229 ELSE 230 INC(FTSupport.Errors); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 231 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 232 IF (Result>127) OR NoACKS (*fatal*) THEN 233 FTSupport.Aborted := TRUE; ***** ^ not supported yet ***** ^ not supported yet 234 RETURN(Result MOD 100H); 235 END; 236 Response := NAK; ***** ^ not supported yet 237 IF FTSupport.Errors>5 (* too many *) THEN ***** ^ not supported yet ***** ^ not supported yet 238 RETURN(Result); 239 END; 240 END; 241 END; 242 UNTIL EndOfFile OR FTSupport.Aborted; ***** ^ not supported yet ***** ^ not supported yet 243 IF FTSupport.Aborted THEN ***** ^ not supported yet ***** ^ not supported yet 244 RETURN(6); 245 ELSE 246 RETURN(0); 247 END; 248 END YMReceive; ***** ^ not supported yet 249 250 (*...............................................*) 251 252 PROCEDURE YModemReceive(VAR Filename:ARRAY OF CHAR):CARDINAL; ***** ^ not supported yet 253 VAR 254 Result : CARDINAL; 255 HookSave : BOOLEAN; 256 BEGIN 257 InitVars(Filename); ***** ^ not supported yet ***** ^ not supported yet 258 FTSupport.CompleteFilename; ***** ^ not supported yet ***** ^ not supported yet 259 f := FIO.Create(FTSupport.FileSpec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 260 IF FIO.IOresult()=0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 261 HookSave := RS232.Hooked; ***** ^ not supported yet ***** ^ not supported yet 262 RS232.Hooked := FTSupport.HookOnFT; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 263 FTSupport.OpenStatusWindow('YModem Download'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 264 FTSupport.NewFilename; ***** ^ not supported yet ***** ^ not supported yet 265 Response := CRCREQ; ***** ^ not supported yet 266 Result := YMReceive(FALSE); ***** ^ not supported yet ***** ^ not supported yet 267 IF Result=1 THEN 268 CRCCheck:=FALSE; 269 FTSupport.XferMode:='CHK'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 270 Response := NAK; ***** ^ not supported yet 271 Result := YMReceive(FALSE); ***** ^ not supported yet ***** ^ not supported yet 272 END; 273 FIO.Close(f); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 274 IF FTSupport.Aborted THEN ***** ^ not supported yet ***** ^ not supported yet 275 FTSupport.Cancel; ***** ^ not supported yet ***** ^ not supported yet 276 END; 277 FTSupport.CloseStatusWindow; ***** ^ not supported yet ***** ^ not supported yet 278 RS232.Hooked := HookSave; ***** ^ not supported yet ***** ^ not supported yet 279 RETURN Result; 280 ELSE 281 CommUtil.ErrorMessage('Could not open file!'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 282 RETURN 12; 283 END; 284 END YModemReceive; ***** ^ not supported yet 285 286 (*..................................................*) 287 288 PROCEDURE GetFileDetails(VAR Filename:ARRAY OF CHAR; VAR Size:LONGCARD); ***** ^ not supported yet ***** ^ undeclared identifier 289 VAR 290 i : CARDINAL; 291 c : CHAR; 292 BEGIN 293 i := 0; 294 REPEAT 295 c := FTSupport.FBuff[i]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 296 Filename[i] := c; ***** ^ not supported yet ***** ^ not supported yet 297 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 298 UNTIL c = 0C; 299 Size := 0; ***** ^ not supported yet 300 c := FTSupport.FBuff[i]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 301 WHILE (c>='0') AND (c<='9') DO 302 Size := Size*10 + LONGCARD(ORD(c)-48); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 303 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 304 c := FTSupport.FBuff[i]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 305 END; 306 END GetFileDetails; ***** ^ not supported yet 307 308 (*...............................................*) 309 310 PROCEDURE YModemBatchReceive():CARDINAL; 311 VAR 312 c : CHAR; 313 Result : CARDINAL; 314 HookSave : BOOLEAN; 315 BEGIN 316 HookSave := RS232.Hooked; ***** ^ not supported yet ***** ^ not supported yet 317 RS232.Hooked := FTSupport.HookOnFT; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 318 FTSupport.OpenStatusWindow('YModem Batch Download'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 319 REPEAT 320 FTSupport.FileSpec:=''; ***** ^ not supported yet ***** ^ not supported yet 321 InitVars(FTSupport.FileSpec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 322 BlockNo := 0; 323 IF NoACKS THEN 324 Response:='G'; 325 Result := YMReceive(TRUE); ***** ^ not supported yet ***** ^ not supported yet 326 END; 327 IF (NOT NoACKS) OR (Result=1) THEN 328 NoACKS := FALSE; 329 Response := CRCREQ; ***** ^ not supported yet 330 Result := YMReceive(TRUE); ***** ^ not supported yet ***** ^ not supported yet 331 IF Result=1 THEN 332 CRCCheck:=FALSE; 333 FTSupport.XferMode:='CHK'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 334 Response := NAK; ***** ^ not supported yet 335 Result := YMReceive(TRUE); ***** ^ not supported yet ***** ^ not supported yet 336 END; 337 END; 338 IF Result=0 THEN 339 IF NOT NoACKS THEN 340 RS232.SerialWrite(ACK,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 341 END; 342 GetFileDetails(FTSupport.FileSpec,FTSupport.SizeInBytes); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 343 IF FTSupport.FileSpec[0]<>0C THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 344 FTSupport.CompleteFilename; ***** ^ not supported yet ***** ^ not supported yet 345 f := FIO.Create(FTSupport.FileSpec); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 346 IF FIO.IOresult()<>0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 347 RS232.Hooked := HookSave; ***** ^ not supported yet ***** ^ not supported yet 348 RETURN(12); 349 END; 350 FTSupport.NewFilename; ***** ^ not supported yet ***** ^ not supported yet 351 Response := CRCREQ; ***** ^ not supported yet 352 BlockNo := 1; 353 Result := YMReceive(FALSE); ***** ^ not supported yet ***** ^ not supported yet 354 IF Result=1 THEN 355 CRCCheck:=FALSE; 356 FTSupport.XferMode:='CHK'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 357 Response := NAK; ***** ^ not supported yet 358 Result := YMReceive(FALSE); ***** ^ not supported yet ***** ^ not supported yet 359 END; 360 FIO.Close(f); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 361 END; 362 END; 363 UNTIL (Result<>0) OR FTSupport.Aborted OR (FTSupport.FileSpec[0]=0C); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 364 IF FTSupport.Aborted THEN ***** ^ not supported yet ***** ^ not supported yet 365 FTSupport.Cancel; ***** ^ not supported yet ***** ^ not supported yet 366 END; 367 FTSupport.CloseStatusWindow; ***** ^ not supported yet ***** ^ not supported yet 368 RS232.Hooked := HookSave; ***** ^ not supported yet ***** ^ not supported yet 369 RETURN Result; 370 END YModemBatchReceive; ***** ^ not supported yet 371 372 (*..................................................*) 373 374 PROCEDURE YModemGReceive():CARDINAL; 375 VAR 376 Result : CARDINAL; 377 BEGIN 378 NoACKS := TRUE; 379 FTSupport.OpenStatusWindow('YModem-g Batch Download'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 380 Result := YModemBatchReceive(); ***** ^ not supported yet ***** ^ not supported yet 381 NoACKS := FALSE; 382 RETURN Result; 383 END YModemGReceive; ***** ^ not supported yet 384 385 (*..................................................*) 386 387 PROCEDURE GetResponse(VAR c:CHAR):CARDINAL; 388 VAR 389 CANCount : CARDINAL; 390 GotResponse : BOOLEAN; 391 BEGIN 392 CANCount := 0; 393 REPEAT 394 IF FTSupport.AbortRequested() THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 395 RETURN(6); 396 END; 397 IF ResponseWaiting THEN 398 c:=Response; 399 GotResponse:=TRUE; 400 ResponseWaiting:=FALSE; 401 ELSE 402 GotResponse := RS232.SerialRead(c,100); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 403 END; 404 IF GotResponse THEN 405 IF c=CAN THEN ***** ^ not supported yet 406 INC(CANCount); ***** ^ undeclared identifier ***** ^ not supported yet 407 IF CANCount=3 THEN 408 RETURN(13); 409 END; 410 END; 411 ELSE 412 FTSupport.LastMessage := 'Timeout'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 413 INC(FTSupport.Errors); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 414 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 415 IF FTSupport.Errors=5 THEN ***** ^ not supported yet ***** ^ not supported yet 416 RETURN(2); 417 END; 418 END; 419 UNTIL GotResponse AND ((c=NAK) OR (c=ACK) OR (c=CRCREQ)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 420 FTSupport.LastMessage := ''; ***** ^ not supported yet ***** ^ not supported yet 421 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 422 RETURN 0; 423 END GetResponse; ***** ^ not supported yet 424 425 (*..................................................*) 426 427 PROCEDURE SendBlock(VAR c:CHAR):CARDINAL; 428 VAR 429 Result,i,Lnth, 430 CRC,CheckSum, 431 CRCIndex : CARDINAL; 432 Header : ARRAY[0..2] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 433 BEGIN 434 CRC:=0; 435 CheckSum:=0; 436 Lnth:=BlockSize; 437 IF Lnth=128 THEN 438 Header[0]:=SOH; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 439 ELSE 440 Header[0]:=STX; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 441 END; 442 Header[1]:=CHR(BlockNo); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 443 Header[2]:=CHR(255-BlockNo); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 444 RS232.SerialWrite(Header,3); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 445 IF CRCCheck THEN 446 FOR i:=0 TO Lnth-1 DO 447 RS232.SerialWrite(FTSupport.FBuff[i],1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 448 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 449 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 450 END; 451 FTSupport.FBuff[Lnth] := CHR(CRC DIV 100H); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 452 FTSupport.FBuff[Lnth+1] := CHR(CRC MOD 100H); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 453 RS232.SerialWrite(FTSupport.FBuff[Lnth],2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 454 INC(Lnth,2); ***** ^ undeclared identifier ***** ^ not supported yet 455 ELSE 456 FOR i:=0 TO Lnth-1 DO 457 RS232.SerialWrite(FTSupport.FBuff[i],1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 458 CheckSum := (CheckSum + ORD(FTSupport.FBuff[i])) MOD 100H; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 459 END; 460 FTSupport.FBuff[Lnth] := CHR(CheckSum); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 461 RS232.SerialWrite(CHR(CheckSum),1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 462 INC(Lnth); ***** ^ undeclared identifier ***** ^ not supported yet 463 END; 464 REPEAT 465 IF NOT NoACKS THEN 466 Result := GetResponse(c); ***** ^ not supported yet ***** ^ not supported yet 467 IF Result # 0 THEN 468 RETURN(Result); 469 END; 470 IF c # ACK THEN ***** ^ not supported yet 471 FTSupport.LastMessage := 'Received NAK'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 472 INC(FTSupport.Errors); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 473 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 474 IF FTSupport.Errors=5 THEN ***** ^ not supported yet ***** ^ not supported yet 475 RETURN(14); 476 END; 477 RS232.SerialWrite(Header,3); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 478 RS232.SerialWrite(FTSupport.FBuff,Lnth); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 479 END; 480 ELSE 481 c:=ACK; ***** ^ not supported yet 482 IF FTSupport.AbortRequested() THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 483 RETURN(6); 484 END; 485 END; 486 UNTIL c = ACK; ***** ^ not supported yet 487 RETURN 0; 488 END SendBlock; ***** ^ not supported yet 489 490 (*..................................................*) 491 492 PROCEDURE GetStartChar(VAR c:CHAR):CARDINAL; 493 VAR 494 Result : CARDINAL; 495 BEGIN 496 REPEAT 497 Result := GetResponse(c); ***** ^ not supported yet ***** ^ not supported yet 498 IF Result<>0 THEN 499 RETURN(Result); 500 END; 501 UNTIL (c=NAK) OR (c=CRCREQ) OR (c='G'); ***** ^ not supported yet ***** ^ not supported yet 502 IF c=NAK THEN ***** ^ not supported yet 503 CRCCheck:=FALSE; 504 FTSupport.XferMode:='CHK' ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 505 END; 506 RS232.FlushInBuf; ***** ^ not supported yet ***** ^ not supported yet 507 RETURN 0; 508 END GetStartChar; ***** ^ not supported yet 509 510 (*..................................................*) 511 512 PROCEDURE YMSend():CARDINAL; 513 VAR 514 c : CHAR; 515 Result,BytesRead, 516 CANCount : CARDINAL; 517 BEGIN 518 Result := GetStartChar(c); ***** ^ not supported yet ***** ^ not supported yet 519 IF Result<>0 THEN 520 RETURN(Result); 521 END; 522 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 523 WHILE NOT FIO.EOF DO ***** ^ not supported yet ***** ^ not supported yet 524 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 525 IF FIO.IOresult()<>0 THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 526 RETURN(5); 527 END; 528 IF BytesRead0 THEN 534 RETURN(Result); 535 END; 536 FTSupport.LastMessage := ''; ***** ^ not supported yet ***** ^ not supported yet 537 FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 538 BlockNo := (BlockNo+1) MOD 100H; 539 FTSupport.Errors := 0; ***** ^ not supported yet ***** ^ not supported yet 540 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 541 END; 542 FTSupport.LastMessage := 'End of File'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 543 FTSupport.UpdateStatus; ***** ^ not supported yet ***** ^ not supported yet 544 REPEAT 545 REPEAT 546 RS232.SerialWrite(EOT,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 547 Result := GetResponse(c); ***** ^ not supported yet ***** ^ not supported yet 548 IF Result<>0 THEN 549 RETURN(Result); 550 END; 551 UNTIL (c=NAK) OR (c=ACK); ***** ^ not supported yet ***** ^ not supported yet 552 UNTIL c=ACK; ***** ^ not supported yet 553 RETURN 0; 554 END YMSend; ***** ^ not supported yet 555 556 (*..................................................*) 557 558 PROCEDURE YModemSend(VAR Filename:ARRAY OF CHAR):CARDINAL; ***** ^ not supported yet 559 VAR 560 Result : CARDINAL; 561 HookSave : BOOLEAN; 562 BEGIN 563 IF FIO.Exists(Filename) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 564 HookSave := RS232.Hooked; ***** ^ not supported yet ***** ^ not supported yet 565 RS232.Hooked := FTSupport.HookOnFT; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 566 InitVars(Filename); ***** ^ not supported yet ***** ^ not supported yet 567 BlockSize := 1024; 568 f := FIO.Open(Filename); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 569 FIO.EOF := FALSE; ***** ^ not supported yet ***** ^ not supported yet 570 FTSupport.SizeInBytes := FIO.Size(f); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 571 FTSupport.OpenStatusWindow('YModem Upload'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 572 FTSupport.NewFilename; ***** ^ not supported yet ***** ^ not supported yet 573 Result := YMSend(); ***** ^ not supported yet ***** ^ not supported yet 574 FTSupport.CloseStatusWindow; ***** ^ not supported yet ***** ^ not supported yet 575 RS232.Hooked := HookSave; ***** ^ not supported yet ***** ^ not supported yet 576 FIO.Close(f); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 577 RETURN Result; 578 ELSE 579 CommUtil.ErrorMessage('Could not open file!'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 580 RETURN 7; 581 END; 582 END YModemSend; ***** ^ not supported yet 583 584 (*..................................................*) 585 586 PROCEDURE GetPath(Wild:ARRAY OF CHAR; VAR Path:ARRAY OF CHAR):BOOLEAN; ***** ^ not supported yet ***** ^ not supported yet 587 VAR 588 Drive,Ext : ARRAY[0..4] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 589 Name : ARRAY[0..12] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 590 BEGIN 591 IF NOT Filenames.ParseFilename(Wild,Drive,Path,Name,Ext) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 592 RETURN(FALSE); 593 END; 594 Name := ''; ***** ^ not supported yet ***** ^ incompatible assignment 595 Ext:=''; ***** ^ not supported yet ***** ^ incompatible assignment 596 Filenames.MakeFilename(Drive,Path,Name,Ext,Path); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 597 RETURN TRUE; 598 END GetPath; ***** ^ not supported yet 599 600 (*...............................................*) 601 602 PROCEDURE YModemBatchSend(VAR Wild:ARRAY OF CHAR):CARDINAL; ***** ^ not supported yet 603 VAR 604 c : CHAR; 605 GotFile : BOOLEAN; 606 Result : CARDINAL; 607 Path : ARRAY[0..70] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 608 entry : FIO.DirEntry; ***** ^ not supported yet 609 HookSave : BOOLEAN; 610 BEGIN 611 IF GetPath(Wild,Path) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 612 HookSave := RS232.Hooked; ***** ^ not supported yet ***** ^ not supported yet 613 RS232.Hooked := FTSupport.HookOnFT; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 614 FTSupport.OpenStatusWindow('YModem Batch Upload'); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 615 GotFile := FIO.ReadFirstEntry(Wild,FIO.FileAttr{},entry); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 616 WHILE GotFile DO 617 FTSupport.FileSpec:=''; 618 InitVars(FTSupport.FileSpec); 619 Str.Concat(FTSupport.FileSpec,Path,entry.Name); 620 FTSupport.NewFilename; 621 f := FIO.Open(FTSupport.FileSpec); 622 FIO.EOF := FALSE; 623 FTSupport.SizeInBytes := FIO.Size(f); 624 Lib.Fill(ADR(FTSupport.FBuff),128,0C); 625 SPRINTF.SPrintF2('%s\000%u',entry.Name,FTSupport.SizeInBytes,FTSupport.FBuff); 626 BlockNo := 0; 627 Result := GetStartChar(c); 628 IF Result<>0 THEN 629 FIO.Close(f); 630 FTSupport.CloseStatusWindow; 631 RETURN(Result); 632 END; 633 IF c='G' THEN 634 NoACKS:=TRUE; 635 END; 636 REPEAT 637 Result := SendBlock(c); 638 IF Result<>0 THEN 639 FIO.Close(f); 640 NoACKS:=FALSE; 641 FTSupport.CloseStatusWindow; 642 RETURN Result; 643 END; 644 UNTIL c<>NAK; 645 Response := c; 646 ResponseWaiting := TRUE; 647 BlockNo:=1; 648 BlockSize:=1024; 649 Result := YMSend(); 650 FIO.Close(f); 651 IF Result<>0 THEN 652 FTSupport.CloseStatusWindow; 653 NoACKS:=FALSE; 654 RETURN(Result); 655 END; 656 GotFile := FIO.ReadNextEntry(entry); 657 END; 658 BlockNo:=0; 659 BlockSize:=128; 660 Lib.Fill(ADR(FTSupport.FBuff),128,0C); 661 Result := GetStartChar(c); 662 IF Result=0 THEN 663 Result := SendBlock(c); 664 END; 665 FTSupport.CloseStatusWindow; 666 RS232.Hooked := HookSave; 667 ELSE 668 CommUtil.ErrorMessage('Bad filename'); 669 RETURN 7; 670 END; 671 RETURN 0; 672 END YModemBatchSend; 673 674 (*..................................................*) 675 676 BEGIN 677 ResponseWaiting := FALSE; 678 NoACKS := FALSE; 679 END YModem. 680 653 errors