home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 February / Chip_2004-02_cd1.bin / zkuste / konfig / download / msic / Help / Int / MSI_Disk.int < prev    next >
Text File  |  2003-08-19  |  9KB  |  215 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       MiTeC System Information Component              }
  4. {               Disk Detection Part                     }
  5. {           version 8.3 for Delphi 5,6,7                }
  6. {                                                       }
  7. {       Copyright ⌐ 1997,2003 Michal Mutl               }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. {$INCLUDE MITEC_DEF.INC}
  12.  
  13. unit MSI_Disk;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils, Windows, Classes, MiTeC_Routines;
  19.  
  20. type
  21.   TDisk = class(TPersistent)
  22.   private
  23.     FDisk: TDiskSign;
  24.     {$IFNDEF D6PLUS}
  25.     FMediaPresent: Boolean;
  26.     {$ENDIF}
  27.     FDriveType: TMediaType;
  28.     FSectorsPerCluster: DWORD;
  29.     FBytesPerSector: DWORD;
  30.     FFreeClusters: DWORD;
  31.     FTotalClusters: DWORD;
  32.     FFileFlags: TFileFlags;
  33.     FVolumeLabel: string;
  34.     FSerialNumber: string;
  35.     FFileSystem: string;
  36.     FFreeSpace: int64;
  37.     FCapacity: int64;
  38.     FAvailDisks: string;
  39.     FSerial: dword;
  40.     function GetMediaPresent: Boolean;
  41.   protected
  42.     procedure SetDisk(const Value: TDiskSign);
  43.   public
  44.     procedure GetInfo;
  45.     procedure GetFileFlagsStr(var AFileFlags :TStringList);
  46.     procedure Report(var sl :TStringList; Standalone: Boolean = True); virtual;
  47.     function GetCD :byte;
  48.     function GetMediaTypeStr(MT: TMediaType): string;
  49.     property Serial :dword read FSerial {$IFNDEF D6PLUS} write FSerial {$ENDIF} stored false;
  50.   published
  51.     property Drive :TDiskSign read FDisk write SetDisk stored false;
  52.     property AvailableDisks :string read FAvailDisks {$IFNDEF D6PLUS} write FAvailDisks {$ENDIF} stored false;
  53.     property MediaPresent :Boolean read GetMediaPresent {$IFNDEF D6PLUS} write FMediaPresent {$ENDIF} stored false;
  54.     property MediaType :TMediaType read FDriveType {$IFNDEF D6PLUS} write FDriveType {$ENDIF} stored false;
  55.     property FileFlags :TFileFlags read FFileFlags {$IFNDEF D6PLUS} write FFileFlags {$ENDIF} stored false;
  56.     property FileSystem :string read FFileSystem {$IFNDEF D6PLUS} write FFileSystem {$ENDIF} stored false;
  57.     property FreeClusters :DWORD read FFreeClusters {$IFNDEF D6PLUS} write FFreeClusters {$ENDIF} stored false;
  58.     property TotalClusters :DWORD read FTotalClusters {$IFNDEF D6PLUS} write FTotalClusters {$ENDIF} stored false;
  59.     // FreeSpace and Capacity returns good results for Win95 OSR2, Win98, NT and 2000
  60.     // for Win95 there can be bad sizes for drives over 2GB
  61.     property FreeSpace :int64 read FFreeSpace {$IFNDEF D6PLUS} write FFreeSpace {$ENDIF} stored false;
  62.     property Capacity :int64 read FCapacity {$IFNDEF D6PLUS} write FCapacity {$ENDIF} stored false;
  63.     property SerialNumber :string read FSerialNumber {$IFNDEF D6PLUS} write FSerialNumber {$ENDIF} stored false;
  64.     property VolumeLabel :string read FVolumeLabel {$IFNDEF D6PLUS} write FVolumeLabel {$ENDIF} stored false;
  65.     property SectorsPerCluster :DWORD read FSectorsPerCluster {$IFNDEF D6PLUS} write FSectorsPerCluster {$ENDIF} stored false;
  66.     property BytesPerSector :DWORD read FBytesPerSector {$IFNDEF D6PLUS} write FBytesPerSector {$ENDIF} stored false;
  67.   end;
  68.  
  69. implementation
  70.  
  71. uses MSI_Common;
  72.  
  73. { TDisk }
  74.  
  75. function TDisk.GetCD: byte;
  76. var
  77.   i :integer;
  78.   root :pchar;
  79. begin
  80.   result:=0;
  81.   root:=stralloc(255);
  82.   for i:=1 to length(FAvailDisks) do begin
  83.     strpcopy(root,copy(FAvailDisks,i,1)+':\');
  84.     if getdrivetype(root)=drive_cdrom then begin
  85.       result:=i;
  86.       break;
  87.     end;
  88.   end;
  89.   strdispose(root);
  90. end;
  91.  
  92. procedure TDisk.GetFileFlagsStr;
  93. begin
  94.   with AFileFlags do begin
  95.     Add(Format('Case Is Preserved=%d',[integer(fsCaseIsPreserved in FileFlags)]));
  96.     Add(Format('Case Sensitive=%d',[integer(fsCaseSensitive in FileFlags)]));
  97.     Add(Format('Unicode stored On Disk=%d',[integer(fsUnicodeStoredOnDisk in FileFlags)]));
  98.     Add(Format('Persistent Acls=%d',[integer(fsPersistentAcls in FileFlags)]));
  99.     Add(Format('File Compression=%d',[integer(fsFileCompression in FileFlags)]));
  100.     Add(Format('Volume Is Compressed=%d',[integer(fsVolumeIsCompressed in FileFlags)]));
  101.     Add(Format('Long Filenames=%d',[integer(fsLongFileNames in FileFlags)]));
  102.     Add(Format('Encrypted File System Support=%d',[integer(fsEncryptedFileSystemSupport in FileFlags)]));
  103.     Add(Format('Object IDs Support=%d',[integer(fsObjectIDsSupport in FileFlags)]));
  104.     Add(Format('Reparse Points Support=%d',[integer(fsReparsePointsSupport in FileFlags)]));
  105.     Add(Format('Sparse Files Support=%d',[integer(fsSparseFilesSupport in FileFlags)]));
  106.     Add(Format('Disk Quotas Support=%d',[integer(fsDiskQuotasSupport in FileFlags)]));
  107.   end;
  108. end;
  109.  
  110. procedure TDisk.GetInfo;
  111. var
  112.   i,n :integer;
  113.   buf :pchar;
  114. begin
  115.   buf:=stralloc(255);
  116.   n:=GetLogicalDriveStrings(255,buf);
  117.   FAvailDisks:='';
  118.   for i:=0 to n do
  119.     if buf[i]<>#0 then begin
  120.       if (ord(buf[i]) in [$41..$5a]) or (ord(buf[i]) in [$61..$7a]) then
  121.         FAvailDisks:=FAvailDisks+upcase(buf[i])
  122.     end else
  123.       if buf[i+1]=#0 then
  124.         break;
  125.   strdispose(buf);
  126. end;
  127.  
  128.  
  129. function TDisk.GetMediaPresent :Boolean;
  130. begin
  131.   Result:=MiTeC_Routines.GetMediaPresent(FDisk);
  132. end;
  133.  
  134. procedure TDisk.Report;
  135. var
  136.   i :integer;
  137. begin
  138.   with sl do begin
  139.     if Standalone then ReportHeader(sl);
  140.     Add('<Disk classname="TDisk">');
  141.  
  142.     Add(Format('<data name="AvailableLogicalDisks" type="string">%s</data>',[AvailableDisks]));
  143.     for i:=1 to Length(AvailableDisks) do begin
  144.       SetDisk(copy(AvailableDisks,i,1)+':');
  145.       Add(Format('<section name="Disk_%s">',[copy(AvailableDisks,i,1)]));
  146.       Add(Format('<data name="VolumeLabel" type="string">%s</data>',[CheckXMLValue(VolumeLabel)]));
  147.       Add(Format('<data name="FileSystem" type="string">%s</data>',[FileSystem]));
  148.       Add(Format('<data name="Type" type="string">%s</data>',[CheckXMLValue(GetMediaTypeStr(MediaType))]));
  149.       Add(Format('<data name="UNC" type="string">%s</data>',[CheckXMLValue(ExpandUNCFilename(Drive))]));
  150.       Add(Format('<data name="SerialNumber" type="string">%s</data>',[SerialNumber]));
  151.       Add(Format('<data name="Capacity" type="integer" unit="B">%d</data>',[Self.Capacity]));
  152.       Add(Format('<data name="FreeSpace" type="integer" unit="B">%d</data>',[FreeSpace]));
  153.       Add(Format('<data name="BytesPerSector" type="integer">%d</data>',[BytesPerSector]));
  154.       Add(Format('<data name="SectorsPerCluster" type="integer">%d</data>',[SectorsPerCluster]));
  155.       Add(Format('<data name="FreeClusters" type="integer">%d</data>',[FreeClusters]));
  156.       Add(Format('<data name="TotalClusters" type="integer">%d</data>',[TotalClusters]));
  157.       Add('<section name="Flags">');
  158.       Add(Format('<data name="CaseIsPreserved" type="boolean">%d</data>',[integer(fsCaseIsPreserved in FileFlags)]));
  159.       Add(Format('<data name="CaseSensitive" type="boolean">%d</data>',[integer(fsCaseSensitive in FileFlags)]));
  160.       Add(Format('<data name="UnicodeStoredOnDisk" type="boolean">%d</data>',[integer(fsUnicodeStoredOnDisk in FileFlags)]));
  161.       Add(Format('<data name="PersistentACLs" type="boolean">%d</data>',[integer(fsPersistentAcls in FileFlags)]));
  162.       Add(Format('<data name="FileCompression" type="boolean">%d</data>',[integer(fsFileCompression in FileFlags)]));
  163.       Add(Format('<data name="VolumeIsCompressed" type="boolean">%d</data>',[integer(fsVolumeIsCompressed in FileFlags)]));
  164.       Add(Format('<data name="LongFilenames" type="boolean">%d</data>',[integer(fsLongFileNames in FileFlags)]));
  165.       Add(Format('<data name="EncryptedFileSystemSupport" type="boolean">%d</data>',[integer(fsEncryptedFileSystemSupport in FileFlags)]));
  166.       Add(Format('<data name="ObjectODsSupport" type="boolean">%d</data>',[integer(fsObjectIDsSupport in FileFlags)]));
  167.       Add(Format('<data name="ReparsePointsSupport" type="boolean">%d</data>',[integer(fsReparsePointsSupport in FileFlags)]));
  168.       Add(Format('<data name="SparseFilesSupport" type="boolean">%d</data>',[integer(fsSparseFilesSupport in FileFlags)]));
  169.       Add(Format('<data name="DiskQuotasSupport" type="boolean">%d</data>',[integer(fsDiskQuotasSupport in FileFlags)]));
  170.       Add('</section>');
  171.       Add('</section>');
  172.     end;
  173.  
  174.     Add('</Disk>');
  175.     if Standalone then ReportFooter(sl);
  176.   end;
  177. end;
  178.  
  179. procedure TDisk.SetDisk(const Value: TDiskSign);
  180. var
  181.   DI: TDiskInfo;
  182. begin
  183.   FDisk:=Value;
  184.   DI:=GetDiskInfo(Value);
  185.   FDriveType:=DI.MediaType;
  186.   FFileFlags:=DI.FileFlags;
  187.   FCapacity:=DI.Capacity;
  188.   FFreeSpace:=DI.FreeSpace;
  189.   FBytesPerSector:=DI.BytesPerSector;
  190.   FTotalClusters:=DI.TotalClusters;
  191.   FFreeClusters:=DI.FreeClusters;
  192.   FSectorsPerCluster:=DI.SectorsPerCluster;
  193.   FVolumeLabel:=DI.VolumeLabel;
  194.   FFileSystem:=DI.FileSystem;
  195.   FSerialNumber:=DI.SerialNumber;
  196.   FSerial:=DI.Serial;
  197. end;
  198.  
  199.  
  200.  
  201. function TDisk.GetMediaTypeStr(MT: TMediaType): string;
  202. begin
  203.   case MT of
  204.     dtUnknown     :result:='<unknown>';
  205.     dtNotExists   :result:='<not exists>';
  206.     dtRemovable   :result:='Removable';
  207.     dtFixed       :result:='Fixed';
  208.     dtRemote      :result:='Remote';
  209.     dtCDROM       :result:='CDROM';
  210.     dtRAMDisk     :result:='RAM';
  211.   end;
  212. end;
  213.  
  214. end.
  215.