unit LIRC;
interface
uses
  Windows,Classes,SysUtils,Winsock,Consts,RTLConsts;

type
  TLIRCKeyEvent=procedure(Sender:TObject;RawData:Int64;const Button,Remote:string;RepeatCount:Integer) of object;
  TLIRCClient=class
  private
    FConnected:Boolean;
    FIP:string;
    FOnKey:TLIRCKeyEvent;
    FOnStateChanged:TNotifyEvent;
    FPort:Word;
    FThread:TThread;
    FReconnectInterval:Integer;
    procedure ParseDataLine(Line:string);
    procedure SetActive(const Value:Boolean);
    procedure SetIP(const Value:string);
    procedure SetPort(const Value:Word);
    function GetActive:Boolean;
    procedure SetReconnectInterval(const Value:Integer);
  public
    constructor Create;
    destructor Destroy; override;
    property Active:Boolean read GetActive write SetActive;
    property IP:string read FIP write SetIP;
    property Port:Word read FPort write SetPort;
    property ReconnectInterval:Integer read FReconnectInterval write SetReconnectInterval;
    property Connected:Boolean read FConnected;
    property OnKey:TLIRCKeyEvent read FOnKey write FOnKey;
    property OnStateChanged:TNotifyEvent read FOnStateChanged write FOnStateChanged;
  end;

implementation

type
  TLIRCThread=class(TThread)
  private
    FOwner:TLIRCClient;
    FEvent:THandle;
    FSocket:TSocket;
    FLine:string;
    FConnected:Boolean;
    procedure Open;
    procedure Close;
    procedure DoNewData;
    procedure DoChangeState;
    procedure ChangeState(Connected:Boolean);
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner:TLIRCClient);
    destructor Destroy; override;
  end;

  { TLIRCThread }

constructor TLIRCThread.Create(AOwner:TLIRCClient);
begin
  FOwner:=AOwner;
  FEvent:=CreateEvent(nil,True,False,nil);
  inherited Create(False);
  FreeOnTerminate:=False;
end;

destructor TLIRCThread.Destroy;
begin
  Terminate;
  SetEvent(FEvent);
  Close;
  inherited;
  CloseHandle(FEvent);
end;

procedure TLIRCThread.ChangeState(Connected:Boolean);
begin
  if Connected<>FConnected then begin
    FConnected:=Connected;
    Synchronize(DoChangeState);
  end;
end;

procedure TLIRCThread.Open;
var
  FAddr:TSockAddrIn;
  Val:Integer;
begin
  FAddr.sin_family:=AF_INET;
  FAddr.sin_port:=htons(FOwner.FPort);
  FAddr.sin_addr.S_addr:=inet_addr(PChar(FOwner.FIP));
  FSocket:=socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
  Val:=1;
  if (FSocket<>INVALID_SOCKET)and not Terminated
    and(setsockopt(FSocket,SOL_SOCKET,SO_KEEPALIVE,@Val,SizeOf(Val))=0)
    and(connect(FSocket,FAddr,SizeOf(FAddr))=0) then
    ChangeState(True)
  else
    Close;
end;

procedure TLIRCThread.Close;
var
  S:TSocket;
begin
  S:=InterlockedExchange(FSocket,INVALID_SOCKET);
  if S<>INVALID_SOCKET then begin
    Shutdown(S,SD_SEND);
    CloseSocket(S);
  end;
  ChangeState(False);
end;

procedure TLIRCThread.DoChangeState;
begin
  FOwner.FConnected:=FConnected;
  if Assigned(FOwner.FOnStateChanged) then FOwner.FOnStateChanged(FOwner);
end;

procedure TLIRCThread.DoNewData;
begin
  FOwner.ParseDataLine(FLine);
end;

procedure TLIRCThread.Execute;
var
  Pos,Readed:Integer;
  Buffer:array[0..1024-1] of Char;
  Start,PC,MaxPC:PChar;
begin
  try
    Pos:=0;
    while not Terminated do begin
      if (FSocket=INVALID_SOCKET)or(Pos>=SizeOf(Buffer)) then begin
        Pos:=0;
        Close;
        Open;
      end;
      if FSocket<>INVALID_SOCKET then begin
        Readed:=recv(FSocket,Buffer[Pos],SizeOf(Buffer)-Pos,0);
        if (Readed>0)and(Readed<=SizeOf(Buffer)) then begin
          PC:=@Buffer;
          MaxPC:=@Buffer[Pos+Readed];
          Start:=PC;
          repeat
            while (PC<MaxPC)and not(PC^in [#10,#13]) do
              Inc(PC);
            if PC<MaxPC then begin
              SetString(FLine,Start,PC-Start);
              Synchronize(DoNewData);
              if (PC>=MaxPC-1) then
                Inc(PC)
              else
                if ((PC^=#13)and(PC[1]=#10))or((PC^=#10)and(PC[1]=#13)) then Inc(PC,2);
              Start:=PC;
            end;
          until PC>=MaxPC;
          if Start<>@Buffer then Move(Start^,Buffer,MaxPC-Start);
          Pos:=MaxPC-Start;
        end
        else
          Close;
      end
      else
        WaitForSingleObject(FEvent,FOwner.FReconnectInterval);
    end;
  except
    if Assigned(ApplicationHandleException) then
      ApplicationHandleException(Self)
    else
      raise;
  end;
end;

{ TLIRCClient }

constructor TLIRCClient.Create;
var
  WSAData:TWSAData;
begin
  WSAStartup($0101,WSAData);
  FPort:=8765;
  FIP:='127.0.0.1';
  FReconnectInterval:=1000;
end;

destructor TLIRCClient.Destroy;
begin
  Active:=False;
  WSACleanup;
end;

function TLIRCClient.GetActive:Boolean;
begin
  Result:=Assigned(FThread);
end;

procedure TLIRCClient.SetActive(const Value:Boolean);
begin
  if Active<>Value then begin
    if Value then
      FThread:=TLIRCThread.Create(Self)
    else
      FreeAndNil(FThread);
  end;
end;

procedure TLIRCClient.ParseDataLine(Line:string);
  function GetNext:string;
  var
    A:Integer;
  begin
    Line:=Trim(Line);
    A:=Pos(' ',Line);
    if A=0 then A:=Length(Line)+1;
    Result:=Copy(Line,1,A-1);
    Delete(Line,1,A);
  end;
var
  RawData:Int64;
  Count,Code:Integer;
  Button:string;
begin
  Val('$'+GetNext,RawData,Code);
  if Code<>0 then Exit;
  Val('$'+GetNext,Count,Code);
  if (Code<>0)or(Count<0)or(Count>MaxWord) then Exit;
  Button:=GetNext;
  if Button='' then Exit;
  if Assigned(FOnKey) then FOnKey(Self,RawData,Button,GetNext,Count);
end;

procedure TLIRCClient.SetIP(const Value:string);
begin
  if FIP<>Value then begin
    if Active then raise Exception.CreateRes(@SCantChangeWhileActive);
    FIP:=Value;
  end;
end;

procedure TLIRCClient.SetPort(const Value:Word);
begin
  if FPort<>Value then begin
    if Active then raise Exception.CreateRes(@SCantChangeWhileActive);
    FPort:=Value;
  end;
end;

procedure TLIRCClient.SetReconnectInterval(const Value:Integer);
begin
  if FReconnectInterval<>Value then begin
    if (Value<0)or(Value>=MaxInt) then
      raise Exception.CreateResFmt(@SOutOfRange, [0,MaxInt]);
    if Active then raise Exception.CreateRes(@SCantChangeWhileActive);
    FReconnectInterval:=Value;
  end;
end;

end.