mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 17:20:30 +02:00
+ Initial implementation of pipestream
This commit is contained in:
parent
ca19d190a3
commit
ba20598d84
23
fcl/go32v2/pipes.inc
Normal file
23
fcl/go32v2/pipes.inc
Normal file
@ -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;
|
@ -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
fcl/inc/pipes.pp
Normal file
91
fcl/inc/pipes.pp
Normal file
@ -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
fcl/linux/pipes.inc
Normal file
23
fcl/linux/pipes.inc
Normal file
@ -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
fcl/win32/pipes.inc
Normal file
36
fcl/win32/pipes.inc
Normal file
@ -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;
|
Loading…
Reference in New Issue
Block a user