{ TIGCC IDE Copyright (C) 2000-2004 Sebastian Reichelt Copyright (C) 2007 Kevin Kofler This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. } unit LinkUnit; { Uncomment to enable logging of all bytes sent and received to C:\Linklog.txt. } (* {$DEFINE LOGLINK} *) interface uses CalcUnit, Windows, Classes; { Calculator-specific Types } type { Enumeration Types } TLinkPortType = (lpCOM); TLinkCableType = (lcBlack, lcGray); TCalcVarTypeID = Byte; TLinkPort = record PortType: TLinkPortType; PortNumber: Cardinal; end; TLinkConnection = record Port: TLinkPort; CableType: TLinkCableType; CalcType: TCalcDest; Open: Boolean; PortHandle: THandle; end; { Variable or Folder Name } TCalcVarName = array [0..9] of Char; { Variable Structure } TCalcVar = record CalcType: TCalcDest; Folder, Name: TCalcVarName; TypeID: TCalcVarTypeID; Size: LongWord; end; { Progress callback function Should return False if cancelled, True otherwise } TProgressCallBack = function(ID: Pointer; Progress: PDWord): Boolean; { Variable list callback function This type is called by GetVarList on every item found } TVarListCallBack = function(ID: Pointer; const NewVar: TCalcVar): Boolean; { Exported Functions } function CreateConnection(var Connection: TLinkConnection): Boolean; function OpenConnection(var Connection: TLinkConnection): Boolean; procedure CloseConnection(var Connection: TLinkConnection); function CalcReady(var Connection: TLinkConnection): Boolean; function SendAck(var Connection: TLinkConnection): Boolean; function SendWait(var Connection: TLinkConnection): Boolean; function SendByte(var Connection: TLinkConnection; Value: Byte; CheckSum: PWord = nil): Boolean; function SendWord(var Connection: TLinkConnection; Value: Word; CheckSum: PWord = nil): Boolean; function SendLongWord(var Connection: TLinkConnection; Value: LongWord; CheckSum: PWord = nil): Boolean; function SendString(var Connection: TLinkConnection; Value: PChar; CheckSum: PWord = nil): Boolean; function SendKey(var Connection: TLinkConnection; Key: Char): Boolean; overload; function SendKey(var Connection: TLinkConnection; Key: Word): Boolean; overload; function SendKeys(var Connection: TLinkConnection; const Keys: string): Boolean; function SendVar(var Connection: TLinkConnection; Folder, Name: PChar; Buffer: Pointer; BufSize: Cardinal; Progress: PDWord = nil; ProgressCallBack: TProgressCallBack = nil; ID: Pointer = nil): Boolean; function SendFile(var Connection: TLinkConnection; Folder, Name: PChar; const FileName: string; Progress: PDWord = nil; ProgressCallBack: TProgressCallBack = nil; ID: Pointer = nil): Boolean; function ExecuteHomeLine(var Connection: TLinkConnection; const Line: string): Boolean; function CheckFileFormat(var Connection: TLinkConnection; const FileName: string; Folder: PChar = nil; Name: PChar = nil; Size: PWord = nil): Boolean; function WaitForAck(var Connection: TLinkConnection; LastResult: PByte = nil): Boolean; function CalcWaiting(var Connection: TLinkConnection; LastResult: PByte = nil): Boolean; function ReceiveByte(var Connection: TLinkConnection; out Value: Byte; CheckSum: PWord = nil): Boolean; function ReceiveWord(var Connection: TLinkConnection; out Value: Word; CheckSum: PWord = nil): Boolean; function ReceiveLongWord(var Connection: TLinkConnection; out Value: LongWord; CheckSum: PWord = nil): Boolean; function GetCalcType(var Connection: TLinkConnection): Boolean; implementation uses SysUtils, Registry; const SendRetry = 1; SendTimeout = 500; ReceiveTimeout = 2000; SleepBetweenReady = 500; FirstReadyTimeout = 5000; NormalReadyTimeout = 5000; SendVarTimeout = 2000; ProgressInterval = 100; NonBlockingRead = False; NonBlockingWrite = True; {$IFDEF LOGLINK} var LogFile: Text; LogSend: Boolean; {$ENDIF} var OpenedOnce: Boolean = False; function GetPortState(Handle: THandle): Cardinal; forward; procedure SetPortState(Handle: THandle; State: Cardinal); forward; function GetPortName(const Port: TLinkPort): string; forward; function IsValidAck(Value: Byte): Boolean; forward; { Creates a connection, opening the link port, but does not transfer any data. } function CreateConnection(var Connection: TLinkConnection): Boolean; var NewHandle: THandle; Settings: TDCB; Timeouts: TCommTimeouts; begin Result := False; NewHandle := CreateFile (PChar (GetPortName (Connection.Port) + ':'), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); if NewHandle = INVALID_HANDLE_VALUE then Exit; if Connection.CableType = lcBlack then begin if not SetCommBreak (NewHandle) then begin CloseHandle (NewHandle); Exit; end; end else begin if not SetupComm (NewHandle, 1024, 1024) then begin CloseHandle (NewHandle); Exit; end; FillChar (Settings, SizeOf (Settings), 0); with Settings do begin DCBLength := SizeOf (Settings); BaudRate := CBR_9600; ByteSize := 8; StopBits := ONESTOPBIT; Flags := $00001001; end; if not SetCommState (NewHandle, Settings) then begin CloseHandle (NewHandle); Exit; end; FillChar (Timeouts, SizeOf (Timeouts), 0); with Timeouts do begin ReadIntervalTimeout := MaxDWord; if not NonBlockingRead then ReadTotalTimeoutConstant := ReceiveTimeout; if not NonBlockingWrite then WriteTotalTimeoutConstant := SendTimeOut; end; if not SetCommTimeouts (NewHandle, Timeouts) then begin CloseHandle (NewHandle); Exit; end; end; Connection.PortHandle := NewHandle; Result := True; end; { Opens a connection if it is not already open. } function OpenConnection(var Connection: TLinkConnection): Boolean; var Timeout, StartTime: Cardinal; begin if Connection.Open then Result := True else begin {$IFDEF LOGLINK} AssignFile (LogFile, 'C:\Linklog.txt'); ReWrite (LogFile); Write (LogFile, ' - Calculator Link Log - '); LogSend := False; {$ENDIF} Connection.Open := True; if OpenedOnce then Timeout := NormalReadyTimeout else Timeout := FirstReadyTimeout; StartTime := GetTickCount; repeat Result := CalcReady (Connection); if not Result then Sleep (SleepBetweenReady); until Result or (GetTickCount - StartTime > Timeout); OpenedOnce := True; if not Result then Connection.Open := False; end; end; { Closes a connection if it is open, and frees the handle. } procedure CloseConnection(var Connection: TLinkConnection); begin if Connection.CableType = lcBlack then SetPortState (Connection.PortHandle, 0); CloseHandle (Connection.PortHandle); {$IFDEF LOGLINK} CloseFile (LogFile); {$ENDIF} end; procedure ResetConnection(var Connection: TLinkConnection); begin if Connection.CableType = lcBlack then SetPortState (Connection.PortHandle, 0); end; function WaitForAck(var Connection: TLinkConnection; LastResult: PByte = nil): Boolean; var TempResult: Byte; begin Result := ReceiveByte (Connection, TempResult) and IsValidAck (TempResult) and ReceiveByte (Connection, TempResult) and (TempResult = $56) and ReceiveByte (Connection, TempResult) and ReceiveByte (Connection, TempResult); if Assigned (LastResult) then LastResult^ := TempResult; end; function CalcReady(var Connection: TLinkConnection): Boolean; var TempResult: Byte; begin Result := False; if not (SendByte (Connection, $09) and SendByte (Connection, $68) and SendByte (Connection, $00) and SendByte (Connection, $00) and WaitForAck (Connection) and SendByte (Connection, $08) and SendByte (Connection, $68) and SendByte (Connection, $00) and SendByte (Connection, $00) and ReceiveByte (Connection, TempResult) and IsValidAck (TempResult)) then Exit; case TempResult of $98, $89: Connection.CalcType := cdTI89; $88: Connection.CalcType := cdTI92Plus; else Exit; end; Result := ReceiveByte (Connection, TempResult) and (TempResult = $56) and ReceiveByte (Connection, TempResult) and ReceiveByte (Connection, TempResult); end; function CalcWaiting(var Connection: TLinkConnection; LastResult: PByte = nil): Boolean; var TempResult: Byte; begin Result := ReceiveByte (Connection, TempResult) and IsValidAck (TempResult) and ReceiveByte (Connection, TempResult) and (TempResult = $09) and ReceiveByte (Connection, TempResult) and ReceiveByte (Connection, TempResult); if Assigned (LastResult) then LastResult^ := TempResult; end; function SendAck(var Connection: TLinkConnection): Boolean; begin Result := SendByte (Connection, $08) and SendByte (Connection, $56) and SendByte (Connection, $00) and SendByte (Connection, $00); end; function SendWait(var Connection: TLinkConnection): Boolean; begin Result := SendByte (Connection, $08) and SendByte (Connection, $09) and SendByte (Connection, $00) and SendByte (Connection, $00); end; function SendByte(var Connection: TLinkConnection; Value: Byte; CheckSum: PWord = nil): Boolean; var I: Cardinal; StartTime: Cardinal; RetryCount: Integer; State: Cardinal; begin Result := OpenConnection (Connection); if Result then begin {$IFDEF LOGLINK} if not LogSend then begin WriteLn (LogFile); WriteLn (LogFile, 'Sending:'); LogSend := True; end; Write (LogFile, ' ' + IntToHex (Value, 2)); {$ENDIF} if Connection.CableType = lcGray then Result := WriteFile (Connection.PortHandle, Value, 1, I, nil) else begin StartTime := GetTickCount; for I := 0 to 7 do begin for RetryCount := 0 to SendRetry do begin if ((Value and (1 shl I)) <> 0) then SetPortState (Connection.PortHandle, 2) else SetPortState (Connection.PortHandle, 1); repeat State := GetPortState (Connection.PortHandle); if GetTickCount - StartTime > SendTimeout then Break; until State = 0; if State = 0 then break; end; if State <> 0 then begin Result := False; Exit; end; for RetryCount := 0 to SendRetry do begin SetPortState (Connection.PortHandle, 3); repeat State := GetPortState (Connection.PortHandle); if GetTickCount - StartTime > SendTimeout then Break; until State = 3; if State = 3 then break; end; if State <> 3 then begin Result := False; Exit; end; end; end; if Assigned (CheckSum) then Inc (CheckSum^, Value); end; end; function SendWord(var Connection: TLinkConnection; Value: Word; CheckSum: PWord = nil): Boolean; begin Result := SendByte (Connection, Value, CheckSum) and SendByte (Connection, (Value shr (SizeOf (Value) * 4)), CheckSum); end; function SendLongWord(var Connection: TLinkConnection; Value: LongWord; CheckSum: PWord = nil): Boolean; begin Result := SendWord (Connection, Value, CheckSum) and SendWord (Connection, (Value shr (SizeOf (Value) * 4)), CheckSum); end; function SendString(var Connection: TLinkConnection; Value: PChar; CheckSum: PWord = nil): Boolean; begin Result := True; while Value [0] <> #0 do begin Result := Result and SendByte (Connection, Byte (Value [0]), CheckSum); Value := @(Value[1]); end; end; function SendKey(var Connection: TLinkConnection; Key: Char): Boolean; overload; begin Result := SendByte (Connection, $09) and SendByte (Connection, $87) and SendWord (Connection, Byte (Key)) and WaitForAck (Connection); end; function SendKey(var Connection: TLinkConnection; Key: Word): Boolean; overload; begin Result := SendByte (Connection, $09) and SendByte (Connection, $87) and SendWord (Connection, Key) and WaitForAck (Connection); end; function SendKeys(var Connection: TLinkConnection; const Keys: string): Boolean; var I: Integer; begin Result := OpenConnection (Connection); for I := 1 to Length (Keys) do begin Result := SendKey (Connection, Keys [I]); if not Result then Break; end; end; function SendVar(var Connection: TLinkConnection; Folder, Name: PChar; Buffer: Pointer; BufSize: Cardinal; Progress: PDWord = nil; ProgressCallBack: TProgressCallBack = nil; ID: Pointer = nil): Boolean; var I: Cardinal; Buf: PByteArray; FileType: Byte; FileSize, BlockSize: Word; Sum: Word; TempProgress: DWord; StartTime: Cardinal; begin Result := BufSize >= 88; if not Result then Exit; if not Assigned (Progress) then Progress := @TempProgress; Buf := Buffer; FileType := Buf [72]; Buf [72] := 0; FileSize := Buf [86] shl 8 + Buf [87] + 2; if not Assigned (Folder) then Folder := @(Buf[10]); Folder [8] := #0; if not Assigned (Name) then Name := @(Buf[64]); Name [8] := #0; {$IFDEF LOGLINK} WriteLn (LogFile); WriteLn (LogFile); WriteLn (LogFile, AnsiString (Folder), '\', AnsiString (Name), ': ', FileSize, ' (', IntToHex (FileSize, 4), ') Bytes'); {$ENDIF} Sum := 0; StartTime := GetTickCount; repeat until CalcReady (Connection) or (GetTickCount - StartTime > SendVarTimeout); Result := SendKey (Connection, 264) and SendKey (Connection, 264) and SendKey (Connection, 277) and SendByte (Connection, $08) and SendByte (Connection, $06) and SendWord (Connection, StrLen (Folder) + StrLen (Name) + 8) and SendLongWord (Connection, FileSize, @Sum) and SendByte (Connection, FileType, @Sum) and SendByte (Connection, StrLen (Folder) + StrLen (Name) + 1, @Sum) and SendString (Connection, Folder, @Sum) and SendString (Connection, '\', @Sum) and SendString (Connection, Name, @Sum) and SendByte (Connection, $00) and SendWord (Connection, Sum) and WaitForAck (Connection) and CalcWaiting (Connection) and SendAck (Connection) and SendByte (Connection, $08) and SendByte (Connection, $15) and SendWord (Connection, FileSize + 4) and SendLongWord (Connection, 0); if not Result then Exit; BlockSize := FileSize - 2; Sum := 0; Result := SendByte (Connection, BlockSize and $FF00 shr 8, @Sum) and SendByte (Connection, BlockSize and $00FF, @Sum); Inc (Progress^, 2); if not Result then Exit; for I := 0 to BlockSize - 1 do begin if (I < BufSize) and SendByte (Connection, Buf [I + 88], @Sum) then Inc (Progress^) else begin Result := False; Break; end; if ((I + 2) mod ProgressInterval = 0) and Assigned (ProgressCallBack) and (not ProgressCallBack (ID, Progress)) then begin Result := False; Break; end; end; if not Result then Exit; Result := SendWord (Connection, Sum) and WaitForAck (Connection) and SendByte (Connection, $08) and SendByte (Connection, $92) and SendByte (Connection, $00) and SendByte (Connection, $00) and WaitForAck (Connection); end; function SendFile(var Connection: TLinkConnection; Folder, Name: PChar; const FileName: string; Progress: PDWord = nil; ProgressCallBack: TProgressCallBack = nil; ID: Pointer = nil): Boolean; var FHandle: HFile; Buffer: Pointer; Size, Read: Cardinal; begin FHandle := CreateFile (PChar (FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0); Result := FHandle <> 0; if not Result then Exit; Size := GetFileSize (FHandle, nil); Buffer := AllocMem (Size); Result := Assigned (Buffer); if not Result then begin CloseHandle (FHandle); Exit; end; Result := ReadFile (FHandle, Buffer^, Size, Read, nil); CloseHandle (FHandle); if Result then Result := SendVar (Connection, Folder, Name, Buffer, Size, Progress, ProgressCallBack, ID); FreeMem (Buffer); end; function CheckFileFormat(var Connection: TLinkConnection; const FileName: string; Folder: PChar = nil; Name: PChar = nil; Size: PWord = nil): Boolean; var FHandle: HFile; Buffer: array [0..4] of Char; Read: Cardinal; begin FHandle := CreateFile (PChar (FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); Result := (FHandle <> 0) and ReadFile (FHandle, Buffer, 4, Read, nil); if not Result then Exit; Buffer [4] := #0; Result := Buffer = '**TI'; if not Result then Exit; if Assigned (Folder) then begin SetFilePointer (FHandle, 10, nil, FILE_BEGIN); Result := ReadFile (FHandle, Folder^, 8, Read, nil) and Result; Folder [8] := #0; end; if Assigned (Name) then begin SetFilePointer (FHandle, 64, nil, FILE_BEGIN); Result := ReadFile (FHandle, Name^, 8, Read, nil) and Result; Name [8] := #0; end; if Assigned (Size) then begin SetFilePointer (FHandle, 86, nil, FILE_BEGIN); Result := ReadFile (FHandle, Buffer, 2, Read, nil) and Result; Size^ := Byte (Buffer [0]) shl 8 + Byte (Buffer [1]) + 2; end; if FHandle <> 0 then CloseHandle (FHandle); end; function ExecuteHomeLine(var Connection: TLinkConnection; const Line: string): Boolean; begin Result := SendKey (Connection, 264) and SendKey (Connection, 264) and SendKey (Connection, 277) and SendKey (Connection, 263) and SendKey (Connection, 263) and SendKeys (Connection, Line) and SendKey (Connection, 13); end; function ReceiveByte(var Connection: TLinkConnection; out Value: Byte; CheckSum: PWord = nil): Boolean; var I, State: Cardinal; StartTime: Cardinal; begin Value := 0; Result := OpenConnection (Connection); if Result then begin if Connection.CableType = lcGray then begin StartTime := GetTickCount; repeat Result := ReadFile (Connection.PortHandle, Value, 1, I, nil); until Result or (GetTickCount - StartTime > ReceiveTimeout); end else begin StartTime := GetTickCount; for I := 0 to 7 do begin repeat State := GetPortState (Connection.PortHandle); if (State = 3) and (GetTickCount - StartTime > ReceiveTimeout) then begin Result := False; Exit; end; until State <> 3; if State = 1 then begin Value := Value or (1 shl I); SetPortState (Connection.PortHandle, 1); State := 2; end else begin SetPortState (Connection.PortHandle, 2); State := 1; end; while (GetPortState (Connection.PortHandle) and State) = 0 do if GetTickCount - StartTime > ReceiveTimeout then begin Result := False; Exit; end; SetPortState (Connection.PortHandle, 3); end; end; if Assigned (CheckSum) then Inc (CheckSum^, Value); {$IFDEF LOGLINK} if LogSend then begin WriteLn (LogFile); WriteLn (LogFile, 'Receiving:'); LogSend := False; end; Write (LogFile, ' ' + IntToHex (Value, 2)); {$ENDIF} end; end; function ReceiveWord(var Connection: TLinkConnection; out Value: Word; CheckSum: PWord = nil): Boolean; var Temp1, Temp2: Byte; begin Result := ReceiveByte (Connection, Temp1, CheckSum) and ReceiveByte (Connection, Temp2, CheckSum); Value := Temp1 or (Temp2 shl (SizeOf (Temp1) * 8)); end; function ReceiveLongWord(var Connection: TLinkConnection; out Value: LongWord; CheckSum: PWord = nil): Boolean; var Temp1, Temp2: Word; begin Result := ReceiveWord (Connection, Temp1, CheckSum) and ReceiveWord (Connection, Temp2, CheckSum); Value := Temp1 or (Temp2 shl (SizeOf (Temp1) * 8)); end; function GetCalcType(var Connection: TLinkConnection): Boolean; begin Result := OpenConnection (Connection); end; function GetPortState(Handle: THandle): Cardinal; var InternalState: Cardinal; begin GetCommModemStatus (Handle, InternalState); Result := 0; if (InternalState and MS_CTS_ON) <> 0 then Inc (Result, 1); if (InternalState and MS_DSR_ON) <> 0 then Inc (Result, 2); end; procedure SetPortState(Handle: THandle; State: Cardinal); procedure Send(Func: Cardinal); begin EscapeCommFunction (Handle, Func); end; begin if (State and 2) <> 0 then Send (SETRTS) else Send (CLRRTS); if (State and 1) <> 0 then Send (SETDTR) else Send (CLRDTR); end; function GetPortName(const Port: TLinkPort): string; begin case Port.PortType of lpCOM: Result := 'COM' + IntToStr (Port.PortNumber); else Result := ''; end; end; function IsValidAck(Value: Byte): Boolean; begin Result := Value in [$88, $89, $98]; end; end.