Browse Source

+ Initial implementation of pipestream

michael 26 years ago
parent
commit
ba20598d84
5 changed files with 174 additions and 1 deletions
  1. 23 0
      fcl/go32v2/pipes.inc
  2. 1 1
      fcl/inc/Makefile.inc
  3. 91 0
      fcl/inc/pipes.pp
  4. 23 0
      fcl/linux/pipes.inc
  5. 36 0
      fcl/win32/pipes.inc

+ 23 - 0
fcl/go32v2/pipes.inc

@@ -0,0 +1,23 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1998 by Michael Van Canneyt
+
+    DOS/go32v2 specific part of pipe stream.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+// No pipes under dos, sorry...
+
+Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
+
+begin
+  Result := False;
+end;

+ 1 - 1
fcl/inc/Makefile.inc

@@ -5,4 +5,4 @@ INCNAMES=classes.inc classesh.inc bits.inc collect.inc compon.inc filer.inc\
          lists.inc parser.inc persist.inc reader.inc streams.inc stringl.inc\
          writer.inc
 
-INCUNITS=inifiles ezcgi
+INCUNITS=inifiles ezcgi pipes

+ 91 - 0
fcl/inc/pipes.pp

@@ -0,0 +1,91 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1998 by Michael Van Canneyt
+
+    Implementation of pipe stream.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+Unit Pipes;
+
+Interface
+
+Uses sysutils,Classes;
+
+Type
+
+  ENoReadPipe = Class(ESTreamError);
+  ENoWritePipe = Class (EStreamError);
+  EPipeSeek = Class (EStreamError);
+  EPipeCreation = Class (Exception);
+
+  TPipeStream = Class (THandleStream)
+    public
+      Function Seek (Offset : Longint;Origin : Word) : longint;override;
+    end;
+
+  TInputPipeStream = Class(TPipeStream)
+    public
+      Function Write (Const Buffer; Count : Longint) :Longint; Override;
+    end;
+
+  TOutputPipeStream = Class(TPipeStream)
+    Public
+      Function Read (Var Buffer; Count : Longint) : longint; Override;
+    end;
+
+Procedure CreatePipeStreams (Var InPipe : TInputPipeStream;
+                             Var OutPipe : TOutputPipeStream);
+
+Const EPipeMsg = 'Failed to create pipe.';
+      ENoReadMSg = 'Cannot read from OuputPipeStream.';
+      ENoWriteMsg = 'Cannot write to InputPipeStream.';
+      ENoSeekMsg = 'Cannot seek on pipes';
+
+
+Implementation
+
+{$i pipes.inc}
+
+Procedure CreatePipeStreams (Var InPipe : TInputPipeStream;
+                             Var OutPipe : TOutputPipeStream);
+
+Var InHandle,OutHandle : Longint;
+
+begin
+  if CreatePipeHandles (InHandle, OutHandle) then
+    begin
+    Inpipe:=TinputPipeStream.Create (InHandle);
+    OutPipe:=ToutputPipeStream.Create (OutHandle);
+    end
+  Else
+    Raise EPipeCreation.CreateFmt (EPipeMsg,[getlasterror])
+end;
+
+Function TPipeStream.Seek (Offset : Longint;Origin : Word) : longint;
+
+begin
+  Raise EPipeSeek.Create (ENoSeekMsg);
+end;
+
+Function TInputPipeStream.Write (Const Buffer; Count : Longint) : longint;
+
+begin
+  Raise ENoWritePipe.Create (ENoWriteMsg);
+end;
+
+Function TOutputPipeStream.Read(Var Buffer; Count : Longint) : longint;
+
+begin
+  Raise ENoReadPipe.Create (ENoReadMsg);
+end;
+
+end.

+ 23 - 0
fcl/linux/pipes.inc

@@ -0,0 +1,23 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1998 by Michael Van Canneyt
+
+    Linux specific part of pipe stream.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+uses linux;
+
+Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
+
+begin
+  Result := AssignPipe (Inhandle,OutHandle);
+end;

+ 36 - 0
fcl/win32/pipes.inc

@@ -0,0 +1,36 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1998 by Michael Van Canneyt
+
+    Win32 part of pipe stream.
+    
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+uses windows;
+
+Const piInheritablePipe : TSecurityAttributes = (
+                           nlength:SizeOF(TSecurityAttributes);
+                           lpSecurityDescriptor:Nil;
+                           Binherithandle:True);
+      piNonInheritablePipe : TSecurityAttributes = (
+                             nlength:SizeOF(TSecurityAttributes);
+                             lpSecurityDescriptor:Nil;
+                             Binherithandle:False);
+
+
+      PipeBufSize = 1024;
+      
+
+Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
+
+begin
+  Result := CreatePipe (@Inhandle,@OutHandle,@piInheritablePipe,PipeBufSize);
+end;