1 (*
2 * Licensed to the Apache Software Foundation (ASF) under one
3 * or more contributor license agreements. See the NOTICE file
4 * distributed with this work for additional information
5 * regarding copyright ownership. The ASF licenses this file
6 * to you under the Apache License, Version 2.0 (the
7 * "License"); you may not use this file except in compliance
8 * with the License. You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing,
13 * software distributed under the License is distributed on an
14 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 * KIND, either express or implied. See the License for the
16 * specific language governing permissions and limitations
17 * under the License.
18 *)
19
20 unit Thrift.Stream;
21
22 {$I Thrift.Defines.inc}
23
24 interface
25
26 uses
27 Classes,
28 SysUtils,
29 SysConst,
30 RTLConsts,
31 {$IFDEF OLD_UNIT_NAMES}
32 ActiveX,
33 {$ELSE}
34 Winapi.ActiveX,
35 {$ENDIF}
36 Thrift.Utils;
37
38 type
39
40 IThriftStream = interface
41 ['{2A77D916-7446-46C1-8545-0AEC0008DBCA}']
42 procedure Write( const buffer: TBytes; offset: Integer; count: Integer); overload;
43 procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); overload;
Readnull44 function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; overload;
Readnull45 function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload;
46 procedure Open;
47 procedure Close;
48 procedure Flush;
IsOpennull49 function IsOpen: Boolean;
ToArraynull50 function ToArray: TBytes;
51 end;
52
53 TThriftStreamImpl = class( TInterfacedObject, IThriftStream)
54 private
55 procedure CheckSizeAndOffset( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer); overload;
56 protected
57 procedure Write( const buffer: TBytes; offset: Integer; count: Integer); overload; inline;
58 procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); overload; virtual;
Readnull59 function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; overload; inline;
Readnull60 function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; overload; virtual;
61 procedure Open; virtual; abstract;
62 procedure Close; virtual; abstract;
63 procedure Flush; virtual; abstract;
IsOpennull64 function IsOpen: Boolean; virtual; abstract;
ToArraynull65 function ToArray: TBytes; virtual; abstract;
66 end;
67
68 TThriftStreamAdapterDelphi = class( TThriftStreamImpl )
69 private
70 FStream : TStream;
71 FOwnsStream : Boolean;
72 protected
73 procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); override;
Readnull74 function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
75 procedure Open; override;
76 procedure Close; override;
77 procedure Flush; override;
IsOpennull78 function IsOpen: Boolean; override;
ToArraynull79 function ToArray: TBytes; override;
80 public
81 constructor Create( const AStream: TStream; AOwnsStream : Boolean);
82 destructor Destroy; override;
83 end;
84
85 TThriftStreamAdapterCOM = class( TThriftStreamImpl)
86 private
87 FStream : IStream;
88 protected
89 procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); override;
Readnull90 function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
91 procedure Open; override;
92 procedure Close; override;
93 procedure Flush; override;
IsOpennull94 function IsOpen: Boolean; override;
ToArraynull95 function ToArray: TBytes; override;
96 public
97 constructor Create( const AStream: IStream);
98 end;
99
100 implementation
101
102 { TThriftStreamAdapterCOM }
103
104 procedure TThriftStreamAdapterCOM.Close;
105 begin
106 FStream := nil;
107 end;
108
109 constructor TThriftStreamAdapterCOM.Create( const AStream: IStream);
110 begin
111 inherited Create;
112 FStream := AStream;
113 end;
114
115 procedure TThriftStreamAdapterCOM.Flush;
116 begin
117 if IsOpen then begin
118 if FStream <> nil then begin
119 FStream.Commit( STGC_DEFAULT );
120 end;
121 end;
122 end;
123
TThriftStreamAdapterCOM.IsOpennull124 function TThriftStreamAdapterCOM.IsOpen: Boolean;
125 begin
126 Result := FStream <> nil;
127 end;
128
129 procedure TThriftStreamAdapterCOM.Open;
130 begin
131 // nothing to do
132 end;
133
Readnull134 function TThriftStreamAdapterCOM.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
135 var pTmp : PByte;
136 begin
137 inherited;
138
139 if count >= buflen-offset
140 then count := buflen-offset;
141
142 Result := 0;
143 if FStream <> nil then begin
144 if count > 0 then begin
145 pTmp := pBuf;
146 Inc( pTmp, offset);
147 FStream.Read( pTmp, count, @Result);
148 end;
149 end;
150 end;
151
ToArraynull152 function TThriftStreamAdapterCOM.ToArray: TBytes;
153 var
154 statstg: TStatStg;
155 len : Integer;
156 NewPos : {$IF CompilerVersion >= 29.0} UInt64 {$ELSE} Int64 {$IFEND};
157 cbRead : Integer;
158 begin
159 FillChar( statstg, SizeOf( statstg), 0);
160 len := 0;
161 if IsOpen then begin
162 if Succeeded( FStream.Stat( statstg, STATFLAG_NONAME )) then begin
163 len := statstg.cbSize;
164 end;
165 end;
166
167 SetLength( Result, len );
168
169 if len > 0 then begin
170 if Succeeded( FStream.Seek( 0, STREAM_SEEK_SET, NewPos) ) then begin
171 FStream.Read( @Result[0], len, @cbRead);
172 end;
173 end;
174 end;
175
176 procedure TThriftStreamAdapterCOM.Write( const pBuf: Pointer; offset: Integer; count: Integer);
177 var nWritten : Integer;
178 pTmp : PByte;
179 begin
180 inherited;
181 if IsOpen then begin
182 if count > 0 then begin
183 pTmp := pBuf;
184 Inc( pTmp, offset);
185 FStream.Write( pTmp, count, @nWritten);
186 end;
187 end;
188 end;
189
190 { TThriftStreamImpl }
191
192 procedure TThriftStreamImpl.CheckSizeAndOffset( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer);
193 begin
194 if count > 0 then begin
195 if (offset < 0) or ( offset >= buflen) then begin
196 raise ERangeError.Create( SBitsIndexError );
197 end;
198 if count > buflen then begin
199 raise ERangeError.Create( SBitsIndexError );
200 end;
201 end;
202 end;
203
Readnull204 function TThriftStreamImpl.Read(var buffer: TBytes; offset, count: Integer): Integer;
205 begin
206 if Length(buffer) > 0
207 then Result := Read( @buffer[0], Length(buffer), offset, count)
208 else Result := 0;
209 end;
210
Readnull211 function TThriftStreamImpl.Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer;
212 begin
213 Result := 0;
214 CheckSizeAndOffset( pBuf, buflen, offset, count );
215 end;
216
217 procedure TThriftStreamImpl.Write(const buffer: TBytes; offset, count: Integer);
218 begin
219 if Length(buffer) > 0
220 then Write( @buffer[0], offset, count);
221 end;
222
223 procedure TThriftStreamImpl.Write( const pBuf : Pointer; offset: Integer; count: Integer);
224 begin
225 CheckSizeAndOffset( pBuf, offset+count, offset, count);
226 end;
227
228 { TThriftStreamAdapterDelphi }
229
230 procedure TThriftStreamAdapterDelphi.Close;
231 begin
232 FStream.Free;
233 FStream := nil;
234 FOwnsStream := False;
235 end;
236
237 constructor TThriftStreamAdapterDelphi.Create( const AStream: TStream; AOwnsStream: Boolean);
238 begin
239 inherited Create;
240 FStream := AStream;
241 FOwnsStream := AOwnsStream;
242 end;
243
244 destructor TThriftStreamAdapterDelphi.Destroy;
245 begin
246 if FOwnsStream
247 then Close;
248
249 inherited;
250 end;
251
252 procedure TThriftStreamAdapterDelphi.Flush;
253 begin
254 // nothing to do
255 end;
256
TThriftStreamAdapterDelphi.IsOpennull257 function TThriftStreamAdapterDelphi.IsOpen: Boolean;
258 begin
259 Result := FStream <> nil;
260 end;
261
262 procedure TThriftStreamAdapterDelphi.Open;
263 begin
264 // nothing to do
265 end;
266
Readnull267 function TThriftStreamAdapterDelphi.Read(const pBuf : Pointer; const buflen : Integer; offset, count: Integer): Integer;
268 var pTmp : PByte;
269 begin
270 inherited;
271
272 if count >= buflen-offset
273 then count := buflen-offset;
274
275 if count > 0 then begin
276 pTmp := pBuf;
277 Inc( pTmp, offset);
278 Result := FStream.Read( pTmp^, count)
279 end
280 else Result := 0;
281 end;
282
ToArraynull283 function TThriftStreamAdapterDelphi.ToArray: TBytes;
284 var
285 OrgPos : Integer;
286 len : Integer;
287 begin
288 len := 0;
289 if FStream <> nil then
290 begin
291 len := FStream.Size;
292 end;
293
294 SetLength( Result, len );
295
296 if len > 0 then
297 begin
298 OrgPos := FStream.Position;
299 try
300 FStream.Position := 0;
301 FStream.ReadBuffer( Pointer(@Result[0])^, len );
302 finally
303 FStream.Position := OrgPos;
304 end;
305 end
306 end;
307
308 procedure TThriftStreamAdapterDelphi.Write(const pBuf : Pointer; offset, count: Integer);
309 var pTmp : PByte;
310 begin
311 inherited;
312 if count > 0 then begin
313 pTmp := pBuf;
314 Inc( pTmp, offset);
315 FStream.Write( pTmp^, count)
316 end;
317 end;
318
319 end.
320