Changeset 119


Ignore:
Timestamp:
Jan 5, 2011, 1:16:30 PM (13 years ago)
Author:
george
Message:
  • Created: New Lazarus package as container for few classes with bidirectional pin interconnection system .
Files:
6 added
1 deleted
7 edited

Legend:

Unmodified
Added
Removed

  • Comm

    • Property svn:ignore set to
      lib

  • Comm/UCommFrame.pas

    r26 r119  
    66
    77uses
    8   Classes, UMemoryStreamEx, Dialogs, SysUtils,
    9   Forms, UCommPin;
     8  Classes, UStreamHelper, Dialogs, SysUtils,
     9  UCommPin;
    1010
    1111const
    … …  
    2222  private
    2323    LastCharIsSpecialChar: Boolean;
    24     ReceiveBuffer: TMemoryStreamEx;
     24    ReceiveBuffer: TStreamHelper;
    2525    FrameState: TFrameState;
    2626    FFrameErrorCount: Integer;
    … …  
    3131    FrameDataPin: TCommPin;
    3232    PacketLoss: Real;
    33     procedure RawDataReceive(Stream: TStream);
    34     procedure FrameDataReceive(Stream: TStream);
     33    procedure RawDataReceive(Sender: TCommPin; Stream: TStream);
     34    procedure FrameDataReceive(Sender: TCommPin; Stream: TStream);
    3535    constructor Create;
    3636    destructor Destroy; override;
    … …  
    4646constructor TCommFrame.Create;
    4747begin
    48   ReceiveBuffer := TMemoryStreamEx.Create;
     48  ReceiveBuffer := TStreamHelper.Create;
    4949  RawDataPin := TCommPin.Create;
    5050  RawDataPin.OnReceive := RawDataReceive;
    … …  
    6262end;
    6363
    64 procedure TCommFrame.FrameDataReceive(Stream: TStream);
     64procedure TCommFrame.FrameDataReceive(Sender: TCommPin; Stream: TStream);
    6565var
    66   RawData: TMemoryStreamEx;
     66  RawData: TStreamHelper;
    6767  I: Integer;
    6868  Character: Byte;
    … …  
    7575  // Byte stuffing
    7676  Stream.Position := 0;
    77   RawData := TMemoryStreamEx.Create;
    78   RawData.WriteByte(SpecialChar);
    79   RawData.WriteByte(ControlCodeFrameStart);
    80   for I := 0 to Stream.Size - 1 do begin
    81     Character := TMemoryStreamEx(Stream).ReadByte;
     77  try
     78    RawData := TStreamHelper.Create;
     79    RawData.WriteByte(SpecialChar);
     80    RawData.WriteByte(ControlCodeFrameStart);
     81    for I := 0 to Stream.Size - 1 do begin
     82      Character := Stream.ReadByte;
     83      if Character = SpecialChar then begin
     84        RawData.WriteByte(SpecialChar);
     85        RawData.WriteByte(ControlCodeSpecialChar);
     86      end else RawData.WriteByte(Character);
     87    end;
     88
     89    Character := CRC;
    8290    if Character = SpecialChar then begin
    8391      RawData.WriteByte(SpecialChar);
    8492      RawData.WriteByte(ControlCodeSpecialChar);
    8593    end else RawData.WriteByte(Character);
     94
     95    RawData.WriteByte(SpecialChar);
     96    RawData.WriteByte(ControlCodeFrameEnd);
     97    //if Random >= PacketLoss then
     98      RawDataPin.Send(RawData);
     99
     100  finally
     101    RawData.Free;
    86102  end;
    87 
    88   Character := CRC;
    89   if Character = SpecialChar then begin
    90     RawData.WriteByte(SpecialChar);
    91     RawData.WriteByte(ControlCodeSpecialChar);
    92   end else RawData.WriteByte(Character);
    93 
    94   RawData.WriteByte(SpecialChar);
    95   RawData.WriteByte(ControlCodeFrameEnd);
    96   //if Random >= PacketLoss then
    97     RawDataPin.Send(RawData);
    98   RawData.Free;
    99103end;
    100104
    101 procedure TCommFrame.RawDataReceive(Stream: TStream);
     105procedure TCommFrame.RawDataReceive(Sender: TCommPin; Stream: TStream);
    102106var
    103107  Character: Byte;
    … …  
    107111begin
    108112  for I := 0 to Stream.Size - 1 do begin
    109     Character := TMemoryStreamEx(Stream).ReadByte;
     113    Character := Stream.ReadByte;
    110114    if LastCharIsSpecialChar then begin
    111115      if Character = ControlCodeSpecialChar then begin
    … …  
    115119          if FrameState = fsInside then
    116120            Inc(FFrameErrorCount);
    117           ReceiveBuffer.Clear;
     121          ReceiveBuffer.Size := 0;
    118122          FrameState := fsInside;
    119123        end else
    … …  
    123127            if ReceiveBuffer.Size > 0 then begin
    124128              ReceiveBuffer.Position := ReceiveBuffer.Size - 1;
    125               CRC := TMemoryStreamEx(ReceiveBuffer).ReadByte;
     129              CRC := ReceiveBuffer.ReadByte;
    126130              ReceiveBuffer.Size := ReceiveBuffer.Size - 1;
    127131              ExpectedCRC := GetStreamCRC8(ReceiveBuffer);

  • Comm/UCommPin.pas

    r26 r119  
    99
    1010type
     11  TCommPin = class;
     12
    1113  TDataDiretion = (ddReceive, ddSend);
    1214  TOnLogDataEvent = procedure (Stream: TStream; Direction: TDataDiretion) of object;
    13   TOnStreamEvent = procedure (Stream: TStream) of object;
     15  TOnStreamEvent = procedure (Sender: TCommPin; Stream: TStream) of object;
    1416
    1517  { TCommPin }
    … …  
    1921    FOnLogData: TOnLogDataEvent;
    2022    FOnReceive: TOnStreamEvent;
     23    FDataTxCount: Integer;
     24    FDataRxCount: Integer;
     25    FFrameTxCount: Integer;
     26    FFrameRxCount: Integer;
    2127    function GetConnected: Boolean;
    2228  public
    2329    RemotePin: TCommPin;
     30    constructor Create;
    2431    destructor Destroy; override;
    2532    procedure Connect(Pin: TCommPin);
    … …  
    2734    procedure Send(Stream: TStream);
    2835    procedure Receive(Stream: TStream);
     36    procedure ResetCounters;
    2937    property OnReceive: TOnStreamEvent read FOnReceive write FOnReceive;
    3038    property Connected: Boolean read GetConnected;
    3139    property OnLogData: TOnLogDataEvent read FOnLogData write FOnLogData;
     40    property DataTxCount: Integer read FDataTxCount;
     41    property DataRxCount: Integer read FDataRxCount;
     42    property FrameTxCount: Integer read FFrameTxCount;
     43    property FrameRxCount: Integer read FFrameRxCount;
    3244  end;
    3345
    … …  
    6375end;
    6476
     77constructor TCommPin.Create;
     78begin
     79  RemotePin := nil;
     80end;
     81
    6582procedure TCommPin.Receive(Stream: TStream);
    6683begin
     84  Inc(FDataRxCount, Stream.Size);
     85  Inc(FFrameRxCount);
    6786  if Assigned(FOnLogData) then FOnLogData(Stream, ddReceive);
    6887  Stream.Position := 0;
    69   if Assigned(FOnReceive) then FOnReceive(Stream);
     88  if Assigned(FOnReceive) then FOnReceive(Self, Stream);
     89end;
     90
     91procedure TCommPin.ResetCounters;
     92begin
     93  FDataTxCount := 0;
     94  FDataRxCount := 0;
     95  FFrameTxCount := 0;
     96  FFrameRxCount := 0;
    7097end;
    7198
    7299procedure TCommPin.Send(Stream: TStream);
    73100begin
     101  Inc(FDataTxCount, Stream.Size);
     102  Inc(FFrameTxCount);
    74103  if Assigned(FOnLogData) then FOnLogData(Stream, ddSend);
    75104  if Assigned(RemotePin) then RemotePin.Receive(Stream);

  • Comm/UCommSerialPort.pas

    r31 r119  
    1111  TCommSerialPort = class(TSerialPort)
    1212  private
    13     FTxCount: Integer;
    14     FRxCount: Integer;
    15     procedure Receive(Stream: TStream);
     13    procedure Receive(Sender: TCommPin; Stream: TStream);
    1614    procedure ReceiveData(Stream: TMemoryStream);
    1715  public
    18     DataPin: TCommPin;
     16    Pin: TCommPin;
    1917    destructor Destroy; override;
    2018    constructor Create;
    21     property TxCount: Integer read FTxCount;
    22     property RxCount: Integer read FRxCount;
    2319  end;
    2420
    … …  
    3127procedure TCommSerialPort.ReceiveData(Stream: TMemoryStream);
    3228begin
    33   Inc(FRxCount, Stream.Size);
    34   DataPin.Send(Stream);
     29  Pin.Send(Stream);
    3530end;
    3631
    … …  
    3833begin
    3934  inherited;
    40   DataPin := TCommPin.Create;
    41   DataPin.OnReceive := Receive;
     35  Pin := TCommPin.Create;
     36  Pin.OnReceive := Receive;
    4237  OnReceiveData := ReceiveData;
    4338end;
    … …  
    4641begin
    4742  OnReceiveData := nil;
    48   DataPin.Destroy;
     43  Pin.Free;
    4944  inherited;
    5045end;
    5146
    52 procedure TCommSerialPort.Receive(Stream: TStream);
     47procedure TCommSerialPort.Receive(Sender: TCommPin; Stream: TStream);
    5348begin
    54   Inc(FTxCount, Stream.Size);
    5549  Stream.Position := 0;
    5650  repeat

  • Comm/UPacketBurst.pas

    r35 r119  
    11unit UPacketBurst;
     2
     3{$mode Delphi}{$H+}
    24
    35interface
    46
    57uses
    6   Classes, CommPort, UPin, UMemoryStreamEx, SyncObjs;
     8  Classes, UCommPin, SyncObjs, UStreamHelper;
    79
    810type
    … …  
    1921    SendThread: TPacketBurstSendThread;
    2022    SendStreamLock: TCriticalSection;
    21     SendStream: TMemoryStreamEx;
    22     ReceiveStream: TMemoryStreamEx;
    23     procedure PacketSingleReceive(Stream: TStream);
    24     procedure PacketBurstReceive(Stream: TStream);
     23    SendStream: TStreamHelper;
     24    ReceiveStream: TStreamHelper;
     25    procedure PacketSingleReceive(Sender: TCommPin; Stream: TStream);
     26    procedure PacketBurstReceive(Sender: TCommPin; Stream: TStream);
    2527  public
    2628    SendPeriod: Integer; // ms
    2729    SendBurstSize: Integer;
    28     PacketSinglePin: TPin;
    29     PacketBurstPin: TPin;
     30    PacketSinglePin: TCommPin;
     31    PacketBurstPin: TCommPin;
    3032    destructor Destroy; override;
    3133    constructor Create;
    … …  
    3840constructor TPacketBurst.Create;
    3941begin
    40   PacketSinglePin := TPin.Create;
     42  PacketSinglePin := TCommPin.Create;
    4143  PacketSinglePin.OnReceive := PacketSingleReceive;
    42   PacketBurstPin := TPin.Create;
     44  PacketBurstPin := TCommPin.Create;
    4345  PacketBurstPin.OnReceive := PacketBurstReceive;
    4446  SendThread := TPacketBurstSendThread.Create(True);
    4547  SendThread.PacketBurst := Self;
    46   SendThread.Resume;
     48  SendThread.Start;
    4749end;
    4850
    … …  
    5557end;
    5658
    57 procedure TPacketBurst.PacketBurstReceive(Stream: TStream);
     59procedure TPacketBurst.PacketBurstReceive(Sender: TCommPin; Stream: TStream);
    5860var
    59   PacketStream: TMemoryStreamEx;
     61  PacketStream: TStreamHelper;
    6062  Size: Word;
    6163begin
    62   PacketStream := TMemoryStreamEx.Create;
    63   ReceiveStream.Seek(0, soFromEnd);
    64   ReceiveStream.WriteStream(Stream);
    65   ReceiveStream.Position := 0;
    66   Size := ReceiveStream.ReadWord;
    67   while Size < ReceiveStream.Size do begin
    68     PacketStream.Clear;
    69     PacketStream.ReadStream(TStream(ReceiveStream), Size);
    70     PacketSinglePin.Send(PacketStream);
     64  try
     65    PacketStream := TStreamHelper.Create;
     66    ReceiveStream.Seek(0, soFromEnd);
     67    ReceiveStream.WriteStream(Stream, Stream.Size);
     68    ReceiveStream.Position := 0;
    7169    Size := ReceiveStream.ReadWord;
     70    while Size < ReceiveStream.Size do begin
     71      PacketStream.Stream.Size := 0;
     72      PacketStream.ReadStream(TStream(ReceiveStream), Size);
     73      PacketSinglePin.Send(PacketStream);
     74      Size := ReceiveStream.ReadWord;
     75    end;
     76  finally
     77    PacketStream.Free;
    7278  end;
    73   PacketStream.Free;
    7479end;
    7580
    76 procedure TPacketBurst.PacketSingleReceive(Stream: TStream);
     81procedure TPacketBurst.PacketSingleReceive(Sender: TCommPin; Stream: TStream);
    7782var
    7883  SignalEvent: Boolean;
    7984begin
    80   SendStreamLock.Acquire;
    81   SendStream.WriteWord(Stream.Size);
    82   Stream.Position := 0;
    83   SendStream.WriteStream(Stream);
    84   SignalEvent := SendStream.Size > SendBurstSize;
    85   SendStreamLock.Release;
     85  try
     86    SendStreamLock.Acquire;
     87    SendStream.WriteWord(Stream.Size);
     88    Stream.Position := 0;
     89    SendStream.WriteStream(Stream, Stream.Size);
     90    SignalEvent := SendStream.Size > SendBurstSize;
     91  finally
     92    SendStreamLock.Release;
     93  end;
    8694  if SignalEvent then SendThreadEvent.SetEvent;
    8795end;
    … …  
    9199procedure TPacketBurstSendThread.Execute;
    92100var
    93   Stream: TMemoryStreamEx;
     101  Stream: TStreamHelper;
    94102begin
    95103  inherited;
    96   Stream := TMemoryStreamEx.Create;
    97   with PacketBurst do
    98   repeat
    99     if SendThreadEvent.WaitFor(SendPeriod) = wrSignaled then begin
    100       SendStreamLock.Acquire;
    101       SendStream.Position := 0;
    102       if SendStream.Size < SendBurstSize then begin
    103         PacketBurstPin.Send(SendStream);
    104         SendStream.Clear;
    105       end else
    106       while (SendStream.Size - SendStream.Position) > SendBurstSize do begin
    107         Stream.Clear;
    108         SendStream.ReadStream(TStream(Stream), SendBurstSize);
    109         PacketBurstPin.Send(Stream);
     104  try
     105    Stream := TStreamHelper.Create;
     106    with PacketBurst do
     107    repeat
     108      if SendThreadEvent.WaitFor(SendPeriod) = wrSignaled then
     109      try
     110        SendStreamLock.Acquire;
     111        SendStream.Position := 0;
     112        if SendStream.Size < SendBurstSize then begin
     113          PacketBurstPin.Send(SendStream);
     114          SendStream.Stream.Size := 0;
     115        end else
     116        while (SendStream.Size - SendStream.Position) > SendBurstSize do begin
     117          Stream.Stream.Size := 0;
     118          SendStream.ReadStream(TStream(Stream), SendBurstSize);
     119          PacketBurstPin.Send(Stream);
     120        end;
     121      finally
     122        SendStreamLock.Release;
    110123      end;
    111       SendStreamLock.Release;
    112     end;
    113   until Terminated;
    114   Stream.Free;
     124    until Terminated;
     125  finally
     126    Stream.Free;
     127  end;
    115128end;
    116129

  • Comm/USerialPort.pas

    r31 r119  
    66
    77uses
    8   Classes, SysUtils, SynaSer, StdCtrls, Windows, Dialogs;
     8  Classes, SysUtils, SynaSer, StdCtrls, Dialogs;
    99
    1010type
    … …  
    2424  TSerialPortReceiveThread = class(TThread)
    2525    Parent: TSerialPort;
    26     Stream: TMemoryStream;
    2726    procedure Execute; override;
    28     constructor Create(CreateSuspended: Boolean;
    29       const StackSize: SizeUInt = DefaultStackSize);
    3027    destructor Destroy; override;
    3128  end;
    … …  
    4643    FStopBits: TStopBits;
    4744    FReceiveThread: TSerialPortReceiveThread;
     45    FReceiveBuffer: TMemoryStream;
    4846    function GetBaudRateNumeric: Integer;
    4947    function GetName: string;
    50     function GetReceiveBuffer:TMemoryStream;
    5148    procedure SetBaudRate(const AValue: TBaudRate);
    5249    procedure SetBaudRateNumeric(const AValue: Integer);
    … …  
    7168    property RTS: Boolean read FRTS write SetRTS;
    7269    property DTR: Boolean read FDTR write SetDTR;
    73     property ReceiveBuffer: TMemoryStream read GetReceiveBuffer;
     70    property ReceiveBuffer: TMemoryStream read FReceiveBuffer;
    7471
    7572    property BaudRateNumeric: Integer read GetBaudRateNumeric write SetBaudRateNumeric;
    … …  
    8885implementation
    8986
     87resourcestring
     88  SAssignmentError = 'Assignment error';
     89  SWrongNumericBaudRate = 'Wrong numeric baud rate %s';
     90  SWrongDataBitsNumber = 'Wrong data bits number %s';
     91
    9092{ TSerialPort }
    9193
    … …  
    9597    FActive := True;
    9698    Open;
    97     FActive := FHandle <> INVALID_HANDLE_VALUE
     99    FActive := FHandle <> INVALID_HANDLE_VALUE;
     100    if not FActive then FreeAndNil(FReceiveThread);
    98101  end else
    99102  if FActive and not AValue then begin
    … …  
    137140begin
    138141  Connect(FName);
     142  //set_fDtrControl(DCB, 1);
     143  //DCB.flags := ;
    139144  SetBaudRate(FBaudRate);
    140145  SetParity(FParity);
    … …  
    144149  SetDTR(FDTR);
    145150  SetRTS(FRTS);
     151
     152  FReceiveThread := TSerialPortReceiveThread.Create(True);
     153  FReceiveThread.FreeOnTerminate := False;
     154  FReceiveThread.Parent := Self;
     155  FReceiveThread.Start;
    146156end;
    147157
    148158procedure TSerialPort.Close;
    149159begin
     160  FreeAndNil(FReceiveThread);
    150161  CloseSocket;
    151162end;
    … …  
    154165begin
    155166  inherited Create;
     167  FReceiveBuffer := TMemoryStream.Create;
    156168  FBaudRate := br9600;
    157169  FName := 'COM1';
    … …  
    163175  FRTS := False;
    164176  Active := False;
    165 
    166   FReceiveThread := TSerialPortReceiveThread.Create(True);
    167   FReceiveThread.FreeOnTerminate := False;
    168   FReceiveThread.Parent := Self;
    169   FReceiveThread.Resume;
    170177end;
    171178
    172179destructor TSerialPort.Destroy;
    173180begin
    174   FReceiveThread.Terminate;
    175   FReceiveThread.WaitFor;
    176   FReceiveThread.Destroy;
     181  Active := False;
     182  FReceiveThread.Free;
     183  ReceiveBuffer.Free;
    177184  inherited Destroy;
    178185end;
    … …  
    189196    DTR := TSerialPort(Source).DTR;
    190197    RTS := TSerialPort(Source).RTS;
    191   end else raise Exception.Create('Assignment error');
     198  end else raise Exception.Create(SAssignmentError);
    192199end;
    193200
    … …  
    210217begin
    211218  Result := FName;
    212 end;
    213 
    214 function TSerialPort.GetReceiveBuffer:TMemoryStream;
    215 begin
    216   Result := FReceiveThread.Stream;
    217219end;
    218220
    … …  
    235237    128000: BaudRate := br128000;
    236238    256000: BaudRate := br256000;
    237     else raise Exception.Create('Wrong numeric baud rate');
     239    else raise Exception.CreateFmt(SWrongNumericBaudRate, [AValue]);
    238240  end;
    239241end;
    … …  
    242244begin
    243245  if (AValue >= 5) and (AValue <= 8) then FDataBits := AValue
    244     else raise Exception.Create('Wrong data bits number');
     246    else raise Exception.CreateFmt(SWrongDataBitsNumber, [IntToStr(AValue)]);
    245247  if FActive then begin
    246248    GetCommState;
    … …  
    253255begin
    254256  FDTR := AValue;
    255   if FActive then SetDTRF(FDTR);
     257  if FFlowControl = fcNone then
     258    DCB.flags := DCB.flags and (not (dcb_DtrControlEnable * 3)) or
     259    (dcb_DtrControlEnable * Byte(AValue));
     260  if FActive then begin
     261    if FFlowControl = fcNone then SetCommState
     262    else SetDTRF(FDTR);
     263  end;
    256264end;
    257265
    … …  
    263271    case AValue of
    264272      fcNone: DCB.flags := 0;
    265       fcSoftware: DCB.flags := DCB.Flags or dcb_OutX or dcb_InX;
    266       fcHardware: DCB.flags := DCB.Flags
    267         or dcb_OutxCtsFlow or dcb_OutxDsrFlow
    268         or dcb_DtrControlHandshake  or dcb_RtsControlHandshake;
     273      fcSoftware: DCB.flags := dcb_OutX or dcb_InX or
     274        dcb_DtrControlEnable or dcb_RtsControlEnable;
     275      fcHardware: DCB.flags := dcb_OutxCtsFlow or dcb_OutxDsrFlow
     276        or dcb_DtrControlHandshake or dcb_RtsControlHandshake;
    269277    end;
    270278    SetCommState;
    … …  
    280288begin
    281289  InBufferUsed := 0;
    282   with Parent do
    283   repeat
    284     if InBufferUsed = 0 then Sleep(1);
    285     if Active then begin
    286       InBufferUsed := WaitingData;
    287       if InBufferUsed > 0 then begin
    288         SetLength(Buffer, InBufferUsed);
    289         RecvBuffer(Buffer, Length(Buffer));
    290 
    291         Stream.Size := Length(Buffer);
    292         Stream.Position := 0;
    293         Stream.Write(Buffer[0], Length(Buffer));
    294         if Assigned(Parent.FOnReceiveData) then
    295           Parent.FOnReceiveData(Stream);
     290  with Parent do repeat
     291    try
     292      if InBufferUsed = 0 then Sleep(1);
     293      if Active then begin
     294        InBufferUsed := WaitingData;
     295        if InBufferUsed > 0 then begin
     296          SetLength(Buffer, InBufferUsed);
     297          RecvBuffer(Buffer, Length(Buffer));
     298
     299          Parent.FReceiveBuffer.Size := Length(Buffer);
     300          Parent.FReceiveBuffer.Position := 0;
     301          Parent.FReceiveBuffer.Write(Buffer[0], Length(Buffer));
     302          if Assigned(Parent.FOnReceiveData) then
     303            Parent.FOnReceiveData(Parent.FReceiveBuffer);
     304        end else InBufferUsed := 0;
    296305      end else InBufferUsed := 0;
    297     end else InBufferUsed := 0;
     306    except
     307      on E: Exception do
     308        //MainForm.ExceptionLogger1.ThreadExceptionHandler(Self, E);
     309    end;
    298310  until Terminated;
    299311end;
    300312
    301 constructor TSerialPortReceiveThread.Create(CreateSuspended: Boolean;
    302   const StackSize: SizeUInt);
     313destructor TSerialPortReceiveThread.Destroy;
    303314begin
    304315  inherited;
    305   Stream := TMemoryStream.Create;
    306 end;
    307 
    308 destructor TSerialPortReceiveThread.Destroy;
    309 begin
    310   Stream.Destroy;
    311   inherited;
    312316end;
    313317

  • CoolStreaming/UVarBlockSerializer.pas

    r117 r119  
    1111
    1212uses
    13   Classes, DateUtils, UStreamHelper, Math, Dialogs, SysUtils, USubStream,
     13  Classes, DateUtils, UStreamHelper, Math, SysUtils, USubStream,
    1414  Contnrs, SpecializedList;
    1515
Note: See TracChangeset for help on using the changeset viewer.