| 1 | unit UCommSerialPort;
|
|---|
| 2 |
|
|---|
| 3 | {$mode Delphi}{$H+}
|
|---|
| 4 |
|
|---|
| 5 | interface
|
|---|
| 6 |
|
|---|
| 7 | uses
|
|---|
| 8 | Classes, USerialPort, UCommPin, SysUtils, DateUtils, SpecializedList,
|
|---|
| 9 | SyncObjs;
|
|---|
| 10 |
|
|---|
| 11 | type
|
|---|
| 12 |
|
|---|
| 13 | { TCommSerialPort }
|
|---|
| 14 |
|
|---|
| 15 | TCommSerialPort = class(TCommNode)
|
|---|
| 16 | private
|
|---|
| 17 | procedure Receive(Sender: TCommPin; Stream: TListByte);
|
|---|
| 18 | procedure SetStatus(Sender: TCommPin; AValue: Integer);
|
|---|
| 19 | procedure ReceiveData(Stream: TListByte);
|
|---|
| 20 | protected
|
|---|
| 21 | procedure SetActive(const AValue: Boolean); override;
|
|---|
| 22 | procedure AssignTo(Dest: TPersistent); override;
|
|---|
| 23 | public
|
|---|
| 24 | SerialPort: TSerialPort;
|
|---|
| 25 | Pin: TCommPin;
|
|---|
| 26 | destructor Destroy; override;
|
|---|
| 27 | constructor Create(AOwner: TComponent); override;
|
|---|
| 28 | end;
|
|---|
| 29 |
|
|---|
| 30 |
|
|---|
| 31 | implementation
|
|---|
| 32 |
|
|---|
| 33 |
|
|---|
| 34 | { TCommSerialPort }
|
|---|
| 35 |
|
|---|
| 36 | procedure TCommSerialPort.ReceiveData(Stream: TListByte);
|
|---|
| 37 | begin
|
|---|
| 38 | if SerialPort.Active then Pin.Send(Stream);
|
|---|
| 39 | end;
|
|---|
| 40 |
|
|---|
| 41 | procedure TCommSerialPort.SetActive(const AValue: Boolean);
|
|---|
| 42 | begin
|
|---|
| 43 | inherited;
|
|---|
| 44 | SerialPort.Active := AValue;
|
|---|
| 45 | FActive := SerialPort.Active;
|
|---|
| 46 | end;
|
|---|
| 47 |
|
|---|
| 48 | procedure TCommSerialPort.AssignTo(Dest: TPersistent);
|
|---|
| 49 | begin
|
|---|
| 50 | if Dest is TCommSerialPort then begin
|
|---|
| 51 | TCommSerialPort(Dest).SerialPort.Assign(SerialPort);
|
|---|
| 52 | end else inherited;
|
|---|
| 53 | end;
|
|---|
| 54 |
|
|---|
| 55 | procedure TCommSerialPort.SetStatus(Sender: TCommPin; AValue: Integer);
|
|---|
| 56 | begin
|
|---|
| 57 | try
|
|---|
| 58 | SerialPort.Lock.Acquire;
|
|---|
| 59 | if (AValue and 1) = 1 then SerialPort.Parity := paMark
|
|---|
| 60 | else SerialPort.Parity := paSpace;
|
|---|
| 61 | finally
|
|---|
| 62 | SerialPort.Lock.Release;
|
|---|
| 63 | end;
|
|---|
| 64 | end;
|
|---|
| 65 |
|
|---|
| 66 | constructor TCommSerialPort.Create(AOwner: TComponent);
|
|---|
| 67 | begin
|
|---|
| 68 | inherited;
|
|---|
| 69 | SerialPort := TSerialPort.Create;
|
|---|
| 70 | SerialPort.OnReceiveData := ReceiveData;
|
|---|
| 71 | Pin := TCommPin.Create;
|
|---|
| 72 | Pin.OnReceive := Receive;
|
|---|
| 73 | Pin.OnSetSatus := SetStatus;
|
|---|
| 74 | Pin.Node := Self;
|
|---|
| 75 | end;
|
|---|
| 76 |
|
|---|
| 77 | destructor TCommSerialPort.Destroy;
|
|---|
| 78 | begin
|
|---|
| 79 | SerialPort.OnReceiveData := nil;
|
|---|
| 80 | FreeAndNil(Pin);
|
|---|
| 81 | FreeAndNil(SerialPort);
|
|---|
| 82 | inherited;
|
|---|
| 83 | end;
|
|---|
| 84 |
|
|---|
| 85 | procedure TCommSerialPort.Receive(Sender: TCommPin; Stream: TListByte);
|
|---|
| 86 | var
|
|---|
| 87 | S: TMemoryStream;
|
|---|
| 88 | begin
|
|---|
| 89 | try
|
|---|
| 90 | S := TMemoryStream.Create;
|
|---|
| 91 | Stream.WriteToStream(S);
|
|---|
| 92 | if SerialPort.Active then begin
|
|---|
| 93 | S.Position := 0;
|
|---|
| 94 | repeat
|
|---|
| 95 | try
|
|---|
| 96 | SerialPort.Lock.Acquire;
|
|---|
| 97 | if SerialPort.CanWrite(0) then
|
|---|
| 98 | SerialPort.SendStreamRaw(S);
|
|---|
| 99 | finally
|
|---|
| 100 | SerialPort.Lock.Release;
|
|---|
| 101 | end;
|
|---|
| 102 | if S.Position <> S.Size then
|
|---|
| 103 | Sleep(1);
|
|---|
| 104 | until S.Position = S.Size;
|
|---|
| 105 | end;
|
|---|
| 106 | finally
|
|---|
| 107 | S.Free;
|
|---|
| 108 | end;
|
|---|
| 109 | end;
|
|---|
| 110 |
|
|---|
| 111 | end.
|
|---|