XMODEM.LST 43 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971
  1. Listing:
  2. 1 (* Release 3.10 *)
  3. 2 (*-------------------------------------------------------------------------*
  4. 3 * *
  5. 4 * XMODEM.MOD - COMMS Toolkit XMODEM protocol *
  6. 5 * *
  7. 6 * COPYRIGHT (C) 1988..1992 Clarion Software Corporation. *
  8. 7 * All Rights Reserved *
  9. 8 * *
  10. 9 *--------------------------------------------------------------------------*)
  11. 10
  12. 11 IMPLEMENTATION MODULE XModem;
  13. 12 IMPORT Lib,FTSupport,CommUtil,FIO,Str,RS232;
  14. 13 FROM FTSupport IMPORT ACK,CAN,CRCREQ,EOT,NAK,SOH,STX;
  15. ***** ^ duplicate identifier
  16. 14
  17. 15 VAR
  18. 16 f : FIO.File;
  19. ***** ^ not supported yet
  20. 17 Response : CHAR;
  21. 18 CRCCheck,
  22. 19 ResponseWaiting : BOOLEAN;
  23. 20 LastBlockNo,BlockNo,
  24. 21 BlockSize : CARDINAL;
  25. 22
  26. 23 (*..................................................*)
  27. 24
  28. 25 PROCEDURE InitVars(VAR Filename:ARRAY OF CHAR);
  29. ***** ^ not supported yet
  30. 26 BEGIN
  31. 27 FTSupport.Errors:=0;
  32. ***** ^ not supported yet
  33. ***** ^ not supported yet
  34. 28 FTSupport.LastMessage:='';
  35. ***** ^ not supported yet
  36. ***** ^ not supported yet
  37. 29 FTSupport.XferMode := 'CRC';
  38. ***** ^ not supported yet
  39. ***** ^ not supported yet
  40. ***** ^ not supported yet
  41. 30 FTSupport.Transferred:=0;
  42. ***** ^ not supported yet
  43. ***** ^ not supported yet
  44. 31 FTSupport.Aborted := FALSE;
  45. ***** ^ not supported yet
  46. ***** ^ not supported yet
  47. 32 FTSupport.SizeInBytes:=0;
  48. ***** ^ not supported yet
  49. ***** ^ not supported yet
  50. 33 Str.Copy(FTSupport.FileSpec,Filename);
  51. ***** ^ not supported yet
  52. ***** ^ not supported yet
  53. ***** ^ not supported yet
  54. ***** ^ not supported yet
  55. ***** ^ not supported yet
  56. 34 BlockNo:=1;
  57. 35 LastBlockNo:=0FFFFH;
  58. 36 BlockSize:=128;
  59. 37 CRCCheck:=TRUE;
  60. 38 END InitVars;
  61. ***** ^ not supported yet
  62. 39
  63. 40 (*...............................................*)
  64. 41
  65. 42 PROCEDURE ReceiveData():CARDINAL;
  66. 43 VAR
  67. 44 c : CHAR;
  68. 45 RxBlk,CRC,RxCRC,
  69. 46 CheckSum,Result,
  70. 47 Cnt,CRCIndex : CARDINAL;
  71. 48 RxState : (Blk,Compl,Data,Chk,CRCH,CRCL,Flushing);
  72. ***** ^ not supported yet
  73. 49 BEGIN
  74. 50 (* Already had the first character SOH or STX *)
  75. 51 RxState:=Blk;
  76. ***** ^ not supported yet
  77. ***** ^ not supported yet
  78. 52 CRC:=0;
  79. 53 CheckSum:=0;
  80. 54 Cnt:=0;
  81. 55 Result:=0;
  82. 56 LOOP
  83. 57 IF FTSupport.Aborted THEN
  84. ***** ^ not supported yet
  85. ***** ^ not supported yet
  86. 58 RETURN(128+6);
  87. 59 END;
  88. 60 IF NOT RS232.SerialRead(c,50) THEN
  89. ***** ^ not supported yet
  90. ***** ^ not supported yet
  91. ***** ^ not supported yet
  92. 61 IF RxState=Flushing THEN
  93. ***** ^ not supported yet
  94. ***** ^ not supported yet
  95. 62 RETURN(Result);
  96. 63 ELSE
  97. 64 FTSupport.LastMessage := 'Timeout';
  98. ***** ^ not supported yet
  99. ***** ^ not supported yet
  100. ***** ^ not supported yet
  101. 65 RETURN(3);
  102. 66 END;
  103. 67 END;
  104. 68 CASE RxState OF
  105. ***** ^ not supported yet
  106. 69 Blk : RxBlk := ORD(c);
  107. ***** ^ not supported yet
  108. ***** ^ undeclared identifier
  109. ***** ^ not supported yet
  110. 70 RxState := Compl; |
  111. ***** ^ not supported yet
  112. ***** ^ not supported yet
  113. 71 Compl : IF 255-ORD(c)<>RxBlk THEN
  114. ***** ^ not supported yet
  115. ***** ^ undeclared identifier
  116. ***** ^ not supported yet
  117. 72 Result:=11;
  118. 73 FTSupport.LastMessage:='Bad Block No';
  119. ***** ^ not supported yet
  120. ***** ^ not supported yet
  121. ***** ^ not supported yet
  122. 74 RxState:=Flushing;
  123. ***** ^ not supported yet
  124. ***** ^ not supported yet
  125. 75 ELSIF RxBlk=LastBlockNo THEN
  126. 76 Result := 15;
  127. 77 RxState := Data;
  128. ***** ^ not supported yet
  129. ***** ^ not supported yet
  130. 78 ELSIF RxBlk<>BlockNo THEN
  131. 79 Result := 128+10;
  132. 80 FTSupport.LastMessage := 'Sequence Error';
  133. ***** ^ not supported yet
  134. ***** ^ not supported yet
  135. ***** ^ not supported yet
  136. 81 RxState := Flushing;
  137. ***** ^ not supported yet
  138. ***** ^ not supported yet
  139. 82 ELSE
  140. 83 RxState := Data;
  141. ***** ^ not supported yet
  142. ***** ^ not supported yet
  143. 84 END; |
  144. 85 Data : FTSupport.FBuff[Cnt] := c;
  145. ***** ^ not supported yet
  146. ***** ^ not supported yet
  147. ***** ^ not supported yet
  148. ***** ^ not supported yet
  149. 86 IF CRCCheck THEN
  150. 87 CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(c)));
  151. ***** ^ undeclared identifier
  152. ***** ^ not supported yet
  153. ***** ^ undeclared identifier
  154. ***** ^ undeclared identifier
  155. ***** ^ not supported yet
  156. 88 CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8))
  157. ***** ^ undeclared identifier
  158. ***** ^ not supported yet
  159. ***** ^ not supported yet
  160. ***** ^ not supported yet
  161. ***** ^ undeclared identifier
  162. ***** ^ not supported yet
  163. 89 ELSE
  164. 90 CheckSum := (CheckSum+ORD(c)) MOD 100H;
  165. ***** ^ undeclared identifier
  166. ***** ^ not supported yet
  167. 91 END;
  168. 92 INC(Cnt);
  169. ***** ^ undeclared identifier
  170. ***** ^ not supported yet
  171. 93 IF Cnt=BlockSize THEN
  172. 94 IF CRCCheck THEN
  173. 95 RxState:=CRCH;
  174. ***** ^ not supported yet
  175. ***** ^ not supported yet
  176. 96 ELSE
  177. 97 RxState:=Chk;
  178. ***** ^ not supported yet
  179. ***** ^ not supported yet
  180. 98 END;
  181. 99 END; |
  182. 100 Chk : IF ORD(c)=CheckSum THEN
  183. ***** ^ not supported yet
  184. ***** ^ undeclared identifier
  185. ***** ^ not supported yet
  186. 101 RETURN Result
  187. 102 ELSE
  188. 103 Result := 8;
  189. 104 FTSupport.LastMessage := 'Bad Checksum';
  190. ***** ^ not supported yet
  191. ***** ^ not supported yet
  192. ***** ^ not supported yet
  193. 105 RxState := Flushing;
  194. ***** ^ not supported yet
  195. ***** ^ not supported yet
  196. 106 END; |
  197. 107 CRCH : RxCRC := ORD(c)<<8;
  198. ***** ^ not supported yet
  199. ***** ^ undeclared identifier
  200. ***** ^ not supported yet
  201. ***** ^ arithmetic operand must be numeric
  202. 108 RxState := CRCL; |
  203. ***** ^ not supported yet
  204. ***** ^ not supported yet
  205. 109 CRCL : RxCRC := RxCRC+ORD(c);
  206. ***** ^ not supported yet
  207. ***** ^ undeclared identifier
  208. ***** ^ not supported yet
  209. 110 IF CRC=RxCRC THEN
  210. 111 RETURN Result
  211. 112 ELSE
  212. 113 Result := 9;
  213. 114 FTSupport.LastMessage := 'Bad CRC';
  214. ***** ^ not supported yet
  215. ***** ^ not supported yet
  216. ***** ^ not supported yet
  217. 115 RxState := Flushing;
  218. ***** ^ not supported yet
  219. ***** ^ not supported yet
  220. 116 END; |
  221. 117 Flushing : (* do nothing *) |
  222. ***** ^ not supported yet
  223. 118 END; (* case *)
  224. 119 END; (* loop *)
  225. 120 END ReceiveData;
  226. ***** ^ not supported yet
  227. 121
  228. 122 (*...............................................*)
  229. 123
  230. 124 PROCEDURE XMReceive():CARDINAL;
  231. 125 VAR
  232. 126 c : CHAR;
  233. 127 EOTCount,Result : CARDINAL;
  234. 128 IncomingData,
  235. 129 Negotiating,
  236. 130 EndOfFile,
  237. 131 Skippit : BOOLEAN;
  238. 132 BEGIN
  239. 133 Negotiating:=TRUE;
  240. 134 EOTCount:=0;
  241. 135 Skippit:=FALSE;
  242. 136 EndOfFile:=FALSE;
  243. 137 REPEAT
  244. 138 IncomingData := FALSE;
  245. 139 REPEAT
  246. 140 FTSupport.UpdateStatus;
  247. ***** ^ not supported yet
  248. ***** ^ not supported yet
  249. 141 IF FTSupport.Aborted THEN
  250. ***** ^ not supported yet
  251. ***** ^ not supported yet
  252. 142 RETURN(6);
  253. 143 END;
  254. 144 IF NOT Skippit THEN
  255. 145 RS232.SerialWrite(Response,1);
  256. ***** ^ not supported yet
  257. ***** ^ not supported yet
  258. ***** ^ not supported yet
  259. 146 END;
  260. 147 Skippit := FALSE;
  261. 148 LOOP
  262. 149 IF RS232.SerialRead(c,100) THEN
  263. ***** ^ not supported yet
  264. ***** ^ not supported yet
  265. ***** ^ not supported yet
  266. 150 IF (c=SOH) OR (c=EOT) OR (c=STX) THEN
  267. ***** ^ not supported yet
  268. ***** ^ not supported yet
  269. ***** ^ not supported yet
  270. 151 FTSupport.LastMessage:='';
  271. ***** ^ not supported yet
  272. ***** ^ not supported yet
  273. 152 Negotiating:=FALSE;
  274. 153 IncomingData := TRUE;
  275. 154 EXIT;
  276. 155 END;
  277. 156 ELSE
  278. 157 Response := NAK;
  279. ***** ^ not supported yet
  280. 158 RS232.SerialWrite(Response,1);
  281. ***** ^ not supported yet
  282. ***** ^ not supported yet
  283. ***** ^ not supported yet
  284. 159 FTSupport.LastMessage := 'Timeout';
  285. ***** ^ not supported yet
  286. ***** ^ not supported yet
  287. ***** ^ not supported yet
  288. 160 INC(FTSupport.Errors);
  289. ***** ^ undeclared identifier
  290. ***** ^ not supported yet
  291. ***** ^ not supported yet
  292. 161 IF FTSupport.Errors>1 THEN
  293. ***** ^ not supported yet
  294. ***** ^ not supported yet
  295. 162 IF Negotiating THEN
  296. 163 RETURN(1);
  297. 164 ELSE
  298. 165 RETURN(2);
  299. 166 END;
  300. 167 END;
  301. 168 EXIT;
  302. 169 END;
  303. 170 END;
  304. 171 UNTIL IncomingData;
  305. 172 IF c=EOT THEN
  306. ***** ^ not supported yet
  307. 173 FTSupport.LastMessage := 'End of File';
  308. ***** ^ not supported yet
  309. ***** ^ not supported yet
  310. ***** ^ not supported yet
  311. 174 INC(EOTCount);
  312. ***** ^ undeclared identifier
  313. ***** ^ not supported yet
  314. 175 IF EOTCount=2 THEN
  315. 176 EndOfFile := TRUE;
  316. 177 Response:=ACK;
  317. ***** ^ not supported yet
  318. 178 RS232.SerialWrite(Response,1)
  319. ***** ^ not supported yet
  320. ***** ^ not supported yet
  321. ***** ^ not supported yet
  322. 179 ELSE
  323. 180 Response:=NAK; (* NAK first EOT in case it was spurious *)
  324. ***** ^ not supported yet
  325. 181 END
  326. 182 ELSE
  327. 183 EOTCount:=0;
  328. 184 IF (c=SOH) THEN
  329. ***** ^ not supported yet
  330. 185 BlockSize:=128;
  331. 186 ELSE
  332. 187 BlockSize:=1024;
  333. 188 END;
  334. 189 Result := ReceiveData();
  335. ***** ^ not supported yet
  336. ***** ^ not supported yet
  337. 190 IF Result=0 THEN
  338. 191 (* ACK a good block immediately so that the background *)
  339. 192 (* receiver can be getting the next block while we write *)
  340. 193 (* this one to disk. *)
  341. 194 Response := ACK;
  342. ***** ^ not supported yet
  343. 195 RS232.SerialWrite(Response,1);
  344. ***** ^ not supported yet
  345. ***** ^ not supported yet
  346. ***** ^ not supported yet
  347. 196 Skippit := TRUE;
  348. 197 LastBlockNo := BlockNo;
  349. 198 BlockNo := (BlockNo+1) MOD 100H;
  350. 199 IF FTSupport.SizeInBytes>0 THEN
  351. ***** ^ not supported yet
  352. ***** ^ not supported yet
  353. 200 IF FTSupport.Transferred+LONGCARD(BlockSize)>FTSupport.SizeInBytes THEN
  354. ***** ^ not supported yet
  355. ***** ^ not supported yet
  356. ***** ^ undeclared identifier
  357. ***** ^ not supported yet
  358. ***** ^ not supported yet
  359. ***** ^ not supported yet
  360. 201 BlockSize := CARDINAL(FTSupport.SizeInBytes-FTSupport.Transferred);
  361. ***** ^ not supported yet
  362. ***** ^ not supported yet
  363. ***** ^ not supported yet
  364. ***** ^ not supported yet
  365. 202 END;
  366. 203 END;
  367. 204 FIO.WrBin(f,FTSupport.FBuff,BlockSize);
  368. ***** ^ not supported yet
  369. ***** ^ not supported yet
  370. ***** ^ not supported yet
  371. ***** ^ not supported yet
  372. ***** ^ not supported yet
  373. ***** ^ not supported yet
  374. 205 IF FIO.IOresult()<>0 THEN
  375. ***** ^ not supported yet
  376. ***** ^ not supported yet
  377. ***** ^ not supported yet
  378. 206 FTSupport.LastMessage := 'Disk Write Error';
  379. ***** ^ not supported yet
  380. ***** ^ not supported yet
  381. ***** ^ not supported yet
  382. 207 FTSupport.UpdateStatus;
  383. ***** ^ not supported yet
  384. ***** ^ not supported yet
  385. 208 RETURN(4);
  386. 209 END;
  387. 210 FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize);
  388. ***** ^ not supported yet
  389. ***** ^ not supported yet
  390. ***** ^ not supported yet
  391. ***** ^ not supported yet
  392. ***** ^ undeclared identifier
  393. ***** ^ not supported yet
  394. 211 FTSupport.Errors:=0;
  395. ***** ^ not supported yet
  396. ***** ^ not supported yet
  397. 212 FTSupport.LastMessage:='';
  398. ***** ^ not supported yet
  399. ***** ^ not supported yet
  400. 213 FTSupport.UpdateStatus;
  401. ***** ^ not supported yet
  402. ***** ^ not supported yet
  403. 214 ELSIF Result=15 THEN
  404. 215 (* Sender resent previous block - ACK and ignore *)
  405. 216 Response := ACK;
  406. ***** ^ not supported yet
  407. 217 FTSupport.Errors := 0;
  408. ***** ^ not supported yet
  409. ***** ^ not supported yet
  410. 218 FTSupport.LastMessage := '';
  411. ***** ^ not supported yet
  412. ***** ^ not supported yet
  413. 219 FTSupport.UpdateStatus;
  414. ***** ^ not supported yet
  415. ***** ^ not supported yet
  416. 220 ELSE
  417. 221 INC(FTSupport.Errors);
  418. ***** ^ undeclared identifier
  419. ***** ^ not supported yet
  420. ***** ^ not supported yet
  421. 222 FTSupport.UpdateStatus;
  422. ***** ^ not supported yet
  423. ***** ^ not supported yet
  424. 223 IF Result>127 (*fatal*) THEN
  425. 224 FTSupport.Aborted := TRUE;
  426. ***** ^ not supported yet
  427. ***** ^ not supported yet
  428. 225 RETURN(Result MOD 100H)
  429. 226 END;
  430. 227 Response := NAK;
  431. ***** ^ not supported yet
  432. 228 IF FTSupport.Errors>5 (* too many *) THEN
  433. ***** ^ not supported yet
  434. ***** ^ not supported yet
  435. 229 RETURN(Result);
  436. 230 END;
  437. 231 END;
  438. 232 END;
  439. 233 UNTIL EndOfFile OR FTSupport.Aborted;
  440. ***** ^ not supported yet
  441. ***** ^ not supported yet
  442. 234 IF FTSupport.Aborted THEN
  443. ***** ^ not supported yet
  444. ***** ^ not supported yet
  445. 235 RETURN(6);
  446. 236 ELSE
  447. 237 RETURN(0);
  448. 238 END;
  449. 239 END XMReceive;
  450. ***** ^ not supported yet
  451. 240
  452. 241 (*...............................................*)
  453. 242
  454. 243 PROCEDURE XModemReceive(VAR Filename:ARRAY OF CHAR):CARDINAL;
  455. ***** ^ not supported yet
  456. 244 VAR
  457. 245 Result : CARDINAL;
  458. 246 HookSave : BOOLEAN;
  459. 247 BEGIN
  460. 248 InitVars(Filename);
  461. ***** ^ not supported yet
  462. ***** ^ not supported yet
  463. 249 FTSupport.CompleteFilename;
  464. ***** ^ not supported yet
  465. ***** ^ not supported yet
  466. 250 f := FIO.Create(FTSupport.FileSpec);
  467. ***** ^ not supported yet
  468. ***** ^ not supported yet
  469. ***** ^ not supported yet
  470. ***** ^ not supported yet
  471. ***** ^ not supported yet
  472. 251 IF FIO.IOresult()=0 THEN
  473. ***** ^ not supported yet
  474. ***** ^ not supported yet
  475. ***** ^ not supported yet
  476. 252 HookSave := RS232.Hooked;
  477. ***** ^ not supported yet
  478. ***** ^ not supported yet
  479. 253 RS232.Hooked := FTSupport.HookOnFT;
  480. ***** ^ not supported yet
  481. ***** ^ not supported yet
  482. ***** ^ not supported yet
  483. ***** ^ not supported yet
  484. 254 FTSupport.OpenStatusWindow('XModem Download');
  485. ***** ^ not supported yet
  486. ***** ^ not supported yet
  487. ***** ^ not supported yet
  488. 255 FTSupport.NewFilename;
  489. ***** ^ not supported yet
  490. ***** ^ not supported yet
  491. 256 Response := CRCREQ;
  492. ***** ^ not supported yet
  493. 257 Result := XMReceive();
  494. ***** ^ not supported yet
  495. ***** ^ not supported yet
  496. 258 IF Result=1 THEN
  497. 259 CRCCheck:=FALSE;
  498. 260 FTSupport.XferMode:='CHK';
  499. ***** ^ not supported yet
  500. ***** ^ not supported yet
  501. ***** ^ not supported yet
  502. 261 Response := NAK;
  503. ***** ^ not supported yet
  504. 262 Result := XMReceive();
  505. ***** ^ not supported yet
  506. ***** ^ not supported yet
  507. 263 END;
  508. 264 RS232.Hooked := HookSave;
  509. ***** ^ not supported yet
  510. ***** ^ not supported yet
  511. 265 FIO.Close(f);
  512. ***** ^ not supported yet
  513. ***** ^ not supported yet
  514. ***** ^ not supported yet
  515. 266 IF FTSupport.Aborted THEN
  516. ***** ^ not supported yet
  517. ***** ^ not supported yet
  518. 267 FTSupport.Cancel;
  519. ***** ^ not supported yet
  520. ***** ^ not supported yet
  521. 268 END;
  522. 269 FTSupport.CloseStatusWindow;
  523. ***** ^ not supported yet
  524. ***** ^ not supported yet
  525. 270 RETURN Result;
  526. 271 ELSE
  527. 272 CommUtil.ErrorMessage('Could not open file!');
  528. ***** ^ not supported yet
  529. ***** ^ not supported yet
  530. ***** ^ not supported yet
  531. 273 RETURN 12;
  532. 274 END;
  533. 275 END XModemReceive;
  534. ***** ^ not supported yet
  535. 276
  536. 277 (*..................................................*)
  537. 278
  538. 279 PROCEDURE GetResponse(VAR c:CHAR):CARDINAL;
  539. 280 VAR
  540. 281 CANCount : CARDINAL;
  541. 282 GotResponse : BOOLEAN;
  542. 283 BEGIN
  543. 284 CANCount := 0;
  544. 285 REPEAT
  545. 286 IF FTSupport.AbortRequested() THEN
  546. ***** ^ not supported yet
  547. ***** ^ not supported yet
  548. ***** ^ not supported yet
  549. 287 RETURN(6);
  550. 288 END;
  551. 289 IF ResponseWaiting THEN
  552. 290 c:=Response;
  553. 291 GotResponse:=TRUE;
  554. 292 ResponseWaiting:=FALSE
  555. 293 ELSE
  556. 294 GotResponse := RS232.SerialRead(c,100);
  557. ***** ^ not supported yet
  558. ***** ^ not supported yet
  559. ***** ^ not supported yet
  560. 295 END;
  561. 296 IF GotResponse THEN
  562. 297 IF c=CAN THEN
  563. ***** ^ not supported yet
  564. 298 INC(CANCount);
  565. ***** ^ undeclared identifier
  566. ***** ^ not supported yet
  567. 299 IF CANCount=3 THEN
  568. 300 RETURN(13);
  569. 301 END;
  570. 302 END;
  571. 303 ELSE
  572. 304 FTSupport.LastMessage := 'Timeout';
  573. ***** ^ not supported yet
  574. ***** ^ not supported yet
  575. ***** ^ not supported yet
  576. 305 INC(FTSupport.Errors);
  577. ***** ^ undeclared identifier
  578. ***** ^ not supported yet
  579. ***** ^ not supported yet
  580. 306 FTSupport.UpdateStatus;
  581. ***** ^ not supported yet
  582. ***** ^ not supported yet
  583. 307 IF FTSupport.Errors=5 THEN
  584. ***** ^ not supported yet
  585. ***** ^ not supported yet
  586. 308 RETURN(2);
  587. 309 END;
  588. 310 END;
  589. 311 UNTIL GotResponse AND ((c=NAK) OR (c=ACK) OR (c=CRCREQ));
  590. ***** ^ not supported yet
  591. ***** ^ not supported yet
  592. ***** ^ not supported yet
  593. 312 FTSupport.LastMessage := '';
  594. ***** ^ not supported yet
  595. ***** ^ not supported yet
  596. 313 FTSupport.UpdateStatus;
  597. ***** ^ not supported yet
  598. ***** ^ not supported yet
  599. 314 RETURN 0;
  600. 315 END GetResponse;
  601. ***** ^ not supported yet
  602. 316
  603. 317 (*..................................................*)
  604. 318
  605. 319 PROCEDURE SendBlock(VAR c:CHAR):CARDINAL;
  606. 320 VAR
  607. 321 Result,i,Lnth,CRC,
  608. 322 CheckSum,CRCIndex : CARDINAL;
  609. 323 Header : ARRAY[0..2] OF CHAR;
  610. ***** ^ not supported yet
  611. ***** ^ not supported yet
  612. 324 BEGIN
  613. 325 CRC:=0;
  614. 326 CheckSum:=0;
  615. 327 Lnth:=BlockSize;
  616. 328 IF Lnth=128 THEN
  617. 329 Header[0]:=SOH;
  618. ***** ^ not supported yet
  619. ***** ^ not supported yet
  620. ***** ^ not supported yet
  621. 330 ELSE
  622. 331 Header[0]:=STX;
  623. ***** ^ not supported yet
  624. ***** ^ not supported yet
  625. ***** ^ not supported yet
  626. 332 END;
  627. 333 Header[1]:=CHR(BlockNo);
  628. ***** ^ not supported yet
  629. ***** ^ not supported yet
  630. ***** ^ undeclared identifier
  631. ***** ^ not supported yet
  632. 334 Header[2]:=CHR(255-BlockNo);
  633. ***** ^ not supported yet
  634. ***** ^ not supported yet
  635. ***** ^ undeclared identifier
  636. ***** ^ not supported yet
  637. 335 RS232.SerialWrite(Header,3);
  638. ***** ^ not supported yet
  639. ***** ^ not supported yet
  640. ***** ^ not supported yet
  641. ***** ^ not supported yet
  642. 336 IF CRCCheck THEN
  643. 337 FOR i:=0 TO Lnth-1 DO
  644. 338 RS232.SerialWrite(FTSupport.FBuff[i],1);
  645. ***** ^ not supported yet
  646. ***** ^ not supported yet
  647. ***** ^ not supported yet
  648. ***** ^ not supported yet
  649. ***** ^ not supported yet
  650. ***** ^ not supported yet
  651. 339 CRCIndex := CARDINAL(BITSET(CRC>>8)/BITSET(ORD(FTSupport.FBuff[i])));
  652. ***** ^ undeclared identifier
  653. ***** ^ not supported yet
  654. ***** ^ undeclared identifier
  655. ***** ^ undeclared identifier
  656. ***** ^ not supported yet
  657. ***** ^ not supported yet
  658. ***** ^ not supported yet
  659. 340 CRC := CARDINAL(BITSET(FTSupport.CRCTable[CRCIndex])/BITSET(CRC<<8))
  660. ***** ^ undeclared identifier
  661. ***** ^ not supported yet
  662. ***** ^ not supported yet
  663. ***** ^ not supported yet
  664. ***** ^ undeclared identifier
  665. ***** ^ not supported yet
  666. 341 END;
  667. 342 FTSupport.FBuff[Lnth] := CHR(CRC DIV 100H);
  668. ***** ^ not supported yet
  669. ***** ^ not supported yet
  670. ***** ^ not supported yet
  671. ***** ^ undeclared identifier
  672. ***** ^ not supported yet
  673. 343 FTSupport.FBuff[Lnth+1] := CHR(CRC MOD 100H);
  674. ***** ^ not supported yet
  675. ***** ^ not supported yet
  676. ***** ^ not supported yet
  677. ***** ^ undeclared identifier
  678. ***** ^ not supported yet
  679. 344 RS232.SerialWrite(FTSupport.FBuff[Lnth],2);
  680. ***** ^ not supported yet
  681. ***** ^ not supported yet
  682. ***** ^ not supported yet
  683. ***** ^ not supported yet
  684. ***** ^ not supported yet
  685. ***** ^ not supported yet
  686. 345 INC(Lnth,2);
  687. ***** ^ undeclared identifier
  688. ***** ^ not supported yet
  689. 346 ELSE
  690. 347 FOR i:=0 TO Lnth-1 DO
  691. 348 RS232.SerialWrite(FTSupport.FBuff[i],1);
  692. ***** ^ not supported yet
  693. ***** ^ not supported yet
  694. ***** ^ not supported yet
  695. ***** ^ not supported yet
  696. ***** ^ not supported yet
  697. ***** ^ not supported yet
  698. 349 CheckSum := (CheckSum + ORD(FTSupport.FBuff[i])) MOD 100H;
  699. ***** ^ undeclared identifier
  700. ***** ^ not supported yet
  701. ***** ^ not supported yet
  702. ***** ^ not supported yet
  703. 350 END;
  704. 351 FTSupport.FBuff[Lnth] := CHR(CheckSum);
  705. ***** ^ not supported yet
  706. ***** ^ not supported yet
  707. ***** ^ not supported yet
  708. ***** ^ undeclared identifier
  709. ***** ^ not supported yet
  710. 352 RS232.SerialWrite(CHR(CheckSum),1);
  711. ***** ^ not supported yet
  712. ***** ^ not supported yet
  713. ***** ^ undeclared identifier
  714. ***** ^ not supported yet
  715. ***** ^ not supported yet
  716. 353 INC(Lnth);
  717. ***** ^ undeclared identifier
  718. ***** ^ not supported yet
  719. 354 END;
  720. 355 REPEAT
  721. 356 Result := GetResponse(c);
  722. ***** ^ not supported yet
  723. ***** ^ not supported yet
  724. 357 IF Result<>0 THEN
  725. 358 RETURN(Result);
  726. 359 END;
  727. 360 IF c#ACK THEN
  728. ***** ^ not supported yet
  729. 361 FTSupport.LastMessage := 'Received NAK';
  730. ***** ^ not supported yet
  731. ***** ^ not supported yet
  732. ***** ^ not supported yet
  733. 362 INC(FTSupport.Errors);
  734. ***** ^ undeclared identifier
  735. ***** ^ not supported yet
  736. ***** ^ not supported yet
  737. 363 FTSupport.UpdateStatus;
  738. ***** ^ not supported yet
  739. ***** ^ not supported yet
  740. 364 IF FTSupport.Errors=5 THEN
  741. ***** ^ not supported yet
  742. ***** ^ not supported yet
  743. 365 RETURN(14);
  744. 366 END;
  745. 367 RS232.SerialWrite(Header,3);
  746. ***** ^ not supported yet
  747. ***** ^ not supported yet
  748. ***** ^ not supported yet
  749. ***** ^ not supported yet
  750. 368 RS232.SerialWrite(FTSupport.FBuff,Lnth);
  751. ***** ^ not supported yet
  752. ***** ^ not supported yet
  753. ***** ^ not supported yet
  754. ***** ^ not supported yet
  755. ***** ^ not supported yet
  756. 369 END;
  757. 370 UNTIL c=ACK;
  758. ***** ^ not supported yet
  759. 371 RETURN 0;
  760. 372 END SendBlock;
  761. ***** ^ not supported yet
  762. 373
  763. 374 (*..................................................*)
  764. 375
  765. 376 PROCEDURE GetStartChar(VAR c:CHAR):CARDINAL;
  766. 377 VAR
  767. 378 Result : CARDINAL;
  768. 379 BEGIN
  769. 380 REPEAT
  770. 381 Result := GetResponse(c);
  771. ***** ^ not supported yet
  772. ***** ^ not supported yet
  773. 382 IF Result<>0 THEN
  774. 383 RETURN(Result);
  775. 384 END;
  776. 385 UNTIL (c=NAK) OR (c=CRCREQ);
  777. ***** ^ not supported yet
  778. ***** ^ not supported yet
  779. 386 IF c=NAK THEN
  780. ***** ^ not supported yet
  781. 387 CRCCheck:=FALSE;
  782. 388 FTSupport.XferMode:='CHK'
  783. ***** ^ not supported yet
  784. ***** ^ not supported yet
  785. ***** ^ not supported yet
  786. 389 END;
  787. 390 RS232.FlushInBuf;
  788. ***** ^ not supported yet
  789. ***** ^ not supported yet
  790. 391 RETURN 0;
  791. 392 END GetStartChar;
  792. ***** ^ not supported yet
  793. 393
  794. 394 (*..................................................*)
  795. 395
  796. 396 PROCEDURE XMSend():CARDINAL;
  797. 397 VAR
  798. 398 c : CHAR;
  799. 399 Result,BytesRead,
  800. 400 CANCount : CARDINAL;
  801. 401 BEGIN
  802. 402 Result := GetStartChar(c);
  803. ***** ^ not supported yet
  804. ***** ^ not supported yet
  805. 403 IF Result<>0 THEN
  806. 404 RETURN(Result);
  807. 405 END;
  808. 406 FTSupport.UpdateStatus;
  809. ***** ^ not supported yet
  810. ***** ^ not supported yet
  811. 407 WHILE NOT FIO.EOF DO
  812. ***** ^ not supported yet
  813. ***** ^ not supported yet
  814. 408 BytesRead := FIO.RdBin(f,FTSupport.FBuff,BlockSize);
  815. ***** ^ not supported yet
  816. ***** ^ not supported yet
  817. ***** ^ not supported yet
  818. ***** ^ not supported yet
  819. ***** ^ not supported yet
  820. ***** ^ not supported yet
  821. 409 IF FIO.IOresult()<>0 THEN
  822. ***** ^ not supported yet
  823. ***** ^ not supported yet
  824. ***** ^ not supported yet
  825. 410 RETURN(5);
  826. 411 END;
  827. 412 IF BytesRead<BlockSize THEN
  828. 413 Lib.Fill(ADR(FTSupport.FBuff[BytesRead]),BlockSize-BytesRead,CHR(26));
  829. ***** ^ not supported yet
  830. ***** ^ not supported yet
  831. ***** ^ undeclared identifier
  832. ***** ^ not supported yet
  833. ***** ^ not supported yet
  834. ***** ^ not supported yet
  835. ***** ^ undeclared identifier
  836. ***** ^ not supported yet
  837. 414 END;
  838. 415 FTSupport.Errors := 0;
  839. ***** ^ not supported yet
  840. ***** ^ not supported yet
  841. 416 Result := SendBlock(c);
  842. ***** ^ not supported yet
  843. ***** ^ not supported yet
  844. 417 IF Result<>0 THEN
  845. 418 RETURN(Result);
  846. 419 END;
  847. 420 FTSupport.LastMessage := '';
  848. ***** ^ not supported yet
  849. ***** ^ not supported yet
  850. 421 FTSupport.Transferred := FTSupport.Transferred+LONGCARD(BlockSize);
  851. ***** ^ not supported yet
  852. ***** ^ not supported yet
  853. ***** ^ not supported yet
  854. ***** ^ not supported yet
  855. ***** ^ undeclared identifier
  856. ***** ^ not supported yet
  857. 422 BlockNo := (BlockNo+1) MOD 100H;
  858. 423 FTSupport.Errors := 0;
  859. ***** ^ not supported yet
  860. ***** ^ not supported yet
  861. 424 FTSupport.UpdateStatus;
  862. ***** ^ not supported yet
  863. ***** ^ not supported yet
  864. 425 END;
  865. 426 FTSupport.LastMessage := 'End of File';
  866. ***** ^ not supported yet
  867. ***** ^ not supported yet
  868. ***** ^ not supported yet
  869. 427 FTSupport.UpdateStatus;
  870. ***** ^ not supported yet
  871. ***** ^ not supported yet
  872. 428 REPEAT
  873. 429 REPEAT
  874. 430 RS232.SerialWrite(EOT,1);
  875. ***** ^ not supported yet
  876. ***** ^ not supported yet
  877. ***** ^ not supported yet
  878. ***** ^ not supported yet
  879. 431 Result := GetResponse(c);
  880. ***** ^ not supported yet
  881. ***** ^ not supported yet
  882. 432 IF Result<>0 THEN
  883. 433 RETURN(Result);
  884. 434 END;
  885. 435 UNTIL (c=NAK) OR (c=ACK);
  886. ***** ^ not supported yet
  887. ***** ^ not supported yet
  888. 436 UNTIL c=ACK;
  889. ***** ^ not supported yet
  890. 437 RETURN 0;
  891. 438 END XMSend;
  892. ***** ^ not supported yet
  893. 439
  894. 440 (*..................................................*)
  895. 441
  896. 442 PROCEDURE XModemSend(VAR Filename:ARRAY OF CHAR):CARDINAL;
  897. ***** ^ not supported yet
  898. 443 VAR
  899. 444 Result : CARDINAL;
  900. 445 HookSave : BOOLEAN;
  901. 446 BEGIN
  902. 447 IF FIO.Exists(Filename) THEN
  903. ***** ^ not supported yet
  904. ***** ^ not supported yet
  905. ***** ^ not supported yet
  906. 448 HookSave := RS232.Hooked;
  907. ***** ^ not supported yet
  908. ***** ^ not supported yet
  909. 449 RS232.Hooked := FTSupport.HookOnFT;
  910. ***** ^ not supported yet
  911. ***** ^ not supported yet
  912. ***** ^ not supported yet
  913. ***** ^ not supported yet
  914. 450 InitVars(Filename);
  915. ***** ^ not supported yet
  916. ***** ^ not supported yet
  917. 451 f := FIO.Open(Filename);
  918. ***** ^ not supported yet
  919. ***** ^ not supported yet
  920. ***** ^ not supported yet
  921. ***** ^ not supported yet
  922. 452 FIO.EOF := FALSE;
  923. ***** ^ not supported yet
  924. ***** ^ not supported yet
  925. 453 FTSupport.SizeInBytes := FIO.Size(f);
  926. ***** ^ not supported yet
  927. ***** ^ not supported yet
  928. ***** ^ not supported yet
  929. ***** ^ not supported yet
  930. ***** ^ not supported yet
  931. 454 FTSupport.OpenStatusWindow('XModem Upload');
  932. ***** ^ not supported yet
  933. ***** ^ not supported yet
  934. ***** ^ not supported yet
  935. 455 FTSupport.NewFilename;
  936. ***** ^ not supported yet
  937. ***** ^ not supported yet
  938. 456 Result := XMSend();
  939. ***** ^ not supported yet
  940. ***** ^ not supported yet
  941. 457 RS232.Hooked := HookSave;
  942. ***** ^ not supported yet
  943. ***** ^ not supported yet
  944. 458 FTSupport.CloseStatusWindow;
  945. ***** ^ not supported yet
  946. ***** ^ not supported yet
  947. 459 FIO.Close(f);
  948. ***** ^ not supported yet
  949. ***** ^ not supported yet
  950. ***** ^ not supported yet
  951. 460 RETURN Result;
  952. 461 ELSE
  953. 462 CommUtil.ErrorMessage('Could not open file!');
  954. ***** ^ not supported yet
  955. ***** ^ not supported yet
  956. ***** ^ not supported yet
  957. 463 RETURN 7
  958. 464 END;
  959. 465 END XModemSend;
  960. ***** ^ not supported yet
  961. 466
  962. 467 (*..................................................*)
  963. 468
  964. 469 END XModem.
  965. ***** ^ not supported yet
  966. 470
  967. 495 errors