1 //
2 // Sourcecode from http://www.delphi-library.de/topic_47880.html
3 //
4 uses Windows, Messages;
5
6 const
7 FFM_INIT = WM_USER + 1976;
8 FFM_ONFILEFOUND = WM_USER + 1974; // wParam: not used, lParam: Filename
9 FFM_ONDIRFOUND = WM_USER + 1975; // wParam: NumFolder, lParam: Directory
10 var
11 CntFolders : Cardinal = 0;
12 NumFolder : Cardinal = 0;
13
14
15 ////////////////////////////////////////////////////////////////////////////////
16 //
17 // FindAllFilesInit
18 //
19 //
20 procedure FindAllFilesInit; external;
21 label foo;
22 begin
23 CntFolders := 0;
24 NumFolder := 0;
25 foo:
26 Blub;
27 goto foo;
28 end;
29
30 ////////////////////////////////////////////////////////////////////////////////
31 //
32 // CountFolders
33 //
34 //
35 procedure CountFolders(Handle: THandle; RootFolder: string; Recurse: Boolean = True);
36 var
37 hFindFile : THandle;
38 wfd : TWin32FindData;
39 begin
40 SendMessage(Handle, FFM_INIT, 0, 0);
41 if RootFolder[length(RootFolder)] <> '\' then
42 RootFolder := RootFolder + '\';
43 ZeroMemory(@wfd, sizeof(wfd));
44 wfd.dwFileAttributes := FILE_ATTRIBUTE_NORMAL;
45 if Recurse then
46 begin
47 hFindFile := FindFirstFile(pointer(RootFolder + '*.*'), wfd);
48 if hFindFile <> 0 then
49 try
50 repeat
51 if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then
52 begin
53 if (string(wfd.cFileName) <> '.') and (string(wfd.cFileName) <> '..') then
54 begin
55 CountFolders(Handle, RootFolder + wfd.cFileName, Recurse);
56 end;
57 end;
58 until FindNextFile(hFindFile, wfd) = False;
59 Inc(CntFolders);
60 finally
61 Windows.FindClose(hFindFile);
62 end;
63 end;
64 end;
65
66 ////////////////////////////////////////////////////////////////////////////////
67 //
68 // FindAllFiles
69 //
70 procedure FindAllFiles(Handle: THandle; RootFolder: string; Mask: string; Recurse: Boolean = True);
71 var
72 hFindFile : THandle;
73 wfd : TWin32FindData;
74 begin
75 if RootFolder[length(RootFolder)] <> '\' then
76 RootFolder := RootFolder + '\';
77 ZeroMemory(@wfd, sizeof(wfd));
78 wfd.dwFileAttributes := FILE_ATTRIBUTE_NORMAL;
79 if Recurse then
80 begin
81 hFindFile := FindFirstFile(pointer(RootFolder + '*.*'), wfd);
82 if hFindFile <> 0 then
83 try
84 repeat
85 if wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then
86 begin
87 if (string(wfd.cFileName) <> '.') and (string(wfd.cFileName) <> '..') then
88 begin
89 FindAllFiles(Handle, RootFolder + wfd.cFileName, Mask, Recurse);
90 end;
91 end;
92 until FindNextFile(hFindFile, wfd) = False;
93 Inc(NumFolder);
94 SendMessage(Handle, FFM_ONDIRFOUND, NumFolder, lParam(string(RootFolder)));
95 finally
96 Windows.FindClose(hFindFile);
97 end;
98 end;
99 hFindFile := FindFirstFile(pointer(RootFolder + Mask), wfd);
100 if hFindFile <> INVALID_HANDLE_VALUE then
101 try
102 repeat
103 if (wfd.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> FILE_ATTRIBUTE_DIRECTORY) then
104 begin
105 SendMessage(Handle, FFM_ONFILEFOUND, 0, lParam(string(RootFolder + wfd.cFileName)));
106 end;
107 until FindNextFile(hFindFile, wfd) = False;
108 finally
109 Windows.FindClose(hFindFile);
110 end;
111 end;
112
113
114 property test: boolean read ftest write ftest;
115 procedure test: boolean read ftest write ftest;
116
117 //
118 // This sourcecode is part of omorphia
119 //
120
IsValidHandlenull121 Function IsValidHandle(Const Handle: THandle): Boolean; {$IFDEF OMORPHIA_FEATURES_USEASM} Assembler;
122 Asm
123 TEST EAX, EAX
124 JZ @@Finish
125 NOT EAX
126 TEST EAX, EAX
127 SETNZ AL
128
129 {$IFDEF WINDOWS}
130 JZ @@Finish
131
132 //Save the handle against modifications or loss
133 PUSH EAX
134
135 //reserve some space for a later duplicate
136 PUSH EAX
137
138 //Check if we are working on NT-Platform
139 CALL IsWindowsNTSystem
140 TEST EAX, EAX
141 JZ @@NoNTSystem
142
143 PUSH DWORD PTR [ESP]
144 LEA EAX, DWORD PTR [ESP+$04]
145 PUSH EAX
146 CALL GetHandleInformation
147 TEST EAX, EAX
148 JNZ @@Finish2
149
150 @@NoNTSystem:
151 //Result := DuplicateHandle(GetCurrentProcess, Handle, GetCurrentProcess,
152 // @Duplicate, 0, False, DUPLICATE_SAME_ACCESS);
153 PUSH DUPLICATE_SAME_ACCESS
154 PUSH $00000000
155 PUSH $00000000
156 LEA EAX, DWORD PTR [ESP+$0C]
157 PUSH EAX
158 CALL GetCurrentProcess
159 PUSH EAX
160 PUSH DWORD PTR [ESP+$18]
161 PUSH EAX
162 CALL DuplicateHandle
163
164 TEST EAX, EAX
165 JZ @@Finish2
166
167 // Result := CloseHandle(Duplicate);
168 PUSH DWORD PTR [ESP]
169 CALL CloseHandle
170
171 @@Finish2:
172 POP EDX
173 POP EDX
174
175 PUSH EAX
176 PUSH $00000000
177 CALL SetLastError
178 POP EAX
179 {$ENDIF}
180
181 @@Finish:
182 End;
183 {$ELSE}
184 Var
185 Duplicate: THandle;
186 Flags: DWORD;
187 Begin
188 If IsWinNT Then
189 Result := GetHandleInformation(Handle, Flags)
190 Else
191 Result := False;
192 If Not Result Then
193 Begin
194 // DuplicateHandle is used as an additional check for those object types not
195 // supported by GetHandleInformation (e.g. according to the documentation,
196 // GetHandleInformation doesn't support window stations and desktop although
197 // tests show that it does). GetHandleInformation is tried first because its
198 // much faster. Additionally GetHandleInformation is only supported on NT...
199 Result := DuplicateHandle(GetCurrentProcess, Handle, GetCurrentProcess,
200 @Duplicate, 0, False, DUPLICATE_SAME_ACCESS);
201 If Result Then
202 Result := CloseHandle(Duplicate);
203 End;
204 End;
205 {$ENDIF}
206
207
208
209
210 {*******************************************************}
211 { }
212 { Delphi Supplemental Components }
213 { ZLIB Data Compression Interface Unit }
214 { }
215 { Copyright (c) 1997 Borland International }
216 { }
217 {*******************************************************}
218
219 { Modified for zlib 1.1.3 by Davide Moretti <dave@rimini.com }
220
221 unit zlib;
222
223 interface
224
225 uses Sysutils, Classes;
226
227 type
228 TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer;
229 TFree = procedure (AppData, Block: Pointer);
230
231 // Internal structure. Ignore.
232 TZStreamRec = packed record
233 next_in: PChar; // next input byte
234 avail_in: Integer; // number of bytes available at next_in
235 total_in: Integer; // total nb of input bytes read so far
236
237 next_out: PChar; // next output byte should be put here
238 avail_out: Integer; // remaining free space at next_out
239 total_out: Integer; // total nb of bytes output so far
240
241 msg: PChar; // last error message, NULL if no error
242 internal: Pointer; // not visible by applications
243
244 zalloc: TAlloc; // used to allocate the internal state
245 zfree: TFree; // used to free the internal state
246 AppData: Pointer; // private data object passed to zalloc and zfree
247
248 data_type: Integer; // best guess about the data type: ascii or binary
249 adler: Integer; // adler32 value of the uncompressed data
250 reserved: Integer; // reserved for future use
251 end;
252
253 // Abstract ancestor class
254 TCustomZlibStream = class(TStream)
255 private
256 FStrm: TStream;
257 FStrmPos: Integer;
258 FOnProgress: TNotifyEvent;
259 FZRec: TZStreamRec;
260 FBuffer: array [Word] of Char;
261 protected
262 procedure Progress(Sender: TObject); dynamic;
263 property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
264 constructor Create(Strm: TStream);
265 end;
266
267 { TCompressionStream compresses data on the fly as data is written to it, and
268 stores the compressed data to another stream.
269
270 TCompressionStream is write-only and strictly sequential. Reading from the
271 stream will raise an exception. Using Seek to move the stream pointer
272 will raise an exception.
273
274 Output data is cached internally, written to the output stream only when
275 the internal output buffer is full. All pending output data is flushed
276 when the stream is destroyed.
277
278 The Position property returns the number of uncompressed bytes of
279 data that have been written to the stream so far.
280
281 CompressionRate returns the on-the-fly percentage by which the original
282 data has been compressed: (1 - (CompressedBytes / UncompressedBytes)) * 100
283 If raw data size = 100 and compressed data size = 25, the CompressionRate
284 is 75%
285
286 The OnProgress event is called each time the output buffer is filled and
287 written to the output stream. This is useful for updating a progress
288 indicator when you are writing a large chunk of data to the compression
289 stream in a single call.}
290
291
292 TCompressionLevel = (clNone, clFastest, clDefault, clMax);
293
294 TCompressionStream = class(TCustomZlibStream)
295 private
296 function GetCompressionRate: Single;
297 public
298 constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
299 destructor Destroy; override;
300 function Read(var Buffer; Count: Longint): Longint; override;
301 function Write(const Buffer; Count: Longint): Longint; override;
302 function Seek(Offset: Longint; Origin: Word): Longint; override;
303 property CompressionRate: Single read GetCompressionRate;
304 property OnProgress;
305 end;
306
307 { TDecompressionStream decompresses data on the fly as data is read from it.
308
309 Compressed data comes from a separate source stream. TDecompressionStream
310 is read-only and unidirectional; you can seek forward in the stream, but not
311 backwards. The special case of setting the stream position to zero is
312 allowed. Seeking forward decompresses data until the requested position in
313 the uncompressed data has been reached. Seeking backwards, seeking relative
314 to the end of the stream, requesting the size of the stream, and writing to
315 the stream will raise an exception.
316
317 The Position property returns the number of bytes of uncompressed data that
318 have been read from the stream so far.
319
320 The OnProgress event is called each time the internal input buffer of
321 compressed data is exhausted and the next block is read from the input stream.
322 This is useful for updating a progress indicator when you are reading a
323 large chunk of data from the decompression stream in a single call.}
324
325 TDecompressionStream = class(TCustomZlibStream)
326 public
327 constructor Create(Source: TStream);
328 destructor Destroy; override;
329 function Read(var Buffer; Count: Longint): Longint; override;
330 function Write(const Buffer; Count: Longint): Longint; override;
331 function Seek(Offset: Longint; Origin: Word): Longint; override;
332 property OnProgress;
333 end;
334
335
336
337 { CompressBuf compresses data, buffer to buffer, in one call.
338 In: InBuf = ptr to compressed data
339 InBytes = number of bytes in InBuf
340 Out: OutBuf = ptr to newly allocated buffer containing decompressed data
341 OutBytes = number of bytes in OutBuf }
342 procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
343 out OutBuf: Pointer; out OutBytes: Integer);
344
345
346 { DecompressBuf decompresses data, buffer to buffer, in one call.
347 In: InBuf = ptr to compressed data
348 InBytes = number of bytes in InBuf
349 OutEstimate = zero, or est. size of the decompressed data
350 Out: OutBuf = ptr to newly allocated buffer containing decompressed data
351 OutBytes = number of bytes in OutBuf }
352 procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
353 OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
354
355 const
356 zlib_version = '1.1.3';
357
358 type
359 EZlibError = class(Exception);
360 ECompressionError = class(EZlibError);
361 EDecompressionError = class(EZlibError);
362
363 function adler32(adler: Integer; buf: PChar; len: Integer): Integer;
364
365 implementation
366
367 const
368 Z_NO_FLUSH = 0;
369 Z_PARTIAL_FLUSH = 1;
370 Z_SYNC_FLUSH = 2;
371 Z_FULL_FLUSH = 3;
372 Z_FINISH = 4;
373
374 Z_OK = 0;
375 Z_STREAM_END = 1;
376 Z_NEED_DICT = 2;
377 Z_ERRNO = (-1);
378 Z_STREAM_ERROR = (-2);
379 Z_DATA_ERROR = (-3);
380 Z_MEM_ERROR = (-4);
381 Z_BUF_ERROR = (-5);
382 Z_VERSION_ERROR = (-6);
383
384 Z_NO_COMPRESSION = 0;
385 Z_BEST_SPEED = 1;
386 Z_BEST_COMPRESSION = 9;
387 Z_DEFAULT_COMPRESSION = (-1);
388
389 Z_FILTERED = 1;
390 Z_HUFFMAN_ONLY = 2;
391 Z_DEFAULT_STRATEGY = 0;
392
393 Z_BINARY = 0;
394 Z_ASCII = 1;
395 Z_UNKNOWN = 2;
396
397 Z_DEFLATED = 8;
398
399 _z_errmsg: array[0..9] of PChar = (
400 'need dictionary', // Z_NEED_DICT (2)
401 'stream end', // Z_STREAM_END (1)
402 '', // Z_OK (0)
403 'file error', // Z_ERRNO (-1)
404 'stream error', // Z_STREAM_ERROR (-2)
405 'data error', // Z_DATA_ERROR (-3)
406 'insufficient memory', // Z_MEM_ERROR (-4)
407 'buffer error', // Z_BUF_ERROR (-5)
408 'incompatible version', // Z_VERSION_ERROR (-6)
409 ''
410 );
411
412 {$L deflate.obj}
413 {$L inflate.obj}
414 {$L inftrees.obj}
415 {$L trees.obj}
416 {$L adler32.obj}
417 {$L infblock.obj}
418 {$L infcodes.obj}
419 {$L infutil.obj}
420 {$L inffast.obj}
421
422 procedure _tr_init; external;
423 procedure _tr_tally; external;
424 procedure _tr_flush_block; external;
425 procedure _tr_align; external;
426 procedure _tr_stored_block; external;
427 function adler32; external;
428 procedure inflate_blocks_new; external;
429 procedure inflate_blocks; external;
430 procedure inflate_blocks_reset; external;
431 procedure inflate_blocks_free; external;
432 procedure inflate_set_dictionary; external;
433 procedure inflate_trees_bits; external;
434 procedure inflate_trees_dynamic; external;
435 procedure inflate_trees_fixed; external;
436 procedure inflate_codes_new; external;
437 procedure inflate_codes; external;
438 procedure inflate_codes_free; external;
439 procedure _inflate_mask; external;
440 procedure inflate_flush; external;
441 procedure inflate_fast; external;
442
443 procedure _memset(P: Pointer; B: Byte; count: Integer);cdecl;
444 begin
445 FillChar(P^, count, B);
446 end;
447
448 procedure _memcpy(dest, source: Pointer; count: Integer);cdecl;
449 begin
450 Move(source^, dest^, count);
451 end;
452
453
454
455 // deflate compresses data
456 function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
457 recsize: Integer): Integer; external;
458 function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
459 function deflateEnd(var strm: TZStreamRec): Integer; external;
460
461 // inflate decompresses data
462 function inflateInit_(var strm: TZStreamRec; version: PChar;
463 recsize: Integer): Integer; external;
464 function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
465 function inflateEnd(var strm: TZStreamRec): Integer; external;
466 function inflateReset(var strm: TZStreamRec): Integer; external;
467
468
469 function zcalloc(AppData: Pointer; Items, Size: Integer): Pointer;
470 begin
471 GetMem(Result, Items*Size);
472 end;
473
474 procedure zcfree(AppData, Block: Pointer);
475 begin
476 FreeMem(Block);
477 end;
478
479 function zlibCheck(code: Integer): Integer;
480 begin
481 Result := code;
482 if code < 0 then
483 raise EZlibError.Create('error'); //!!
484 end;
485
486 function CCheck(code: Integer): Integer;
487 begin
488 Result := code;
489 if code < 0 then
490 raise ECompressionError.Create('error'); //!!
491 end;
492
493 function DCheck(code: Integer): Integer;
494 begin
495 Result := code;
496 if code < 0 then
497 raise EDecompressionError.Create('error'); //!!
498 end;
499
500 procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
501 out OutBuf: Pointer; out OutBytes: Integer);
502 var
503 strm: TZStreamRec;
504 P: Pointer;
505 begin
506 FillChar(strm, sizeof(strm), 0);
507 OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
508 GetMem(OutBuf, OutBytes);
509 try
510 strm.next_in := InBuf;
511 strm.avail_in := InBytes;
512 strm.next_out := OutBuf;
513 strm.avail_out := OutBytes;
514 CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)));
515 try
516 while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
517 begin
518 P := OutBuf;
519 Inc(OutBytes, 256);
520 ReallocMem(OutBuf, OutBytes);
521 strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
522 strm.avail_out := 256;
523 end;
524 finally
525 CCheck(deflateEnd(strm));
526 end;
527 ReallocMem(OutBuf, strm.total_out);
528 OutBytes := strm.total_out;
529 except
530 FreeMem(OutBuf);
531 raise
532 end;
533 end;
534
535
536 procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
537 OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
538 var
539 strm: TZStreamRec;
540 P: Pointer;
541 BufInc: Integer;
542 begin
543 FillChar(strm, sizeof(strm), 0);
544 BufInc := (InBytes + 255) and not 255;
545 if OutEstimate = 0 then
546 OutBytes := BufInc
547 else
548 OutBytes := OutEstimate;
549 GetMem(OutBuf, OutBytes);
550 try
551 strm.next_in := InBuf;
552 strm.avail_in := InBytes;
553 strm.next_out := OutBuf;
554 strm.avail_out := OutBytes;
555 DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
556 try
557 while DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do
558 begin
559 P := OutBuf;
560 Inc(OutBytes, BufInc);
561 ReallocMem(OutBuf, OutBytes);
562 strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
563 strm.avail_out := BufInc;
564 end;
565 finally
566 DCheck(inflateEnd(strm));
567 end;
568 ReallocMem(OutBuf, strm.total_out);
569 OutBytes := strm.total_out;
570 except
571 FreeMem(OutBuf);
572 raise
573 end;
574 end;
575
576
577 // TCustomZlibStream
578
579 constructor TCustomZLibStream.Create(Strm: TStream);
580 begin
581 inherited Create;
582 FStrm := Strm;
583 FStrmPos := Strm.Position;
584 end;
585
586 procedure TCustomZLibStream.Progress(Sender: TObject);
587 begin
588 if Assigned(FOnProgress) then FOnProgress(Sender);
589 end;
590
591
592 // TCompressionStream
593
594 constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
595 Dest: TStream);
596 const
597 Levels: array [TCompressionLevel] of ShortInt =
598 (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
599 begin
600 inherited Create(Dest);
601 FZRec.next_out := FBuffer;
602 FZRec.avail_out := sizeof(FBuffer);
603 CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
604 end;
605
606 destructor TCompressionStream.Destroy;
607 begin
608 FZRec.next_in := nil;
609 FZRec.avail_in := 0;
610 try
611 if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
612 while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
613 and (FZRec.avail_out = 0) do
614 begin
615 FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
616 FZRec.next_out := FBuffer;
617 FZRec.avail_out := sizeof(FBuffer);
618 end;
619 if FZRec.avail_out < sizeof(FBuffer) then
620 FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
621 finally
622 deflateEnd(FZRec);
623 end;
624 inherited Destroy;
625 end;
626
Readnull627 function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
628 begin
629 raise ECompressionError.Create('Invalid stream operation');
630 end;
631
Writenull632 function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
633 begin
634 FZRec.next_in := @Buffer;
635 FZRec.avail_in := Count;
636 if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
637 while (FZRec.avail_in > 0) do
638 begin
639 CCheck(deflate(FZRec, 0));
640 if FZRec.avail_out = 0 then
641 begin
642 FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
643 FZRec.next_out := FBuffer;
644 FZRec.avail_out := sizeof(FBuffer);
645 FStrmPos := FStrm.Position;
646 Progress(Self);
647 end;
648 end;
649 Result := Count;
650 end;
651
Seeknull652 function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
653 begin
654 if (Offset = 0) and (Origin = soFromCurrent) then
655 Result := FZRec.total_in
656 else
657 raise ECompressionError.Create('Invalid stream operation');
658 end;
659
GetCompressionRatenull660 function TCompressionStream.GetCompressionRate: Single;
661 begin
662 if FZRec.total_in = 0 then
663 Result := 0
664 else
665 Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
666 end;
667
668
669 // TDecompressionStream
670
671 constructor TDecompressionStream.Create(Source: TStream);
672 begin
673 inherited Create(Source);
674 FZRec.next_in := FBuffer;
675 FZRec.avail_in := 0;
676 DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
677 end;
678
679 destructor TDecompressionStream.Destroy;
680 begin
681 inflateEnd(FZRec);
682 inherited Destroy;
683 end;
684
Readnull685 function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
686 begin
687 FZRec.next_out := @Buffer;
688 FZRec.avail_out := Count;
689 if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
690 while (FZRec.avail_out > 0) do
691 begin
692 if FZRec.avail_in = 0 then
693 begin
694 FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
695 if FZRec.avail_in = 0 then
696 begin
697 Result := Count - FZRec.avail_out;
698 Exit;
699 end;
700 FZRec.next_in := FBuffer;
701 FStrmPos := FStrm.Position;
702 Progress(Self);
703 end;
704 DCheck(inflate(FZRec, 0));
705 end;
706 Result := Count;
707 end;
708
Writenull709 function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
710 begin
711 raise EDecompressionError.Create('Invalid stream operation');
712 end;
713
Seeknull714 function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
715 var
716 I: Integer;
717 Buf: array [0..4095] of Char;
718 begin
719 if (Offset = 0) and (Origin = soFromBeginning) then
720 begin
721 DCheck(inflateReset(FZRec));
722 FZRec.next_in := FBuffer;
723 FZRec.avail_in := 0;
724 FStrm.Position := 0;
725 FStrmPos := 0;
726 end
727 else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
728 ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
729 begin
730 if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
731 if Offset > 0 then
732 begin
733 for I := 1 to Offset div sizeof(Buf) do
734 ReadBuffer(Buf, sizeof(Buf));
735 ReadBuffer(Buf, Offset mod sizeof(Buf));
736 end;
737 end
738 else
739 raise EDecompressionError.Create('Invalid stream operation');
740 Result := FZRec.total_out;
741 end;
742
743 end.
744