1 |
// Upgraded to Delphi 2009: Sebastian Zierer
|
2 |
|
3 |
(* ***** BEGIN LICENSE BLOCK *****
|
4 |
* Version: MPL 1.1
|
5 |
*
|
6 |
* The contents of this file are subject to the Mozilla Public License Version
|
7 |
* 1.1 (the "License"); you may not use this file except in compliance with
|
8 |
* the License. You may obtain a copy of the License at
|
9 |
* http://www.mozilla.org/MPL/
|
10 |
*
|
11 |
* Software distributed under the License is distributed on an "AS IS" basis,
|
12 |
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
13 |
* for the specific language governing rights and limitations under the
|
14 |
* License.
|
15 |
*
|
16 |
* The Original Code is TurboPower SysTools
|
17 |
*
|
18 |
* The Initial Developer of the Original Code is
|
19 |
* TurboPower Software
|
20 |
*
|
21 |
* Portions created by the Initial Developer are Copyright (C) 1996-2002
|
22 |
* the Initial Developer. All Rights Reserved.
|
23 |
*
|
24 |
* Contributor(s):
|
25 |
*
|
26 |
* ***** END LICENSE BLOCK ***** *)
|
27 |
|
28 |
{*********************************************************}
|
29 |
{* SysTools: StStrms.pas 4.04 *}
|
30 |
{*********************************************************}
|
31 |
{* SysTools: Specialized Stream Classes for SysTools *}
|
32 |
{*********************************************************}
|
33 |
|
34 |
{$I StDefine.inc}
|
35 |
|
36 |
unit StStrms;
|
37 |
|
38 |
interface
|
39 |
|
40 |
uses
|
41 |
Windows,
|
42 |
SysUtils,
|
43 |
Classes,
|
44 |
|
45 |
StBase,
|
46 |
StConst;
|
47 |
|
48 |
type
|
49 |
TStMemSize = Integer;
|
50 |
|
51 |
TStBufferedStream = class(TStream)
|
52 |
private
|
53 |
FBufCount: TStMemSize; {count of valid bytes in buffer}
|
54 |
FBuffer : PAnsiChar; {buffer into underlying stream}
|
55 |
FBufOfs : longint; {offset of buffer in underlying stream}
|
56 |
FBufPos : TStMemSize; {current position in buffer}
|
57 |
FBufSize : TStMemSize; {size of buffer}
|
58 |
FDirty : boolean; {has data in buffer been changed?}
|
59 |
FSize : Int64; {size of underlying stream}
|
60 |
FStream : TStream; {underlying stream}
|
61 |
{$IFNDEF VERSION3}
|
62 |
FOnSetStreamSize : TStSetStreamSize;
|
63 |
{event to set underlying stream's size}
|
64 |
{$ENDIF}
|
65 |
protected
|
66 |
procedure bsSetStream(aValue : TStream);
|
67 |
|
68 |
procedure bsInitForNewStream; virtual;
|
69 |
function bsReadChar(var aCh : AnsiChar) : boolean;
|
70 |
procedure bsReadFromStream;
|
71 |
procedure bsWriteToStream;
|
72 |
|
73 |
{$IFDEF VERSION3}
|
74 |
procedure SetSize(NewSize : longint); override;
|
75 |
{$ENDIF}
|
76 |
public
|
77 |
constructor Create(aStream : TStream);
|
78 |
constructor CreateEmpty;
|
79 |
destructor Destroy; override;
|
80 |
|
81 |
function Read(var Buffer; Count : longint) : longint; override;
|
82 |
function Seek(Offset : longint; Origin : word) : longint; override;
|
83 |
function Write(const Buffer; Count : longint) : longint; override;
|
84 |
{$IFNDEF VERSION3}
|
85 |
procedure SetSize(NewSize : longint);
|
86 |
{$ENDIF}
|
87 |
|
88 |
property FastSize : Int64 read FSize;
|
89 |
property Stream : TStream read FStream write bsSetStream;
|
90 |
|
91 |
{$IFNDEF VERSION3}
|
92 |
property OnSetStreamSize : TStSetStreamSize
|
93 |
read FOnSetStreamSize write FOnSetStreamSize;
|
94 |
{$ENDIF}
|
95 |
end;
|
96 |
|
97 |
type
|
98 |
{!!.01 - moved to StBase.pas }
|
99 |
(*
|
100 |
TStLineTerminator = ( {possible line terminators...}
|
101 |
ltNone, {..no terminator, ie fixed length lines}
|
102 |
ltCR, {..carriage return (#13)}
|
103 |
ltLF, {..line feed (#10)}
|
104 |
ltCRLF, {..carriage return/line feed (#13/#10)}
|
105 |
ltOther); {..another character}
|
106 |
*)
|
107 |
{!!.01 - end moved }
|
108 |
|
109 |
|
110 |
// TODO-UNICODE: add TStUnicodeTextStream
|
111 |
|
112 |
TStAnsiTextStream = class(TStBufferedStream)
|
113 |
private
|
114 |
FLineEndCh : AnsiChar;
|
115 |
FLineLen : integer;
|
116 |
FLineTerm : TStLineTerminator;
|
117 |
FFixedLine : PAnsiChar;
|
118 |
FLineCount : longint;
|
119 |
FLineCurrent : longint;
|
120 |
FLineCurOfs : longint;
|
121 |
FLineIndex : TList;
|
122 |
FLineInxStep : longint;
|
123 |
FLineInxTop : integer;
|
124 |
protected
|
125 |
function atsGetLineCount : longint;
|
126 |
|
127 |
procedure atsSetLineTerm(aValue : TStLineTerminator);
|
128 |
procedure atsSetLineEndCh(aValue : AnsiChar);
|
129 |
procedure atsSetLineLen(aValue : integer);
|
130 |
|
131 |
procedure atsGetLine(var aStartPos : longint;
|
132 |
var aEndPos : longint;
|
133 |
var aLen : longint);
|
134 |
procedure atsResetLineIndex;
|
135 |
|
136 |
procedure bsInitForNewStream; override;
|
137 |
public
|
138 |
constructor Create(aStream : TStream);
|
139 |
destructor Destroy; override;
|
140 |
|
141 |
function AtEndOfStream : boolean;
|
142 |
|
143 |
function ReadLine : AnsiString;
|
144 |
function ReadLineArray(aCharArray : PAnsiChar; aLen : TStMemSize)
|
145 |
: TStMemSize;
|
146 |
function ReadLineZ(aSt : PAnsiChar; aMaxLen : TStMemSize) : PAnsiChar;
|
147 |
|
148 |
function SeekNearestLine(aOffset : longint) : longint;
|
149 |
function SeekLine(aLineNum : longint) : longint;
|
150 |
|
151 |
procedure WriteLine(const aSt : AnsiString);
|
152 |
procedure WriteLineArray(aCharArray : PAnsiChar; aLen : TStMemSize);
|
153 |
procedure WriteLineZ(aSt : PAnsiChar);
|
154 |
|
155 |
property FixedLineLength : integer
|
156 |
read FLineLen write atsSetLineLen;
|
157 |
property LineCount : longint
|
158 |
read atsGetLineCount;
|
159 |
property LineTermChar : AnsiChar
|
160 |
read FLineEndCh write atsSetLineEndCh;
|
161 |
property LineTerminator : TStLineTerminator
|
162 |
read FLineTerm write atsSetLineTerm;
|
163 |
end;
|
164 |
|
165 |
TStMemoryMappedFile = class(TStream)
|
166 |
protected {private}
|
167 |
FBuffer : Pointer;
|
168 |
FHeaderSize : Word;
|
169 |
FDataSize : Cardinal;
|
170 |
FHandle : THandle;
|
171 |
FMapObj : THandle;
|
172 |
FMaxHi : Cardinal;
|
173 |
FMaxLo : Cardinal;
|
174 |
FMutex : THandle;
|
175 |
FPos : Cardinal;
|
176 |
FReadOnly : Boolean;
|
177 |
FSharedData : Boolean;
|
178 |
|
179 |
protected
|
180 |
function GetDataSize : Cardinal;
|
181 |
|
182 |
public
|
183 |
constructor Create(const FileName : string; {!!.02}
|
184 |
MaxSize : Cardinal;
|
185 |
ReadOnly : Boolean;
|
186 |
SharedData : Boolean);
|
187 |
destructor Destroy; override;
|
188 |
|
189 |
function Read(var Buffer; Count : Longint) : Longint; override;
|
190 |
function Seek(Offset : Longint; Origin : Word) : Longint; override;
|
191 |
function Write(const Buffer; Count : Longint) : Longint; override;
|
192 |
|
193 |
property DataSize : Cardinal
|
194 |
read GetDataSize;
|
195 |
|
196 |
property MaxSize : Cardinal
|
197 |
read FMaxLo;
|
198 |
|
199 |
property Position : Cardinal
|
200 |
read FPos;
|
201 |
|
202 |
property ReadOnly : Boolean
|
203 |
read FReadOnly;
|
204 |
|
205 |
property SharedData : Boolean
|
206 |
read FSharedData;
|
207 |
end;
|
208 |
|
209 |
implementation
|
210 |
|
211 |
const
|
212 |
LineTerm : array [TStLineTerminator] of
|
213 |
array [0..1] of AnsiChar =
|
214 |
('', #13, #10, #13#10, '');
|
215 |
|
216 |
const
|
217 |
LineIndexCount = 1024;
|
218 |
LineIndexMax = pred(LineIndexCount);
|
219 |
|
220 |
|
221 |
{--- Helper routines ---------------------------------------------------------}
|
222 |
|
223 |
function MinLong(A, B : longint) : longint;
|
224 |
begin
|
225 |
if A < B then
|
226 |
Result := A
|
227 |
else
|
228 |
Result := B;
|
229 |
end;
|
230 |
|
231 |
|
232 |
{-----------------------------------------------------------------------------}
|
233 |
{ TStBufferedStream }
|
234 |
{-----------------------------------------------------------------------------}
|
235 |
|
236 |
constructor TStBufferedStream.Create(aStream : TStream);
|
237 |
begin
|
238 |
inherited Create;
|
239 |
|
240 |
{allocate the buffer}
|
241 |
FBufSize := 4096;
|
242 |
GetMem(FBuffer, FBufSize);
|
243 |
|
244 |
{save the stream}
|
245 |
if (aStream = nil) then
|
246 |
RaiseStError(EStBufStreamError, stscNilStream);
|
247 |
FStream := aStream;
|
248 |
|
249 |
bsInitForNewStream;
|
250 |
end;
|
251 |
|
252 |
{-----------------------------------------------------------------------------}
|
253 |
|
254 |
constructor TStBufferedStream.CreateEmpty;
|
255 |
begin
|
256 |
inherited Create;
|
257 |
|
258 |
{allocate the buffer}
|
259 |
FBufSize := 4096;
|
260 |
GetMem(FBuffer, FBufSize);
|
261 |
|
262 |
bsInitForNewStream
|
263 |
end;
|
264 |
|
265 |
{-----------------------------------------------------------------------------}
|
266 |
|
267 |
destructor TStBufferedStream.Destroy;
|
268 |
begin
|
269 |
if (FBuffer <> nil) then begin
|
270 |
if FDirty and (FStream <> nil) then
|
271 |
bsWriteToStream;
|
272 |
FreeMem(FBuffer, FBufSize);
|
273 |
end;
|
274 |
|
275 |
inherited Destroy;
|
276 |
end;
|
277 |
|
278 |
{-----------------------------------------------------------------------------}
|
279 |
|
280 |
procedure TStBufferedStream.bsInitForNewStream;
|
281 |
begin
|
282 |
if (FStream <> nil) then
|
283 |
FSize := FStream.Size
|
284 |
else
|
285 |
FSize := 0;
|
286 |
FBufCount := 0;
|
287 |
FBufOfs := 0;
|
288 |
FBufPos := 0;
|
289 |
FDirty := false;
|
290 |
end;
|
291 |
|
292 |
{-----------------------------------------------------------------------------}
|
293 |
|
294 |
function TStBufferedStream.bsReadChar(var aCh : AnsiChar) : boolean;
|
295 |
begin
|
296 |
{is there anything to read?}
|
297 |
if (FSize = (FBufOfs + FBufPos)) then begin
|
298 |
Result := false;
|
299 |
Exit;
|
300 |
end;
|
301 |
{if we get here, we'll definitely read a character}
|
302 |
Result := true;
|
303 |
{make sure that the buffer has some data in it}
|
304 |
if (FBufCount = 0) then
|
305 |
bsReadFromStream
|
306 |
else if (FBufPos = FBufCount) then begin
|
307 |
if FDirty then
|
308 |
bsWriteToStream;
|
309 |
FBufPos := 0;
|
310 |
inc(FBufOfs, FBufSize);
|
311 |
bsReadFromStream;
|
312 |
end;
|
313 |
{get the next character}
|
314 |
aCh := AnsiChar(FBuffer[FBufPos]);
|
315 |
inc(FBufPos);
|
316 |
end;
|
317 |
|
318 |
{-----------------------------------------------------------------------------}
|
319 |
|
320 |
procedure TStBufferedStream.bsReadFromStream;
|
321 |
var
|
322 |
NewPos : longint;
|
323 |
begin
|
324 |
{assumptions: FBufOfs is where to read the buffer
|
325 |
FBufSize is the number of bytes to read
|
326 |
FBufCount will be the number of bytes read}
|
327 |
NewPos := FStream.Seek(FBufOfs, soFromBeginning);
|
328 |
if (NewPos <> FBufOfs) then
|
329 |
RaiseStError(EStBufStreamError, stscNoSeekForRead);
|
330 |
FBufCount := FStream.Read(FBuffer^, FBufSize);
|
331 |
end;
|
332 |
|
333 |
{-----------------------------------------------------------------------------}
|
334 |
|
335 |
procedure TStBufferedStream.bsSetStream(aValue : TStream);
|
336 |
begin
|
337 |
if (aValue <> FStream) then begin
|
338 |
{if the buffer is dirty, flush it to the current stream}
|
339 |
if FDirty and (FStream <> nil) then
|
340 |
bsWriteToStream;
|
341 |
{remember the stream and initialize all fields}
|
342 |
FStream := aValue;
|
343 |
bsInitForNewStream;
|
344 |
end;
|
345 |
end;
|
346 |
|
347 |
{-----------------------------------------------------------------------------}
|
348 |
|
349 |
procedure TStBufferedStream.bsWriteToStream;
|
350 |
var
|
351 |
NewPos : longint;
|
352 |
BytesWritten : longint;
|
353 |
begin
|
354 |
{assumptions: FDirty is true
|
355 |
FBufOfs is where to write the buffer
|
356 |
FBufCount is the number of bytes to write
|
357 |
FDirty will be set false afterwards}
|
358 |
NewPos := FStream.Seek(FBufOfs, soFromBeginning);
|
359 |
if (NewPos <> FBufOfs) then
|
360 |
RaiseStError(EStBufStreamError, stscNoSeekForWrite);
|
361 |
BytesWritten := FStream.Write(FBuffer^, FBufCount);
|
362 |
if (BytesWritten <> FBufCount) then
|
363 |
RaiseStError(EStBufStreamError, stscCannotWrite);
|
364 |
FDirty := false;
|
365 |
end;
|
366 |
|
367 |
{-----------------------------------------------------------------------------}
|
368 |
|
369 |
function TStBufferedStream.Read(var Buffer; Count : longint) : longint;
|
370 |
var
|
371 |
BytesToGo : longint;
|
372 |
BytesToRead : longint;
|
373 |
// BufAsBytes : TByteArray absolute Buffer; {!!.02}
|
374 |
// DestPos : longint; {!!.02}
|
375 |
BufAsBytes : PByte; {!!.02}
|
376 |
begin
|
377 |
BufAsBytes := @Buffer; {!!.02}
|
378 |
|
379 |
if (FStream = nil) then
|
380 |
RaiseStError(EStBufStreamError, stscNilStream);
|
381 |
{calculate the number of bytes we could read if possible}
|
382 |
BytesToGo := MinLong(Count, FSize - (FBufOfs + FBufPos));
|
383 |
{we will return this number of bytes or raise an exception}
|
384 |
Result := BytesToGo;
|
385 |
{are we going to read some data after all?}
|
386 |
if (BytesToGo > 0) then begin
|
387 |
{make sure that the buffer has some data in it}
|
388 |
if (FBufCount = 0) then
|
389 |
bsReadFromStream;
|
390 |
{read as much as we can from the current buffer}
|
391 |
BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
|
392 |
{transfer that number of bytes}
|
393 |
// Move(FBuffer[FBufPos], BufAsBytes[0], BytesToRead); {!!.02}
|
394 |
Move(FBuffer[FBufPos], BufAsBytes^, BytesToRead); {!!.02}
|
395 |
{update our counters}
|
396 |
inc(FBufPos, BytesToRead);
|
397 |
dec(BytesToGo, BytesToRead);
|
398 |
{if we have more bytes to read then we've reached the end of the
|
399 |
buffer and so we need to read another, and another, etc}
|
400 |
// DestPos := 0; {!!.02}
|
401 |
while BytesToGo > 0 do begin
|
402 |
{if the current buffer is dirty, write it out}
|
403 |
if FDirty then
|
404 |
bsWriteToStream;
|
405 |
{position and read the next buffer}
|
406 |
FBufPos := 0;
|
407 |
inc(FBufOfs, FBufSize);
|
408 |
bsReadFromStream;
|
409 |
{calculate the new destination position, and the number of bytes
|
410 |
to read from this buffer}
|
411 |
// inc(DestPos, BytesToRead); {!!.02}
|
412 |
Inc(BufAsBytes, BytesToRead); {!!.02}
|
413 |
BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
|
414 |
{transfer that number of bytes}
|
415 |
// Move(FBuffer[FBufPos], BufAsBytes[DestPos], BytesToRead); {!!.02}
|
416 |
Move(FBuffer[FBufPos], BufAsBytes^, BytesToRead); {!!.02}
|
417 |
|
418 |
{update our counters}
|
419 |
inc(FBufPos, BytesToRead);
|
420 |
dec(BytesToGo, BytesToRead);
|
421 |
end;
|
422 |
end;
|
423 |
end;
|
424 |
|
425 |
{-----------------------------------------------------------------------------}
|
426 |
|
427 |
function TStBufferedStream.Seek(Offset : longint; Origin : word) : longint;
|
428 |
var
|
429 |
NewPos : longint;
|
430 |
NewOfs : longint;
|
431 |
begin
|
432 |
if (FStream = nil) then
|
433 |
RaiseStError(EStBufStreamError, stscNilStream);
|
434 |
{optimization: to help code that just wants the current stream
|
435 |
position (ie, reading the Position property), check for this as a
|
436 |
special case}
|
437 |
if (Offset = 0) and (Origin = soFromCurrent) then begin
|
438 |
Result := FBufOfs + FBufPos;
|
439 |
Exit;
|
440 |
end;
|
441 |
{calculate the desired position}
|
442 |
case Origin of
|
443 |
soFromBeginning : NewPos := Offset;
|
444 |
soFromCurrent : NewPos := (FBufOfs + FBufPos) + Offset;
|
445 |
soFromEnd : NewPos := FSize + Offset;
|
446 |
else
|
447 |
RaiseStError(EStBufStreamError, stscBadOrigin);
|
448 |
NewPos := 0; {to fool the compiler's warning--we never get here}
|
449 |
end;
|
450 |
{force the new position to be valid}
|
451 |
if (NewPos < 0) then
|
452 |
NewPos := 0
|
453 |
else if (NewPos > FSize) then
|
454 |
NewPos := FSize;
|
455 |
{calculate the offset for the buffer}
|
456 |
NewOfs := (NewPos div FBufSize) * FBufSize;
|
457 |
{if the offset differs, we have to move the buffer window}
|
458 |
if (NewOfs <> FBufOfs) then begin
|
459 |
{check to see whether we have to write the current buffer to the
|
460 |
original stream first}
|
461 |
if FDirty then
|
462 |
bsWriteToStream;
|
463 |
{mark the buffer as empty}
|
464 |
FBufOfs := NewOfs;
|
465 |
FBufCount := 0;
|
466 |
end;
|
467 |
{set the position within the buffer}
|
468 |
FBufPos := NewPos - FBufOfs;
|
469 |
Result := NewPos;
|
470 |
end;
|
471 |
|
472 |
{-----------------------------------------------------------------------------}
|
473 |
|
474 |
procedure TStBufferedStream.SetSize(NewSize : longint);
|
475 |
var
|
476 |
NewPos : longint;
|
477 |
begin
|
478 |
{get rid of the simple case first where the new size and the old
|
479 |
size are the same}
|
480 |
if (NewSize = FSize) then
|
481 |
Exit;
|
482 |
{if the buffer is dirty, write it out}
|
483 |
if FDirty then
|
484 |
bsWriteToStream;
|
485 |
{now set the size of the underlying stream}
|
486 |
FStream.Size := NewSize;
|
487 |
{patch up the buffer fields so that the buffered stream points to
|
488 |
somewhere in the newly resized stream}
|
489 |
NewPos := FBufOfs + FBufPos;
|
490 |
if (NewPos > NewSize) then
|
491 |
NewPos := NewSize;
|
492 |
bsInitForNewStream;
|
493 |
Seek(NewPos, soFromBeginning);
|
494 |
end;
|
495 |
|
496 |
{-----------------------------------------------------------------------------}
|
497 |
|
498 |
function TStBufferedStream.Write(const Buffer; Count : longint) : longint;
|
499 |
var
|
500 |
BytesToGo : longint;
|
501 |
BytesToWrite: longint;
|
502 |
// BufAsBytes : TByteArray absolute Buffer; {!!.02}
|
503 |
// DestPos : longint; {!!.02}
|
504 |
BufAsBytes : PByte; {!!.02}
|
505 |
begin
|
506 |
BufAsBytes := @Buffer; {!!.02}
|
507 |
|
508 |
if (FStream = nil) then
|
509 |
RaiseStError(EStBufStreamError, stscNilStream);
|
510 |
{calculate the number of bytes we should be able to write}
|
511 |
BytesToGo := Count;
|
512 |
{we will return this number of bytes or raise an exception}
|
513 |
Result := BytesToGo;
|
514 |
{are we going to write some data?}
|
515 |
if (BytesToGo > 0) then begin
|
516 |
{try and make sure that the buffer has some data in it}
|
517 |
if (FBufCount = 0) then
|
518 |
bsReadFromStream;
|
519 |
{write as much as we can to the current buffer}
|
520 |
BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
|
521 |
{transfer that number of bytes}
|
522 |
// Move(BufAsBytes[0], FBuffer[FBufPos], BytesToWrite); {!!.02}
|
523 |
Move(BufAsBytes^, FBuffer[FBufPos], BytesToWrite); {!!.02}
|
524 |
FDirty := true;
|
525 |
{update our counters}
|
526 |
inc(FBufPos, BytesToWrite);
|
527 |
if (FBufCount < FBufPos) then begin
|
528 |
FBufCount := FBufPos;
|
529 |
FSize := FBufOfs + FBufPos;
|
530 |
end;
|
531 |
dec(BytesToGo, BytesToWrite);
|
532 |
{if we have more bytes to write then we've reached the end of the
|
533 |
buffer and so we need to write another, and another, etc}
|
534 |
// DestPos := 0; {!!.02}
|
535 |
while BytesToGo > 0 do begin
|
536 |
{as the current buffer is dirty, write it out}
|
537 |
bsWriteToStream;
|
538 |
{position and read the next buffer, if required}
|
539 |
FBufPos := 0;
|
540 |
inc(FBufOfs, FBufSize);
|
541 |
if (FBufOfs < FSize) then
|
542 |
bsReadFromStream
|
543 |
else
|
544 |
FBufCount := 0;
|
545 |
{calculate the new destination position, and the number of bytes
|
546 |
to write to this buffer}
|
547 |
// inc(DestPos, BytesToWrite); {!!.02}
|
548 |
Inc(BufAsBytes, BytesToWrite); {!!.02}
|
549 |
BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
|
550 |
{transfer that number of bytes}
|
551 |
// Move(BufAsBytes[DestPos], FBuffer[0], BytesToWrite); {!!.02}
|
552 |
Move(BufAsBytes^, FBuffer[0], BytesToWrite); {!!.02}
|
553 |
FDirty := true;
|
554 |
{update our counters}
|
555 |
inc(FBufPos, BytesToWrite);
|
556 |
if (FBufCount < FBufPos) then begin
|
557 |
FBufCount := FBufPos;
|
558 |
FSize := FBufOfs + FBufPos;
|
559 |
end;
|
560 |
dec(BytesToGo, BytesToWrite);
|
561 |
end;
|
562 |
end;
|
563 |
end;
|
564 |
|
565 |
{-----------------------------------------------------------------------------}
|
566 |
{ TStAnsiTextStream }
|
567 |
{-----------------------------------------------------------------------------}
|
568 |
|
569 |
constructor TStAnsiTextStream.Create(aStream : TStream);
|
570 |
begin
|
571 |
inherited Create(aStream);
|
572 |
|
573 |
{set up the line index variables}
|
574 |
atsResetLineIndex;
|
575 |
end;
|
576 |
|
577 |
{-----------------------------------------------------------------------------}
|
578 |
|
579 |
destructor TStAnsiTextStream.Destroy;
|
580 |
begin
|
581 |
{if needed, free the fixed line buffer}
|
582 |
if (FFixedLine <> nil) then
|
583 |
FreeMem(FFixedLine, FixedLineLength);
|
584 |
{free the line index}
|
585 |
FLineIndex.Free;
|
586 |
inherited Destroy;
|
587 |
end;
|
588 |
|
589 |
{-----------------------------------------------------------------------------}
|
590 |
|
591 |
function TStAnsiTextStream.AtEndOfStream : boolean;
|
592 |
begin
|
593 |
Result := FSize = (FBufOfs + FBufPos);
|
594 |
end;
|
595 |
|
596 |
{-----------------------------------------------------------------------------}
|
597 |
|
598 |
procedure TStAnsiTextStream.atsGetLine(var aStartPos : longint;
|
599 |
var aEndPos : longint;
|
600 |
var aLen : longint);
|
601 |
var
|
602 |
Done : boolean;
|
603 |
Ch : AnsiChar;
|
604 |
PrevCh : AnsiChar;
|
605 |
begin
|
606 |
if (LineTerminator = ltNone) then begin
|
607 |
aStartPos := FBufOfs + FBufPos;
|
608 |
aEndPos := Seek(aStartPos + FixedLineLength, soFromBeginning);
|
609 |
aLen := aEndPos - aStartPos;
|
610 |
end
|
611 |
else begin
|
612 |
aStartPos := FBufOfs + FBufPos;
|
613 |
Ch := #0;
|
614 |
Done := false;
|
615 |
while not Done do begin
|
616 |
PrevCh := Ch;
|
617 |
if not bsReadChar(Ch) then begin
|
618 |
Done := true;
|
619 |
aEndPos := FBufOfs + FBufPos;
|
620 |
aLen := aEndPos - aStartPos;
|
621 |
end
|
622 |
else begin
|
623 |
case LineTerminator of
|
624 |
ltNone : {this'll never get hit};
|
625 |
ltCR : if (Ch = #13) then begin
|
626 |
Done := true;
|
627 |
aEndPos := FBufOfs + FBufPos;
|
628 |
aLen := aEndPos - aStartPos - 1;
|
629 |
end;
|
630 |
ltLF : if (Ch = #10) then begin
|
631 |
Done := true;
|
632 |
aEndPos := FBufOfs + FBufPos;
|
633 |
aLen := aEndPos - aStartPos - 1;
|
634 |
end;
|
635 |
ltCRLF : if (Ch = #10) then begin
|
636 |
Done := true;
|
637 |
aEndPos := FBufOfs + FBufPos;
|
638 |
if PrevCh = #13 then
|
639 |
aLen := aEndPos - aStartPos - 2
|
640 |
else
|
641 |
aLen := aEndPos - aStartPos - 1;
|
642 |
end;
|
643 |
ltOther: if (Ch = LineTermChar) then begin
|
644 |
Done := true;
|
645 |
aEndPos := FBufOfs + FBufPos;
|
646 |
aLen := aEndPos - aStartPos - 1;
|
647 |
end;
|
648 |
else
|
649 |
RaiseStError(EStBufStreamError, stscBadTerminator);
|
650 |
end;
|
651 |
end;
|
652 |
end;
|
653 |
end;
|
654 |
end;
|
655 |
|
656 |
{-----------------------------------------------------------------------------}
|
657 |
|
658 |
function TStAnsiTextStream.atsGetLineCount : longint;
|
659 |
begin
|
660 |
if FLineCount < 0 then
|
661 |
Result := MaxLongInt
|
662 |
else
|
663 |
Result := FLineCount;
|
664 |
end;
|
665 |
|
666 |
{-----------------------------------------------------------------------------}
|
667 |
|
668 |
procedure TStAnsiTextStream.atsResetLineIndex;
|
669 |
begin
|
670 |
{make sure we have a line index}
|
671 |
if (FLineIndex = nil) then begin
|
672 |
FLineIndex := TList.Create; {create the index: even elements are}
|
673 |
FLineIndex.Count := LineIndexCount * 2; {linenums, odd are offsets}
|
674 |
|
675 |
{if we didn't have a line index, set up some reasonable defaults}
|
676 |
FLineTerm := ltCRLF; {normal Windows text file terminator}
|
677 |
FLineEndCh := #10; {not used straight away}
|
678 |
FLineLen := 80; {not used straight away}
|
679 |
end;
|
680 |
FLineIndex[0] := pointer(0); {the first line is line 0 and...}
|
681 |
FLineIndex[1] := pointer(0); {...it starts at position 0}
|
682 |
FLineInxTop := 0; {the top valid index}
|
683 |
FLineInxStep := 1; {step count before add a line to index}
|
684 |
FLineCount := -1; {number of lines (-1 = don't know)}
|
685 |
FLineCurrent := 0; {current line}
|
686 |
FLineCurOfs := 0; {current line offset}
|
687 |
end;
|
688 |
|
689 |
{-----------------------------------------------------------------------------}
|
690 |
|
691 |
procedure TStAnsiTextStream.atsSetLineTerm(aValue : TStLineTerminator);
|
692 |
begin
|
693 |
if (aValue <> LineTerminator) and ((FBufOfs + FBufPos) = 0) then begin
|
694 |
{if there was no terminator, free the line buffer}
|
695 |
if (LineTerminator = ltNone) then begin
|
696 |
FreeMem(FFixedLine, FixedLineLength);
|
697 |
FFixedLine := nil;
|
698 |
end;
|
699 |
{set the new value}
|
700 |
FLineTerm := aValue;
|
701 |
{if there is no terminator now, allocate the line buffer}
|
702 |
if (LineTerminator = ltNone) then begin
|
703 |
GetMem(FFixedLine, FixedLineLength);
|
704 |
end;
|
705 |
atsResetLineIndex;
|
706 |
end;
|
707 |
end;
|
708 |
|
709 |
{-----------------------------------------------------------------------------}
|
710 |
|
711 |
procedure TStAnsiTextStream.atsSetLineEndCh(aValue : AnsiChar);
|
712 |
begin
|
713 |
if ((FBufOfs + FBufPos) = 0) then begin
|
714 |
FLineEndCh := aValue;
|
715 |
atsResetLineIndex;
|
716 |
end;
|
717 |
end;
|
718 |
|
719 |
{-----------------------------------------------------------------------------}
|
720 |
|
721 |
procedure TStAnsiTextStream.atsSetLineLen(aValue : integer);
|
722 |
begin
|
723 |
if (aValue <> FixedLineLength) and ((FBufOfs + FBufPos) = 0) then begin
|
724 |
{validate the new length first}
|
725 |
if (aValue < 1) or (aValue > 1024) then
|
726 |
RaiseStError(EStBufStreamError, stscBadLineLength);
|
727 |
|
728 |
{set the new value; note that if there is no terminator we need to
|
729 |
free the old line buffer, and then allocate a new one}
|
730 |
if (LineTerminator = ltNone) then
|
731 |
FreeMem(FFixedLine, FixedLineLength);
|
732 |
FLineLen := aValue;
|
733 |
if (LineTerminator = ltNone) then
|
734 |
GetMem(FFixedLine, FixedLineLength);
|
735 |
atsResetLineIndex;
|
736 |
end;
|
737 |
end;
|
738 |
|
739 |
{-----------------------------------------------------------------------------}
|
740 |
|
741 |
procedure TStAnsiTextStream.bsInitForNewStream;
|
742 |
begin
|
743 |
inherited bsInitForNewStream;
|
744 |
atsResetLineIndex;
|
745 |
end;
|
746 |
|
747 |
{-----------------------------------------------------------------------------}
|
748 |
|
749 |
function TStAnsiTextStream.ReadLine : AnsiString;
|
750 |
var
|
751 |
CurPos : longint;
|
752 |
EndPos : longint;
|
753 |
Len : longint;
|
754 |
StLen : longint;
|
755 |
begin
|
756 |
atsGetLine(CurPos, EndPos, Len);
|
757 |
if (LineTerminator = ltNone) then begin
|
758 |
{at this point, Len will either equal FixedLineLength, or it will
|
759 |
be less than it because we read the last line of all and it was
|
760 |
short}
|
761 |
StLen := FixedLineLength;
|
762 |
SetLength(Result, StLen);
|
763 |
if (Len < StLen) then
|
764 |
FillChar(Result[Len+1], StLen-Len, ' ');
|
765 |
end
|
766 |
else {LineTerminator is not ltNone} begin
|
767 |
SetLength(Result, Len);
|
768 |
end;
|
769 |
{read the line}
|
770 |
if Len > 0 then begin
|
771 |
Seek(CurPos, soFromBeginning);
|
772 |
Read(Result[1], Len);
|
773 |
end
|
774 |
else {it's a blank line }
|
775 |
Result := '';
|
776 |
Seek(EndPos, soFromBeginning);
|
777 |
end;
|
778 |
|
779 |
{-----------------------------------------------------------------------------}
|
780 |
|
781 |
function TStAnsiTextStream.ReadLineArray(aCharArray : PAnsiChar;
|
782 |
aLen : TStMemSize)
|
783 |
: TStMemSize;
|
784 |
var
|
785 |
CurPos : longint;
|
786 |
EndPos : longint;
|
787 |
Len : longint;
|
788 |
StLen : longint;
|
789 |
begin
|
790 |
atsGetLine(CurPos, EndPos, Len);
|
791 |
if (LineTerminator = ltNone) then begin
|
792 |
{at this point, Len will either equal FixedLineLength, or it will
|
793 |
be less than it because we read the last line of all and it was
|
794 |
short}
|
795 |
StLen := FixedLineLength;
|
796 |
if (StLen > aLen) then
|
797 |
StLen := aLen;
|
798 |
if (Len < StLen) then
|
799 |
FillChar(aCharArray[Len], StLen-Len, ' ');
|
800 |
Result := StLen;
|
801 |
end
|
802 |
else {LineTerminator is not ltNone} begin
|
803 |
if (Len > aLen) then
|
804 |
Len := aLen;
|
805 |
Result := Len;
|
806 |
end;
|
807 |
Seek(CurPos, soFromBeginning);
|
808 |
Read(aCharArray[0], Len);
|
809 |
Seek(EndPos, soFromBeginning);
|
810 |
end;
|
811 |
|
812 |
{-----------------------------------------------------------------------------}
|
813 |
|
814 |
function TStAnsiTextStream.ReadLineZ(aSt : PAnsiChar; aMaxLen : TStMemSize) : PAnsiChar;
|
815 |
var
|
816 |
CurPos : longint;
|
817 |
EndPos : longint;
|
818 |
Len : longint;
|
819 |
StLen : longint;
|
820 |
begin
|
821 |
Result := aSt;
|
822 |
atsGetLine(CurPos, EndPos, Len);
|
823 |
if (LineTerminator = ltNone) then begin
|
824 |
{at this point, Len will either equal FixedLineLength, or it will
|
825 |
be less than it because we read the last line of all and it was
|
826 |
short}
|
827 |
StLen := FixedLineLength;
|
828 |
if (StLen > aMaxLen) then
|
829 |
StLen := aMaxLen;
|
830 |
if (Len < StLen) then
|
831 |
FillChar(Result[Len], StLen-Len, ' ');
|
832 |
Result[StLen] := #0;
|
833 |
end
|
834 |
else {LineTerminator is not ltNone} begin
|
835 |
if (Len > aMaxLen) then
|
836 |
Len := aMaxLen;
|
837 |
Result[Len] := #0;
|
838 |
end;
|
839 |
Seek(CurPos, soFromBeginning);
|
840 |
Read(Result[0], Len);
|
841 |
Seek(EndPos, soFromBeginning);
|
842 |
end;
|
843 |
|
844 |
{-----------------------------------------------------------------------------}
|
845 |
|
846 |
function TStAnsiTextStream.SeekNearestLine(aOffset : longint) : longint;
|
847 |
var
|
848 |
CurLine : longint;
|
849 |
CurOfs : longint;
|
850 |
CurPos : longint;
|
851 |
EndPos : longint;
|
852 |
Len : longint;
|
853 |
i : longint;
|
854 |
Done : boolean;
|
855 |
L, R, M : integer;
|
856 |
begin
|
857 |
{if the offset we want is for the current line, reposition at the
|
858 |
current line offset, return the current line number and exit}
|
859 |
if (aOffset = FLineCurOfs) then begin
|
860 |
Seek(FLineCurOfs, soFromBeginning);
|
861 |
Result := FLineCurrent;
|
862 |
Exit;
|
863 |
end;
|
864 |
{if the offset requested is less than or equal to zero, just
|
865 |
position at line zero (ie, the start of the stream)}
|
866 |
if (aOffset <= 0) then begin
|
867 |
Seek(0, soFromBeginning);
|
868 |
FLineCurrent := 0;
|
869 |
FLineCurOfs := 0;
|
870 |
Result := 0;
|
871 |
Exit;
|
872 |
end;
|
873 |
{if the offset requested is greater than or equal to the size of the
|
874 |
stream, position at the end of the stream (note that if we don't
|
875 |
know the number of lines in the stream yet, FLineCount is set to
|
876 |
-1 and we can't take this shortcut because we need to return the
|
877 |
true value)}
|
878 |
if (FLineCount >= 0) and (aOffset >= FSize) then begin
|
879 |
Seek(0, soFromEnd);
|
880 |
FLineCurrent := FLineCount;
|
881 |
FLineCurOfs := FSize;
|
882 |
Result := FLineCount;
|
883 |
Exit;
|
884 |
end;
|
885 |
{if the offset requested is greater than the top item in the
|
886 |
line index, we shall have to build up the index until we get to the
|
887 |
line we require, or just beyond}
|
888 |
if (aOffset > longint(FLineIndex[FLineInxTop+1])) then begin
|
889 |
{position at the last known line offset}
|
890 |
CurLine := longint(FLineIndex[FLineInxTop]);
|
891 |
CurOfs := longint(FLineIndex[FLineInxTop+1]);
|
892 |
Seek(CurOfs, soFromBeginning);
|
893 |
Done := false;
|
894 |
{continue reading lines in chunks of FLineInxStep and add an index
|
895 |
entry for each chunk}
|
896 |
while not Done do begin
|
897 |
for i := 0 to pred(FLineInxStep) do begin
|
898 |
atsGetLine(CurPos, EndPos, Len);
|
899 |
inc(CurLine);
|
900 |
CurOfs := EndPos;
|
901 |
if (EndPos = FSize) then begin
|
902 |
Done := true;
|
903 |
Break;
|
904 |
end;
|
905 |
end;
|
906 |
if Done then
|
907 |
FLineCount := CurLine
|
908 |
else begin
|
909 |
inc(FLineInxTop, 2);
|
910 |
if (FLineInxTop = (LineIndexCount * 2)) then begin
|
911 |
{we've exhausted the space in the index: rescale}
|
912 |
FLineInxTop := FLineInxTop div 2;
|
913 |
for i := 0 to pred(FLineInxTop) do begin
|
914 |
if Odd(i) then
|
915 |
FLineIndex.Exchange((i*2)-1, i)
|
916 |
else
|
917 |
FLineIndex.Exchange(i*2, i);
|
918 |
end;
|
919 |
FLineInxStep := FLineInxStep * 2;
|
920 |
end;
|
921 |
FLineIndex[FLineInxTop] := pointer(CurLine);
|
922 |
FLineIndex[FLineInxTop+1] := pointer(CurOfs);
|
923 |
if (aOffset <= CurOfs) then
|
924 |
Done := true;
|
925 |
end;
|
926 |
end;
|
927 |
end;
|
928 |
{we can now work out where the nearest item in the index is to the
|
929 |
line we require}
|
930 |
L := 1;
|
931 |
R := FLineInxTop+1;
|
932 |
while (L <= R) do begin
|
933 |
M := (L + R) div 2;
|
934 |
if not Odd(M) then
|
935 |
inc(M);
|
936 |
if (aOffset < longint(FLineIndex[M])) then
|
937 |
R := M - 2
|
938 |
else if (aOffset > longint(FLineIndex[M])) then
|
939 |
L := M + 2
|
940 |
else begin
|
941 |
FLineCurrent := longint(FLineIndex[M-1]);
|
942 |
FLineCurOfs := longint(FLineIndex[M]);
|
943 |
Seek(FLineCurOfs, soFromBeginning);
|
944 |
Result := FLineCurrent;
|
945 |
Exit;
|
946 |
end;
|
947 |
end;
|
948 |
{the item at L-2 will have the nearest smaller offset than the
|
949 |
one we want, hence the nearest smaller line is at L-3; start here
|
950 |
and read through the stream forwards}
|
951 |
CurLine := longint(FLineIndex[L-3]);
|
952 |
Seek(longint(FLineIndex[L-2]), soFromBeginning);
|
953 |
while true do begin
|
954 |
atsGetLine(CurPos, EndPos, Len);
|
955 |
inc(CurLine);
|
956 |
if (EndPos > aOffset) then begin
|
957 |
FLineCurrent := CurLine - 1;
|
958 |
FLineCurOfs := CurPos;
|
959 |
Seek(CurPos, soFromBeginning);
|
960 |
Result := CurLine - 1;
|
961 |
Exit;
|
962 |
end
|
963 |
else if (CurLine = FLineCount) or (EndPos = aOffset) then begin
|
964 |
FLineCurrent := CurLine;
|
965 |
FLineCurOfs := EndPos;
|
966 |
Seek(EndPos, soFromBeginning);
|
967 |
Result := CurLine;
|
968 |
Exit;
|
969 |
end;
|
970 |
end;
|
971 |
end;
|
972 |
|
973 |
{-----------------------------------------------------------------------------}
|
974 |
|
975 |
function TStAnsiTextStream.SeekLine(aLineNum : longint) : longint;
|
976 |
var
|
977 |
CurLine : longint;
|
978 |
CurOfs : longint;
|
979 |
CurPos : longint;
|
980 |
EndPos : longint;
|
981 |
Len : longint;
|
982 |
i : longint;
|
983 |
Done : boolean;
|
984 |
L, R, M : integer;
|
985 |
begin
|
986 |
{if the line number we want is the current line, reposition at the
|
987 |
current line offset, return the current line number and exit}
|
988 |
if (aLineNum = FLineCurrent) then begin
|
989 |
Seek(FLineCurOfs, soFromBeginning);
|
990 |
Result := FLineCurrent;
|
991 |
Exit;
|
992 |
end;
|
993 |
{if the line number requested is less than or equal to zero, just
|
994 |
position at line zero (ie, the start of the stream)}
|
995 |
if (aLineNum <= 0) then begin
|
996 |
Seek(0, soFromBeginning);
|
997 |
FLineCurrent := 0;
|
998 |
FLineCurOfs := 0;
|
999 |
Result := 0;
|
1000 |
Exit;
|
1001 |
end;
|
1002 |
{if the line number requested is greater than or equal to the line
|
1003 |
count, position at the end of the stream (note that if we don't
|
1004 |
know the number of lines in the stream yet, FLineCount is set to
|
1005 |
-1)}
|
1006 |
if (FLineCount >= 0) and (aLineNum > FLineCount) then begin
|
1007 |
Seek(0, soFromEnd);
|
1008 |
FLineCurrent := FLineCount;
|
1009 |
FLineCurOfs := FSize;
|
1010 |
Result := FLineCount;
|
1011 |
Exit;
|
1012 |
end;
|
1013 |
{if the line number requested is greater than the top item in the
|
1014 |
line index, we shall have to build up the index until we get to the
|
1015 |
line we require, or just beyond}
|
1016 |
if (aLineNum > longint(FLineIndex[FLineInxTop])) then begin
|
1017 |
{position at the last known line offset}
|
1018 |
CurLine := longint(FLineIndex[FLineInxTop]);
|
1019 |
CurOfs := longint(FLineIndex[FLineInxTop+1]);
|
1020 |
Seek(CurOfs, soFromBeginning);
|
1021 |
Done := false;
|
1022 |
{continue reading lines in chunks of FLineInxStep and add an index
|
1023 |
entry for each chunk}
|
1024 |
while not Done do begin
|
1025 |
for i := 0 to pred(FLineInxStep) do begin
|
1026 |
atsGetLine(CurPos, EndPos, Len);
|
1027 |
inc(CurLine);
|
1028 |
CurOfs := EndPos;
|
1029 |
if (EndPos = FSize) then begin
|
1030 |
Done := true;
|
1031 |
Break;
|
1032 |
end;
|
1033 |
end;
|
1034 |
if Done then
|
1035 |
FLineCount := CurLine
|
1036 |
else begin
|
1037 |
inc(FLineInxTop, 2);
|
1038 |
if (FLineInxTop = (LineIndexCount * 2)) then begin
|
1039 |
{we've exhausted the space in the index: rescale}
|
1040 |
FLineInxTop := FLineInxTop div 2;
|
1041 |
for i := 0 to pred(FLineInxTop) do begin
|
1042 |
if Odd(i) then
|
1043 |
FLineIndex.Exchange((i*2)-1, i)
|
1044 |
else
|
1045 |
FLineIndex.Exchange(i*2, i);
|
1046 |
end;
|
1047 |
FLineInxStep := FLineInxStep * 2;
|
1048 |
end;
|
1049 |
FLineIndex[FLineInxTop] := pointer(CurLine);
|
1050 |
FLineIndex[FLineInxTop+1] := pointer(CurOfs);
|
1051 |
if (aLineNum <= CurLine) then
|
1052 |
Done := true;
|
1053 |
end;
|
1054 |
end;
|
1055 |
end;
|
1056 |
{we can now work out where the nearest item in the index is to the
|
1057 |
line we require}
|
1058 |
L := 0;
|
1059 |
R := FLineInxTop;
|
1060 |
while (L <= R) do begin
|
1061 |
M := (L + R) div 2;
|
1062 |
if Odd(M) then
|
1063 |
dec(M);
|
1064 |
if (aLineNum < longint(FLineIndex[M])) then
|
1065 |
R := M - 2
|
1066 |
else if (aLineNum > longint(FLineIndex[M])) then
|
1067 |
L := M + 2
|
1068 |
else begin
|
1069 |
FLineCurrent := longint(FLineIndex[M]);
|
1070 |
FLineCurOfs := longint(FLineIndex[M+1]);
|
1071 |
Seek(FLineCurOfs, soFromBeginning);
|
1072 |
Result := FLineCurrent;
|
1073 |
Exit;
|
1074 |
end;
|
1075 |
end;
|
1076 |
{the item at L-2 will have the nearest smaller line number than the
|
1077 |
one we want; start here and read through the stream forwards}
|
1078 |
CurLine := longint(FLineIndex[L-2]);
|
1079 |
Seek(longint(FLineIndex[L-1]), soFromBeginning);
|
1080 |
while true do begin
|
1081 |
atsGetLine(CurPos, EndPos, Len);
|
1082 |
inc(CurLine);
|
1083 |
if (CurLine = FLineCount) or (CurLine = aLineNum) then begin
|
1084 |
FLineCurrent := CurLine;
|
1085 |
FLineCurOfs := EndPos;
|
1086 |
Seek(EndPos, soFromBeginning);
|
1087 |
Result := CurLine;
|
1088 |
Exit;
|
1089 |
end;
|
1090 |
end;
|
1091 |
end;
|
1092 |
|
1093 |
{-----------------------------------------------------------------------------}
|
1094 |
|
1095 |
procedure TStAnsiTextStream.WriteLine(const aSt : AnsiString);
|
1096 |
var
|
1097 |
Len : Integer;
|
1098 |
begin
|
1099 |
Len := Length(aSt);
|
1100 |
if Len > 0 then
|
1101 |
WriteLineArray(PAnsiChar(aSt), Len)
|
1102 |
else
|
1103 |
WriteLineArray('', 0);
|
1104 |
end;
|
1105 |
|
1106 |
{-----------------------------------------------------------------------------}
|
1107 |
|
1108 |
procedure TStAnsiTextStream.WriteLineArray(aCharArray : PAnsiChar;
|
1109 |
aLen : TStMemSize);
|
1110 |
var
|
1111 |
C : AnsiChar;
|
1112 |
begin
|
1113 |
if (aCharArray = nil) then
|
1114 |
aLen := 0;
|
1115 |
if (LineTerminator = ltNone) then begin
|
1116 |
if (aLen >= FixedLineLength) then
|
1117 |
Write(aCharArray[0], FixedLineLength)
|
1118 |
else begin
|
1119 |
FillChar(FFixedLine[aLen], FixedLineLength-aLen, ' ');
|
1120 |
if (aLen > 0) then
|
1121 |
Move(aCharArray[0], FFixedLine[0], aLen);
|
1122 |
Write(FFixedLine[0], FixedLineLength);
|
1123 |
end;
|
1124 |
end
|
1125 |
else begin
|
1126 |
if (aLen > 0) then
|
1127 |
Write(aCharArray[0], aLen);
|
1128 |
case LineTerminator of
|
1129 |
ltNone : {this'll never get hit};
|
1130 |
ltCR : Write(LineTerm[ltCR], 1);
|
1131 |
ltLF : Write(LineTerm[ltLF], 1);
|
1132 |
ltCRLF : Write(LineTerm[ltCRLF], 2);
|
1133 |
ltOther: begin
|
1134 |
C := LineTermChar;
|
1135 |
Write(C, 1);
|
1136 |
end;
|
1137 |
else
|
1138 |
RaiseStError(EStBufStreamError, stscBadTerminator);
|
1139 |
end;
|
1140 |
end;
|
1141 |
end;
|
1142 |
|
1143 |
{-----------------------------------------------------------------------------}
|
1144 |
|
1145 |
procedure TStAnsiTextStream.WriteLineZ(aSt : PAnsiChar);
|
1146 |
var
|
1147 |
LenSt : TStMemSize;
|
1148 |
begin
|
1149 |
if (aSt = nil) then
|
1150 |
LenSt := 0
|
1151 |
else
|
1152 |
LenSt := StrLen(aSt);
|
1153 |
WriteLineArray(aSt, LenSt);
|
1154 |
end;
|
1155 |
|
1156 |
|
1157 |
{-----------------------------------------------------------------------------}
|
1158 |
{ TStMemoryMappedFile }
|
1159 |
{-----------------------------------------------------------------------------}
|
1160 |
|
1161 |
constructor TStMemoryMappedFile.Create(const FileName : string; {!!.02}
|
1162 |
MaxSize : Cardinal;
|
1163 |
ReadOnly : Boolean;
|
1164 |
SharedData : Boolean);
|
1165 |
var
|
1166 |
RO1,
|
1167 |
RO2,
|
1168 |
RO3,
|
1169 |
RO4,
|
1170 |
FHi : DWORD;
|
1171 |
SetSize: Boolean;
|
1172 |
begin
|
1173 |
inherited Create;
|
1174 |
|
1175 |
FMutex := CreateMutex(nil, False, nil);
|
1176 |
FSharedData := SharedData;
|
1177 |
if (FSharedData) then
|
1178 |
FHeaderSize := SizeOf(Word) + SizeOf(Cardinal)
|
1179 |
else
|
1180 |
FHeaderSize := 0;
|
1181 |
|
1182 |
FReadOnly := ReadOnly;
|
1183 |
if (SharedData) then
|
1184 |
FReadOnly := False;
|
1185 |
if (FReadOnly) then begin
|
1186 |
RO1 := GENERIC_READ;
|
1187 |
RO2 := FILE_ATTRIBUTE_READONLY;
|
1188 |
RO3 := PAGE_READONLY;
|
1189 |
RO4 := FILE_MAP_READ;
|
1190 |
FMaxHi := 0;
|
1191 |
FMaxLo := 0;
|
1192 |
end else begin
|
1193 |
RO1 := GENERIC_READ or GENERIC_WRITE;
|
1194 |
RO2 := FILE_ATTRIBUTE_NORMAL;
|
1195 |
RO3 := PAGE_READWRITE;
|
1196 |
RO4 := FILE_MAP_WRITE;
|
1197 |
FMaxHi := 0;
|
1198 |
FMaxLo := MaxSize;
|
1199 |
end;
|
1200 |
|
1201 |
if (not SharedData) then begin
|
1202 |
FHandle := CreateFile(PChar(FileName),
|
1203 |
RO1,
|
1204 |
FILE_SHARE_READ or FILE_SHARE_WRITE,
|
1205 |
nil,
|
1206 |
OPEN_ALWAYS,
|
1207 |
RO2,
|
1208 |
0);
|
1209 |
|
1210 |
if (FHandle = INVALID_HANDLE_VALUE) then
|
1211 |
RaiseStError(EStMMFileError, stscCreateFileFailed);
|
1212 |
|
1213 |
{reset FMaxLo if file is read/write and less < FileSize}
|
1214 |
{the result is that the file size cannot be changed but the contents can}
|
1215 |
{still be modified}
|
1216 |
FDataSize := GetFileSize(FHandle, @FHi);
|
1217 |
if (FDataSize <> $FFFFFFFF) then begin
|
1218 |
if (not ReadOnly) and (FDataSize > FMaxLo) then
|
1219 |
FMaxLo := FDataSize;
|
1220 |
end else begin
|
1221 |
CloseHandle(FHandle);
|
1222 |
RaiseStError(EStMMFileError, stscGetSizeFailed);
|
1223 |
end;
|
1224 |
end else
|
1225 |
FDataSize := 0;
|
1226 |
|
1227 |
if (not SharedData) then begin
|
1228 |
FMapObj := CreateFileMapping(FHandle, nil, RO3, FMaxHi, FMaxLo, nil);
|
1229 |
SetSize := False;
|
1230 |
end else begin
|
1231 |
if (FMaxLo > (High(Cardinal) - FHeaderSize)) then
|
1232 |
FMaxLo := High(Cardinal) - FHeaderSize
|
1233 |
else
|
1234 |
FMaxLo := FMaxLo + FHeaderSize;
|
1235 |
FMapObj := CreateFileMapping(THandle($FFFFFFFF), nil, RO3,
|
1236 |
FMaxHi, FMaxLo, 'STMMFILE1');
|
1237 |
SetSize := (GetLastError = ERROR_ALREADY_EXISTS);
|
1238 |
end;
|
1239 |
|
1240 |
if (FMapObj = INVALID_HANDLE_VALUE) then
|
1241 |
RaiseStError(EStMMFileError, stscFileMappingFailed);
|
1242 |
|
1243 |
FBuffer := MapViewOfFile(FMapObj, RO4, 0, 0, FMaxLo);
|
1244 |
if (not Assigned(FBuffer)) then
|
1245 |
RaiseStError(EStMMFileError, stscCreateViewFailed);
|
1246 |
|
1247 |
if (SharedData) then begin
|
1248 |
if (SetSize) then
|
1249 |
Move(PByteArray(FBuffer)[SizeOf(Word)-1], FDataSize, SizeOf(Cardinal))
|
1250 |
else begin
|
1251 |
Move(FHeaderSize, PByteArray(FBuffer)[0], SizeOf(Word));
|
1252 |
FDataSize := 0;
|
1253 |
Move(FDataSize, PByteArray(FBuffer)[SizeOf(Word)-1], SizeOf(Cardinal));
|
1254 |
end;
|
1255 |
end;
|
1256 |
{set position to beginning}
|
1257 |
FPos := FHeaderSize;
|
1258 |
end;
|
1259 |
|
1260 |
{-----------------------------------------------------------------------------}
|
1261 |
|
1262 |
destructor TStMemoryMappedFile.Destroy;
|
1263 |
begin
|
1264 |
{Close the View and Mapping object}
|
1265 |
UnmapViewOfFile(FBuffer);
|
1266 |
FBuffer := nil;
|
1267 |
CloseHandle(FMapObj);
|
1268 |
|
1269 |
if (not SharedData) then begin
|
1270 |
{set the file pointer to the end of the actual data}
|
1271 |
SetFilePointer(FHandle, FDataSize, nil, FILE_BEGIN);
|
1272 |
{set the EOF marker to the end of actual data}
|
1273 |
SetEndOfFile(FHandle);
|
1274 |
CloseHandle(FHandle);
|
1275 |
end;
|
1276 |
|
1277 |
{now the Mutex can be cleared}
|
1278 |
CloseHandle(FMutex);
|
1279 |
FMutex := 0;
|
1280 |
|
1281 |
inherited Destroy;
|
1282 |
end;
|
1283 |
|
1284 |
{-----------------------------------------------------------------------------}
|
1285 |
|
1286 |
function TStMemoryMappedFile.GetDataSize : Cardinal;
|
1287 |
begin
|
1288 |
Move(PByteArray(FBuffer)[SizeOf(Word)-1], FDataSize, SizeOf(Cardinal));
|
1289 |
Result := FDataSize;
|
1290 |
end;
|
1291 |
|
1292 |
{-----------------------------------------------------------------------------}
|
1293 |
|
1294 |
function TStMemoryMappedFile.Read(var Buffer; Count : Longint) : Longint;
|
1295 |
var
|
1296 |
// ByteArray : TByteArray absolute Buffer; {!!.02}
|
1297 |
ByteArray : PByte; {!!.02}
|
1298 |
begin
|
1299 |
ByteArray := @Buffer; {!!.02}
|
1300 |
{check to make sure that the read does not go beyond the actual data}
|
1301 |
if (((FPos-FHeaderSize) + DWORD(Count)) > FDataSize) then
|
1302 |
Count := FDataSize - FPos + FHeaderSize;
|
1303 |
|
1304 |
if (SharedData) then begin
|
1305 |
WaitForSingleObject(FMutex, INFINITE);
|
1306 |
try
|
1307 |
// Move(PByteArray(FBuffer)[FPos], ByteArray[0], Count); {!!.02}
|
1308 |
Move(PByteArray(FBuffer)[FPos], ByteArray^, Count); {!!.02}
|
1309 |
Inc(FPos, Count);
|
1310 |
Result := Count;
|
1311 |
finally
|
1312 |
ReleaseMutex(FMutex);
|
1313 |
end;
|
1314 |
end else begin
|
1315 |
// Move(PByteArray(FBuffer)[FPos], ByteArray[0], Count); {!!.02}
|
1316 |
Move(PByteArray(FBuffer)[FPos], ByteArray^, Count); {!!.02}
|
1317 |
Inc(FPos, Count);
|
1318 |
Result := Count;
|
1319 |
end;
|
1320 |
end;
|
1321 |
|
1322 |
{-----------------------------------------------------------------------------}
|
1323 |
|
1324 |
function TStMemoryMappedFile.Write(const Buffer; Count : Longint) : Longint;
|
1325 |
var
|
1326 |
// ByteArray : TByteArray absolute Buffer; {!!.02}
|
1327 |
ByteArray : PByte; {!!.02}
|
1328 |
begin
|
1329 |
ByteArray := @Buffer; {!!.02}
|
1330 |
if (ReadOnly) then begin
|
1331 |
Result := 0;
|
1332 |
Exit;
|
1333 |
end;
|
1334 |
|
1335 |
{check that the write does not go beyond the maximum file size}
|
1336 |
if ((FPos + DWORD(Count)) > pred(FMaxLo)) then
|
1337 |
Count := pred(FMaxLo - FPos);
|
1338 |
|
1339 |
if (SharedData) then begin
|
1340 |
WaitForSingleObject(FMutex, INFINITE);
|
1341 |
try
|
1342 |
// Move(ByteArray[0], PByteArray(FBuffer)[FPos], Count); {!!.02}
|
1343 |
Move(ByteArray^, PByteArray(FBuffer)[FPos], Count); {!!.02}
|
1344 |
Inc(FPos, Count);
|
1345 |
{if the write went beyond the previous end of data, update FDataSize}
|
1346 |
if ((FPos-FHeaderSize) > FDataSize) then
|
1347 |
FDataSize := FPos-FHeaderSize;
|
1348 |
Move(FDataSize, PByteArray(FBuffer)[SizeOf(Word)-1], SizeOf(Cardinal));
|
1349 |
Result := Count;
|
1350 |
finally
|
1351 |
ReleaseMutex(FMutex);
|
1352 |
end;
|
1353 |
end else begin
|
1354 |
// Move(ByteArray[0], PByteArray(FBuffer)[FPos], Count); {!!.02}
|
1355 |
Move(ByteArray^, PByteArray(FBuffer)[FPos], Count); {!!.02}
|
1356 |
Inc(FPos, Count);
|
1357 |
{if the write went beyond the previous end of data, update FDataSize}
|
1358 |
if ((FPos-FHeaderSize) > FDataSize) then
|
1359 |
FDataSize := FPos-FHeaderSize;
|
1360 |
Move(FDataSize, PByteArray(FBuffer)[SizeOf(Word)-1], SizeOf(Cardinal));
|
1361 |
Result := Count;
|
1362 |
end;
|
1363 |
end;
|
1364 |
|
1365 |
{-----------------------------------------------------------------------------}
|
1366 |
|
1367 |
function TStMemoryMappedFile.Seek(Offset : Longint; Origin : Word) : Longint;
|
1368 |
begin
|
1369 |
if (SharedData) then begin
|
1370 |
WaitForSingleObject(FMutex, INFINITE);
|
1371 |
try
|
1372 |
case Origin of
|
1373 |
{$WARNINGS OFF}
|
1374 |
soFromBeginning : FPos := Offset + FHeaderSize;
|
1375 |
soFromCurrent : FPos := FPos + Offset + FHeaderSize;
|
1376 |
{the seek should be based on actual data, not the mapped size since}
|
1377 |
{the "data" between FDataSize and the mapped size is undefined}
|
1378 |
soFromEnd : FPos := FDataSize + Offset + FHeaderSize;
|
1379 |
{$WARNINGS ON}
|
1380 |
else
|
1381 |
RaiseStError(EStMMFileError, stscBadOrigin);
|
1382 |
end;
|
1383 |
|
1384 |
{force the new position to be valid}
|
1385 |
if ((FPos-FHeaderSize) > FDataSize) then
|
1386 |
FPos := FDataSize + FHeaderSize;
|
1387 |
Result := FPos;
|
1388 |
finally
|
1389 |
ReleaseMutex(FMutex);
|
1390 |
end;
|
1391 |
end else begin
|
1392 |
{$WARNINGS OFF}
|
1393 |
case Origin of
|
1394 |
soFromBeginning : FPos := Offset + FHeaderSize;
|
1395 |
soFromCurrent : FPos := FPos + Offset + FHeaderSize;
|
1396 |
{the seek should be based on actual data, not the mapped size since}
|
1397 |
{the "data" between FDataSize and the mapped size is undefined}
|
1398 |
soFromEnd : FPos := FDataSize + Offset + FHeaderSize;
|
1399 |
else
|
1400 |
RaiseStError(EStMMFileError, stscBadOrigin);
|
1401 |
end;
|
1402 |
{$WARNINGS ON}
|
1403 |
|
1404 |
{force the new position to be valid}
|
1405 |
if ((FPos-FHeaderSize) > FDataSize) then
|
1406 |
FPos := FDataSize + FHeaderSize;
|
1407 |
Result := FPos;
|
1408 |
end;
|
1409 |
end;
|
1410 |
|
1411 |
{-----------------------------------------------------------------------------}
|
1412 |
|
1413 |
end.
|
1414 |
|