Changeset 440


Ignore:
Timestamp:
Nov 19, 2012, 2:43:40 PM (12 years ago)
Author:
chronos
Message:
  • Fixed: Thread safe access to serial port pin interface using lock.
Location:
PinConnection
Files:
14 edited

Legend:

Unmodified
Added
Removed

  • PinConnection/Languages/USerialPort.cs.po

    r268 r440  
    1818msgstr "Nesprávné číslo datových bitů %s"
    1919
    20 #: userialport.swrongnumericbaudrate
    21 msgid "Wrong numeric baud rate %s"
    22 msgstr "Nesprávná číslená baudová rychlost %s"
    23 

  • PinConnection/Languages/USerialPort.po

    r340 r440  
    1010msgstr ""
    1111
    12 #: userialport.swrongnumericbaudrate
    13 msgid "Wrong numeric baud rate %s"
    14 msgstr ""
    15 

  • PinConnection/PinConnection.lpk

    r416 r440  
    8080      </Item14>
    8181      <Item15>
    82         <Filename Value="UCommConnector.pas"/>
    83         <UnitName Value="UCommConnector"/>
    84       </Item15>
    85       <Item16>
    8682        <Filename Value="UPinConnection.pas"/>
    8783        <HasRegisterProc Value="True"/>
    8884        <UnitName Value="UPinConnection"/>
     85      </Item15>
     86      <Item16>
     87        <Filename Value="UCommConnector.pas"/>
     88        <UnitName Value="UCommConnector"/>
    8989      </Item16>
    9090    </Files>

  • PinConnection/PinConnection.pas

    r416 r440  
    1010  USerialPort, UPacketBurst, UCommFrame, UCommHub, UCommPin, UCommSerialPort,
    1111  UCommThread, UCommConcentrator, UCommDelay, UCommTCPClient, UCommTCPServer,
    12   UCommTelnet, UCommTelnetComPortOption, UCommMark, UCommConnector,
    13   UPinConnection, LazarusPackageIntf;
     12  UCommTelnet, UCommTelnetComPortOption, UCommMark, UPinConnection,
     13  UCommConnector, LazarusPackageIntf;
    1414
    1515implementation

  • PinConnection/UCommConnector.pas

    r416 r440  
    77uses
    88  Classes, SysUtils, UCommPin, UCommSerialPort, UCommTCPClient, UCommThread,
    9   UCommHub, USerialPort, UCommTCPServer, UCommTelnet,
     9  UCommHub, UCommTCPServer, UCommTelnet,
    1010  UCommTelnetComPortOption;
    1111

  • PinConnection/UCommDelay.pas

    r414 r440  
    66
    77uses
    8   Classes, SysUtils, UCommPin, UThreading, SyncObjs, SpecializedList, UStreamHelper,
    9   UBinarySerializer;
     8  Classes, SysUtils, UCommPin, UThreading, SyncObjs, SpecializedList;
    109
    1110type

  • PinConnection/UCommFrame.pas

    r413 r440  
    66
    77uses
    8   Classes, UStreamHelper, Dialogs, SysUtils, SpecializedList, UBinarySerializer,
     8  Classes, Dialogs, SysUtils, SpecializedList, UBinarySerializer,
    99  UCommPin;
    1010

  • PinConnection/UCommTCPClient.pas

    r416 r440  
    3131  private
    3232    FActive: Boolean;
    33     FOnReceiveData: TReceiveDataEvent;
     33    //FOnReceiveData: TReceiveDataEvent;
    3434    FReceiveThread: TCommSocketReceiveThread;
    3535    procedure ReceiveData(Sender: TCommPin; Stream: TListByte);
    36     procedure SetActive(const AValue: Boolean);
    3736  protected
     37    procedure SetActive(const AValue: Boolean); override;
    3838    procedure AssignTo(Dest: TPersistent); override;
    3939  public

  • PinConnection/UCommTCPServer.pas

    r413 r440  
    77uses
    88  Classes, SysUtils, blcksock, synsock, UCommPin, UCommon, UThreading,
    9   DateUtils, SpecializedList, tlntsend;
     9  DateUtils, SpecializedList;
    1010
    1111type
    … …  
    4848    FOnConnect: TSocketConnectEvent;
    4949    FOnDisconnect: TSocketConnectEvent;
    50     FOnReceiveData: TReceiveDataEvent;
     50    //FOnReceiveData: TReceiveDataEvent;
    5151    FReceiveThread: TCommSocketReceiveThread;
    52     procedure SetActive(const AValue: Boolean);
     52  protected
     53    procedure SetActive(const AValue: Boolean); override;
    5354  public
    5455    Sessions: TListObject; // TListObject<TCommTCPServerSession>
    … …  
    7475    Mem := TMemoryStream.Create;
    7576    Stream.WriteToStream(Mem);
     77    Mem.Position := 0;
    7678    Socket.SendStreamRaw(Mem);
    7779  finally
    … …  
    172174  if AValue then begin
    173175    Socket.Bind(Address, IntToStr(Port));
    174     if Socket.LastError <> 0 then raise Exception.Create('Bind error');
     176    if Socket.LastError <> 0 then raise Exception.Create('Bind error' + Socket.GetErrorDesc(Socket.LastError));
    175177    Socket.Listen;
    176178    if Socket.LastError <> 0 then raise Exception.Create('Listen error');

  • PinConnection/UCommTelnet.pas

    r416 r440  
    66
    77uses
    8   Classes, SysUtils, UCommPin, SpecializedList, DateUtils, UStreamHelper,
    9   SpecializedStream, UBinarySerializer;
     8  Classes, SysUtils, UCommPin, SpecializedList, DateUtils, Dialogs,
     9  UBinarySerializer;
    1010
    1111type
    … …  
    7474    FState: TTelnetState;
    7575    FCommandData: TBinarySerializer;
    76     procedure SetActive(AValue: Boolean);
    7776    procedure TelnetDataReceive(Sender: TCommPin; Stream: TListByte);
    7877    procedure RawDataReceive(Sender: TCommPin; Stream: TListByte);
    … …  
    8079    function ResponseCount: Integer;
    8180  protected
     81    procedure SetActive(const AValue: Boolean); override;
    8282    procedure AssignTo(Dest: TPersistent); override;
    8383  public
    … …  
    153153    RequestData.Free;
    154154  end;
     155  Result := SupportedByServer;
    155156end;
    156157
    … …  
    159160  RequestData: TBinarySerializer;
    160161  ResponseData: TBinarySerializer;
    161   I: Integer;
    162162begin
    163163  if Telnet.OptionsNegotationEnable then CheckOption;
    … …  
    210210end;
    211211
    212 procedure TCommTelnet.SetActive(AValue: Boolean);
     212procedure TCommTelnet.SetActive(const AValue: Boolean);
    213213var
    214214  I: Integer;
    … …  
    376376end;
    377377
     378function ByteToStr(Value: Byte): string;
     379begin
     380  Result := IntToStr(Value);
     381end;
     382
    378383procedure TCommTelnet.SendCommand(Code: TTelnetCode; Request,
    379384  Response: TListByte);
    … …  
    405410      if Code = tcSB then begin
    406411        if (Response[Response.Count - 2] <> Byte(tcIAC)) or
    407         (Response[Response.Count - 1] <> Byte(tcSE)) then
     412        (Response[Response.Count - 1] <> Byte(tcSE)) then begin
     413          ShowMessage(Response.Implode(' ', ByteToStr));
     414          ReadResponse(Response);
     415          ShowMessage(Response.Implode(' ', ByteToStr));
    408416          raise Exception.Create(SWrongResponse);
     417        end;
    409418        Response.DeleteItems(Response.Count - 2, 2);
    410419      end;
    411420      // Remove IAC escape character from data
    412421      I := 0;
     422      LastIAC := False;
    413423      while (I < Response.Count) do begin
    414424        if Response[I] = Byte(tcIAC) then begin

  • PinConnection/UCommTelnetComPortOption.pas

    r416 r440  
    66
    77uses
    8   Classes, SysUtils, UCommPin, UCommTelnet, USerialPort, UStreamHelper,
     8  Classes, SysUtils, UCommTelnet, USerialPort,
    99  SpecializedList, UBinarySerializer;
    1010
    … …  
    9393    SetDTR(FDTR);
    9494    SetRTS(FRTS);
     95    SetFlowControl(fcNone);
    9596  end;
    9697end;

  • PinConnection/UCommThread.pas

    r414 r440  
    66
    77uses
    8   Classes, SysUtils, blcksock, UCommPin, SyncObjs, UStreamHelper, UCommon,
     8  Classes, SysUtils, blcksock, UCommPin, SyncObjs, UCommon,
    99  DateUtils, UThreading, SpecializedList, UBinarySerializer;
    1010
    … …  
    3030  TCommThread = class(TCommNode)
    3131  private
    32     FOnReceiveData: TReceiveDataEvent;
     32    //FOnReceiveData: TReceiveDataEvent;
    3333    FReceiveThread: TCommThreadReceiveThread;
    3434    FInputBuffer: TBinarySerializer;

  • PinConnection/UPacketBurst.pas

    r414 r440  
    66
    77uses
    8   Classes, UCommPin, SyncObjs, UStreamHelper, UCommon, SysUtils, SpecializedList,
     8  Classes, UCommPin, SyncObjs, UCommon, SysUtils, SpecializedList,
    99  DateUtils, UBinarySerializer;
    1010
    … …  
    138138        while (SendStream.List.Count - SendStream.Position) > SendBurstSize do begin
    139139          Stream.Count := 0;
    140           SendStream.ReadStream(TStream(Stream), SendBurstSize);
     140          SendStream.ReadList(Stream, 0, SendBurstSize);
    141141          PacketBurstPin.Send(Stream);
    142142        end;

  • PinConnection/USerialPort.pas

    r415 r440  
    66
    77uses
    8   Classes, SysUtils, SynaSer, StdCtrls, Dialogs, UCommon, UThreading,
     8  {$IFDEF Windows}Windows, {$ENDIF}Registry,
     9  Classes, SysUtils, SynaSer, Dialogs, UCommon, UThreading, Syncobjs,
    910  DateUtils, FileUtil, SpecializedList;
    1011
    … …  
    4950    FReceiveThread: TSerialPortReceiveThread;
    5051    FReceiveBuffer: TListByte;
     52    function FindFriendlyName(Key: string; Port: string): string;
    5153    function GetName: string;
     54    procedure GetSerialPortNamesExt(Strings: TStrings);
    5255    procedure SetBaudRate(const AValue: Integer);
    5356    procedure SetDataBits(const AValue: TDataBits);
    … …  
    6265    procedure Close;
    6366  public
     67    Lock: TCriticalSection;
    6468    property Name: string read GetName write SetName;
    6569    property FlowControl: TFlowControl read FFlowControl write SetFlowControl;
    … …  
    7781    constructor Create;
    7882    destructor Destroy; override;
     83    procedure Flush;
     84    procedure Purge;
    7985    procedure Assign(Source: TObject);
    8086  end;
    … …  
    9096resourcestring
    9197  SAssignmentError = 'Assignment error';
    92   SWrongNumericBaudRate = 'Wrong numeric baud rate %s';
    9398  SWrongDataBitsNumber = 'Wrong data bits number %s';
    9499
    … …  
    149154begin
    150155  Connect(FName);
    151   //set_fDtrControl(DCB, 1);
    152   //DCB.flags := ;
    153   SetBaudRate(FBaudRate);
    154   SetParity(FParity);
    155   SetStopBits(FStopBits);
    156   SetDataBits(FDataBits);
    157   SetFlowControl(FFlowControl);
    158   SetDTR(FDTR);
    159   SetRTS(FRTS);
    160 
    161   FReceiveThread := TSerialPortReceiveThread.Create(True);
    162   FReceiveThread.FreeOnTerminate := False;
    163   FReceiveThread.Parent := Self;
    164   FReceiveThread.Name := 'SerialPort';
    165   FReceiveThread.Start;
     156  if FHandle <> INVALID_HANDLE_VALUE then begin
     157    //set_fDtrControl(DCB, 1);
     158    //DCB.flags := ;
     159    {$IFDEF DEBUG}
     160    RaiseExcept := True;
     161    {$ENDIF}
     162    SetBaudRate(FBaudRate);
     163    SetParity(FParity);
     164    SetStopBits(FStopBits);
     165    SetDataBits(FDataBits);
     166    SetFlowControl(FFlowControl);
     167    SetDTR(FDTR);
     168    SetRTS(FRTS);
     169
     170    FReceiveThread := TSerialPortReceiveThread.Create(True);
     171    FReceiveThread.FreeOnTerminate := False;
     172    FReceiveThread.Parent := Self;
     173    FReceiveThread.Name := 'SerialPort';
     174    FReceiveThread.Start;
     175  end;
    166176end;
    167177
    168178procedure TSerialPort.Close;
    169179begin
    170   FreeAndNil(FReceiveThread);
    171   CloseSocket;
     180  if FHandle <> INVALID_HANDLE_VALUE then begin
     181    FreeAndNil(FReceiveThread);
     182    CloseSocket;
     183  end;
     184end;
     185
     186function TSerialPort.FindFriendlyName(Key: string; Port: string): string;
     187var
     188  r: TRegistry;
     189  k: TStringList;
     190  i: Integer;
     191  ck: string;
     192  rs: string;
     193begin
     194  r := TRegistry.Create;
     195  k := TStringList.Create;
     196
     197  r.RootKey := HKEY_LOCAL_MACHINE;
     198  r.OpenKeyReadOnly(key);
     199  r.GetKeyNames(k);
     200  r.CloseKey;
     201
     202  try
     203    for i := 0 to k.Count - 1 do
     204    begin
     205      ck := key + k[i] + '\'; // current key
     206      // looking for "PortName" stringvalue in "Device Parameters" subkey
     207      if r.OpenKeyReadOnly(ck + 'Device Parameters') then
     208      begin
     209        if r.ReadString('PortName') = port then
     210        begin
     211          r.CloseKey;
     212          r.OpenKeyReadOnly(ck);
     213          rs := UTF8Encode(r.ReadString('FriendlyName'));
     214          Break;
     215        end
     216      end
     217      // keep looking on subkeys for "PortName"
     218      else
     219      begin
     220        if r.OpenKeyReadOnly(ck) and r.HasSubKeys then
     221        begin
     222          rs := FindFriendlyName(ck, port);
     223          if rs <> '' then Break;
     224        end;
     225      end;
     226    end;
     227    result := rs;
     228  finally
     229    r.Free;
     230    k.Free;
     231  end;
     232end;
     233
     234procedure TSerialPort.GetSerialPortNamesExt(Strings: TStrings);
     235var
     236  Reg: TRegistry;
     237  l: TStringList;
     238  n: integer;
     239  pn, fn: string;
     240begin
     241  l := TStringList.Create;
     242  Reg := TRegistry.Create;
     243  try
     244    Reg.RootKey := HKEY_LOCAL_MACHINE;
     245    if reg.OpenKeyReadOnly('HARDWARE\DEVICEMAP\SERIALCOMM') then
     246    begin
     247      Reg.GetValueNames(l);
     248      for n := 0 to l.Count - 1 do
     249      begin
     250        pn := Reg.ReadString(l[n]);
     251        fn := FindFriendlyName('\System\CurrentControlSet\Enum\', pn);
     252        if fn <> '' then
     253          Strings.Add(pn + Strings.NameValueSeparator + fn)
     254          else Strings.Add(pn + Strings.NameValueSeparator + pn)
     255      end;
     256    end;
     257  finally
     258    L.Free;
     259    Reg.Free;
     260  end;
    172261end;
    173262
    … …  
    175264var
    176265  I: Integer;
     266  {$IFDEF Linux}Files: TStringList;{$ENDIF}
    177267  TestPort: TSerialPort;
    178   Files: TStringList;
    179268begin
    180269  Strings.Clear;
     270  Strings.NameValueSeparator := '|';
    181271  {$IFDEF Windows}
    182   if Check then
    183   try
    184     TestPort := TSerialPort.Create;
    185     for I := 0 to MaxPort - 1 do
    186     with TestPort do begin
    187       Name := 'COM' + IntToStr(I);
    188       Active := True;
    189       if Active then begin
    190         Strings.AddObject(Name, nil);
     272  if Check then begin
     273    GetSerialPortNamesExt(Strings);
     274    // If no ports with friendly names detected try open all ports (compatibility with Win98)
     275    if Strings.Count = 0 then
     276    try
     277      TestPort := TSerialPort.Create;
     278      for I := 0 to MaxPort - 1 do
     279      with TestPort do begin
     280        Name := 'COM' + IntToStr(I);
     281        Active := True;
     282        if (LastError = ERROR_SUCCESS) or (LastError = ERROR_ACCESS_DENIED) then
     283        begin
     284          Strings.AddObject(Name, nil);
     285        end;
     286        Active := False;
    191287      end;
    192       Active := False;
     288    finally
     289      TestPort.Free;
    193290    end;
    194   finally
    195     TestPort.Free;
    196   end else begin
     291  end  else begin
    197292    for I := 1 to MaxPort do
    198       Strings.AddObject('COM' + IntToStr(I), nil);
     293      Strings.AddObject('COM' + IntToStr(I) + Strings.NameValueSeparator +
     294        'COM' + IntToStr(I), nil);
    199295  end;
    200296  {$ENDIF}
    … …  
    204300    Files := FindAllFiles('/dev', 'tty*', False);
    205301    Strings.Assign(Files);
     302    for I := 0 to Strings.Count - 1 do
     303      Strings.Strings[I] := Strings.Strings[I] + Strings.NameValueSeparator +
     304        Strings.Strings[I];
    206305  finally
    207306    Files.Free;
    208307  end else begin
    209308    for I := 1 to 63 do
    210       Strings.AddObject('/dev/ttyS' + IntToStr(I), nil);
     309      Strings.AddObject('/dev/ttyS' + IntToStr(I) + Strings.NameValueSeparator +
     310        '/dev/ttyS' + IntToStr(I), nil);
    211311  end;
    212312  {$ENDIF}
    … …  
    216316begin
    217317  inherited Create;
     318  Lock := TCriticalSection.Create;
    218319  FReceiveBuffer := TListByte.Create;
    219320  FBaudRate := 9600;
    … …  
    231332begin
    232333  Active := False;
    233   FReceiveThread.Free;
    234   ReceiveBuffer.Free;
    235   inherited Destroy;
     334  FreeAndNil(FReceiveThread);
     335  FreeAndNil(FReceiveBuffer);
     336  FreeAndNil(Lock);
     337  inherited;
     338end;
     339
     340procedure TSerialPort.Flush;
     341begin
     342  if FActive then begin
     343    inherited Flush;
     344  end;
     345end;
     346
     347procedure TSerialPort.Purge;
     348begin
     349  if FActive then
     350    inherited Purge;
    236351end;
    237352
    … …  
    316431      if InBufferUsed = 0 then Sleep(1);
    317432        //else Yield;
    318       if Active then begin
     433      if Active then
     434      try
     435        Parent.Lock.Acquire;
    319436        InBufferUsed := WaitingData;
    320437        if InBufferUsed > 0 then begin
    … …  
    325442          Parent.FReceiveBuffer.Count := Length(Buffer);
    326443          Parent.FReceiveBuffer.ReplaceBuffer(0, PByte(Buffer)^, Length(Buffer));
    327           if Assigned(Parent.FOnReceiveData) then
    328             Parent.FOnReceiveData(Parent.FReceiveBuffer);
     444          if Assigned(Parent.FOnReceiveData) then begin
     445            try
     446              Parent.Lock.Release;
     447              Parent.FOnReceiveData(Parent.FReceiveBuffer);
     448            finally
     449              Parent.Lock.Acquire;
     450            end;
     451          end;
    329452        end else InBufferUsed := 0;
     453      finally
     454        Parent.Lock.Release;
    330455      end else InBufferUsed := 0;
    331456  until Terminated;
Note: See TracChangeset for help on using the changeset viewer.