/
synaser.pas
2412 lines (2216 loc) · 69 KB
/
synaser.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
{==============================================================================|
| Project : Ararat Synapse | 007.006.001 |
|==============================================================================|
| Content: Serial port support |
|==============================================================================|
| Copyright (c)2001-2017, Lukas Gebauer |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
| modification, are permitted provided that the following conditions are met: |
| |
| Redistributions of source code must retain the above copyright notice, this |
| list of conditions and the following disclaimer. |
| |
| Redistributions in binary form must reproduce the above copyright notice, |
| this list of conditions and the following disclaimer in the documentation |
| and/or other materials provided with the distribution. |
| |
| Neither the name of Lukas Gebauer nor the names of its contributors may |
| be used to endorse or promote products derived from this software without |
| specific prior written permission. |
| |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
| DAMAGE. |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2001-2017. |
| All Rights Reserved. |
|==============================================================================|
| Contributor(s): |
| (c)2002, Hans-Georg Joepgen (cpom Comport Ownership Manager and bugfixes) |
|==============================================================================|
| History: see HISTORY.HTM from distribution package |
| (Found at URL: http://www.ararat.cz/synapse/) |
|==============================================================================}
{: @abstract(Serial port communication library)
This unit contains a class that implements serial port communication
for Windows, Linux, Unix or MacOSx. This class provides numerous methods with
same name and functionality as methods of the Ararat Synapse TCP/IP library.
The following is a small example how establish a connection by modem (in this
case with my USB modem):
@longcode(#
ser:=TBlockSerial.Create;
try
ser.Connect('COM3');
ser.config(460800,8,'N',0,false,true);
ser.ATCommand('AT');
if (ser.LastError <> 0) or (not ser.ATResult) then
Exit;
ser.ATConnect('ATDT+420971200111');
if (ser.LastError <> 0) or (not ser.ATResult) then
Exit;
// you are now connected to a modem at +420971200111
// you can transmit or receive data now
finally
ser.free;
end;
#)
}
//old Delphi does not have MSWINDOWS define.
{$IFDEF WIN32}
{$IFNDEF MSWINDOWS}
{$DEFINE MSWINDOWS}
{$ENDIF}
{$ENDIF}
//Kylix does not known UNIX define
{$IFDEF LINUX}
{$IFNDEF UNIX}
{$DEFINE UNIX}
{$ENDIF}
{$ENDIF}
{$IFDEF FPC}
{$MODE DELPHI}
{$IFDEF MSWINDOWS}
{$ASMMODE intel}
{$ENDIF}
{define working mode w/o LIBC for fpc}
{$DEFINE NO_LIBC}
{$ENDIF}
{$Q-}
{$H+}
{$M+}
unit synaser;
interface
uses
{$IFNDEF MSWINDOWS}
{$IFNDEF NO_LIBC}
Libc,
KernelIoctl,
{$ELSE}
termio, baseunix, unix,
{$ENDIF}
{$IFNDEF FPC}
Types,
{$ENDIF}
{$ELSE}
Windows, registry,
{$IFDEF FPC}
winver,
{$ENDIF}
{$ENDIF}
synafpc,
Classes, SysUtils, synautil;
const
CR = #$0d;
LF = #$0a;
CRLF = CR + LF;
cSerialChunk = 8192;
LockfileDirectory = '/var/lock'; {HGJ}
PortIsClosed = -1; {HGJ}
ErrAlreadyOwned = 9991; {HGJ}
ErrAlreadyInUse = 9992; {HGJ}
ErrWrongParameter = 9993; {HGJ}
ErrPortNotOpen = 9994; {HGJ}
ErrNoDeviceAnswer = 9995; {HGJ}
ErrMaxBuffer = 9996;
ErrTimeout = 9997;
ErrNotRead = 9998;
ErrFrame = 9999;
ErrOverrun = 10000;
ErrRxOver = 10001;
ErrRxParity = 10002;
ErrTxFull = 10003;
dcb_Binary = $00000001;
dcb_ParityCheck = $00000002;
dcb_OutxCtsFlow = $00000004;
dcb_OutxDsrFlow = $00000008;
dcb_DtrControlMask = $00000030;
dcb_DtrControlDisable = $00000000;
dcb_DtrControlEnable = $00000010;
dcb_DtrControlHandshake = $00000020;
dcb_DsrSensivity = $00000040;
dcb_TXContinueOnXoff = $00000080;
dcb_OutX = $00000100;
dcb_InX = $00000200;
dcb_ErrorChar = $00000400;
dcb_NullStrip = $00000800;
dcb_RtsControlMask = $00003000;
dcb_RtsControlDisable = $00000000;
dcb_RtsControlEnable = $00001000;
dcb_RtsControlHandshake = $00002000;
dcb_RtsControlToggle = $00003000;
dcb_AbortOnError = $00004000;
dcb_Reserveds = $FFFF8000;
{:stopbit value for 1 stopbit}
SB1 = 0;
{:stopbit value for 1.5 stopbit}
SB1andHalf = 1;
{:stopbit value for 2 stopbits}
SB2 = 2;
{$IFNDEF MSWINDOWS}
const
INVALID_HANDLE_VALUE = THandle(-1);
CS7fix = $0000020;
type
TDCB = record
DCBlength: DWORD;
BaudRate: DWORD;
Flags: Longint;
wReserved: Word;
XonLim: Word;
XoffLim: Word;
ByteSize: Byte;
Parity: Byte;
StopBits: Byte;
XonChar: CHAR;
XoffChar: CHAR;
ErrorChar: CHAR;
EofChar: CHAR;
EvtChar: CHAR;
wReserved1: Word;
end;
PDCB = ^TDCB;
const
{$IFDEF UNIX}
{$IFDEF BSD}
MaxRates = 18; //MAC
{$ELSE}
MaxRates = 30; //UNIX
{$ENDIF}
{$ELSE}
MaxRates = 19; //WIN
{$ENDIF}
Rates: array[0..MaxRates, 0..1] of cardinal =
(
(0, B0),
(50, B50),
(75, B75),
(110, B110),
(134, B134),
(150, B150),
(200, B200),
(300, B300),
(600, B600),
(1200, B1200),
(1800, B1800),
(2400, B2400),
(4800, B4800),
(9600, B9600),
(19200, B19200),
(38400, B38400),
(57600, B57600),
(115200, B115200),
(230400, B230400)
{$IFNDEF BSD}
,(460800, B460800)
{$IFDEF UNIX}
,(500000, B500000),
(576000, B576000),
(921600, B921600),
(1000000, B1000000),
(1152000, B1152000),
(1500000, B1500000),
(2000000, B2000000),
(2500000, B2500000),
(3000000, B3000000),
(3500000, B3500000),
(4000000, B4000000)
{$ENDIF}
{$ENDIF}
);
{$ENDIF}
{$IFDEF BSD}
const // From fcntl.h
O_SYNC = $0080; { synchronous writes }
{$ENDIF}
const
sOK = 0;
sErr = integer(-1);
type
{:Possible status event types for @link(THookSerialStatus)}
THookSerialReason = (
HR_SerialClose,
HR_Connect,
HR_CanRead,
HR_CanWrite,
HR_ReadCount,
HR_WriteCount,
HR_Wait
);
{:procedural prototype for status event hooking}
THookSerialStatus = procedure(Sender: TObject; Reason: THookSerialReason;
const Value: string) of object;
{:@abstract(Exception type for SynaSer errors)}
ESynaSerError = class(Exception)
public
ErrorCode: integer;
ErrorMessage: string;
end;
ESynaSerErrorBreakEvent = class (ESynaSerError);
{:@abstract(Main class implementing all communication routines)}
TBlockSerial = class(TObject)
protected
FOnStatus: THookSerialStatus;
Fhandle: THandle;
FTag: integer;
FDevice: string;
FLastError: integer;
FLastErrorDesc: string;
FBuffer: AnsiString;
FRaiseExcept: boolean;
FRecvBuffer: integer;
FSendBuffer: integer;
FModemWord: integer;
FRTSToggle: Boolean;
FDeadlockTimeout: integer;
FInstanceActive: boolean; {HGJ}
FTestDSR: Boolean;
FTestCTS: Boolean;
FLastCR: Boolean;
FLastLF: Boolean;
FMaxLineLength: Integer;
FLinuxLock: Boolean;
FMaxSendBandwidth: Integer;
FNextSend: LongWord;
FMaxRecvBandwidth: Integer;
FNextRecv: LongWord;
FConvertLineEnd: Boolean;
FATResult: Boolean;
FAtTimeout: integer;
FInterPacketTimeout: Boolean;
FComNr: integer;
FBreakEvent: THandle;
{$IFDEF MSWINDOWS}
FPortAddr: Word;
function CanEvent(Event: dword; Timeout: integer): boolean;
procedure DecodeCommError(Error: DWord); virtual;
{$IFDEF WIN32}
function GetPortAddr: Word; virtual;
function ReadTxEmpty(PortAddr: Word): Boolean; virtual;
{$ENDIF}
{$ENDIF}
procedure SetSizeRecvBuffer(size: integer); virtual;
function GetDSR: Boolean; virtual;
procedure SetDTRF(Value: Boolean); virtual;
function GetCTS: Boolean; virtual;
procedure SetRTSF(Value: Boolean); virtual;
function GetCarrier: Boolean; virtual;
function GetRing: Boolean; virtual;
procedure DoStatus(Reason: THookSerialReason; const Value: string); virtual;
procedure GetComNr(Value: string); virtual;
function PreTestFailing: boolean; virtual;{HGJ}
function TestCtrlLine: Boolean; virtual;
{$IFDEF UNIX}
procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual;
procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual;
function ReadLockfile: integer; virtual;
function LockfileName: String; virtual;
procedure CreateLockfile(PidNr: integer); virtual;
{$ENDIF}
procedure LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord); virtual;
procedure SetBandwidth(Value: Integer); virtual;
public
{: data Control Block with communication parameters. Usable only when you
need to call API directly.}
DCB: Tdcb;
{$IFDEF UNIX}
TermiosStruc: termios;
{$ENDIF}
{:Object constructor.}
constructor Create;
{:Object destructor.}
destructor Destroy; override;
{:Returns a string containing the version number of the library.}
class function GetVersion: string; virtual;
{:Destroy handle in use. It close connection to serial port.}
procedure CloseSocket; virtual;
{:Reconfigure communication parameters on the fly. You must be connected to
port before!
@param(baud Define connection speed. Baud rate can be from 50 to 4000000
bits per second. (it depends on your hardware!))
@param(bits Number of bits in communication.)
@param(parity Define communication parity (N - None, O - Odd, E - Even, M - Mark or S - Space).)
@param(stop Define number of stopbits. Use constants @link(SB1),
@link(SB1andHalf) and @link(SB2).)
@param(softflow Enable XON/XOFF handshake.)
@param(hardflow Enable CTS/RTS handshake.)}
procedure Config(baud, bits: integer; parity: char; stop: integer;
softflow, hardflow: boolean); virtual;
{:Connects to the port indicated by comport. Comport can be used in Windows
style (COM2), or in Linux style (/dev/ttyS1). When you use windows style
in Linux, then it will be converted to Linux name. And vice versa! However
you can specify any device name! (other device names then standart is not
converted!)
After successfull connection the DTR signal is set (if you not set hardware
handshake, then the RTS signal is set, too!)
Connection parameters is predefined by your system configuration. If you
need use another parameters, then you can use Config method after.
Notes:
- Remember, the commonly used serial Laplink cable does not support
hardware handshake.
- Before setting any handshake you must be sure that it is supported by
your hardware.
- Some serial devices are slow. In some cases you must wait up to a few
seconds after connection for the device to respond.
- when you connect to a modem device, then is best to test it by an empty
AT command. (call ATCommand('AT'))}
procedure Connect(comport: string); virtual;
{:Set communication parameters from the DCB structure (the DCB structure is
simulated under Linux).}
procedure SetCommState; virtual;
{:Read communication parameters into the DCB structure (DCB structure is
simulated under Linux).}
procedure GetCommState; virtual;
{:Sends Length bytes of data from Buffer through the connected port.}
function SendBuffer(buffer: pointer; length: integer): integer; virtual;
{:One data BYTE is sent.}
procedure SendByte(data: byte); virtual;
{:Send the string in the data parameter. No terminator is appended by this
method. If you need to send a string with CR/LF terminator, you must append
the CR/LF characters to the data string!
Since no terminator is appended, you can use this function for sending
binary data too.}
procedure SendString(data: AnsiString); virtual;
{:send four bytes as integer.}
procedure SendInteger(Data: integer); virtual;
{:send data as one block. Each block begins with integer value with Length
of block.}
procedure SendBlock(const Data: AnsiString); virtual;
{:send content of stream from current position}
procedure SendStreamRaw(const Stream: TStream); virtual;
{:send content of stream as block. see @link(SendBlock)}
procedure SendStream(const Stream: TStream); virtual;
{:send content of stream as block, but this is compatioble with Indy library.
(it have swapped lenght of block). See @link(SendStream)}
procedure SendStreamIndy(const Stream: TStream); virtual;
{:Waits until the allocated buffer is filled by received data. Returns number
of data bytes received, which equals to the Length value under normal
operation. If it is not equal, the communication channel is possibly broken.
This method not using any internal buffering, like all others receiving
methods. You cannot freely combine this method with all others receiving
methods!}
function RecvBuffer(buffer: pointer; length: integer): integer; virtual;
{:Method waits until data is received. If no data is received within
the Timeout (in milliseconds) period, @link(LastError) is set to
@link(ErrTimeout). This method is used to read any amount of data
(e. g. 1MB), and may be freely combined with all receviving methods what
have Timeout parameter, like the @link(RecvString), @link(RecvByte) or
@link(RecvTerminated) methods.}
function RecvBufferEx(buffer: pointer; length: integer; timeout: integer): integer; virtual;
{:It is like recvBufferEx, but data is readed to dynamicly allocated binary
string.}
function RecvBufferStr(Length: Integer; Timeout: Integer): AnsiString; virtual;
{:Read all available data and return it in the function result string. This
function may be combined with @link(RecvString), @link(RecvByte) or related
methods.}
function RecvPacket(Timeout: Integer): AnsiString; virtual;
{:Waits until one data byte is received which is returned as the function
result. If no data is received within the Timeout (in milliseconds) period,
@link(LastError) is set to @link(ErrTimeout).}
function RecvByte(timeout: integer): byte; virtual;
{:This method waits until a terminated data string is received. This string
is terminated by the Terminator string. The resulting string is returned
without this termination string! If no data is received within the Timeout
(in milliseconds) period, @link(LastError) is set to @link(ErrTimeout).}
function RecvTerminated(Timeout: Integer; const Terminator: AnsiString): AnsiString; virtual;
{:This method waits until a terminated data string is received. The string
is terminated by a CR/LF sequence. The resulting string is returned without
the terminator (CR/LF)! If no data is received within the Timeout (in
milliseconds) period, @link(LastError) is set to @link(ErrTimeout).
If @link(ConvertLineEnd) is used, then the CR/LF sequence may not be exactly
CR/LF. See the description of @link(ConvertLineEnd).
This method serves for line protocol implementation and uses its own
buffers to maximize performance. Therefore do NOT use this method with the
@link(RecvBuffer) method to receive data as it may cause data loss.}
function Recvstring(timeout: integer): AnsiString; virtual;
{:Waits until four data bytes are received which is returned as the function
integer result. If no data is received within the Timeout (in milliseconds) period,
@link(LastError) is set to @link(ErrTimeout).}
function RecvInteger(Timeout: Integer): Integer; virtual;
{:Waits until one data block is received. See @link(sendblock). If no data
is received within the Timeout (in milliseconds) period, @link(LastError)
is set to @link(ErrTimeout).}
function RecvBlock(Timeout: Integer): AnsiString; virtual;
{:Receive all data to stream, until some error occured. (for example timeout)}
procedure RecvStreamRaw(const Stream: TStream; Timeout: Integer); virtual;
{:receive requested count of bytes to stream}
procedure RecvStreamSize(const Stream: TStream; Timeout: Integer; Size: Integer); virtual;
{:receive block of data to stream. (Data can be sended by @link(sendstream)}
procedure RecvStream(const Stream: TStream; Timeout: Integer); virtual;
{:receive block of data to stream. (Data can be sended by @link(sendstreamIndy)}
procedure RecvStreamIndy(const Stream: TStream; Timeout: Integer); virtual;
{:Returns the number of received bytes waiting for reading. 0 is returned
when there is no data waiting.}
function WaitingData: integer; virtual;
{:Same as @link(WaitingData), but in respect to data in the internal
@link(LineBuffer).}
function WaitingDataEx: integer; virtual;
{:Returns the number of bytes waiting to be sent in the output buffer.
0 is returned when the output buffer is empty.}
function SendingData: integer; virtual;
{:Enable or disable RTS driven communication (half-duplex). It can be used
to communicate with RS485 converters, or other special equipment. If you
enable this feature, the system automatically controls the RTS signal.
Notes:
- On Windows NT (or higher) ir RTS signal driven by system driver.
- On Win9x family is used special code for waiting until last byte is
sended from your UART.
- On Linux you must have kernel 2.1 or higher!}
procedure EnableRTSToggle(value: boolean); virtual;
{:Waits until all data to is sent and buffers are emptied.
Warning: On Windows systems is this method returns when all buffers are
flushed to the serial port controller, before the last byte is sent!}
procedure Flush; virtual;
{:Unconditionally empty all buffers. It is good when you need to interrupt
communication and for cleanups.}
procedure Purge; virtual;
{:Returns @True, if you can from read any data from the port. Status is
tested for a period of time given by the Timeout parameter (in milliseconds).
If the value of the Timeout parameter is 0, the status is tested only once
and the function returns immediately. If the value of the Timeout parameter
is set to -1, the function returns only after it detects data on the port
(this may cause the process to hang).}
function CanRead(Timeout: integer): boolean; virtual;
{:Returns @True, if you can write any data to the port (this function is not
sending the contents of the buffer). Status is tested for a period of time
given by the Timeout parameter (in milliseconds). If the value of
the Timeout parameter is 0, the status is tested only once and the function
returns immediately. If the value of the Timeout parameter is set to -1,
the function returns only after it detects that it can write data to
the port (this may cause the process to hang).}
function CanWrite(Timeout: integer): boolean; virtual;
{:Same as @link(CanRead), but the test is against data in the internal
@link(LineBuffer) too.}
function CanReadEx(Timeout: integer): boolean; virtual;
{:Returns the status word of the modem. Decoding the status word could yield
the status of carrier detect signaland other signals. This method is used
internally by the modem status reading properties. You usually do not need
to call this method directly.}
function ModemStatus: integer; virtual;
{:Send a break signal to the communication device for Duration milliseconds.}
procedure SetBreak(Duration: integer); virtual;
{:This function is designed to send AT commands to the modem. The AT command
is sent in the Value parameter and the response is returned in the function
return value (may contain multiple lines!).
If the AT command is processed successfully (modem returns OK), then the
@link(ATResult) property is set to True.
This function is designed only for AT commands that return OK or ERROR
response! To call connection commands the @link(ATConnect) method.
Remember, when you connect to a modem device, it is in AT command mode.
Now you can send AT commands to the modem. If you need to transfer data to
the modem on the other side of the line, you must first switch to data mode
using the @link(ATConnect) method.}
function ATCommand(value: AnsiString): AnsiString; virtual;
{:This function is used to send connect type AT commands to the modem. It is
for commands to switch to connected state. (ATD, ATA, ATO,...)
It sends the AT command in the Value parameter and returns the modem's
response (may be multiple lines - usually with connection parameters info).
If the AT command is processed successfully (the modem returns CONNECT),
then the ATResult property is set to @True.
This function is designed only for AT commands which respond by CONNECT,
BUSY, NO DIALTONE NO CARRIER or ERROR. For other AT commands use the
@link(ATCommand) method.
The connect timeout is 90*@link(ATTimeout). If this command is successful
(@link(ATresult) is @true), then the modem is in data state. When you now
send or receive some data, it is not to or from your modem, but from the
modem on other side of the line. Now you can transfer your data.
If the connection attempt failed (@link(ATResult) is @False), then the
modem is still in AT command mode.}
function ATConnect(value: AnsiString): AnsiString; virtual;
{:If you "manually" call API functions, forward their return code in
the SerialResult parameter to this function, which evaluates it and sets
@link(LastError) and @link(LastErrorDesc).}
function SerialCheck(SerialResult: integer): integer; virtual;
{:If @link(Lasterror) is not 0 and exceptions are enabled, then this procedure
raises an exception. This method is used internally. You may need it only
in special cases.}
procedure ExceptCheck; virtual;
{:Set Synaser to error state with ErrNumber code. Usually used by internal
routines.}
procedure SetSynaError(ErrNumber: integer); virtual;
{:Raise Synaser error with ErrNumber code. Usually used by internal routines.}
procedure RaiseSynaError(ErrNumber: integer); virtual;
{$IFDEF UNIX}
function cpomComportAccessible: boolean; virtual;{HGJ}
procedure cpomReleaseComport; virtual; {HGJ}
{$ENDIF}
{:True device name of currently used port}
property Device: string read FDevice;
{:Error code of last operation. Value is defined by the host operating
system, but value 0 is always OK.}
property LastError: integer read FLastError;
{:Human readable description of LastError code.}
property LastErrorDesc: string read FLastErrorDesc;
{:Indicates if the last @link(ATCommand) or @link(ATConnect) method was successful}
property ATResult: Boolean read FATResult;
{:Read the value of the RTS signal.}
property RTS: Boolean write SetRTSF;
{:Indicates the presence of the CTS signal}
property CTS: boolean read GetCTS;
{:Use this property to set the value of the DTR signal.}
property DTR: Boolean write SetDTRF;
{:Exposes the status of the DSR signal.}
property DSR: boolean read GetDSR;
{:Indicates the presence of the Carrier signal}
property Carrier: boolean read GetCarrier;
{:Reflects the status of the Ring signal.}
property Ring: boolean read GetRing;
{:indicates if this instance of SynaSer is active. (Connected to some port)}
property InstanceActive: boolean read FInstanceActive; {HGJ}
{:Defines maximum bandwidth for all sending operations in bytes per second.
If this value is set to 0 (default), bandwidth limitation is not used.}
property MaxSendBandwidth: Integer read FMaxSendBandwidth Write FMaxSendBandwidth;
{:Defines maximum bandwidth for all receiving operations in bytes per second.
If this value is set to 0 (default), bandwidth limitation is not used.}
property MaxRecvBandwidth: Integer read FMaxRecvBandwidth Write FMaxRecvBandwidth;
{:Defines maximum bandwidth for all sending and receiving operations
in bytes per second. If this value is set to 0 (default), bandwidth
limitation is not used.}
property MaxBandwidth: Integer Write SetBandwidth;
{:Size of the Windows internal receive buffer. Default value is usually
4096 bytes. Note: Valid only in Windows versions!}
property SizeRecvBuffer: integer read FRecvBuffer write SetSizeRecvBuffer;
published
{:Returns the descriptive text associated with ErrorCode. You need this
method only in special cases. Description of LastError is now accessible
through the LastErrorDesc property.}
class function GetErrorDesc(ErrorCode: integer): string;
{:Freely usable property}
property Tag: integer read FTag write FTag;
{:Contains the handle of the open communication port.
You may need this value to directly call communication functions outside
SynaSer.}
property Handle: THandle read Fhandle write FHandle;
{:Internally used read buffer.}
property LineBuffer: AnsiString read FBuffer write FBuffer;
{:If @true, communication errors raise exceptions. If @false (default), only
the @link(LastError) value is set.}
property RaiseExcept: boolean read FRaiseExcept write FRaiseExcept;
{:This event is triggered when the communication status changes. It can be
used to monitor communication status.}
property OnStatus: THookSerialStatus read FOnStatus write FOnStatus;
{:If you set this property to @true, then the value of the DSR signal
is tested before every data transfer. It can be used to detect the presence
of a communications device.}
property TestDSR: boolean read FTestDSR write FTestDSR;
{:If you set this property to @true, then the value of the CTS signal
is tested before every data transfer. It can be used to detect the presence
of a communications device. Warning: This property cannot be used if you
need hardware handshake!}
property TestCTS: boolean read FTestCTS write FTestCTS;
{:Use this property you to limit the maximum size of LineBuffer
(as a protection against unlimited memory allocation for LineBuffer).
Default value is 0 - no limit.}
property MaxLineLength: Integer read FMaxLineLength Write FMaxLineLength;
{:This timeout value is used as deadlock protection when trying to send data
to (or receive data from) a device that stopped communicating during data
transmission (e.g. by physically disconnecting the device).
The timeout value is in milliseconds. The default value is 30,000 (30 seconds).}
property DeadlockTimeout: Integer read FDeadlockTimeout Write FDeadlockTimeout;
{:If set to @true (default value), port locking is enabled (under Linux only).
WARNING: To use this feature, the application must run by a user with full
permission to the /var/lock directory!}
property LinuxLock: Boolean read FLinuxLock write FLinuxLock;
{:Indicates if non-standard line terminators should be converted to a CR/LF pair
(standard DOS line terminator). If @TRUE, line terminators CR, single LF
or LF/CR are converted to CR/LF. Defaults to @FALSE.
This property has effect only on the behavior of the RecvString method.}
property ConvertLineEnd: Boolean read FConvertLineEnd Write FConvertLineEnd;
{:Timeout for AT modem based operations}
property AtTimeout: integer read FAtTimeout Write FAtTimeout;
{:If @true (default), then all timeouts is timeout between two characters.
If @False, then timeout is overall for whoole reading operation.}
property InterPacketTimeout: Boolean read FInterPacketTimeout Write FInterPacketTimeout;
{:For safe wait stop}
property BreakEvent: THandle read FBreakEvent write FBreakEvent;
end;
{:Returns list of existing computer serial ports. Working properly only in Windows!}
function GetSerialPortNames: string;
implementation
constructor TBlockSerial.Create;
begin
inherited create;
FRaiseExcept := false;
FHandle := INVALID_HANDLE_VALUE;
FDevice := '';
FComNr:= PortIsClosed; {HGJ}
FInstanceActive:= false; {HGJ}
Fbuffer := '';
FRTSToggle := False;
FMaxLineLength := 0;
FTestDSR := False;
FTestCTS := False;
FDeadlockTimeout := 30000;
FLinuxLock := True;
FMaxSendBandwidth := 0;
FNextSend := 0;
FMaxRecvBandwidth := 0;
FNextRecv := 0;
FConvertLineEnd := False;
SetSynaError(sOK);
FRecvBuffer := 4096;
FLastCR := False;
FLastLF := False;
FAtTimeout := 1000;
FInterPacketTimeout := True;
end;
destructor TBlockSerial.Destroy;
begin
CloseSocket;
inherited destroy;
end;
class function TBlockSerial.GetVersion: string;
begin
Result := 'SynaSer 7.6.0';
end;
procedure TBlockSerial.CloseSocket;
begin
if Fhandle <> INVALID_HANDLE_VALUE then
begin
Purge;
RTS := False;
DTR := False;
FileClose(FHandle);
end;
if InstanceActive then
begin
{$IFDEF UNIX}
if FLinuxLock then
cpomReleaseComport;
{$ENDIF}
FInstanceActive:= false
end;
Fhandle := INVALID_HANDLE_VALUE;
FComNr:= PortIsClosed;
SetSynaError(sOK);
DoStatus(HR_SerialClose, FDevice);
end;
{$IFDEF WIN32}
function TBlockSerial.GetPortAddr: Word;
begin
Result := 0;
if Win32Platform <> VER_PLATFORM_WIN32_NT then
begin
EscapeCommFunction(FHandle, 10);
asm
MOV @Result, DX;
end;
end;
end;
function TBlockSerial.ReadTxEmpty(PortAddr: Word): Boolean;
begin
Result := True;
if Win32Platform <> VER_PLATFORM_WIN32_NT then
begin
asm
MOV DX, PortAddr;
ADD DX, 5;
IN AL, DX;
AND AL, $40;
JZ @K;
MOV AL,1;
@K: MOV @Result, AL;
end;
end;
end;
{$ENDIF}
procedure TBlockSerial.GetComNr(Value: string);
begin
FComNr := PortIsClosed;
if pos('COM', uppercase(Value)) = 1 then
FComNr := StrToIntdef(copy(Value, 4, Length(Value) - 3), PortIsClosed + 1) - 1;
if pos('/DEV/TTYS', uppercase(Value)) = 1 then
FComNr := StrToIntdef(copy(Value, 10, Length(Value) - 9), PortIsClosed - 1);
end;
procedure TBlockSerial.SetBandwidth(Value: Integer);
begin
MaxSendBandwidth := Value;
MaxRecvBandwidth := Value;
end;
procedure TBlockSerial.LimitBandwidth(Length: Integer; MaxB: integer; var Next: LongWord);
var
x: LongWord;
y: LongWord;
begin
if MaxB > 0 then
begin
y := GetTick;
if Next > y then
begin
x := Next - y;
if x > 0 then
begin
DoStatus(HR_Wait, IntToStr(x));
sleep(x);
end;
end;
Next := GetTick + Trunc((Length / MaxB) * 1000);
end;
end;
procedure TBlockSerial.Config(baud, bits: integer; parity: char; stop: integer;
softflow, hardflow: boolean);
begin
FillChar(dcb, SizeOf(dcb), 0);
GetCommState;
dcb.DCBlength := SizeOf(dcb);
dcb.BaudRate := baud;
dcb.ByteSize := bits;
case parity of
'N', 'n': dcb.parity := 0;
'O', 'o': dcb.parity := 1;
'E', 'e': dcb.parity := 2;
'M', 'm': dcb.parity := 3;
'S', 's': dcb.parity := 4;
end;
dcb.StopBits := stop;
dcb.XonChar := #17;
dcb.XoffChar := #19;
dcb.XonLim := FRecvBuffer div 4;
dcb.XoffLim := FRecvBuffer div 4;
dcb.Flags := dcb_Binary;
if softflow then
dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX;
if hardflow then
dcb.Flags := dcb.Flags or dcb_OutxCtsFlow or dcb_RtsControlHandshake
else
dcb.Flags := dcb.Flags or dcb_RtsControlEnable;
dcb.Flags := dcb.Flags or dcb_DtrControlEnable;
if dcb.Parity > 0 then
dcb.Flags := dcb.Flags or dcb_ParityCheck;
SetCommState;
end;
procedure TBlockSerial.Connect(comport: string);
{$IFDEF MSWINDOWS}
var
CommTimeouts: TCommTimeouts;
{$ENDIF}
begin
// Is this TBlockSerial Instance already busy?
if InstanceActive then {HGJ}
begin {HGJ}
RaiseSynaError(ErrAlreadyInUse);
Exit; {HGJ}
end; {HGJ}
FBuffer := '';
FDevice := comport;
GetComNr(comport);
{$IFDEF MSWINDOWS}
SetLastError (sOK);
{$ELSE}
{$IFNDEF FPC}
SetLastError (sOK);
{$ELSE}
fpSetErrno(sOK);
{$ENDIF}
{$ENDIF}
{$IFNDEF MSWINDOWS}
if FComNr <> PortIsClosed then
FDevice := '/dev/ttyS' + IntToStr(FComNr);
// Comport already owned by another process? {HGJ}
if FLinuxLock then
if not cpomComportAccessible then
begin
RaiseSynaError(ErrAlreadyOwned);
Exit;
end;
{$IFNDEF FPC}
FHandle := THandle(Libc.open(pchar(FDevice), O_RDWR or O_SYNC));
{$ELSE}
FHandle := THandle(fpOpen(FDevice, O_RDWR or O_SYNC));
{$ENDIF}
if FHandle = INVALID_HANDLE_VALUE then //because THandle is not integer on all platforms!
SerialCheck(-1)
else
SerialCheck(0);
{$IFDEF UNIX}
if FLastError <> sOK then
if FLinuxLock then
cpomReleaseComport;
{$ENDIF}
ExceptCheck;
if FLastError <> sOK then
Exit;
{$ELSE}
if FComNr <> PortIsClosed then
FDevice := '\\.\COM' + IntToStr(FComNr + 1);
FHandle := THandle(CreateFile(PChar(FDevice), GENERIC_READ or GENERIC_WRITE,
0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED, 0));
if FHandle = INVALID_HANDLE_VALUE then //because THandle is not integer on all platforms!
SerialCheck(-1)
else
SerialCheck(0);
ExceptCheck;
if FLastError <> sOK then
Exit;
SetCommMask(FHandle, 0);
SetupComm(Fhandle, FRecvBuffer, 0);
CommTimeOuts.ReadIntervalTimeout := MAXWORD;
CommTimeOuts.ReadTotalTimeoutMultiplier := 0;
CommTimeOuts.ReadTotalTimeoutConstant := 0;
CommTimeOuts.WriteTotalTimeoutMultiplier := 0;
CommTimeOuts.WriteTotalTimeoutConstant := 0;
SetCommTimeOuts(FHandle, CommTimeOuts);
{$IFDEF WIN32}
FPortAddr := GetPortAddr;
{$ENDIF}
{$ENDIF}
SetSynaError(sOK);
if not TestCtrlLine then {HGJ}
begin
SetSynaError(ErrNoDeviceAnswer);
FileClose(FHandle); {HGJ}
{$IFDEF UNIX}
if FLinuxLock then
cpomReleaseComport; {HGJ}
{$ENDIF} {HGJ}