LinkUnit.pas 20 KB

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