123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702 |
- {
- TIGCC IDE
- Copyright (C) 2000-2004 Sebastian Reichelt
- 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, ComServ;
- 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.
|