1 {
2 Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman
3
4 This module provides stream classes
5
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program; if not, write to the Free Software
18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19
20 ****************************************************************************
21 }
22 unit cstreams;
23
24 {$i fpcdefs.inc}
25
26 interface
27
28 uses
29 cutils;
30
31
32 {****************************************************************************
33 TCStream
34 ****************************************************************************}
35
36 {
37 TCStream is copied directly from classesh.inc from the FCL so
38 it's compatible with the normal Classes.TStream.
39
40 TCFileStream is a merge of THandleStream and TFileStream and updated
41 to have a 'file' type instead of Handle.
42
43 TCCustomMemoryStream and TCMemoryStream are direct copies.
44 }
45 const
46 { TCStream seek origins }
47 soFromBeginning = 0;
48 soFromCurrent = 1;
49 soFromEnd = 2;
50
51 { TCFileStream create mode }
52 fmCreate = $FFFF;
53 fmOpenRead = 0;
54 fmOpenWrite = 1;
55 fmOpenReadWrite = 2;
56
57 var
58 { Used for Error reporting instead of exceptions }
59 CStreamError : longint;
60
61 type
62 { Fake TComponent class, it isn't used any futher }
63 TCComponent = class(TObject)
64 end;
65
66 { TCStream abstract class }
67
68 TCStream = class(TObject)
69 private
GetPositionnull70 function GetPosition: Longint;
71 procedure SetPosition(Pos: Longint);
GetSizenull72 function GetSize: Longint;
73 protected
74 procedure SetSize(NewSize: Longint); virtual;
75 public
Readnull76 function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
Writenull77 function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
Seeknull78 function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
79 procedure ReadBuffer(var Buffer; Count: Longint);
80 procedure WriteBuffer(const Buffer; Count: Longint);
CopyFromnull81 function CopyFrom(Source: TCStream; Count: Longint): Longint;
ReadComponentnull82 function ReadComponent(Instance: TCComponent): TCComponent;
ReadComponentResnull83 function ReadComponentRes(Instance: TCComponent): TCComponent;
84 procedure WriteComponent(Instance: TCComponent);
85 procedure WriteComponentRes(const ResName: string; Instance: TCComponent);
86 procedure WriteDescendent(Instance, Ancestor: TCComponent);
87 procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TCComponent);
88 procedure WriteResourceHeader(const ResName: string; {!!!:out} var FixupInfo: Integer);
89 procedure FixupResourceHeader(FixupInfo: Integer);
90 procedure ReadResHeader;
ReadBytenull91 function ReadByte : Byte;
ReadWordnull92 function ReadWord : Word;
ReadDWordnull93 function ReadDWord : Cardinal;
ReadAnsiStringnull94 function ReadAnsiString : AnsiString;
95 procedure WriteByte(b : Byte);
96 procedure WriteWord(w : Word);
97 procedure WriteDWord(d : Cardinal);
98 Procedure WriteAnsiString (S : AnsiString);
99 property Position: Longint read GetPosition write SetPosition;
100 property Size: Longint read GetSize write SetSize;
101 end;
102
103 { TCCustomFileStream class }
104
105 TCCustomFileStream = class(TCStream)
106 protected
107 FFileName : String;
108 public
109 constructor Create(const AFileName: string;{shortstring!} Mode: Word); virtual; abstract;
EOFnull110 function EOF: boolean; virtual; abstract;
111 property FileName : String Read FFilename;
112 end;
113
114 { TFileStream class }
115
116 TCFileStream = class(TCCustomFileStream)
117 Private
118 FHandle: File;
119 protected
120 procedure SetSize(NewSize: Longint); override;
121 public
122 constructor Create(const AFileName: string; Mode: Word); override;
123 destructor Destroy; override;
Readnull124 function Read(var Buffer; Count: Longint): Longint; override;
Writenull125 function Write(const Buffer; Count: Longint): Longint; override;
Seeknull126 function Seek(Offset: Longint; Origin: Word): Longint; override;
EOFnull127 function EOF: boolean; override;
128 end;
129
130 TCFileStreamClass = class of TCCustomFileStream;
131 var
132 CFileStreamClass: TCFileStreamClass = TCFileStream;
133
134 type
135 TCRangeStream = class(TCStream)
136 private
137 FBase: TCStream;
138 FOffset: LongInt;
139 FMaxOffset: LongInt;
140 FSize: LongInt;
141 FPosition: LongInt;
142 public
143 constructor Create(ABase: TCStream; AOffset, ASize: LongInt);
Readnull144 function Read(var Buffer; Count: LongInt): LongInt; override;
Writenull145 function Write(const Buffer; Count: LongInt): LongInt; override;
Seeknull146 function Seek(Offset: LongInt; Origin: Word): LongInt; override;
147 end;
148
149 { TCustomMemoryStream abstract class }
150
151 TCCustomMemoryStream = class(TCStream)
152 private
153 FMemory: Pointer;
154 FSize, FPosition: Longint;
155 protected
156 procedure SetPointer(Ptr: Pointer; ASize: Longint);
157 public
Readnull158 function Read(var Buffer; Count: Longint): Longint; override;
Seeknull159 function Seek(Offset: Longint; Origin: Word): Longint; override;
160 procedure SaveToStream(Stream: TCStream);
161 procedure SaveToFile(const FileName: string);
162 property Memory: Pointer read FMemory;
163 end;
164
165 { TCMemoryStream }
166
167 TCMemoryStream = class(TCCustomMemoryStream)
168 private
169 FCapacity: Longint;
170 procedure SetCapacity(NewCapacity: Longint);
171 protected
Reallocnull172 function Realloc(var NewCapacity: Longint): Pointer; virtual;
173 property Capacity: Longint read FCapacity write SetCapacity;
174 public
175 destructor Destroy; override;
176 procedure Clear;
177 procedure LoadFromStream(Stream: TCStream);
178 procedure LoadFromFile(const FileName: string);
179 procedure SetSize(NewSize: Longint); override;
Writenull180 function Write(const Buffer; Count: Longint): Longint; override;
181 end;
182
183
184 implementation
185
186 Type
187 PByte = ^Byte;
188
189 {*****************************************************************************
190 TCStream
191 *****************************************************************************}
192
TCStream.GetPositionnull193 function TCStream.GetPosition: Longint;
194
195 begin
196 Result:=Seek(0,soFromCurrent);
197 end;
198
199 procedure TCStream.SetPosition(Pos: Longint);
200
201 begin
202 Seek(pos,soFromBeginning);
203 end;
204
TCStream.GetSizenull205 function TCStream.GetSize: Longint;
206
207 var
208 p : longint;
209
210 begin
211 p:=GetPosition;
212 GetSize:=Seek(0,soFromEnd);
213 Seek(p,soFromBeginning);
214 end;
215
216 procedure TCStream.SetSize(NewSize: Longint);
217
218 begin
219 // We do nothing. Pipe streams don't support this
220 // As well as possible read-ony streams !!
221 end;
222
223 procedure TCStream.ReadBuffer(var Buffer; Count: Longint);
224
225 begin
226 CStreamError:=0;
227 if Read(Buffer,Count)<Count then
228 CStreamError:=102;
229 end;
230
231 procedure TCStream.WriteBuffer(const Buffer; Count: Longint);
232
233 begin
234 CStreamError:=0;
235 if Write(Buffer,Count)<Count then
236 CStreamError:=103;
237 end;
238
239 function TCStream.CopyFrom(Source: TCStream; Count: Longint): Longint;
240
241 var
242 i : longint;
243 buffer : array[0..1023] of byte;
244
245 begin
246 CStreamError:=0;
247 Result:=0;
248 while Count>0 do
249 begin
250 if (Count>sizeof(buffer)) then
251 i:=sizeof(Buffer)
252 else
253 i:=Count;
254 i:=Source.Read(buffer,i);
255 i:=Write(buffer,i);
256 dec(count,i);
257 inc(Result,i);
258 if i=0 then
259 exit;
260 end;
261 end;
262
263 function TCStream.ReadComponent(Instance: TCComponent): TCComponent;
264 begin
265 Result:=nil;
266 end;
267
268 function TCStream.ReadComponentRes(Instance: TCComponent): TCComponent;
269 begin
270 Result:=nil;
271 end;
272
273 procedure TCStream.WriteComponent(Instance: TCComponent);
274 begin
275 end;
276
277 procedure TCStream.WriteComponentRes(const ResName: string; Instance: TCComponent);
278 begin
279 end;
280
281 procedure TCStream.WriteDescendent(Instance, Ancestor: TCComponent);
282 begin
283 end;
284
285 procedure TCStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TCComponent);
286 begin
287 end;
288
289 procedure TCStream.WriteResourceHeader(const ResName: string; {!!!: out} var FixupInfo: Integer);
290 begin
291 end;
292
293 procedure TCStream.FixupResourceHeader(FixupInfo: Integer);
294 begin
295 end;
296
297 procedure TCStream.ReadResHeader;
298 begin
299 end;
300
301 function TCStream.ReadByte : Byte;
302
303 var
304 b : Byte;
305
306 begin
307 ReadBuffer(b,1);
308 ReadByte:=b;
309 end;
310
311 function TCStream.ReadWord : Word;
312
313 var
314 w : Word;
315
316 begin
317 ReadBuffer(w,2);
318 ReadWord:=w;
319 end;
320
321 function TCStream.ReadDWord : Cardinal;
322
323 var
324 d : Cardinal;
325
326 begin
327 ReadBuffer(d,4);
328 ReadDWord:=d;
329 end;
330
331 Function TCStream.ReadAnsiString : AnsiString;
332 Var
333 TheSize : Longint;
334 P : PByte ;
335 begin
336 Result:='';
337 ReadBuffer (TheSize,SizeOf(TheSize));
338 SetLength(Result,TheSize);
339 // Illegal typecast if no AnsiStrings defined.
340 if TheSize>0 then
341 begin
342 ReadBuffer (Pointer(Result)^,TheSize);
343 P:=PByte(PtrInt(Result)+TheSize);
344 p^:=0;
345 end;
346 end;
347
348 Procedure TCStream.WriteAnsiString (S : AnsiString);
349
350 Var L : Longint;
351
352 begin
353 L:=Length(S);
354 WriteBuffer (L,SizeOf(L));
355 WriteBuffer (Pointer(S)^,L);
356 end;
357
358 procedure TCStream.WriteByte(b : Byte);
359
360 begin
361 WriteBuffer(b,1);
362 end;
363
364 procedure TCStream.WriteWord(w : Word);
365
366 begin
367 WriteBuffer(w,2);
368 end;
369
370 procedure TCStream.WriteDWord(d : Cardinal);
371
372 begin
373 WriteBuffer(d,4);
374 end;
375
376
377 {****************************************************************************}
378 {* TCFileStream *}
379 {****************************************************************************}
380
381 constructor TCFileStream.Create(const AFileName: string; Mode: Word);
382 var
383 oldfilemode : byte;
384 begin
385 FFileName:=AFileName;
386 If Mode=fmcreate then
387 begin
388 system.assign(FHandle,AFileName);
389 {$push} {$I-}
390 system.rewrite(FHandle,1);
391 {$pop}
392 CStreamError:=IOResult;
393 end
394 else
395 begin
396 oldfilemode:=filemode;
397 filemode:=$40 or Mode;
398 system.assign(FHandle,AFileName);
399 {$push} {$I-}
400 system.reset(FHandle,1);
401 {$pop}
402 CStreamError:=IOResult;
403 filemode:=oldfilemode;
404 end;
405 end;
406
407
408 destructor TCFileStream.Destroy;
409 begin
410 {$push} {$I-}
411 System.Close(FHandle);
412 {$pop}
413 CStreamError:=IOResult;
414 end;
415
416
Readnull417 function TCFileStream.Read(var Buffer; Count: Longint): Longint;
418 begin
419 CStreamError:=0;
420 BlockRead(FHandle,Buffer,Count,Result);
421 If Result=-1 then Result:=0;
422 end;
423
424
Writenull425 function TCFileStream.Write(const Buffer; Count: Longint): Longint;
426 begin
427 CStreamError:=0;
428 BlockWrite (FHandle,(@Buffer)^,Count,Result);
429 If Result=-1 then Result:=0;
430 end;
431
432
433 Procedure TCFileStream.SetSize(NewSize: Longint);
434 begin
435 {$push} {$I-}
436 System.Seek(FHandle,NewSize);
437 System.Truncate(FHandle);
438 {$pop}
439 CStreamError:=IOResult;
440 end;
441
442
Seeknull443 function TCFileStream.Seek(Offset: Longint; Origin: Word): Longint;
444 var
445 l : longint;
446 begin
447 {$push} {$I-}
448 case Origin of
449 soFromBeginning :
450 begin
451 System.Seek(FHandle,Offset);
452 l:=Offset;
453 end;
454 soFromCurrent :
455 begin
456 l:=System.FilePos(FHandle);
457 inc(l,Offset);
458 System.Seek(FHandle,l);
459 end;
460 soFromEnd :
461 begin
462 l:=System.FileSize(FHandle);
463 dec(l,Offset);
464 if l<0 then
465 l:=0;
466 System.Seek(FHandle,l);
467 end;
468 else
469 begin
470 CStreamError:=103;
471 l:=Offset;
472 end;
473 end;
474 {$pop}
475 CStreamError:=IOResult;
476 Result:=l;
477 end;
478
EOFnull479 function TCFileStream.EOF: boolean;
480 begin
481 EOF:=system.eof(FHandle);
482 end;
483
484
485 {****************************************************************************}
486 {* TCRangeStream *}
487 {****************************************************************************}
488
489
490 constructor TCRangeStream.Create(ABase: TCStream; AOffset, ASize: LongInt);
491 begin
492 if not assigned(ABase) then
493 CStreamError:=155
494 else
495 { we allow to be positioned directly at the end for appending }
496 if (AOffset<0) or (AOffset>ABase.Size) then
497 CStreamError:=156
498 else
499 begin
500 FBase:=ABase;
501 FOffset:=AOffset;
502 if ASize<0 then
503 FSize:=maxLongint-FOffset
504 else
505 FSize:=ASize;
506 FMaxOffset:=FOffset+FSize-1;
507 end;
508 end;
509
510
Readnull511 function TCRangeStream.Read(var Buffer; Count: LongInt): LongInt;
512 begin
513 Count:=Min(Count,FMaxOffset-FPosition+1);
514 if Count>0 then
515 begin
516 FBase.Seek(FOffset+FPosition,soFromBeginning);
517 result:=FBase.Read(Buffer,Count);
518 end
519 else
520 result:=0;
521 FPosition:=FPosition+result;
522 end;
523
524
Writenull525 function TCRangeStream.Write(const Buffer; Count: LongInt): LongInt;
526 begin
527 Count:=Min(Count,FMaxOffset-FPosition+1);
528 if Count>0 then
529 begin
530 FBase.Seek(FOffset+FPosition,soFromBeginning);
531 result:=FBase.Write(Buffer,Count);
532 end
533 else
534 result:=0;
535 FPosition:=FPosition+result;
536 end;
537
538
Seeknull539 function TCRangeStream.Seek(Offset: LongInt; Origin: Word): LongInt;
540 begin
541 case Origin of
542 soFromBeginning:
543 begin
544 if Offset>FMaxOffset then
545 CStreamError:=156
546 else
547 FPosition:=FBase.Seek(FOffset+Offset,soFromBeginning)-FOffset;
548 end;
549 soFromCurrent:
550 begin
551 if Offset>FMaxOffset then
552 CStreamError:=156
553 else
554 FPosition:=FBase.Seek(FOffset+FPosition+Offset,soFromBeginning)-FOffset;
555 end;
556 soFromEnd:
557 begin
558 if Offset>FSize-1 then
559 CStreamError:=156
560 else
561 FPosition:=FBase.Seek(FMaxOffset-Offset,soFromBeginning)-FOffset;
562 end;
563 else
564 begin
565 CStreamError:=156;
566 end;
567 end;
568 Result:=FPosition;
569 end;
570
571 {****************************************************************************}
572 {* TCustomMemoryStream *}
573 {****************************************************************************}
574
575 procedure TCCustomMemoryStream.SetPointer(Ptr: Pointer; ASize: Longint);
576
577 begin
578 FMemory:=Ptr;
579 FSize:=ASize;
580 end;
581
582
Readnull583 function TCCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
584
585 begin
586 Result:=0;
587 If (FSize>0) and (FPosition<Fsize) then
588 begin
589 Result:=FSize-FPosition;
590 If Result>Count then Result:=Count;
591 Move (Pointer(PtrUInt(FMemory)+PtrUInt(FPosition))^,Buffer,Result);
592 FPosition:=Fposition+Result;
593 end;
594 end;
595
596
Seeknull597 function TCCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
598
599 begin
600 Case Origin of
601 soFromBeginning : FPosition:=Offset;
602 soFromEnd : FPosition:=FSize+Offset;
603 soFromCurrent : FpoSition:=FPosition+Offset;
604 end;
605 Result:=FPosition;
606 end;
607
608
609 procedure TCCustomMemoryStream.SaveToStream(Stream: TCStream);
610
611 begin
612 if FSize>0 then Stream.WriteBuffer (FMemory^,FSize);
613 end;
614
615
616 procedure TCCustomMemoryStream.SaveToFile(const FileName: string);
617
618 Var S : TCCustomFileStream;
619
620 begin
621 Try
622 S:=CFileStreamClass.Create (FileName,fmCreate);
623 SaveToStream(S);
624 finally
625 S.free;
626 end;
627 end;
628
629
630 {****************************************************************************}
631 {* TCMemoryStream *}
632 {****************************************************************************}
633
634
635 Const TMSGrow = 4096; { Use 4k blocks. }
636
637 procedure TCMemoryStream.SetCapacity(NewCapacity: Longint);
638
639 begin
640 SetPointer (Realloc(NewCapacity),Fsize);
641 FCapacity:=NewCapacity;
642 end;
643
644
Reallocnull645 function TCMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
646
647 Var MoveSize : Longint;
648
649 begin
650 CStreamError:=0;
651 If NewCapacity>0 Then // round off to block size.
652 NewCapacity := (NewCapacity + (TMSGrow-1)) and not (TMSGROW-1);
653 // Only now check !
654 If NewCapacity=FCapacity then
655 Result:=FMemory
656 else
657 If NewCapacity=0 then
658 begin
659 FreeMem (FMemory,Fcapacity);
660 Result:=nil;
661 end
662 else
663 begin
664 GetMem (Result,NewCapacity);
665 If Result=Nil then
666 CStreamError:=204;
667 If FCapacity>0 then
668 begin
669 MoveSize:=FSize;
670 If MoveSize>NewCapacity then MoveSize:=NewCapacity;
671 Move (Fmemory^,Result^,MoveSize);
672 FreeMem (FMemory,FCapacity);
673 end;
674 end;
675 end;
676
677
678 destructor TCMemoryStream.Destroy;
679
680 begin
681 Clear;
682 Inherited Destroy;
683 end;
684
685
686 procedure TCMemoryStream.Clear;
687
688 begin
689 FSize:=0;
690 FPosition:=0;
691 SetCapacity (0);
692 end;
693
694
695 procedure TCMemoryStream.LoadFromStream(Stream: TCStream);
696
697 begin
698 Stream.Position:=0;
699 SetSize(Stream.Size);
700 If FSize>0 then Stream.ReadBuffer(FMemory^,FSize);
701 end;
702
703
704 procedure TCMemoryStream.LoadFromFile(const FileName: string);
705
706 Var S : TCCustomFileStream;
707
708 begin
709 Try
710 S:=CFileStreamClass.Create (FileName,fmOpenRead);
711 LoadFromStream(S);
712 finally
713 S.free;
714 end;
715 end;
716
717
718 procedure TCMemoryStream.SetSize(NewSize: Longint);
719
720 begin
721 SetCapacity (NewSize);
722 FSize:=NewSize;
723 IF FPosition>FSize then
724 FPosition:=FSize;
725 end;
726
727
Writenull728 function TCMemoryStream.Write(const Buffer; Count: Longint): Longint;
729
730 Var NewPos : Longint;
731
732 begin
733 If Count=0 then
734 begin
735 Result:=0;
736 exit;
737 end;
738 NewPos:=FPosition+Count;
739 If NewPos>Fsize then
740 begin
741 IF NewPos>FCapacity then
742 SetCapacity (NewPos);
743 FSize:=Newpos;
744 end;
745 System.Move (Buffer,Pointer(Ptruint(FMemory)+PtrUInt(FPosition))^,Count);
746 FPosition:=NewPos;
747 Result:=Count;
748 end;
749
750 end.
751