1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 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.
**********************************************************************}
{$mode objfpc}
{$IFNDEF FPC_DOTTEDUNITS}
Unit Pipes331;
{$ENDIF FPC_DOTTEDUNITS}
Interface
{$IFDEF FPC_DOTTEDUNITS}
Uses System.SysUtils,System.Classes;
{$ELSE FPC_DOTTEDUNITS}
Uses sysutils,Classes;
{$ENDIF FPC_DOTTEDUNITS}
Type
EPipeError = Class(EStreamError);
EPipeSeek = Class (EPipeError);
EPipeCreation = Class (EPipeError);
{ TInputPipeStream }
TInputPipeStream = Class(THandleStream)
Private
FPos : Int64;
function GetNumBytesAvailable: DWord;
protected
function GetPosition: Int64; override;
procedure InvalidSeek; override;
public
destructor Destroy; override;
Function Write (Const Buffer; Count : Longint) :Longint; Override;
function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
Function Read (Var Buffer; Count : Longint) : longint; Override;
property NumBytesAvailable: DWord read GetNumBytesAvailable;
end;
TOutputPipeStream = Class(THandleStream)
private
FDontClose : boolean;
Public
destructor Destroy; override;
function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
Function Read (Var Buffer; Count : Longint) : longint; Override;
property DontClose : boolean read FDontClose write FDontClose;
end;
Function CreatePipeHandles (Var Inhandle,OutHandle : THandle; APipeBufferSize : Cardinal = 1024) : Boolean;
Procedure CreatePipeStreams (Var InPipe : TInputPipeStream;
Var OutPipe : TOutputPipeStream);
Const EPipeMsg = 'Failed to create pipe.';
ENoSeekMsg = 'Cannot seek on pipes';
Implementation
{$IFDEF WINDOWS}
{$i win_pipes.inc}
{$ELSE}
{$i unix_pipes.inc}
{$ENDIF}
Procedure CreatePipeStreams (Var InPipe : TInputPipeStream;
Var OutPipe : TOutputPipeStream);
Var InHandle,OutHandle : THandle;
begin
if CreatePipeHandles (InHandle, OutHandle) then
begin
InPipe:=TInputPipeStream.Create (InHandle);
OutPipe:=TOutputPipeStream.Create (OutHandle);
end
Else
Raise EPipeCreation.Create (EPipeMsg)
end;
destructor TInputPipeStream.Destroy;
begin
PipeClose (Handle);
inherited;
end;
Function TInputPipeStream.Write (Const Buffer; Count : Longint) : longint;
begin
WriteNotImplemented;
Result := 0;
end;
Function TInputPipeStream.Read (Var Buffer; Count : Longint) : longint;
{$ifdef MorphOS}
var
i: Integer;
Runner: PByte;
{$endif}
begin
{$ifdef MorphOS}
FillChar(Buffer, Count, 0);
if FGetS(Handle, @Buffer, Count) = nil then
Result := 0
else
begin
Result := 0;
Runner := @Buffer;
repeat
if Runner^ = 0 then
Break;
Inc(Result);
until Result >= Count;
end;
{$else}
Result:=Inherited Read(Buffer,Count);
Inc(FPos,Result);
{$endif}
end;
function TInputPipeStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
begin
FakeSeekForward(Offset,Origin,FPos);
Result:=FPos;
end;
destructor TOutputPipeStream.Destroy;
begin
if not fdontclose then
PipeClose (Handle);
inherited;
end;
Function TOutputPipeStream.Read(Var Buffer; Count : Longint) : longint;
begin
ReadNotImplemented;
Result := 0;
end;
function TOutputPipeStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
begin
Result:=0; { to silence warning mostly }
InvalidSeek;
end;
end.
|
