home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue62 / system / CABFile.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-09-08  |  2.7 KB  |  99 lines
  1. unit CABFile;
  2.  
  3. interface
  4.  
  5. uses SysUtils, Classes;
  6.  
  7. type
  8.     ECABError = class (Exception);
  9.  
  10.     TCabinet = class (TComponent)
  11.     private
  12.         fCABFileName: String;
  13.         fFileList: TStringList;
  14.         fFileCount: Integer;
  15.         procedure Clear;
  16.         function GetFileName (Index: Integer): String;
  17.         function GetFileSize (Index: Integer): String;
  18.         function GetFileDate (Index: Integer): String;
  19.         procedure SetCABFileName (const Value: String);
  20.     public
  21.         constructor Create (AOwner: TComponent); override;
  22.         destructor Destroy; override;
  23.         property CABFileName: String read fCABFileName write SetCABFileName;
  24.         property FileCount: Integer read fFileCount;
  25.         property FileName [Index: Integer]: string read GetFileName; default;
  26.         property FileSize [Index: Integer]: string read GetFileSize;
  27.         property FileDate [Index: Integer]: string read GetFileDate;
  28.     end;
  29.  
  30. implementation
  31.  
  32. uses CABAPI;
  33.  
  34. // TCabinet
  35.  
  36. function GetField (S: String; Num: Integer): String;
  37. var
  38.     Idx: Integer;
  39. begin
  40.     while Num > 0 do begin
  41.         Idx := Pos ('|', S);
  42.         if Idx > 0 then Delete (S, 1, Idx);
  43.         Dec (Num);
  44.     end;
  45.  
  46.     Idx := Pos ('|', S);
  47.     if Idx > 0 then Delete (S, Idx, MaxInt);
  48.     Result := S;
  49. end;
  50.  
  51. constructor TCabinet.Create (AOwner: TComponent);
  52. begin
  53.     Inherited Create (AOwner);
  54.     fFileList := TStringList.Create;
  55. end;
  56.  
  57. destructor TCabinet.Destroy;
  58. begin
  59.     Clear;
  60.     fFileList.Free;
  61.     Inherited Destroy;
  62. end;
  63.  
  64. procedure TCabinet.Clear;
  65. begin
  66.     fCABFileName := '';
  67.     fFileList.Clear;
  68. end;
  69.  
  70. procedure TCabinet.SetCABFileName (const Value: String);
  71. begin
  72.     Clear;
  73.     if not FileExists (Value) then raise ECABError.Create ('Specified CAB file not found') else
  74.     if not CABIsFile (Value) then raise ECABError.Create ('Not a valid CAB file') else
  75.     if CABIsMultiPart (Value) then raise ECABError.Create ('Multi-part CAB files not supported') else begin
  76.         fCABFileName := Value;
  77.         fFileCount := CABGetFileCount (fCABFileName);
  78.         CABGetFileList (fCABFileName, fFileList);
  79.     end;
  80. end;
  81.  
  82. function TCabinet.GetFileName (Index: Integer): String;
  83. begin
  84.     if (Index >= 0) and (Index <= fFileCount) then Result := GetField (fFileList [Index], 0);
  85. end;
  86.  
  87. function TCabinet.GetFileSize (Index: Integer): String;
  88. begin
  89.     if (Index >= 0) and (Index <= fFileCount) then Result := GetField (fFileList [Index], 1);
  90. end;
  91.  
  92. function TCabinet.GetFileDate (Index: Integer): String;
  93. begin
  94.     if (Index >= 0) and (Index <= fFileCount) then
  95.         Result := FormatDateTime ('', FileDateToDateTime (StrToInt (GetField (fFileList [Index], 2))));
  96. end;
  97.  
  98. end.
  99.