LinkUnit.pas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682
  1. unit LinkUnit;
  2. { Uncomment to enable logging of all bytes sent and received to
  3. C:\Linklog.txt. }
  4. (* {$DEFINE LOGLINK} *)
  5. interface
  6. uses
  7. CalcUnit,
  8. Windows, Classes;
  9. { Calculator-specific Types }
  10. type
  11. { Enumeration Types }
  12. TLinkPortType = (lpCOM);
  13. TLinkCableType = (lcBlack, lcGray);
  14. TCalcVarTypeID = Byte;
  15. TLinkPort = record
  16. PortType: TLinkPortType;
  17. PortNumber: Cardinal;
  18. end;
  19. TLinkConnection = record
  20. Port: TLinkPort;
  21. CableType: TLinkCableType;
  22. CalcType: TCalcDest;
  23. Open: Boolean;
  24. PortHandle: THandle;
  25. end;
  26. { Variable or Folder Name }
  27. TCalcVarName = array [0..9] of Char;
  28. { Variable Structure }
  29. TCalcVar = record
  30. CalcType: TCalcDest;
  31. Folder,
  32. Name: TCalcVarName;
  33. TypeID: TCalcVarTypeID;
  34. Size: LongWord;
  35. end;
  36. { Progress callback function
  37. Should return False if cancelled, True otherwise }
  38. TProgressCallBack = function(ID: Pointer; Progress: PDWord): Boolean;
  39. { Variable list callback function
  40. This type is called by GetVarList on every item found }
  41. TVarListCallBack = function(ID: Pointer; const NewVar: TCalcVar): Boolean;
  42. { Exported Functions }
  43. function CreateConnection(var Connection: TLinkConnection): Boolean;
  44. function OpenConnection(var Connection: TLinkConnection): Boolean;
  45. procedure CloseConnection(var Connection: TLinkConnection);
  46. function CalcReady(var Connection: TLinkConnection): Boolean;
  47. function SendAck(var Connection: TLinkConnection): Boolean;
  48. function SendWait(var Connection: TLinkConnection): Boolean;
  49. function SendByte(var Connection: TLinkConnection; Value: Byte; CheckSum: PWord = nil): Boolean;
  50. function SendWord(var Connection: TLinkConnection; Value: Word; CheckSum: PWord = nil): Boolean;
  51. function SendLongWord(var Connection: TLinkConnection; Value: LongWord; CheckSum: PWord = nil): Boolean;
  52. function SendString(var Connection: TLinkConnection; Value: PChar; CheckSum: PWord = nil): Boolean;
  53. function SendKey(var Connection: TLinkConnection; Key: Char): Boolean; overload;
  54. function SendKey(var Connection: TLinkConnection; Key: Word): Boolean; overload;
  55. function SendKeys(var Connection: TLinkConnection; const Keys: string): Boolean;
  56. function SendVar(var Connection: TLinkConnection; Folder, Name: PChar; Buffer: Pointer; BufSize: Cardinal; Progress: PDWord = nil; ProgressCallBack: TProgressCallBack = nil; ID: Pointer = nil): Boolean;
  57. function SendFile(var Connection: TLinkConnection; Folder, Name: PChar; const FileName: string; Progress: PDWord = nil; ProgressCallBack: TProgressCallBack = nil; ID: Pointer = nil): Boolean;
  58. function ExecuteHomeLine(var Connection: TLinkConnection; const Line: string): Boolean;
  59. function CheckFileFormat(var Connection: TLinkConnection; const FileName: string; Folder: PChar = nil; Name: PChar = nil; Size: PWord = nil): Boolean;
  60. function WaitForAck(var Connection: TLinkConnection; LastResult: PByte = nil): Boolean;
  61. function CalcWaiting(var Connection: TLinkConnection; LastResult: PByte = nil): Boolean;
  62. function ReceiveByte(var Connection: TLinkConnection; out Value: Byte; CheckSum: PWord = nil): Boolean;
  63. function ReceiveWord(var Connection: TLinkConnection; out Value: Word; CheckSum: PWord = nil): Boolean;
  64. function ReceiveLongWord(var Connection: TLinkConnection; out Value: LongWord; CheckSum: PWord = nil): Boolean;
  65. function GetCalcType(var Connection: TLinkConnection): Boolean;
  66. implementation
  67. uses
  68. SysUtils, Registry, ComServ;
  69. const
  70. SendRetry = 1;
  71. SendTimeout = 500;
  72. ReceiveTimeout = 2000;
  73. SleepBetweenReady = 500;
  74. FirstReadyTimeout = 5000;
  75. NormalReadyTimeout = 5000;
  76. SendVarTimeout = 2000;
  77. ProgressInterval = 100;
  78. NonBlockingRead = False;
  79. NonBlockingWrite = True;
  80. {$IFDEF LOGLINK}
  81. var
  82. LogFile: Text;
  83. LogSend: Boolean;
  84. {$ENDIF}
  85. var
  86. OpenedOnce: Boolean = False;
  87. function GetPortState(Handle: THandle): Cardinal; forward;
  88. procedure SetPortState(Handle: THandle; State: Cardinal); forward;
  89. function GetPortName(const Port: TLinkPort): string; forward;
  90. function IsValidAck(Value: Byte): Boolean; forward;
  91. { Creates a connection, opening the link port, but does not transfer any
  92. data. }
  93. function CreateConnection(var Connection: TLinkConnection): Boolean;
  94. var
  95. NewHandle: THandle;
  96. Settings: TDCB;
  97. Timeouts: TCommTimeouts;
  98. begin
  99. Result := False;
  100. NewHandle := CreateFile (PChar (GetPortName (Connection.Port) + ':'), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  101. if NewHandle = INVALID_HANDLE_VALUE then
  102. Exit;
  103. if Connection.CableType = lcBlack then begin
  104. if not SetCommBreak (NewHandle) then begin
  105. CloseHandle (NewHandle);
  106. Exit;
  107. end;
  108. end else begin
  109. if not SetupComm (NewHandle, 1024, 1024) then begin
  110. CloseHandle (NewHandle);
  111. Exit;
  112. end;
  113. FillChar (Settings, SizeOf (Settings), 0);
  114. with Settings do begin
  115. DCBLength := SizeOf (Settings);
  116. BaudRate := CBR_9600;
  117. ByteSize := 8;
  118. StopBits := ONESTOPBIT;
  119. Flags := $00001001;
  120. end;
  121. if not SetCommState (NewHandle, Settings) then begin
  122. CloseHandle (NewHandle);
  123. Exit;
  124. end;
  125. FillChar (Timeouts, SizeOf (Timeouts), 0);
  126. with Timeouts do begin
  127. ReadIntervalTimeout := MaxDWord;
  128. if not NonBlockingRead then
  129. ReadTotalTimeoutConstant := ReceiveTimeout;
  130. if not NonBlockingWrite then
  131. WriteTotalTimeoutConstant := SendTimeOut;
  132. end;
  133. if not SetCommTimeouts (NewHandle, Timeouts) then begin
  134. CloseHandle (NewHandle);
  135. Exit;
  136. end;
  137. end;
  138. Connection.PortHandle := NewHandle;
  139. Result := True;
  140. end;
  141. { Opens a connection if it is not already open. }
  142. function OpenConnection(var Connection: TLinkConnection): Boolean;
  143. var
  144. Timeout,
  145. StartTime: Cardinal;
  146. begin
  147. if Connection.Open then
  148. Result := True
  149. else begin
  150. {$IFDEF LOGLINK}
  151. AssignFile (LogFile, 'C:\Linklog.txt');
  152. ReWrite (LogFile);
  153. Write (LogFile, ' - Calculator Link Log - ');
  154. LogSend := False;
  155. {$ENDIF}
  156. Connection.Open := True;
  157. if OpenedOnce then
  158. Timeout := NormalReadyTimeout
  159. else
  160. Timeout := FirstReadyTimeout;
  161. StartTime := GetTickCount;
  162. repeat
  163. Result := CalcReady (Connection);
  164. if not Result then
  165. Sleep (SleepBetweenReady);
  166. until Result or (GetTickCount - StartTime > Timeout);
  167. OpenedOnce := True;
  168. if not Result then
  169. Connection.Open := False;
  170. end;
  171. end;
  172. { Closes a connection if it is open, and frees the handle. }
  173. procedure CloseConnection(var Connection: TLinkConnection);
  174. begin
  175. if Connection.CableType = lcBlack then
  176. SetPortState (Connection.PortHandle, 0);
  177. CloseHandle (Connection.PortHandle);
  178. {$IFDEF LOGLINK}
  179. CloseFile (LogFile);
  180. {$ENDIF}
  181. end;
  182. procedure ResetConnection(var Connection: TLinkConnection);
  183. begin
  184. if Connection.CableType = lcBlack then
  185. SetPortState (Connection.PortHandle, 0);
  186. end;
  187. function WaitForAck(var Connection: TLinkConnection; LastResult: PByte = nil): Boolean;
  188. var
  189. TempResult: Byte;
  190. begin
  191. Result :=
  192. ReceiveByte (Connection, TempResult) and IsValidAck (TempResult) and
  193. ReceiveByte (Connection, TempResult) and (TempResult = $56) and
  194. ReceiveByte (Connection, TempResult) and
  195. ReceiveByte (Connection, TempResult);
  196. if Assigned (LastResult) then
  197. LastResult^ := TempResult;
  198. end;
  199. function CalcReady(var Connection: TLinkConnection): Boolean;
  200. var
  201. TempResult: Byte;
  202. begin
  203. Result := False;
  204. if not
  205. (SendByte (Connection, $09) and
  206. SendByte (Connection, $68) and
  207. SendByte (Connection, $00) and
  208. SendByte (Connection, $00) and
  209. WaitForAck (Connection) and
  210. SendByte (Connection, $08) and
  211. SendByte (Connection, $68) and
  212. SendByte (Connection, $00) and
  213. SendByte (Connection, $00) and
  214. ReceiveByte (Connection, TempResult) and IsValidAck (TempResult)) then
  215. Exit;
  216. case TempResult of
  217. $98, $89: Connection.CalcType := cdTI89;
  218. $88: Connection.CalcType := cdTI92Plus;
  219. else Exit;
  220. end;
  221. Result :=
  222. ReceiveByte (Connection, TempResult) and (TempResult = $56) and
  223. ReceiveByte (Connection, TempResult) and
  224. ReceiveByte (Connection, TempResult);
  225. end;
  226. function CalcWaiting(var Connection: TLinkConnection; LastResult: PByte = nil): Boolean;
  227. var
  228. TempResult: Byte;
  229. begin
  230. Result :=
  231. ReceiveByte (Connection, TempResult) and IsValidAck (TempResult) and
  232. ReceiveByte (Connection, TempResult) and (TempResult = $09) and
  233. ReceiveByte (Connection, TempResult) and
  234. ReceiveByte (Connection, TempResult);
  235. if Assigned (LastResult) then
  236. LastResult^ := TempResult;
  237. end;
  238. function SendAck(var Connection: TLinkConnection): Boolean;
  239. begin
  240. Result :=
  241. SendByte (Connection, $08) and
  242. SendByte (Connection, $56) and
  243. SendByte (Connection, $00) and
  244. SendByte (Connection, $00);
  245. end;
  246. function SendWait(var Connection: TLinkConnection): Boolean;
  247. begin
  248. Result :=
  249. SendByte (Connection, $08) and
  250. SendByte (Connection, $09) and
  251. SendByte (Connection, $00) and
  252. SendByte (Connection, $00);
  253. end;
  254. function SendByte(var Connection: TLinkConnection; Value: Byte; CheckSum: PWord = nil): Boolean;
  255. var
  256. I: Cardinal;
  257. StartTime: Cardinal;
  258. RetryCount: Integer;
  259. State: Cardinal;
  260. begin
  261. Result := OpenConnection (Connection);
  262. if Result then begin
  263. {$IFDEF LOGLINK}
  264. if not LogSend then begin
  265. WriteLn (LogFile);
  266. WriteLn (LogFile, 'Sending:');
  267. LogSend := True;
  268. end;
  269. Write (LogFile, ' ' + IntToHex (Value, 2));
  270. {$ENDIF}
  271. if Connection.CableType = lcGray then
  272. Result := WriteFile (Connection.PortHandle, Value, 1, I, nil)
  273. else begin
  274. StartTime := GetTickCount;
  275. for I := 0 to 7 do begin
  276. for RetryCount := 0 to SendRetry do begin
  277. if ((Value and (1 shl I)) <> 0) then
  278. SetPortState (Connection.PortHandle, 2)
  279. else
  280. SetPortState (Connection.PortHandle, 1);
  281. repeat
  282. State := GetPortState (Connection.PortHandle);
  283. if GetTickCount - StartTime > SendTimeout then
  284. Break;
  285. until State = 0;
  286. if State = 0 then
  287. break;
  288. end;
  289. if State <> 0 then begin
  290. Result := False;
  291. Exit;
  292. end;
  293. for RetryCount := 0 to SendRetry do begin
  294. SetPortState (Connection.PortHandle, 3);
  295. repeat
  296. State := GetPortState (Connection.PortHandle);
  297. if GetTickCount - StartTime > SendTimeout then
  298. Break;
  299. until State = 3;
  300. if State = 3 then
  301. break;
  302. end;
  303. if State <> 3 then begin
  304. Result := False;
  305. Exit;
  306. end;
  307. end;
  308. end;
  309. if Assigned (CheckSum) then
  310. Inc (CheckSum^, Value);
  311. end;
  312. end;
  313. function SendWord(var Connection: TLinkConnection; Value: Word; CheckSum: PWord = nil): Boolean;
  314. begin
  315. Result :=
  316. SendByte (Connection, Value, CheckSum) and
  317. SendByte (Connection, (Value shr (SizeOf (Value) * 4)), CheckSum);
  318. end;
  319. function SendLongWord(var Connection: TLinkConnection; Value: LongWord; CheckSum: PWord = nil): Boolean;
  320. begin
  321. Result :=
  322. SendWord (Connection, Value, CheckSum) and
  323. SendWord (Connection, (Value shr (SizeOf (Value) * 4)), CheckSum);
  324. end;
  325. function SendString(var Connection: TLinkConnection; Value: PChar; CheckSum: PWord = nil): Boolean;
  326. begin
  327. Result := True;
  328. while Value [0] <> #0 do begin
  329. Result := Result and SendByte (Connection, Byte (Value [0]), CheckSum);
  330. Value := @(Value[1]);
  331. end;
  332. end;
  333. function SendKey(var Connection: TLinkConnection; Key: Char): Boolean; overload;
  334. begin
  335. Result :=
  336. SendByte (Connection, $09) and
  337. SendByte (Connection, $87) and
  338. SendWord (Connection, Byte (Key)) and
  339. WaitForAck (Connection);
  340. end;
  341. function SendKey(var Connection: TLinkConnection; Key: Word): Boolean; overload;
  342. begin
  343. Result :=
  344. SendByte (Connection, $09) and
  345. SendByte (Connection, $87) and
  346. SendWord (Connection, Key) and
  347. WaitForAck (Connection);
  348. end;
  349. function SendKeys(var Connection: TLinkConnection; const Keys: string): Boolean;
  350. var
  351. I: Integer;
  352. begin
  353. Result := OpenConnection (Connection);
  354. for I := 1 to Length (Keys) do begin
  355. Result := SendKey (Connection, Keys [I]);
  356. if not Result then
  357. Break;
  358. end;
  359. end;
  360. function SendVar(var Connection: TLinkConnection; Folder, Name: PChar; Buffer: Pointer; BufSize: Cardinal; Progress: PDWord = nil; ProgressCallBack: TProgressCallBack = nil; ID: Pointer = nil): Boolean;
  361. var
  362. I: Cardinal;
  363. Buf: PByteArray;
  364. FileType: Byte;
  365. FileSize,
  366. BlockSize: Word;
  367. Sum: Word;
  368. TempProgress: DWord;
  369. StartTime: Cardinal;
  370. begin
  371. Result := BufSize >= 88;
  372. if not Result then
  373. Exit;
  374. if not Assigned (Progress) then
  375. Progress := @TempProgress;
  376. Buf := Buffer;
  377. FileType := Buf [72];
  378. Buf [72] := 0;
  379. FileSize := Buf [86] shl 8 + Buf [87] + 2;
  380. if not Assigned (Folder) then
  381. Folder := @(Buf[10]);
  382. Folder [8] := #0;
  383. if not Assigned (Name) then
  384. Name := @(Buf[64]);
  385. Name [8] := #0;
  386. {$IFDEF LOGLINK}
  387. WriteLn (LogFile);
  388. WriteLn (LogFile);
  389. WriteLn (LogFile, AnsiString (Folder), '\', AnsiString (Name), ': ', FileSize, ' (', IntToHex (FileSize, 4), ') Bytes');
  390. {$ENDIF}
  391. Sum := 0;
  392. StartTime := GetTickCount;
  393. repeat until CalcReady (Connection) or (GetTickCount - StartTime > SendVarTimeout);
  394. Result :=
  395. SendKey (Connection, 264) and
  396. SendKey (Connection, 264) and
  397. SendKey (Connection, 277) and
  398. SendByte (Connection, $08) and
  399. SendByte (Connection, $06) and
  400. SendWord (Connection, StrLen (Folder) + StrLen (Name) + 8) and
  401. SendLongWord (Connection, FileSize, @Sum) and
  402. SendByte (Connection, FileType, @Sum) and
  403. SendByte (Connection, StrLen (Folder) + StrLen (Name) + 1, @Sum) and
  404. SendString (Connection, Folder, @Sum) and
  405. SendString (Connection, '\', @Sum) and
  406. SendString (Connection, Name, @Sum) and
  407. SendByte (Connection, $00) and
  408. SendWord (Connection, Sum) and
  409. WaitForAck (Connection) and
  410. CalcWaiting (Connection) and
  411. SendAck (Connection) and
  412. SendByte (Connection, $08) and
  413. SendByte (Connection, $15) and
  414. SendWord (Connection, FileSize + 4) and
  415. SendLongWord (Connection, 0);
  416. if not Result then
  417. Exit;
  418. BlockSize := FileSize - 2;
  419. Sum := 0;
  420. Result :=
  421. SendByte (Connection, BlockSize and $FF00 shr 8, @Sum) and
  422. SendByte (Connection, BlockSize and $00FF, @Sum);
  423. Inc (Progress^, 2);
  424. if not Result then
  425. Exit;
  426. for I := 0 to BlockSize - 1 do begin
  427. if (I < BufSize) and SendByte (Connection, Buf [I + 88], @Sum) then
  428. Inc (Progress^)
  429. else begin
  430. Result := False;
  431. Break;
  432. end;
  433. if ((I + 2) mod ProgressInterval = 0) and Assigned (ProgressCallBack) and (not ProgressCallBack (ID, Progress)) then begin
  434. Result := False;
  435. Break;
  436. end;
  437. end;
  438. if not Result then
  439. Exit;
  440. Result :=
  441. SendWord (Connection, Sum) and
  442. WaitForAck (Connection) and
  443. SendByte (Connection, $08) and
  444. SendByte (Connection, $92) and
  445. SendByte (Connection, $00) and
  446. SendByte (Connection, $00) and
  447. WaitForAck (Connection);
  448. end;
  449. function SendFile(var Connection: TLinkConnection; Folder, Name: PChar; const FileName: string; Progress: PDWord = nil; ProgressCallBack: TProgressCallBack = nil; ID: Pointer = nil): Boolean;
  450. var
  451. FHandle: HFile;
  452. Buffer: Pointer;
  453. Size,
  454. Read: Cardinal;
  455. begin
  456. FHandle := CreateFile (PChar (FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0);
  457. Result := FHandle <> 0;
  458. if not Result then
  459. Exit;
  460. Size := GetFileSize (FHandle, nil);
  461. Buffer := AllocMem (Size);
  462. Result := Assigned (Buffer);
  463. if not Result then begin
  464. CloseHandle (FHandle);
  465. Exit;
  466. end;
  467. Result := ReadFile (FHandle, Buffer^, Size, Read, nil);
  468. CloseHandle (FHandle);
  469. if Result then
  470. Result := SendVar (Connection, Folder, Name, Buffer, Size, Progress, ProgressCallBack, ID);
  471. FreeMem (Buffer);
  472. end;
  473. function CheckFileFormat(var Connection: TLinkConnection; const FileName: string; Folder: PChar = nil; Name: PChar = nil; Size: PWord = nil): Boolean;
  474. var
  475. FHandle: HFile;
  476. Buffer: array [0..4] of Char;
  477. Read: Cardinal;
  478. begin
  479. FHandle := CreateFile (PChar (FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  480. Result :=
  481. (FHandle <> 0) and
  482. ReadFile (FHandle, Buffer, 4, Read, nil);
  483. if not Result then
  484. Exit;
  485. Buffer [4] := #0;
  486. Result := Buffer = '**TI';
  487. if not Result then
  488. Exit;
  489. if Assigned (Folder) then begin
  490. SetFilePointer (FHandle, 10, nil, FILE_BEGIN);
  491. Result := ReadFile (FHandle, Folder^, 8, Read, nil) and Result;
  492. Folder [8] := #0;
  493. end;
  494. if Assigned (Name) then begin
  495. SetFilePointer (FHandle, 64, nil, FILE_BEGIN);
  496. Result := ReadFile (FHandle, Name^, 8, Read, nil) and Result;
  497. Name [8] := #0;
  498. end;
  499. if Assigned (Size) then begin
  500. SetFilePointer (FHandle, 86, nil, FILE_BEGIN);
  501. Result := ReadFile (FHandle, Buffer, 2, Read, nil) and Result;
  502. Size^ := Byte (Buffer [0]) shl 8 + Byte (Buffer [1]) + 2;
  503. end;
  504. if FHandle <> 0 then
  505. CloseHandle (FHandle);
  506. end;
  507. function ExecuteHomeLine(var Connection: TLinkConnection; const Line: string): Boolean;
  508. begin
  509. Result :=
  510. SendKey (Connection, 264) and
  511. SendKey (Connection, 264) and
  512. SendKey (Connection, 277) and
  513. SendKey (Connection, 263) and
  514. SendKey (Connection, 263) and
  515. SendKeys (Connection, Line) and
  516. SendKey (Connection, 13);
  517. end;
  518. function ReceiveByte(var Connection: TLinkConnection; out Value: Byte; CheckSum: PWord = nil): Boolean;
  519. var
  520. I,
  521. State: Cardinal;
  522. StartTime: Cardinal;
  523. begin
  524. Value := 0;
  525. Result := OpenConnection (Connection);
  526. if Result then begin
  527. if Connection.CableType = lcGray then begin
  528. StartTime := GetTickCount;
  529. repeat
  530. Result := ReadFile (Connection.PortHandle, Value, 1, I, nil);
  531. until Result or (GetTickCount - StartTime > ReceiveTimeout);
  532. end else begin
  533. StartTime := GetTickCount;
  534. for I := 0 to 7 do begin
  535. repeat
  536. State := GetPortState (Connection.PortHandle);
  537. if (State = 3) and (GetTickCount - StartTime > ReceiveTimeout) then begin
  538. Result := False;
  539. Exit;
  540. end;
  541. until State <> 3;
  542. if State = 1 then begin
  543. Value := Value or (1 shl I);
  544. SetPortState (Connection.PortHandle, 1);
  545. State := 2;
  546. end else begin
  547. SetPortState (Connection.PortHandle, 2);
  548. State := 1;
  549. end;
  550. while (GetPortState (Connection.PortHandle) and State) = 0 do
  551. if GetTickCount - StartTime > ReceiveTimeout then begin
  552. Result := False;
  553. Exit;
  554. end;
  555. SetPortState (Connection.PortHandle, 3);
  556. end;
  557. end;
  558. if Assigned (CheckSum) then
  559. Inc (CheckSum^, Value);
  560. {$IFDEF LOGLINK}
  561. if LogSend then begin
  562. WriteLn (LogFile);
  563. WriteLn (LogFile, 'Receiving:');
  564. LogSend := False;
  565. end;
  566. Write (LogFile, ' ' + IntToHex (Value, 2));
  567. {$ENDIF}
  568. end;
  569. end;
  570. function ReceiveWord(var Connection: TLinkConnection; out Value: Word; CheckSum: PWord = nil): Boolean;
  571. var
  572. Temp1,
  573. Temp2: Byte;
  574. begin
  575. Result :=
  576. ReceiveByte (Connection, Temp1, CheckSum) and
  577. ReceiveByte (Connection, Temp2, CheckSum);
  578. Value := Temp1 or (Temp2 shl (SizeOf (Temp1) * 8));
  579. end;
  580. function ReceiveLongWord(var Connection: TLinkConnection; out Value: LongWord; CheckSum: PWord = nil): Boolean;
  581. var
  582. Temp1,
  583. Temp2: Word;
  584. begin
  585. Result :=
  586. ReceiveWord (Connection, Temp1, CheckSum) and
  587. ReceiveWord (Connection, Temp2, CheckSum);
  588. Value := Temp1 or (Temp2 shl (SizeOf (Temp1) * 8));
  589. end;
  590. function GetCalcType(var Connection: TLinkConnection): Boolean;
  591. begin
  592. Result := OpenConnection (Connection);
  593. end;
  594. function GetPortState(Handle: THandle): Cardinal;
  595. var
  596. InternalState: Cardinal;
  597. begin
  598. GetCommModemStatus (Handle, InternalState);
  599. Result := 0;
  600. if (InternalState and MS_CTS_ON) <> 0 then
  601. Inc (Result, 1);
  602. if (InternalState and MS_DSR_ON) <> 0 then
  603. Inc (Result, 2);
  604. end;
  605. procedure SetPortState(Handle: THandle; State: Cardinal);
  606. procedure Send(Func: Cardinal);
  607. begin
  608. EscapeCommFunction (Handle, Func);
  609. end;
  610. begin
  611. if (State and 2) <> 0 then
  612. Send (SETRTS)
  613. else
  614. Send (CLRRTS);
  615. if (State and 1) <> 0 then
  616. Send (SETDTR)
  617. else
  618. Send (CLRDTR);
  619. end;
  620. function GetPortName(const Port: TLinkPort): string;
  621. begin
  622. case Port.PortType of
  623. lpCOM: Result := 'COM' + IntToStr (Port.PortNumber);
  624. else Result := '';
  625. end;
  626. end;
  627. function IsValidAck(Value: Byte): Boolean;
  628. begin
  629. Result := Value in [$88, $89, $98];
  630. end;
  631. end.