unit Pipes;
{ Based on PipeObjs unit. See pipes.txt.
  Component wrapper for pipes implementation in WinNT/2000 }

{
  (C) 2000 - 2003 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://jindrich.com
                      http://chromulan.org
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface

uses
  Windows, Classes, SysUtils;

const
  PipePrefix = '\\.\pipe\';
type
  EPipe = class(Exception);
  TPipeName = type AnsiString;//classes sysutils

  TSecAttr = (saInheritHandle);
  TSecAttrs = set of TSecAttr;

  TOnRead = procedure(Buf: pointer; Count: integer) of object;//tthreadmethod

  TPipe = class(TComponent)
  private
    FPipeHandle: THandle;
    FPipeName: string;
    FActive: boolean;

  protected
    procedure RaiseError(const Msg: string);
    procedure SetActive(OnOff: boolean); virtual; abstract;
    function GetFullPipeName: string;
  public
    destructor Destroy; override;

    procedure Read(var Buf; BufSize: Integer; var BytesRead: Integer);
    procedure Write(var Buf; BufSize: Integer; var BytesWritten: Integer);
    procedure ReadStr(var Buf: AnsiString);
    procedure WriteStr(ToSend: AnsiString);
    property FullPipeName: string read GetFullPipeName;

  //to be published
    property PipeName: string read FPipeName write FPipeName;
    property Active: boolean read FActive write SetActive;
  end;

  TPipeServer = class;

  TPipeThread = class(TThread)
  private
    FPipeServer: TPipeServer;
  public
    procedure Execute; override;
    procedure Sync(AMethod: TThreadMethod);//synchronize
    constructor Create(APipeServer: TPipeServer);
  end;

  TPipeServer = class(TPipe)
  private
    FThread: TPipeThread;//checksynchronize
    FSecAttrs: TSecAttrs;
    FInBuf: pointer;
    FInBufSize: integer;
    FInBufCount: integer;
    FOnRead: TOnRead;
    FConnected: boolean;
  protected
    procedure SetActive(OnOff: boolean); override;
    function Connect: Boolean;
    function Disconnect: Boolean;
    procedure Loop;
    procedure DoOnRead; virtual;
  public
    //constructor Create(APipeName: TPipeName; var sa: TSecurityAttributes); virtual;
    // input (read) buffer
    property InBuf: pointer read FInBuf;
    // count of bytes read into to buffer by last Read call
    property InBufCount: integer read FInBufCount;
    property Connected: boolean read FConnected;
  published
    property SecAttrs: TSecAttrs read FSecAttrs write FSecAttrs;
    // size of the input (read) buffer
    property InBufSize: integer read FInBufSize write FInBufSize;
    property OnRead: TOnRead read FOnRead write FOnRead;
    property PipeName;
    property Active;
  end;

  TPipeClient = class(TPipe)
    //constructor Create(const APipeName: TPipeName); virtual;
  protected
    procedure SetActive(OnOff: boolean); override;
  published
    property PipeName;
    property Active;
  end;

procedure Register; //filescanner

implementation

{TPipe.}
function TPipe.GetFullPipeName: string;
begin
  Result := PipePrefix + PipeName;
end;

procedure TPipe.RaiseError(const Msg: string);
begin
  raise EPipe.Create(ClassName + '.' + Msg);
end;

procedure TPipe.Read(var Buf; BufSize: Integer; var BytesRead: Integer);
var rc: boolean;
begin
  rc := ReadFile(FPipeHandle, Buf, BufSize, DWORD(BytesRead), nil);//pipes.txt
  if not rc then
    RaiseError('Read : Broken pipe, error = ' + IntToStr(GetLastError));
end;

procedure TPipe.Write(var Buf; BufSize: Integer; var BytesWritten: Integer);
var rc: boolean;
begin
  rc := WriteFile(FPipeHandle, Buf, BufSize, DWORD(BytesWritten), nil);
  if not rc then
    RaiseError('Write : Broken pipe, error = ' + IntToStr(GetLastError));
end;

procedure TPipe.ReadStr(var Buf: AnsiString);
var
  BytesRead: Integer;
  s: shortstring;
begin
  Read(s[1], sizeof(s) - 1, BytesRead);
  SetLength(s, BytesRead);
  Buf := s;
end;

procedure TPipe.WriteStr(ToSend: AnsiString);
var
  Buf: AnsiString;
  BytesWritten: Integer;
begin
  Buf := ToSend;
  Write(Buf[1], length(Buf), BytesWritten);
end;


destructor TPipe.Destroy;
begin
  Active := false;
  Inherited Destroy;
end;
{/TPipe.}

procedure SecurityAttributesInit(var sa: TSecurityAttributes; const SecAttrs: TSecAttrs);
begin
  FillChar(sa, sizeof(sa), 0);
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := saInheritHandle in SecAttrs;
end;

//procedure SecurityAttributesDone(var sa: TSecurityAttributes);
//begin
//
//end;
procedure TPipeThread.Execute;
//const
//  BufSize = 1024;
var
  brokenPipe: boolean;
//  buf: array[0..BufSize-1] of byte;
begin
  repeat
    if FPipeServer.Connect then begin
      brokenPipe:= false;
      repeat
        try
          FPipeServer.Loop;
        except
          brokenPipe:= true;
        end;
  //synchronize      if not BrokenPipe then
  //        Pipe.WriteStr(UpperCase(buf));
      until brokenPipe;
      FPipeServer.Disconnect;
    end else
      FPipeServer.RaiseError('.Connect failed: ' +IntToStr(GetLastError));
  until Terminated;
end;

constructor TPipeThread.Create(APipeServer: TPipeServer);
begin
  inherited Create(true);
  FPipeServer := APipeServer;
  Resume;
end;

procedure TPipeThread.Sync(AMethod: TThreadMethod);
begin
  Synchronize(AMethod);
end;
{TPipeServer.}
procedure TPipeServer.SetActive(OnOff: boolean);
var
  sa: TSecurityAttributes;//windows securityattributes
{  _SECURITY_ATTRIBUTES = record
    nLength: DWORD;
    lpSecurityDescriptor: Pointer;
    bInheritHandle: BOOL;
  end; }
begin
  if FActive = OnOff then
    exit;
  if OnOff then begin
    SecurityAttributesInit(sa, SecAttrs);
    FPipeHandle := CreateNamedPipe(PChar(FullPipeName), PIPE_ACCESS_DUPLEX,
      PIPE_TYPE_MESSAGE + PIPE_WAIT, 1, 0, 0, 150, @sa);
    if FPipeHandle = INVALID_HANDLE_VALUE then begin
      FPipeHandle := 0;
      RaiseError('SetActive, error = ' + IntToStr(GetLastError));
    end;
//    if not Connect then
//      RaiseError('Connect failed, error = ' + IntToStr(GetLastError));
    if FInBufSize = 0 then
      FInBufSize := 1024;
    GetMem(FInBuf, FInBufSize);
    FThread := TPipeThread.Create(Self);//classes
  end else begin
    if FPipeHandle <> 0 then begin
      if FThread <> nil then begin
        FThread.Terminate;
        // thread should be terminated before calling
        // disconnect, otherwise Connect will be called again
        // from withing execuet and Disconnect will wait forever
      end;
      Disconnect;
      CloseHandle(FPipeHandle);
      FPipeHandle :=0;
    end;
    if FThread <> nil then begin
      FreeAndNil(FThread);
    end;
    if FInBuf <> nil then begin
      FreeMem(FInBuf);
      FInBuf := nil;
      FInBufCount := 0;
    end;
  end;
  FActive := OnOff;
end;

function TPipeServer.Connect: Boolean;
begin
  Result := ConnectNamedPipe(FPipeHandle, nil);
  FConnected := Result;
end;

function TPipeServer.Disconnect: boolean;
var p: TPipeClient;
begin
  if FPipeHandle <> 0 then begin
    if not Connected then begin
      // i.e. waiting in Connect call, in such Pipe state can be Disconnect called from SetActive(false)
      if WaitNamedPipe(PChar(FullPipeName), 5) then begin
        //NMPWAIT_USE_DEFAULT_WAIT  NMPWAIT_WAIT_FOREVER
        p := TPipeClient.Create(nil);
        try
          p.PipeName := PipeName;
          p.Active := true;
            // connection should be established rigth now
          p.Active := false;
            // and closed again, Execute should finish, because
            // Termidated should be true
        finally
          p.Free;
        end;
        {v0.69}
        Result := true;
        {/v0.69}
      end;
    end else begin
      Result := DisconnectNamedPipe(FPipeHandle);//createnamedpipe
    end;
  end else begin
    Result := true;
  end;
  FConnected := false;
end;

procedure TPipeServer.Loop;
begin
  repeat
    Read(FInBuf^, FInBufSize, FInBufCount);
    FThread.Sync(DoOnRead);
  until false;
end;

procedure TPipeServer.DoOnRead;
begin
  if Assigned(FOnRead) then
    FOnRead(FInBuf, FInBufCount);
end;
{/TPipeServer.}

{TPipeClient.}
procedure TPipeClient.SetActive(OnOff: boolean);
begin
  if OnOff = FActive then
    exit;
  if OnOff then begin
    FPipeHandle := CreateFile(PChar(FullPipeName),
      GENERIC_READ + GENERIC_WRITE,  FILE_SHARE_READ, nil, OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL, 0);
    if FPipeHandle = INVALID_HANDLE_VALUE then
      RaiseError('CreateFile error = ' + IntToStr(GetLastError));
  end else begin
    if FPipeHandle <> 0 then
      CloseHandle(FPipeHandle);
  end;
  FActive := OnOff;
end;
{/TPipeClient.}

procedure Register;
begin
  RegisterComponents('NonVis', [TPipeClient, TPipeServer]);
end;
end.
