home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kompon / d5 / cak / CAKDIR.ZIP / Cabinet.pas next >
Pascal/Delphi Source File  |  2001-05-01  |  38KB  |  1,278 lines
  1.  {++
  2.  
  3. c a b i n e t . p a s
  4. Copyright (c) 1997 by Alexander Staubo, all rights reserved.
  5.  
  6. Abstract:
  7.  
  8.   Class framework wrapping around the Microsoft Cabinet SDK FCI and FDI
  9.   interfaces.
  10.  
  11.   Known issues:
  12.  
  13.   - Stream errors are not converted to error codes. Error handling in default
  14.     file handler/sevent handlers is strictly rudimentary. Exceptions are raised
  15.     upon API errors and are not handled responsibly.
  16.  
  17.   - Only one TCabinetReader instance can be active at any time, due to a sordid
  18.     little limitation in the FDI API.
  19.  
  20.   - fdintENUMERATE notification message is not handled in this version.
  21.  
  22.   - Error codes in exceptions are not expanded into descriptive strings.
  23.  
  24.   About event handlers:
  25.  
  26.   The default event handlers of TCabinetReader and TCabinetWriter lessen the
  27.   work of performing common CAB ops for file-system-based cabinets, but
  28.   assume file handles are Win32 file handles; so they are incompatible with
  29.   non-file cabinet file handlers by default. This behaviour is controlled by
  30.   the FileSupport property of either object; turning this off disables the
  31.   file-handle support. For more information, see the component declarations
  32.   below.
  33.  
  34.   The default implementation of OnGetTempFile uses the first three characters
  35.   in the module file name for the temporary file name.
  36.  
  37. Revision history:
  38.  
  39.   26/12/1997 02:57  alexs  1.0
  40.     Initial release
  41.  
  42. --}
  43.  
  44. unit Cabinet;
  45.  
  46. interface
  47.  
  48. uses
  49.   Classes, SysUtils, Windows,fci,fdi;
  50.  
  51. { Options for adding files }
  52.  
  53. type
  54.   TAddFileOption =
  55.     (
  56.       afoExecuteOnExtract
  57.     );
  58.  
  59.   TAddFileOptions = set of TAddFileOption;
  60.  
  61. { File type }
  62.  
  63.   TFileType =
  64.     (
  65.       ftCabinet,
  66.       ftSource,
  67.       ftDestination
  68.     );
  69.  
  70. { Compression type }
  71.  
  72.   TCompressionType =
  73.     (
  74.       ctNone,
  75.       ctMsZip,
  76.       ctQuantum,
  77.       ctLzx
  78.     );
  79.  
  80. { Parameters for compression }
  81.  
  82.   TCompressionParameters =
  83.     record
  84.       Compression : TCompressionType;
  85.       LzxLevel : 15..21;
  86.       QuantumLevel : 1..7;
  87.       QuantumMemory : 10..21;
  88.     end;
  89.  
  90. { CPU type for use in decompression }
  91.  
  92.   TCpuType =
  93.     (
  94.       cptAuto,
  95.       cpt80286,
  96.       cpt80386
  97.     );
  98.  
  99. { Action to take when copying file }
  100.  
  101.   TFileCopyAction =
  102.     (
  103.       fcaAbort,
  104.       fcaSkip,
  105.       fcaCopy,
  106.       fcaDefaultCopy
  107.     );
  108.  
  109. { Class forwards }
  110.  
  111.   TCabinetInterface = class;
  112.  
  113. { Writer events }
  114.  
  115.   TFileStatusEvent = procedure (Sender : TObject; CompressedSize,
  116.     UncompressedSize : Longint; var ResultCode : Integer) of object;
  117.  
  118.   TFolderStatusEvent = procedure (Sender : TObject; SizeCopied,
  119.     TotalSize : Longint; var ResultCode : Integer) of object;
  120.  
  121.   TCabinetStatusEvent = procedure (Sender : TObject; PreEstimatedSize,
  122.     ActualSize : Longint; var WantedSize : Longint) of object;
  123.  
  124.   TGetNextCabinetEvent = procedure (Sender : TObject;
  125.     var CabParameters : TCCAB; var NewCabFileName : string;
  126.     PreviousCabEstimatedSize : Longint; var AbortCreation : Boolean) of object;
  127.  
  128.   TFilePlacedEvent = procedure (Sender : TObject; var CabParameters : TCCAB;
  129.     const FileName : string; FileLength : Longint; Continuation : Boolean;
  130.     var AbortProcessing : Boolean) of object;
  131.  
  132.   TGetTempFileEvent = procedure (Sender : TObject; var TempFileName : string; 
  133.     var Success : Boolean) of object;
  134.  
  135.   TGetOpenInfoEvent = procedure (Sender : TObject; const FileName : string;
  136.     var Date, Time, Attributes : Smallint; var FileHandle,
  137.     ResultCode : Longint) of object;
  138.  
  139. { Reader events }
  140.  
  141.   TCabinetInfoEvent = procedure (Sender : TObject; const CabinetName,
  142.     CabinetDisk, CabinetPath : string; SetId, CabinetNumber : Longint;
  143.     var Abort : Boolean) of object;
  144.  
  145.   TPartialFileEvent = procedure (Sender : TObject; const FileName,
  146.     FirstCabinetName, FirstCabinetDisk : string;
  147.     var Abort : Boolean) of object;
  148.  
  149.   TCopyFileEvent = procedure (Sender : TObject; const FileName : string;
  150.     UncompressedSize : Longint; Date, Time, Attribs : Smallint;
  151.     var Action : TFileCopyAction; var DestFileHandle : Integer) of object;
  152.  
  153.   TCloseCopiedFileEvent = procedure (Sender : TObject; const FileName : string;
  154.     FileHandle : Integer; Date, Time, Attribs : Smallint;
  155.     FolderIndex : Integer; Execute : Boolean; var Abort : Boolean) of object;
  156.  
  157.   TNextCabinetEvent = procedure (Sender : TObject; const NextCabinetName,
  158.     NextCabinetDisk : string; var CabinetPath : string;
  159.     ErrorIndication : TFDIERROR; var Abort : Boolean) of object;
  160.  
  161. { Classes }
  162.  
  163.   { TCabinetFileHandler abstract class -- represents a cabinet-associated file
  164.     handler. The class is used for reading source files (when compressing), for
  165.     writing destination files (when decompressing) and for reading and writing
  166.     to the cabinet file being processed
  167.  
  168.     The methods mimick the behaviour of the C run-time library I/O API (_open,
  169.     _close, etc.) and must be implemented to accomodate these aspects. The API
  170.     has been augmented with an Win32 error code which is returned to the FCI
  171.     and FDI interfaces if they are filled in.
  172.  
  173.       Open
  174.         Open a file and return its file handle. The FileType parameter
  175.         specifies the type of file to open: source, destination or cabinet.
  176.  
  177.       Read
  178.         Read from an opened file.
  179.  
  180.       Write
  181.         Write to an opened file.
  182.  
  183.       Close
  184.         Close an opened file.
  185.  
  186.       Seek
  187.         Seek to a position in an opened file.
  188.  
  189.       Delete
  190.         Delete a file. }
  191.  
  192.   TCabinetFileHandler =
  193.     class(TComponent)
  194.     public
  195.       function Open (const FileName : string; OpenFlag, OpenMode : Integer;
  196.         var Error : Integer; FileType : TFileType) : Integer; virtual;
  197.         abstract;
  198.       function Read (FileHandle : Integer; var Buffer;
  199.         Count : Integer; var Error : Integer) : Integer; virtual; abstract;
  200.       function Write (FileHandle : Integer; var Buffer;
  201.         Count : Integer; var Error : Integer) : Integer; virtual; abstract;
  202.       function Close (FileHandle : Integer; var Error : Integer)
  203.         : Integer; virtual; abstract;
  204.       function Seek (FileHandle : Integer; Distance : Longint;
  205.         SeekType : Integer; var Error : Integer) : Integer; virtual; abstract;
  206.       function Delete (const FileName : string; var Error : Integer)
  207.         : Integer; virtual; abstract;
  208.     end;
  209.  
  210.   { TStreamCabinetFileHandler class -- uses a collection of streams for
  211.     handling file access. The streams are accessed in the file system }
  212.  
  213.   TStreamCabinetFileHandler =
  214.     class(TCabinetFileHandler)
  215.     protected
  216.       FStreams : TList;
  217.       function FindStream (Handle : Integer) : TStream;
  218.     public
  219.       constructor Create (AOwner : TComponent); override;
  220.       destructor Destroy; override;
  221.       function Open (const FileName : string; OpenFlag, OpenMode : Integer;
  222.         var Error : Integer; FileType : TFileType) : Integer; override;
  223.       function Read (FileHandle : Integer; var Buffer;
  224.         Count : Integer; var Error : Integer) : Integer; override;
  225.       function Write (FileHandle : Integer; var Buffer;
  226.         Count : Integer; var Error : Integer) : Integer; override;
  227.       function Close (FileHandle : Integer; var Error : Integer) : Integer;
  228.         override;
  229.       function Seek (FileHandle : Integer; Distance : Longint;
  230.         SeekType : Integer; var Error : Integer) : Integer; override;
  231.       function Delete (const FileName : string; var Error : Integer) : Integer;
  232.         override;
  233.     end;
  234.  
  235.   { TCabinetInterface base class -- abstract cabinet interface.
  236.  
  237.       CabCheck
  238.         Check the result of a cabinet operation, and raise an ECabinetError
  239.         exception if the error buffer contains an error }
  240.  
  241.   TCabinetInterface =
  242.     class(TComponent)
  243.     protected
  244.       FErrorBuffer : TERF;
  245.       FFileHandler : TCabinetFileHandler;
  246.       procedure CabCheck (Result : Boolean);
  247.     public
  248.       property FileHandler : TCabinetFileHandler read FFileHandler write FFileHandler;
  249.     end;
  250.  
  251.   { TCabinetWriter class -- for compressing files into a new cabinet file
  252.  
  253.       DoFileStatus
  254.       DoFolderStatus
  255.       DoCabinetStatus
  256.       DoGetNextCabinet
  257.       DoFilePlaced
  258.       DoGetTempFile
  259.       DoGetOpenInfo
  260.         The virtual equivalents of their respective event handlers
  261.         (OnFileStatus etc.). These implement the minimal functionality required
  262.         for creating cabinets in the file system. In order to work with
  263.         non-file-system data, such as memory-mapped files or custom streams,
  264.         they must be overridden, or the event handlers assigned, to provide
  265.         the additional functionality
  266.  
  267.       Open
  268.         Create a cabinet file for compression. CabinetFileName specifies the
  269.         file name. DiskName specifies the initial disk name (may be empty).
  270.         MaximumCabSize specifies the maximum size of the cabinet.
  271.         FolderThreshold specifies the folder threshold, which seems to be the
  272.         size, in bytes, of each logical cabinet folder. SetId specifies an
  273.         application-specific identifier that is stored in the cabinet
  274.  
  275.       Close
  276.         Close the cabinet
  277.  
  278.       AddFile
  279.         Add a file to the opened cabinet. SourceFileName specifies the name of
  280.         the file to add. DestFileName specifies the name as it is stored in the
  281.         cabinet. Specify afoExecuteOnExtract for Options if the file should be
  282.         executed upon extraction. Compression specifies the compression
  283.         parameters; use the MakeNoCompression, MakeMsZipCompression and
  284.         MakeLzxCompression helper functions to construct a value
  285.  
  286.       FlushCabinet
  287.         Flush the cabinet. If GetNextCabinet is set to True, the
  288.         OnGetNextCabinet event is called to request further cabinet
  289.         information
  290.  
  291.       FlushFolder
  292.         Flush the current folder and reset the compression state data
  293.  
  294.     Properties:
  295.  
  296.       Context
  297.         The FCI context
  298.  
  299.       FailOnIncompressible
  300.         Fail compression if a file is found to be incompressible (compressed
  301.         size exceeds uncompressed size)
  302.  
  303.     Events:
  304.  
  305.       OnFileStatus
  306.       OnFolderStatus
  307.       OnCabinetStatus
  308.       OnGetNextCabinet
  309.       OnFilePlacedEvent
  310.       OnGetOpenInfo
  311.       OnGetTempFile 
  312.   }
  313.  
  314.   TCabinetWriter =
  315.     class(TCabinetInterface)
  316.     protected
  317.       FContext : HFCI;
  318.       FFailOnIncompressible : Boolean;
  319.       FFileSupport : Boolean;
  320.       FOnFileStatus : TFileStatusEvent;
  321.       FOnFolderStatus : TFolderStatusEvent;
  322.       FOnCabinetStatus : TCabinetStatusEvent;
  323.       FOnGetNextCabinet : TGetNextCabinetEvent;
  324.       FOnFilePlacedEvent : TFilePlacedEvent;
  325.       FOnGetOpenInfo : TGetOpenInfoEvent;
  326.       FOnGetTempFile : TGetTempFileEvent;
  327.       procedure DoFileStatus (CompressedSize, UncompressedSize : Longint;
  328.         var ResultCode : Integer); virtual;
  329.       procedure DoFolderStatus (SizeCopied, TotalSize : Longint;
  330.         var ResultCode : Integer); virtual;
  331.       procedure DoCabinetStatus (PreEstimatedSize, ActualSize : Longint;
  332.         var WantedSize : Longint); virtual;
  333.       procedure DoGetNextCabinet (var CabParameters : TCCAB;
  334.         var NewCabFileName : string; PreviousCabEstimatedSize : Longint;
  335.         var AbortCreation : Boolean); virtual;
  336.       procedure DoFilePlaced (var CabParameters : TCCAB;
  337.         const FileName : string; FileLength : Longint; Continuation : Boolean;
  338.         var AbortProcessing : Boolean); virtual;
  339.       procedure DoGetTempFile (var TempFileName : string;
  340.         var Success : Boolean); virtual;
  341.       procedure DoGetOpenInfo (const FileName : string; var Date, Time,
  342.         Attributes : Smallint; var FileHandle, ResultCode : Longint); virtual;
  343.     public
  344.       constructor Create (AOwner : TComponent); override;
  345.       destructor Destroy; override;
  346.       procedure Open (const CabinetFileName, DiskName : string;
  347.         MaximumCabSize, FolderThreshold, SetId : Longint);
  348.       procedure Close;
  349.       procedure AddFile (const SourceFileName, DestFileName : string;
  350.         const Options : TAddFileOptions;
  351.         const Compression : TCompressionParameters);
  352.       procedure FlushCabinet (GetNextCabinet : Boolean);
  353.       procedure FlushFolder;
  354.       property Context : HFCI read FContext;
  355.     published
  356.       property FailOnIncompressible : Boolean read FFailOnIncompressible
  357.         write FFailOnIncompressible default True;
  358.       property FileSupport : Boolean read FFileSupport write FFileSupport
  359.         default True;
  360.       property OnFileStatus : TFileStatusEvent read FOnFileStatus
  361.         write FOnFileStatus;
  362.       property OnFolderStatus : TFolderStatusEvent read FOnFolderStatus
  363.         write FOnFolderStatus;
  364.       property OnCabinetStatus : TCabinetStatusEvent read FOnCabinetStatus
  365.         write FOnCabinetStatus;
  366.       property OnGetNextCabinet : TGetNextCabinetEvent read FOnGetNextCabinet
  367.         write FOnGetNextCabinet;
  368.       property OnFilePlacedEvent : TFilePlacedEvent read FOnFilePlacedEvent
  369.         write FOnFilePlacedEvent;
  370.       property OnGetOpenInfo : TGetOpenInfoEvent read FOnGetOpenInfo
  371.         write FOnGetOpenInfo;
  372.       property OnGetTempFile : TGetTempFileEvent read FOnGetTempFile
  373.         write FOnGetTempFile;
  374.       property FileHandler;
  375.     end;
  376.  
  377.   { TCabinetReader class -- for decompressing files from an existing cabinet
  378.     file
  379.  
  380.       Open
  381.         Opens a cabinet for reading. The associated file handler specified in
  382.         the FileHandler property is used to open the cabinet. The return value
  383.         is True if the specified file is a valid cabinet file, False if not }
  384.  
  385.   TCabinetReader =
  386.     class(TCabinetInterface)
  387.     protected
  388.       FContext : HFDI;
  389.       FCpuType : TCpuType;
  390.       FDestinationPath : string;
  391.       FOnCabinetInfo : TCabinetInfoEvent;
  392.       FOnPartialFile : TPartialFileEvent;
  393.       FOnCopyFile : TCopyFileEvent;
  394.       FOnCloseCopiedFile : TCloseCopiedFileEvent;
  395.       FOnNextCabinet : TNextCabinetEvent;
  396.       FFileSupport : Boolean;
  397.       procedure DestroyContext;
  398.       procedure ContextNeeded;
  399.       procedure DoCabinetInfo (const CabinetName, CabinetDisk,
  400.         CabinetPath : string; SetId, CabinetNumber : Longint;
  401.         var Abort : Boolean); virtual;
  402.       procedure DoPartialFile (const FileName, FirstCabinetName,
  403.         FirstCabinetDisk : string; var Abort : Boolean); virtual;
  404.       procedure DoCopyFile (const FileName : string;
  405.         UncompressedSize : Longint; Date, Time, Attribs : Smallint;
  406.         var Action : TFileCopyAction; var DestFileHandle : Integer); virtual;
  407.       procedure DoCloseCopiedFile (const FileName : string;
  408.         FileHandle : Integer; Date, Time, Attribs : Smallint;
  409.         FolderIndex : Integer; Execute : Boolean; var Abort : Boolean);
  410.         virtual;
  411.       procedure DoNextCabinet (const NextCabinetName, NextCabinetDisk : string;
  412.         var CabinetPath : string; ErrorIndication : TFDIERROR;
  413.         var Abort : Boolean); virtual;
  414.     public
  415.       constructor Create (AOwner : TComponent); override;
  416.       destructor Destroy; override;
  417.       function IsCabinet (const FileName : string;
  418.         var CabInfo : TFDICABINETINFO) : Boolean;
  419.       procedure ExtractFiles (const FileName, DestinationPath : string;
  420.         Flags : Integer);
  421.       property Context : HFDI read FContext;
  422.     published
  423.       property CpuType : TCpuType read FCpuType write FCpuType;
  424.       property DestinationPath : string read FDestinationPath;
  425.       property FileSupport : Boolean read FFileSupport write FFileSupport
  426.         default True;
  427.       property OnCabinetInfo : TCabinetInfoEvent read FOnCabinetInfo
  428.         write FOnCabinetInfo; 
  429.       property OnPartialFile : TPartialFileEvent read FOnPartialFile
  430.         write FOnPartialFile;
  431.       property OnCopyFile : TCopyFileEvent read FOnCopyFile write FOnCopyFile;
  432.       property OnCloseCopiedFile : TCloseCopiedFileEvent
  433.         read FOnCloseCopiedFile write FOnCloseCopiedFile;
  434.       property OnNextCabinet : TNextCabinetEvent read FOnNextCabinet
  435.         write FOnNextCabinet;
  436.       property FileHandler;
  437.     end;
  438.  
  439. { Exceptions }
  440.  
  441.   ECabinetError =
  442.     class(Exception)
  443.       ErrorCode : Integer;
  444.       ErrorType : Integer;
  445.     end;
  446.  
  447. { Function declarations }
  448.  
  449. function MakeNoCompression : TCompressionParameters;
  450.  
  451. function MakeMsZipCompression : TCompressionParameters;
  452.  
  453. function MakeLzxCompression (Level : Integer) : TCompressionParameters;
  454.  
  455. procedure RaiseCabinetError (ErrorCode, ErrorType : Integer);
  456.  
  457. procedure CheckErf (Erf : TERF);
  458.  
  459. { Registration }
  460.  
  461. procedure Register;
  462.  
  463. implementation
  464.  
  465. uses
  466.   Utility, Fcntl;
  467.  
  468. { Private declarations }
  469.  
  470. type
  471.   TCabinetProcRec =
  472.     record
  473.       { FCI/FDI }
  474.       FciAlloc : PFNFCIALLOC;
  475.       FciFree : PFNFCIFREE;
  476.       { FCI }
  477.       FciOpen : PFNFCIOPEN;
  478.       FciRead : PFNFCIREAD;
  479.       FciWrite : PFNFCIWRITE;
  480.       FciClose : PFNFCICLOSE;
  481.       FciSeek : PFNFCISEEK;
  482.       FciDelete : PFNFCIDELETE;
  483.       FciGetTempFile : PFNFCIGETTEMPFILE;
  484.       FciFilePlaced : PFNFCIFILEPLACED;
  485.       FciGetNextCabinet : PFNFCIGETNEXTCABINET;
  486.       FciStatus : PFNFCISTATUS;
  487.       FciGetOpenInfo : PFNFCIGETOPENINFO;
  488.       { FDI }
  489.       FdiOpen : PFNOPEN;
  490.       FdiRead : PFNREAD;
  491.       FdiWrite : PFNWRITE;
  492.       FdiClose : PFNCLOSE;
  493.       FdiSeek : PFNSEEK;
  494.       FdiNotify : PFNFDINOTIFY;
  495.     end;
  496.  
  497. { Standard FCI/FDI procs }
  498.  
  499. function StdFciAlloc (cb : TULONG) : PVoid; cdecl;
  500. begin
  501.   GetMem(Result, cb);
  502. end;
  503.  
  504. function StdFciFree (memory : PVoid) : Pointer; cdecl;
  505. begin
  506.   FreeMem(memory);
  507.   Result:=nil;  //!! Correct?
  508. end;
  509.  
  510. { Standard FCI procs for TCabinetWriter }
  511.  
  512. function StdFciOpen (pszFile : PChar; oflag : Integer; pmode : Integer;
  513.   err : PInteger; pv : Pointer) : Integer; cdecl;
  514. begin
  515.   err^:=0;
  516.   Result:=TCabinetInterface(pv).FileHandler.Open(string(pszFile), oflag, pmode,
  517.     err^, ftCabinet);
  518. end;
  519.  
  520. function StdFciRead (hf : Integer; memory : PVoid; cb : TUINT;
  521.   err : PInteger; pv : Pointer) : TUINT; cdecl;
  522. begin
  523.   err^:=0;
  524.   Result:=TCabinetInterface(pv).FileHandler.Read(hf, memory^, cb, err^);
  525. end;
  526.  
  527. function StdFciWrite (hf : Integer; memory : PVoid; cb : TUINT;
  528.   err : PInteger; pv : Pointer) : TUINT; cdecl;
  529. begin
  530.   err^:=0;
  531.   Result:=TCabinetInterface(pv).FileHandler.Write(hf, memory^, cb, err^);
  532. end;
  533.  
  534. function StdFciClose (hf : Integer; err : PInteger; pv : Pointer) :
  535.   Integer; cdecl;
  536. begin
  537.   err^:=0;
  538.   Result:=TCabinetInterface(pv).FileHandler.Close(hf, err^);
  539. end;
  540.  
  541. function StdFciSeek (hf : Integer; dist : Longint; seektype : Integer;
  542.   err : PInteger; pv : Pointer) : Longint; cdecl;
  543. begin
  544.   err^:=0;
  545.   Result:=TCabinetInterface(pv).FileHandler.Seek(hf, dist, seektype, err^);
  546. end;
  547.  
  548. function StdFciDelete (pszFile : PChar; err : PInteger; pv : Pointer) :
  549.   Integer; cdecl;
  550. begin
  551.   err^:=0;
  552.   Result:=TCabinetWriter(pv).FileHandler.Delete(string(pszFile), err^);
  553. end;
  554.  
  555. function StdFciGetTempFile (pszTempName : PChar; cbTempName : Integer;
  556.   pv : Pointer) : Bool; cdecl;
  557. var
  558.   Buffer : string;
  559.   Success : Boolean;
  560. begin
  561.   Buffer:='';
  562.   TCabinetWriter(pv).DoGetTempFile(Buffer, Success);
  563.   if Success and (Length(Buffer) < cbTempName) then
  564.   begin
  565.     StrLCopy(pszTempName, PChar(Buffer), cbTempName - 1);
  566.     Result:=True;
  567.   end
  568.   else
  569.     Result:=False;
  570. end;
  571.  
  572. function StdFciFilePlaced (pccab : PCCAB; pszFile : PChar;
  573.   cbFile : Longint; fContinuation : Bool; pv : Pointer) : Integer; cdecl;
  574. var
  575.   Abort : Boolean;
  576. begin
  577.   Abort:=False;
  578.   TCabinetWriter(pv).DoFilePlaced(pccab^, string(pszFile), cbFile,
  579.     Boolean(fContinuation), Abort);
  580.   if Abort then
  581.     Result:=-1
  582.   else
  583.     Result:=0;
  584. end;
  585.  
  586. function StdFciGetOpenInfo (pszName : PChar; var pdate : TUSHORT;
  587.   var ptime : TUSHORT; var pattribs : TUSHORT; err : PInteger;
  588.   pv : Pointer) : Integer; cdecl;
  589. var
  590.   FileHandle : Integer;
  591. begin
  592.   FileHandle:=0;
  593.   TCabinetWriter(pv).DoGetOpenInfo(string(pszName), pdate, ptime, pattribs,
  594.     FileHandle, err^);
  595.   if err^ <> 0 then
  596.     Result:=-1
  597.   else
  598.     Result:=FileHandle;
  599. end;
  600.  
  601. function StdFciGetNextCabinet (pccab : PCCAB; cbPrevCab : TULONG;
  602.   pv : Pointer) : Bool; cdecl;
  603. var
  604.   Abort : Boolean;
  605.   NewFileName : string;
  606. begin
  607.   Abort:=True;
  608.   NewFileName:='';
  609.   TCabinetWriter(pv).DoGetNextCabinet(pccab^, NewFileName, cbPrevCab, Abort);
  610.   if Abort then
  611.   begin
  612.     Result:=False;
  613.     Exit;
  614.   end;
  615.   StrCopy(pccab^.szCab, PChar(ExtractFileName(NewFileName)));
  616.   StrCopy(pccab^.szCabPath, PChar(ExtractFilePath(NewFileName)));
  617.   Result:=True;
  618. end;
  619.  
  620. function StdFciStatus (typeStatus : TUINT; cb1 : TULONG; cb2 : TULONG;
  621.   pv : Pointer) : Longint; cdecl;
  622. var
  623.   rc : Integer;
  624. begin
  625.   rc:=0;
  626.   case typeStatus of
  627.     statusFile :
  628.       TCabinetWriter(pv).DoFileStatus(cb1, cb2, rc);
  629.     statusFolder :
  630.       TCabinetWriter(pv).DoFolderStatus(cb1, cb2, rc);
  631.     statusCabinet :
  632.       TCabinetWriter(pv).DoCabinetStatus(cb1, cb2, rc);
  633.   else
  634.     rc:=-1;
  635.   end;
  636.   Result:=rc;
  637. end;
  638.  
  639. { Standard FDI procs for TCabinetWriter }
  640.  
  641. var
  642.   GlobCabinetReader : TCabinetReader = nil;
  643.  
  644. function StdFdiOpen (pszFile : PChar; oflag : Integer; pmode : Integer)
  645.   : Integer; cdecl;
  646. var
  647.   ErrorCode : Integer;
  648. begin
  649.   Result:=GlobCabinetReader.FileHandler.Open(string(pszFile), oflag, pmode,
  650.     ErrorCode, ftCabinet);
  651. end;
  652.  
  653. function StdFdiRead (hf : Integer; memory : PVoid; cb : TUINT) : TUINT; cdecl;
  654. var
  655.   ErrorCode : Integer;
  656. begin
  657.   Result:=GlobCabinetReader.FileHandler.Read(hf, memory^, cb, ErrorCode);
  658. end;
  659.  
  660. function StdFdiWrite (hf : Integer; memory : PVoid; cb : TUINT) : TUINT; cdecl;
  661. var
  662.   ErrorCode : Integer;
  663. begin
  664.   Result:=GlobCabinetReader.FileHandler.Write(hf, memory^, cb, ErrorCode);
  665. end;
  666.  
  667. function StdFdiClose (hf : Integer) : Integer; cdecl;
  668. var
  669.   ErrorCode : Integer;
  670. begin
  671.   Result:=GlobCabinetReader.FileHandler.Close(hf, ErrorCode);
  672. end;
  673.  
  674. function StdFdiSeek (hf : Integer; dist : Longint; seektype : Integer)
  675.   : Longint; cdecl;
  676. var
  677.   ErrorCode : Integer;
  678. begin
  679.   Result:=GlobCabinetReader.FileHandler.Seek(hf, dist, seektype,
  680.     ErrorCode);
  681. end;
  682.  
  683. function StdFdiNotify (fdint : TFDINOTIFICATIONTYPE; pfdin : PFDINOTIFICATION)
  684.   : Integer; cdecl;
  685. var
  686.   Abort : Boolean;
  687.   Action : TFileCopyAction;
  688.   Handle : Integer;
  689.   CabPath : string;
  690. begin
  691.   Abort:=False;
  692.   case fdint of
  693.     fdintCABINET_INFO :
  694.       TCabinetReader(pfdin^.pv).DoCabinetInfo(string(pfdin^.psz1),
  695.         string(pfdin^.psz2), string(pfdin^.psz3), pfdin^.setID,
  696.         pfdin^.iCabinet, Abort);
  697.     fdintPARTIAL_FILE :
  698.       TCabinetReader(pfdin^.pv).DoPartialFile(string(pfdin^.psz1),
  699.         string(pfdin^.psz2), string(pfdin^.psz3), Abort);
  700.     fdintCOPY_FILE :
  701.       begin
  702.         TCabinetReader(pfdin^.pv).DoCopyFile(string(pfdin^.psz1),
  703.           pfdin^.cb, pfdin^.date, pfdin^.time, pfdin^.attribs, Action, Handle);
  704.         if Action = fcaCopy then
  705.           Result:=Handle
  706.         else
  707.           Result:=Integer(Action) - 1;
  708.         Exit;
  709.       end;
  710.     fdintCLOSE_FILE_INFO :
  711.       begin
  712.         TCabinetReader(pfdin^.pv).DoCloseCopiedFile(string(pfdin^.psz1),
  713.           pfdin^.hf, pfdin^.date, pfdin^.time, pfdin^.attribs, pfdin^.iFolder,
  714.           pfdin^.cb = 1, Abort);
  715.         if not Abort then
  716.         begin
  717.           Result:=1;
  718.           Exit;
  719.         end;
  720.       end;
  721.     fdintNEXT_CABINET :
  722.       begin
  723.         CabPath:=string(pfdin^.psz3);
  724.         TCabinetReader(pfdin^.pv).DoNextCabinet(string(pfdin^.psz1),
  725.           string(pfdin^.psz2), CabPath, pfdin^.fdie, Abort);
  726.         StrLCopy(pfdin^.psz3, PChar(CabPath), SizeOf(pfdin^.psz3) - 1);
  727.       end;
  728.     fdintENUMERATE :
  729.       ;
  730.   end;
  731.   if Abort then
  732.     Result:=-1
  733.   else
  734.     Result:=0;
  735. end;
  736.  
  737. { Cabinet procs }
  738.  
  739. const
  740.   StdCabinetProcs : TCabinetProcRec =
  741.     (
  742.       FciAlloc : StdFciAlloc;
  743.       FciFree : StdFciFree;
  744.       FciOpen : StdFciOpen;
  745.       FciRead : StdFciRead;
  746.       FciWrite : StdFciWrite;
  747.       FciClose : StdFciClose;
  748.       FciSeek : StdFciSeek;
  749.       FciDelete : StdFciDelete;
  750.       FciGetTempFile : StdFciGetTempFile;
  751.       FciFilePlaced : StdFciFilePlaced;
  752.       FciGetNextCabinet : StdFciGetNextCabinet;
  753.       FciStatus : StdFciStatus;
  754.       FciGetOpenInfo : StdFciGetOpenInfo;
  755.       FdiOpen : StdFdiOpen;
  756.       FdiRead : StdFdiRead;
  757.       FdiWrite : StdFdiWrite;
  758.       FdiClose : StdFdiClose;
  759.       FdiSeek : StdFdiSeek;
  760.       FdiNotify : StdFdiNotify;
  761.     );
  762.  
  763. { TStreamCabinetFileHandler }
  764.  
  765. function TStreamCabinetFileHandler.FindStream (Handle : Integer) : TStream;
  766. var
  767.   I : Integer;
  768. begin
  769.   for I:=0 to FStreams.Count - 1 do
  770.     if TFileStream(FStreams.Items[I]).Handle = Handle then
  771.     begin
  772.       Result:=TStream(FStreams.Items[I]);
  773.       Exit;
  774.     end;
  775.   Result:=nil;
  776. end;
  777.  
  778. constructor TStreamCabinetFileHandler.Create (AOwner : TComponent);
  779. begin
  780.   inherited Create(AOwner);
  781.   FStreams:=TList.Create;
  782. end;
  783.  
  784. destructor TStreamCabinetFileHandler.Destroy;
  785. var
  786.   Stream : TStream;
  787. begin
  788.   while FStreams.Count > 0 do
  789.   begin
  790.     Stream:=FStreams.Last;
  791.     Stream.Free;
  792.     FStreams.Remove(Stream);
  793.   end;
  794.   inherited Destroy;
  795. end;
  796.  
  797. function TStreamCabinetFileHandler.Open (const FileName : string; OpenFlag,
  798.   OpenMode : Integer; var Error : Integer; FileType : TFileType) : Integer;
  799. var
  800.   Mode : Word;
  801.   Stream : TFileStream;
  802. begin
  803.   if OpenFlag and _O_CREAT <> 0 then
  804.     Mode:=fmCreate
  805.   else
  806.   begin
  807.     Mode:=0;
  808.     if OpenFlag and _O_WRONLY <> 0 then
  809.       Mode:=Mode or fmOpenWrite
  810.     else
  811.       Mode:=Mode or fmOpenRead;
  812.     if OpenFlag and _O_EXCL <> 0 then
  813.       Mode:=Mode or fmShareExclusive
  814.     else
  815.       Mode:=Mode or fmShareDenyNone;
  816.   end;
  817.   try
  818.     Stream:=TFileStream.Create(FileName, Mode);
  819.   except
  820.     on EFOpenError do
  821.     begin
  822.       Error:=GetLastError;
  823.       Result:=-1;
  824.       Exit;
  825.     end;
  826.     on EFCreateError do
  827.     begin
  828.       Error:=GetLastError;
  829.       Result:=-1;
  830.       Exit;
  831.     end;
  832.   end;
  833.   FStreams.Add(Stream);
  834.   Error:=0;
  835.   Result:=Stream.Handle;
  836. end;
  837.  
  838. function TStreamCabinetFileHandler.Read (FileHandle : Integer; var Buffer;
  839.   Count : Integer; var Error : Integer) : Integer;
  840. var
  841.   Stream : TStream;
  842. begin
  843.   Stream:=FindStream(FileHandle);
  844.   if Stream <> nil then
  845.   begin
  846.     Result:=Stream.Read(Buffer, Count);
  847.     if Result <> Count then
  848.       Error:=GetLastError
  849.     else
  850.       Error:=0;
  851.   end
  852.   else
  853.   begin
  854.     Error:=-1;
  855.     Result:=0;
  856.   end;
  857. end;
  858.  
  859. function TStreamCabinetFileHandler.Write (FileHandle : Integer; var Buffer;
  860.   Count : Integer; var Error : Integer) : Integer;
  861. var
  862.   Stream : TStream;
  863. begin
  864.   Stream:=FindStream(FileHandle);
  865.   if Stream <> nil then
  866.   begin
  867.     Result:=Stream.Write(Buffer, Count);
  868.     if Result <> Count then
  869.       Error:=GetLastError
  870.     else
  871.       Error:=0;
  872.   end
  873.   else
  874.   begin
  875.     Error:=-1;
  876.     Result:=0;
  877.   end;
  878. end;
  879.  
  880. function TStreamCabinetFileHandler.Close (FileHandle : Integer;
  881.   var Error : Integer) : Integer;
  882. var
  883.   Stream : TStream;
  884. begin
  885.   Stream:=FindStream(FileHandle);
  886.   if Stream <> nil then
  887.   begin
  888.     FStreams.Remove(Stream);
  889.     Stream.Free;
  890.   end;
  891.   Error:=0;
  892.   Result:=0;
  893. end;
  894.  
  895. function TStreamCabinetFileHandler.Seek (FileHandle : Integer;
  896.   Distance : Longint; SeekType : Integer; var Error : Integer) : Integer;
  897. var
  898.   Stream : TStream;
  899. begin
  900.   Stream:=FindStream(FileHandle);
  901.   if Stream <> nil then
  902.   begin
  903.     Result:=Stream.Seek(Distance, SeekType);
  904.     Error:=0;
  905.   end
  906.   else
  907.   begin
  908.     Error:=-1;
  909.     Result:=0;
  910.   end;
  911. end;
  912.  
  913. function TStreamCabinetFileHandler.Delete (const FileName : string;
  914.   var Error : Integer) : Integer;
  915. begin
  916.   if not DeleteFile(PChar(FileName)) then
  917.     Error:=GetLastError
  918.   else
  919.     Error:=0;
  920.   Result:=0;
  921. end;
  922.  
  923. { TCabinetInterface }
  924.  
  925. procedure TCabinetInterface.CabCheck (Result : Boolean);
  926. begin
  927.   if not Result then
  928.     CheckErf(FErrorBuffer);
  929. end;
  930.  
  931. { TCabinetWriter }
  932.  
  933. procedure TCabinetWriter.DoFileStatus (CompressedSize,
  934.   UncompressedSize : Longint; var ResultCode : Integer);
  935. begin
  936.   if Assigned(FOnFileStatus) then
  937.     FOnFileStatus(Self, CompressedSize, UncompressedSize, ResultCode);
  938. end;
  939.  
  940. procedure TCabinetWriter.DoFolderStatus (SizeCopied, TotalSize : Longint;
  941.   var ResultCode : Integer);
  942. begin
  943.   if Assigned(FOnFolderStatus) then
  944.     FOnFolderStatus(Self, SizeCopied, TotalSize, ResultCode);
  945. end;
  946.  
  947. procedure TCabinetWriter.DoCabinetStatus (PreEstimatedSize,
  948.   ActualSize : Longint; var WantedSize : Longint);
  949. begin
  950.   if Assigned(FOnCabinetStatus) then
  951.     FOnCabinetStatus(Self, PreEstimatedSize, ActualSize, WantedSize);
  952. end;
  953.  
  954. procedure TCabinetWriter.DoGetNextCabinet (var CabParameters : TCCAB;
  955.   var NewCabFileName : string; PreviousCabEstimatedSize : Longint;
  956.   var AbortCreation : Boolean);
  957. begin
  958.   if Assigned(FOnGetNextCabinet) then
  959.     FOnGetNextCabinet(Self, CabParameters, NewCabFileName,
  960.       PreviousCabEstimatedSize, AbortCreation);
  961. end;
  962.  
  963. procedure TCabinetWriter.DoFilePlaced (var CabParameters : TCCAB;
  964.   const FileName : string; FileLength : Longint; Continuation : Boolean;
  965.   var AbortProcessing : Boolean);
  966. begin
  967.   if Assigned(FOnFilePlacedEvent) then
  968.     FOnFilePlacedEvent(Self, CabParameters, FileName, FileLength, Continuation,
  969.       AbortProcessing);
  970. end;
  971.  
  972. procedure TCabinetWriter.DoGetTempFile (var TempFileName : string;
  973.   var Success : Boolean);
  974. begin
  975.   if Assigned(FOnGetTempFile) then
  976.     FOnGetTempFile(Self, TempFileName, Success)
  977.   else
  978.   begin
  979.     TempFileName:=GetTempFileNameStr(GetTempPathStr,
  980.       Copy(ExtractFileName(ParamStr(0)), 1, 3), 0);
  981.     Success:=True;
  982.   end
  983. end;
  984.  
  985. procedure TCabinetWriter.DoGetOpenInfo (const FileName : string; var Date,
  986.   Time, Attributes : Smallint; var FileHandle, ResultCode : Longint);
  987. var
  988.   FileTime : TFileTime;
  989. begin
  990.   if Assigned(FOnGetOpenInfo) then
  991.   begin
  992.     FOnGetOpenInfo(Self, FileName, Date, Time, Attributes, FileHandle,
  993.       ResultCode);
  994.   end
  995.   else
  996.   begin
  997.     if FFileSupport then
  998.     begin
  999.       Attributes:=Word(GetFileAttributes(PChar(FileName)));
  1000.       if Attributes = Word(-1) then
  1001.       begin
  1002.         ResultCode:=GetLastError;
  1003.         Exit;
  1004.       end;
  1005.     end
  1006.     else
  1007.       Attributes:=0;
  1008.     FileHandle:=FFileHandler.Open(FileName, _O_RDONLY or _O_BINARY, 0,
  1009.       ResultCode, ftSource);
  1010.     if ResultCode = 0 then
  1011.     begin
  1012.       Date:=0;
  1013.       Time:=0;
  1014.       if FFileSupport and GetFileTime(FileHandle, nil, nil, @FileTime) then
  1015.         FileTimeToDosDateTime(FileTime, Word(Date), Word(Time));
  1016.     end;
  1017.   end;
  1018. end;
  1019.  
  1020. constructor TCabinetWriter.Create (AOwner : TComponent);
  1021. begin
  1022.   inherited Create(AOwner);
  1023.   FFileSupport:=True;
  1024.   FFailOnIncompressible:=True;
  1025. end;
  1026.  
  1027. destructor TCabinetWriter.Destroy;
  1028. begin
  1029.   Close;
  1030.   inherited Destroy;
  1031. end;
  1032.  
  1033. procedure TCabinetWriter.Open (const CabinetFileName, DiskName : string;
  1034.   MaximumCabSize, FolderThreshold, SetId : Longint);
  1035. var
  1036.   Parameters : TCCAB;
  1037. begin
  1038.   Close;
  1039.   FillChar(Parameters, SizeOf(Parameters), 0);
  1040.   Parameters.cb:=MaximumCabSize;
  1041.   Parameters.cbFolderThresh:=FolderThreshold;
  1042.   Parameters.fFailOnIncompressible:=Integer(FFailOnIncompressible);
  1043.   Parameters.setID:=SetId;
  1044.   StrCopy(Parameters.szDisk, PChar(DiskName));
  1045.   StrCopy(Parameters.szCab, PChar(ExtractFileName(CabinetFileName)));
  1046.   StrCopy(Parameters.szCabPath, PChar(ExtractFilePath(CabinetFileName)));
  1047.   FContext:=FCICreate(@FErrorBuffer, StdCabinetProcs.FciFilePlaced,
  1048.     StdCabinetProcs.FciAlloc, StdCabinetProcs.FciFree, StdCabinetProcs.FciOpen,
  1049.     StdCabinetProcs.FciRead, StdCabinetProcs.FciWrite,
  1050.     StdCabinetProcs.FciClose, StdCabinetProcs.FciSeek,
  1051.     StdCabinetProcs.FciDelete, StdCabinetProcs.FciGetTempFile, @Parameters,
  1052.     Pointer(Self));
  1053.   CabCheck(FContext <> nil);
  1054. end;
  1055.  
  1056. procedure TCabinetWriter.Close;
  1057. begin
  1058.   if FContext <> nil then
  1059.   begin
  1060.     CabCheck(FCIDestroy(FContext));
  1061.     FContext:=nil;
  1062.   end;
  1063. end;
  1064.  
  1065. procedure TCabinetWriter.AddFile (const SourceFileName, DestFileName : string;
  1066.   const Options : TAddFileOptions; const Compression : TCompressionParameters);
  1067. var
  1068.   Compress : TCOMP;
  1069. begin
  1070.   Compress:=Integer(Compression.Compression);
  1071.   case Compression.Compression of
  1072.     ctQuantum :
  1073.       Compress:=Compress or
  1074.         (Compression.QuantumLevel shl tcompSHIFT_QUANTUM_LEVEL) or
  1075.         (Compression.QuantumMemory shl tcompSHIFT_QUANTUM_MEM);
  1076.     ctLzx :
  1077.       Compress:=Compress or (Compression.LzxLevel shl tcompSHIFT_LZX_WINDOW);
  1078.   end;
  1079.   CabCheck(FCIAddFile(FContext, PChar(SourceFileName), PChar(DestFileName),
  1080.     afoExecuteOnExtract in Options, StdCabinetProcs.FciGetNextCabinet,
  1081.     StdCabinetProcs.FciStatus, StdCabinetProcs.FciGetOpenInfo, Compress));
  1082. end;
  1083.  
  1084. procedure TCabinetWriter.FlushCabinet (GetNextCabinet : Boolean);
  1085. begin
  1086.   CabCheck(FCIFlushCabinet(FContext, GetNextCabinet,
  1087.     StdCabinetProcs.FciGetNextCabinet, StdCabinetProcs.FciStatus));
  1088. end;
  1089.  
  1090. procedure TCabinetWriter.FlushFolder;
  1091. begin
  1092.   CabCheck(FCIFlushFolder(FContext, StdCabinetProcs.FciGetNextCabinet,
  1093.     StdCabinetProcs.FciStatus));
  1094. end;
  1095.  
  1096. { TCabinetReader }
  1097.  
  1098. procedure TCabinetReader.DestroyContext;
  1099. begin
  1100.   if FContext <> nil then
  1101.   begin
  1102.     GlobCabinetReader:=Self;
  1103.     CabCheck(FDIDestroy(FContext));
  1104.     FContext:=nil;
  1105.   end;
  1106. end;
  1107.  
  1108. procedure TCabinetReader.ContextNeeded;
  1109. begin
  1110.   if FContext = nil then
  1111.   begin
  1112.     GlobCabinetReader:=Self;
  1113.     FContext:=FDICreate(StdCabinetProcs.FciAlloc, StdCabinetProcs.FciFree,
  1114.       StdCabinetProcs.FdiOpen, StdCabinetProcs.FdiRead,
  1115.       StdCabinetProcs.FdiWrite, StdCabinetProcs.FdiClose,
  1116.       StdCabinetProcs.FdiSeek, Integer(FCpuType) - 1, @FErrorBuffer);
  1117.     CabCheck(FContext <> nil);
  1118.   end;
  1119. end;
  1120.  
  1121. procedure TCabinetReader.DoCabinetInfo (const CabinetName, CabinetDisk,
  1122.   CabinetPath : string; SetId, CabinetNumber : Longint;
  1123.   var Abort : Boolean);
  1124. begin
  1125.   if Assigned(FOnCabinetInfo) then
  1126.     FOnCabinetInfo(Self, CabinetName, CabinetDisk, CabinetPath, SetId,
  1127.       CabinetNumber, Abort);
  1128. end;
  1129.  
  1130. procedure TCabinetReader.DoPartialFile (const FileName, FirstCabinetName,
  1131.   FirstCabinetDisk : string; var Abort : Boolean);
  1132. begin
  1133.   if Assigned(FOnPartialFile) then
  1134.     FOnPartialFile(Self, FileName, FirstCabinetName, FirstCabinetDisk, Abort);
  1135. end;
  1136.  
  1137. procedure TCabinetReader.DoCopyFile (const FileName : string;
  1138.   UncompressedSize : Longint; Date, Time, Attribs : Smallint;
  1139.   var Action : TFileCopyAction; var DestFileHandle : Integer);
  1140. var
  1141.   ErrorCode : Integer;
  1142. begin
  1143.   if Assigned(FOnCopyFile) then
  1144.   begin
  1145.     Action:=fcaCopy;
  1146.     FOnCopyFile(Self, FileName, UncompressedSize, Date, Time, Attribs, Action,
  1147.       DestFileHandle);
  1148.   end
  1149.   else
  1150.     Action:=fcaDefaultCopy;
  1151.   if Action = fcaDefaultCopy then
  1152.   begin
  1153.     Action:=fcaCopy;
  1154.     DestFileHandle:=FFileHandler.Open(FDestinationPath + FileName,
  1155.       _O_CREAT or _O_BINARY, 0, ErrorCode, ftDestination);
  1156.   end;
  1157. end;
  1158.  
  1159. procedure TCabinetReader.DoCloseCopiedFile (const FileName : string;
  1160.   FileHandle : Integer; Date, Time, Attribs : Smallint;
  1161.   FolderIndex : Integer; Execute : Boolean; var Abort : Boolean);
  1162. var
  1163.   ErrorCode : Integer;
  1164.   FileTime : TFileTime;
  1165. begin
  1166.   if Assigned(FOnCloseCopiedFile) then
  1167.     FOnCloseCopiedFile(Self, FileName, FileHandle, Date, Time, Attribs,
  1168.       FolderIndex, Execute, Abort)
  1169.   else 
  1170.   begin
  1171.     if FFileSupport then
  1172.     begin
  1173.       ApiCheck(DosDateTimeToFileTime(Word(Date), Word(Time), FileTime));
  1174.       ApiCheck(SetFileTime(FileHandle, nil, nil, @FileTime));
  1175.     end;
  1176.     FFileHandler.Close(FileHandle, ErrorCode);
  1177.     if FFileSupport then
  1178.       ApiCheck(SetFileAttributes(PChar(FDestinationPath + FileName),
  1179.         Attribs));
  1180.   end;
  1181. end;
  1182.  
  1183. procedure TCabinetReader.DoNextCabinet (const NextCabinetName,
  1184.   NextCabinetDisk : string; var CabinetPath : string;
  1185.   ErrorIndication : TFDIERROR; var Abort : Boolean);
  1186. begin
  1187.   if Assigned(FOnNextCabinet) then
  1188.     FOnNextCabinet(Self, NextCabinetName, NextCabinetDisk, CabinetPath,
  1189.       ErrorIndication, Abort);
  1190. end;
  1191.  
  1192. constructor TCabinetReader.Create (AOwner : TComponent);
  1193. begin
  1194.   inherited Create(AOwner);
  1195.   FFileSupport:=True;
  1196. end;
  1197.  
  1198. destructor TCabinetReader.Destroy;
  1199. begin
  1200.   DestroyContext;
  1201.   inherited Destroy;
  1202. end;
  1203.  
  1204. function TCabinetReader.IsCabinet (const FileName : string;
  1205.   var CabInfo : TFDICABINETINFO) : Boolean;
  1206. var
  1207.   ErrorCode, FileHandle : Integer;
  1208. begin
  1209.   ContextNeeded;
  1210.   GlobCabinetReader:=Self;
  1211.   FileHandle:=FFileHandler.Open(FileName, _O_RDONLY or _O_BINARY, 0, ErrorCode,
  1212.     ftCabinet);
  1213.   if ErrorCode <> 0 then
  1214.     RaiseCabinetError(-1, ErrorCode);
  1215.   try
  1216.     Result:=FDIIsCabinet(FContext, FileHandle, @CabInfo);
  1217.   finally
  1218.     FFileHandler.Close(FileHandle, ErrorCode);
  1219.     if ErrorCode <> 0 then
  1220.       RaiseCabinetError(-1, ErrorCode);
  1221.   end;
  1222. end;
  1223.  
  1224. procedure TCabinetReader.ExtractFiles (const FileName,
  1225.   DestinationPath : string; Flags : Integer);
  1226. begin
  1227.   ContextNeeded;
  1228.   GlobCabinetReader:=Self;
  1229.   FDestinationPath:=AddBkSlash(DestinationPath);
  1230.   CabCheck(FDICopy(FContext, PChar(ExtractFileName(FileName)),
  1231.     PChar(ExtractFilePath(FileName)), Flags, StdCabinetProcs.FdiNotify, nil,
  1232.     Pointer(Self)));
  1233. end;
  1234.  
  1235. { Functions }
  1236.  
  1237. function MakeNoCompression : TCompressionParameters;
  1238. begin
  1239.   Result.Compression:=ctNone;
  1240. end;
  1241.  
  1242. function MakeMsZipCompression : TCompressionParameters;
  1243. begin
  1244.   Result.Compression:=ctMsZip;
  1245. end;
  1246.  
  1247. function MakeLzxCompression (Level : Integer) : TCompressionParameters;
  1248. begin
  1249.   Result.Compression:=ctLzx;
  1250.   Result.LzxLevel:=Level;
  1251. end;
  1252.  
  1253. procedure RaiseCabinetError (ErrorCode, ErrorType : Integer);
  1254. var
  1255.   E : ECabinetError;
  1256. begin
  1257.   E:=ECabinetError.CreateFmt('Cabinet error %d (type %d)',
  1258.     [ErrorCode, ErrorType]);
  1259.   E.ErrorCode:=ErrorCode;
  1260.   E.ErrorType:=ErrorType;
  1261.   if (ErrorCode<>11) then raise E;
  1262. end;
  1263.  
  1264. procedure CheckErf (Erf : TERF);
  1265. begin
  1266.   if Bool(Erf.fError) then
  1267.     RaiseCabinetError(Erf.erfOper, Erf.erfType);
  1268. end;
  1269.  
  1270. procedure Register;
  1271. begin
  1272.   RegisterComponents('Library', [TCabinetWriter, TCabinetReader,
  1273.     TStreamCabinetFileHandler]);
  1274. end;
  1275.  
  1276. end.
  1277.  
  1278.