LinkUnit.pas 20 KB

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