1 { Version 040116. Copyright � Alexey A.Chernobaev, 1996-2004 }
2 
3 unit VTxtStrm;
4 {
5   ��������� �������� �����.
6   ������������ ���������� ����� ������ � ������ LONGSTRINGS - 64K.
7 
8   Text file stream.
9   Maximum line length in the LONGSTRINGS mode - 64K.
10 }
11 
12 interface
13 
14 {$I VCheck.inc}
15 
16 {$IFDEF WIN32}{$IFNDEF V_FREEPASCAL}
17   {$DEFINE W_STREAM}
18 {$ENDIF}{$ENDIF}
19 
20 uses
21   SysUtils, ExtType, ExtSys, VectStr, VectErr,
22   {$IFDEF USE_STREAM64}VStrm64, VFStrm64{$ELSE}VStream, VFStream{$ENDIF};
23 
24 const
25   {$IFDEF UNIX}
26   CRLF: String = #10;
27   {$ELSE}
28   CRLF: String = #13#10;
29   {$ENDIF}
30   { ����������� ����� (� Unix ������ ������������ ���� ������ #10); CRLF
31     ������������ ������ ��� ������ � ������, �.�. ����� ReadStr ���������� �
32     �������� ����������� � #13#10, � #10 }
33   { end-of-line marker (Unix usually uses only #10); CRLF is used only on
34     writing to streams because the ReadStr method accepts both #13#10 and #10 }
35 
36   DefaultBufferSize = {$IFDEF V_16}16384{$ELSE}65536{$ENDIF};
37 
38 type
39   tsMode = (tsRead, tsRewrite, tsAppend);
40 
41   ETextStream = class(Exception);
42 
43   TTextStreamBookmark = class
44   private
45     FLineNumber, FPos: Int32;
46   {$IFDEF CHECK_OBJECTS_FREE}
47   public
48     constructor Create;
49     destructor Destroy; override;
50   {$ENDIF}
51   end;
52 
53   TTextStreamOnStream = class
54   protected
55     FStream: TVStream;
56     FFileIO, FWrite, FBufStrValid, FCanRollBack: Bool;
57     FBufStr: String;
58     FLineNumber, { ������� ����� ������ } { current line number }
59     FLogicalOffset, { �������� ������������� ������ ������������ ������ ����� }
60     { offset of non-read data from the beginning of the file }
61     FBufferStart, { �������� ������ FBuffer ������������ ������ ����� }
62     { offset of the FBuffer start from beginning of the file }
63     FBufferLength, { ����������� ����� (���������� ���� � FBuffer) }
64     { actual data length (number of bytes in FBuffer) }
65     FBufferSize: Int32; { ������ ����� ������, ����������� ��� FBuffer }
66     { size of memory block allocated for FBuffer }
67     FBuffer: PCharArray;
68     procedure WriteBuf;
69   public
70     Ownership: Boolean;
71     Prefix: String;
72     { ������� ����������� � ������ ������ ��������� ������� }
73     { the prefix is being inserted in the beginning of every output string }
74     constructor Create(AStream: TVStream; Mode: tsMode{$IFDEF V_D4};
75       BufferSize: Integer = DefaultBufferSize{$ENDIF});
76     { ������� ��������� �����, ������������ �� ������ AStream; ���� �����������
77       � ������ Mode: tsRewrite - ���� ��������� ������ � �������� ��� ������;
78       tsAppend - ���� ����������� ��� ����������; tsRead - ���� �����������
79       ��� ������; BufferSize - ������ ������ (Delphi 4+) }
80     { creates a text stream based on the stream AStream; the file is opened in
81       one of modes Mode: tsRewrite - rewrites the file and opens it for writing;
82       tsAppend - opens the file for appending; tsRead - opens the file for
83       reading; BufferSize is the size of buffer used (Delphi 4+) }
84     destructor Destroy; override;
85     procedure Reset;
86     { ������ ���� ������� }
87     { read from the beginning }
Eofnull88     function Eof: Bool;
89     { ���������� True, ���� ������� ������� ��������� � ����� ������, �����
90       False }
91     { returns True if the current position is at the end of the stream,
92       otherwise False }
CreateBookmarknull93     function CreateBookmark: TTextStreamBookmark;
94     { ������� "��������" �� ������� ������� }
95     { creates a "bookmark" at the current position }
96     procedure GotoBookmark(ABookmark: TTextStreamBookmark);
97     { ��������� �� �������� "��������" }
98     { goes to the given "bookmark" }
99     procedure PassEmpty;
100     { ���������� ������ ��� ��������� ������� �� �������� � ������ <= ' ' ������ }
101     { passes strings which are empty or contain only characters with codes <= ' ' }
ReadStringnull102     function ReadString: String; virtual;
103     { ������ ��������� ������ }
104     { reads the next string }
ReadTrimmednull105     function ReadTrimmed: String;
106     { ������ ��������� ������ � ���������� ���������, � ������� "��������"
107       ��������� � �������� ������� � ������ <= ' ' }
108     { reads the next string and returns result with trimmed leading and trailing
109       characters with codes <= ' ' }
ReadIntegernull110     function ReadInteger: Integer;
111     { ������ ����� �������� (��� ������ �������� ��������� ������) }
112     { reads an integer value (it should be placed on the separate line) }
113     procedure WriteString(const S: String);
114     { ���������� ������ S � ������� �������� ������ � ����� }
115     { writes the string S and the end-of-line marker to the stream }
116     procedure WriteInteger(I: Integer);
117     { ���������� ����� �������� I � ������� �������� ������ � ����� }
118     { writes the integer value I and the end-of-line marker to the stream }
119     procedure WriteSection(const SectionName: String);
120     { ���������� � ����� ������ ���� "[SectionName]" }
121     { writes the line "[SectionName]" to the stream }
122     procedure WriteStringKey(const Key, Value: String);
123     { ���������� � ����� ������ ���� "Key=Value" }
124     { writes the line "Key=Value" to the stream }
125     procedure WriteIntegerKey(const Key: String; Value: Integer);
126     { ���������� � ����� ������ ���� "Key=Value" }
127     { writes the line "Key=Value" to the stream }
128     procedure Rollback;
129     { ��������� "�����" �� ���������� ������ (��� ��������� ������ ReadXXXX
130       ����� ���������� �� �� ��������); ����� ����������, ���� ��� ��������
131       ����� Flush ��� ����� �������� ������ / ������ ������ PassEmpty �� ����
132       ��������� �� ���� ������ - ����� ������������ �������������� �������� }
133     { executes "rollback" to the previous string (next time ReadXXXX will be
134       called it will return the same value); rollback isn't possible if the
135       Flush method was executed or no strings were read after opening the stream
136       or calling to PassEmpty - in such cases exception will be raised }
137     procedure Flush;
138     { ���������� �� ���� ��������� �������� �����, ��������� � ������� }
139     { writes the system file buffer associated with the stream to the disk }
140     property LineNumber: Int32 read FLineNumber;
141     { ����� ��������� ����������� ��� ���������� ������ }
142     { number of the last line read or written }
143     property Stream: TVStream read FStream;
144     property LogicalOffset: Int32 read FLogicalOffset;
145   end;
146 
147   TTextStream = class(TTextStreamOnStream)
148     constructor Create(const FileName: String; Mode: tsMode{$IFDEF V_D4};
149       BufferSize: Integer = DefaultBufferSize{$ENDIF});
150     {$IFDEF W_STREAM}
151     constructor CreateW(const FileName: WideString; Mode: tsMode{$IFDEF V_D4};
152       BufferSize: Integer = DefaultBufferSize{$ENDIF});
153     {$ENDIF}
154     { ������� ��������� �����, ��������� � ������ FileName }
155     { creates a text stream associated with the file named FileName }
156   end;
157 
158   TPrefixedTextStream = TTextStreamOnStream;
159 
160   TFilteredTextStream = class(TTextStream)
161     CommentPrefix: Char;
162     { ������, � �������� ���������� ����������� (�� ��������� - ';') }
163     { the comments prefix character (default is ';') }
164     constructor Create(const FileName: String; Mode: tsMode{$IFDEF V_D4};
165       BufferSize: Integer = DefaultBufferSize{$ENDIF});
166     {$IFDEF W_STREAM}
167     constructor CreateW(const FileName: WideString; Mode: tsMode{$IFDEF V_D4};
168       BufferSize: Integer = DefaultBufferSize{$ENDIF});
169     {$ENDIF}
ReadStringnull170     function ReadString: String; override;
171     { ������ � ���������� ��������� ������, ������ �� ��� ������������
172       �����������, ������������ � ������� CommentPrefix }
173     { reads and returns the next string excluding the one-line comments starting
174       with the CommentPrefix character from it }
175   end;
176 
177 implementation
178 
179 {$IFDEF CHECK_OBJECTS_FREE}
180 uses ChckFree;
181 {$ENDIF}
182 
183 {$IFDEF CHECK_OBJECTS_FREE}
184 constructor TTextStreamBookmark.Create;
185 begin
186   RegisterObjectCreate(Self);
187   inherited Create;
188 end;
189 
190 destructor TTextStreamBookmark.Destroy;
191 begin
192   RegisterObjectFree(Self);
193   inherited Destroy;
194 end;
195 {$ENDIF}
196 
197 { TTextStreamOnStream }
198 
199 constructor TTextStreamOnStream.Create(AStream: TVStream;
200   Mode: tsMode{$IFDEF V_D4}; BufferSize: Integer{$ENDIF});
201 var
202   P: PChar;
203 begin
204   {$IFDEF CHECK_OBJECTS_FREE}
205   RegisterObjectCreate(Self);
206   {$ENDIF}
207   inherited Create;
208   if AStream <> nil then begin
209     FStream:=AStream;
210     FFileIO:=True;
211     if (Mode = tsRead) or
212       (Mode = tsAppend) and (FileMode = fmOpenReadWrite) and (FStream.Size > 0) then
213     begin
214       {$IFDEF V_D4}
215       ASSERT(BufferSize >= 256);
216       FBufferSize:=IntMin(FStream.Size, BufferSize);
217       {$ELSE}
218       FBufferSize:=IntMin(FStream.Size, DefaultBufferSize);
219       {$ENDIF}
220       GetMem(FBuffer, FBufferSize);
221       if Mode = tsAppend then begin
222         while not Eof do ReadString;
223         { ���� � ����� ��������� ������ ��� CRLF, �� ��������� CRLF }
224         P:=PChar(FBuffer) + FBufferSize - 1;
225         if P^ <> #10 then begin
226           FWrite:=True;
227           WriteString('');
228           WriteBuf;
229         end;
230         FreeMem(FBuffer, FBufferSize);
231         FBuffer:=nil;
232       end;
233     end;
234   end
235   else
236     FFileIO:=False;
237   FWrite:=Mode <> tsRead;
238 end;
239 
240 procedure TTextStreamOnStream.Reset;
241 begin
242   WriteBuf;
243   FLogicalOffset:=0;
244   FLineNumber:=0;
245 end;
246 
247 destructor TTextStreamOnStream.Destroy;
248 begin
249   {$IFDEF CHECK_OBJECTS_FREE}
250   RegisterObjectFree(Self);
251   {$ENDIF}
252   try
253     WriteBuf;
254   finally
255     if FBuffer <> nil then
256       FreeMem(FBuffer, FBufferSize);
257     if Ownership then
258       FStream.Free;
259     inherited Destroy;
260   end;
261 end;
262 
TTextStreamOnStream.Eofnull263 function TTextStreamOnStream.Eof: Bool;
264 begin
265   if FWrite then
266     Result:=True
267   else
268     Result:=(FLogicalOffset >= FStream.Size) and (FCanRollback or not FBufStrValid);
269 end;
270 
TTextStreamOnStream.CreateBookmarknull271 function TTextStreamOnStream.CreateBookmark: TTextStreamBookmark;
272 begin
273   if not FFileIO then
274     raise ETextStream.Create(ErrMsg(SMethodNotApplicable, [0]));
275   WriteBuf;
276   Result:=TTextStreamBookmark.Create;
277   Result.FPos:=FLogicalOffset;
278   Result.FLineNumber:=FLineNumber;
279 end;
280 
281 procedure TTextStreamOnStream.GotoBookmark(ABookmark: TTextStreamBookmark);
282 begin
283   WriteBuf;
284   FLogicalOffset:=ABookmark.FPos;
285   FLineNumber:=ABookmark.FLineNumber;
286 end;
287 
288 procedure TTextStreamOnStream.PassEmpty;
289 begin
290   while not Eof do
291     if Trim(ReadString) <> '' then begin
292       Rollback;
293       Exit;
294     end;
295 end;
296 
ReadStringnull297 function TTextStreamOnStream.ReadString: String;
298 label L1;
299 const
300   SLineTooLong = 'line is too long';
301 var
302   I, L, Count: Int32;
303   P: PChar;
304 begin
305   if FWrite then
306     raise ETextStream.Create(ErrMsg(SMethodNotApplicable, [0]));
307   if not FBufStrValid then begin
308     if FFileIO then begin
309       if (FLogicalOffset < FBufferStart) or
310         (FLogicalOffset >= FBufferStart + FBufferLength)
311       then begin
312         FStream.Position:=FLogicalOffset;
313         FBufferLength:=FStream.ReadFunc(FBuffer^, FBufferSize);
314         if FBufferLength = 0 then
315           raise ETextStream.Create(ErrMsg(SReadAfterEnd, [0]));
316         FBufferStart:=FLogicalOffset;
317       end;
318       FBufStr:='';
319       L:=FLogicalOffset - FBufferStart;
320       Count:=FBufferLength - L;
321       P:=PChar(FBuffer) + L;
322       I:=IndexOfValue8(P^, 10, Count);
323       if I < 0 then begin
324         {$IFDEF V_LONGSTRINGS}
325         SetLength(FBufStr, Count);
326         Move(P^, PChar(FBufStr)^, Count);
327         {$ELSE}
328         if Count > 255 then
329           raise ETextStream.Create(SLineTooLong);
330         FBufStr[0]:=Chr(Count);
331         Move(P^, FBufStr[1], Count);
332         {$ENDIF}
333         Inc(FLogicalOffset, Count);
334         FBufferStart:=FLogicalOffset;
335         FBufferLength:=FStream.ReadFunc(FBuffer^, FBufferSize);
336         if FBufferLength = 0 then begin { must be EOF }
337           Inc(FLogicalOffset);
338           goto L1;
339         end;
340         P:=PChar(FBuffer);
341         I:=IndexOfValue8(P^, 10, FBufferLength);
342         if I < 0 then
343           raise ETextStream.Create(SLineTooLong + ' ' + IntToStr(FLineNumber));
344       end;
345       Count:=I + 1;
346       Inc(FLogicalOffset, Count);
347       L:=Length(FBufStr);
348       {$IFDEF V_LONGSTRINGS}
349       SetLength(FBufStr, L + I);
350       Move(P^, (PChar(FBufStr) + L)^, I);
351       {$ELSE}
352       Count:=L + I;
353       if Count > 255 then
354         raise ETextStream.Create(SLineTooLong);
355       FBufStr[0]:=Chr(Count);
356       Move(P^, FBufStr[L + 1], I);
357       {$ENDIF}
358     L1:
359       L:=Length(FBufStr);
360       if (L > 0) and (FBufStr[L] = #13) then
361         {$IFDEF V_LONGSTRINGS}
362         SetLength(FBufStr, L - 1);
363         {$ELSE}
364         FBufStr[0]:=Chr(L - 1);
365         {$ENDIF}
366     end
367     else
368       readln(FBufStr);
369   end
370   else
371     FBufStrValid:=False;
372   FCanRollBack:=True;
373   Inc(FLineNumber);
374   Result:=FBufStr;
375 end;
376 
ReadTrimmednull377 function TTextStreamOnStream.ReadTrimmed: String;
378 begin
379   Result:=Trim(ReadString);
380 end;
381 
TTextStreamOnStream.ReadIntegernull382 function TTextStreamOnStream.ReadInteger: Integer;
383 begin
384   Result:=StrToInt(ReadTrimmed);
385 end;
386 
387 procedure TTextStreamOnStream.WriteBuf;
388 begin
389   if FWrite and FBufStrValid then begin
390     if FFileIO then begin
391       FStream.Position:=FLogicalOffset;
392       {$IFDEF V_LONGSTRINGS}
393       FStream.WriteProc(PChar(FBufStr)^, Length(FBufStr));
394       FStream.WriteProc(PChar(CRLF)^, Length(CRLF));
395       {$ELSE}
396       FStream.WriteProc(FBufStr[1], Length(FBufStr));
397       FStream.WriteProc(CRLF[1], Length(CRLF));
398       {$ENDIF}
399       FLogicalOffset:=FStream.Position;
400     end
401     else
402       writeln(FBufStr);
403   end;
404   FBufStrValid:=False;
405   FCanRollBack:=False;
406   FBufStr:='';
407 end;
408 
409 procedure TTextStreamOnStream.WriteString(const S: String);
410 begin
411   WriteBuf;
412   FBufStrValid:=True;
413   FCanRollBack:=True;
414   FBufStr:=Prefix + S;
415   Inc(FLineNumber);
416 end;
417 
418 procedure TTextStreamOnStream.WriteInteger(I: Integer);
419 begin
420   WriteString(IntToStr(I));
421 end;
422 
423 procedure TTextStreamOnStream.WriteSection(const SectionName: String);
424 begin
425   WriteString('[' + SectionName + ']');
426 end;
427 
428 procedure TTextStreamOnStream.WriteStringKey(const Key, Value: String);
429 begin
430   WriteString(Key + '=' + Value);
431 end;
432 
433 procedure TTextStreamOnStream.WriteIntegerKey(const Key: String; Value: Integer);
434 begin
435   WriteStringKey(Key, IntToStr(Value));
436 end;
437 
438 procedure TTextStreamOnStream.Rollback;
439 begin
440   if FCanRollBack then begin
441     FCanRollBack:=False;
442     FBufStrValid:=not FWrite;
443     Dec(FLineNumber);
444   end
445   else
446     raise ETextStream.Create(ErrMsg(SCanNotRollBack, [0]));
447 end;
448 
449 procedure TTextStreamOnStream.Flush;
450 begin
451   WriteBuf;
452   if FStream is TVFileStream then
453     TVFileStream(FStream).Flush;
454 end;
455 
456 { TTextStream }
457 
458 constructor TTextStream.Create(const FileName: String; Mode: tsMode{$IFDEF V_D4};
459   BufferSize: Integer{$ENDIF});
460 {$IFDEF W_STREAM}
461 begin
462   CreateW(FileName, Mode{$IFDEF V_D4}, BufferSize{$ENDIF});
463 end;
464 
465 constructor TTextStream.CreateW(const FileName: WideString; Mode: tsMode{$IFDEF V_D4};
466   BufferSize: Integer{$ENDIF});
467 {$ENDIF}
468 var
469   FileMode: Word;
470   AStream: TVFileStream;
471 begin
472   if FileName <> '' then begin
473     FFileIO:=True;
474     Case Mode of
475       tsRead: FileMode:=fmOpenRead{$IFDEF V_WIN} + 32{fmShareDenyWrite}{$ENDIF};
476       tsRewrite: FileMode:=fmCreate;
477     Else
478       { tsAppend }
479       if FileExists(FileName) then
480         FileMode:=fmOpenReadWrite
481       else
482         FileMode:=fmCreate;
483     End;
484     {$IFDEF W_STREAM}
485     AStream:=TVFileStream.CreateW(FileName, FileMode);
486     {$ELSE}
487     AStream:=TVFileStream.Create(FileName, FileMode);
488     {$ENDIF}
489     try
490       inherited Create(AStream, Mode{$IFDEF V_D4}, BufferSize{$ENDIF});
491     except
492       AStream.Free;
493       raise;
494     end;
495     Ownership:=True;
496   end
497   else
498     inherited Create(nil, Mode);
499 end;
500 
501 { TFilteredTextStream }
502 
503 constructor TFilteredTextStream.Create(const FileName: String;
504   Mode: tsMode{$IFDEF V_D4}; BufferSize: Integer{$ENDIF});
505 {$IFDEF W_STREAM}
506 begin
507   CreateW(FileName, Mode{$IFDEF V_D4}, BufferSize{$ENDIF});
508 end;
509 
510 constructor TFilteredTextStream.CreateW(const FileName: WideString;
511   Mode: tsMode{$IFDEF V_D4}; BufferSize: Integer{$ENDIF});
512 {$ENDIF}
513 begin
514   {$IFDEF W_STREAM}
515   inherited CreateW(FileName, Mode{$IFDEF V_D4}, BufferSize{$ENDIF});
516   {$ELSE}
517   inherited Create(FileName, Mode{$IFDEF V_D4}, BufferSize{$ENDIF});
518   {$ENDIF}
519   CommentPrefix:=';';
520 end;
521 
TFilteredTextStream.ReadStringnull522 function TFilteredTextStream.ReadString: String;
523 begin
524   repeat
525     Result:=RemoveComment(inherited ReadString, CommentPrefix);
526   until (Result <> '') or Eof;
527 end;
528 
529 end.
530