Changeset 119 for Comm/UPacketBurst.pas


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

Legend:

Unmodified
Added
Removed
  • Comm

    • Property svn:ignore set to
      lib
  • 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
Note: See TracChangeset for help on using the changeset viewer.