home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DISKINFO.ZIP / DISKINFO.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-11-14  |  4.0 KB  |  117 lines
  1. {$B-} {- : short circuit boolean evaluation: on }
  2. {$D-} {+ : debug & lineinfo: on }
  3. {$F-} {- : force far calls: off }
  4. {$I-} {+ : I/O error checking: on }
  5. {$L+} {+ : link buffer: on }
  6. {$N-} {- : 8087 code: off }
  7. {$R-} {- : numeric range checking: off }
  8. {$S-} {+ : stack overflow checking: on }
  9. {$T-} {- : map file generation: off }
  10. {$V-} {+ : var-string checking: on }
  11. {$M 16384,0,0} { memory in bytes: stacksize,heapmin,heapmax }
  12.  
  13. program DiskInfo;
  14. {
  15. Author:   Michael BoRowiec [72067,3025]
  16. Written:  November 14, 1987
  17. Requires: Turbo Pascal 4.0 -or- greater
  18. }
  19. uses DOS;
  20.  
  21. type
  22.   String5 = string[5]; { for function HexString }
  23. var
  24.   DriveCount : word;   { "for" control variable }
  25.  
  26. {}function HexString(Number: Word): String5; { outputs string5: 0000h }
  27.  
  28. {--}function HexChar(Number: Word): Char;
  29.     begin
  30.       if Number < 10 then
  31.         HexChar:= char(Number + 48)
  32.       else
  33.         HexChar:= char(Number + 55);
  34. {--}end; { function HexChar }
  35.  
  36.   var
  37.     S: String5;
  38.   begin
  39.     S     := '';
  40.     S     := HexChar((Number shr 1) div 2048);
  41.     Number:= (((Number shr 1) mod 2048) shl 1) + (Number and 1);
  42.     S     := S + HexChar(Number div 256);
  43.     Number:= Number mod 256;
  44.     S     := S + HexChar(Number div 16);
  45.     Number:= Number mod 16;
  46.     S     := S + HexChar(Number);
  47.     HexString:= S + 'h';
  48. {}end; { function HexString }
  49.  
  50. {}function GetDriveData(Drive             :word;  { DOS service 01Ch }
  51.                     var SectorsPerCluster :byte;
  52.                     var BytesPerSector,
  53.                         ClustersPerDrive  :word;
  54.                     var DriveType         :byte) : boolean;
  55.  
  56.   var Regs        : Registers; { typed in DOS unit }
  57.       BytePointer : ^byte;     { byte pointer }
  58.  
  59.   begin                             { could use "with", but I don't like it }
  60.     Regs.AX:= $1C00;                { Get Drive Data function }
  61.     Regs.DX:= Drive;                { Loads DL with drive 1=A, 2=B, etc. }
  62.     msdos(Regs);
  63.     if Regs.AL = $FF then           { invalid drive }
  64.       begin
  65.         GetDriveData:= false;
  66.         exit;
  67.       end;
  68.     GetDriveData     := true;
  69.     SectorsPerCluster:= Regs.AL;              { byte }
  70.     BytesPerSector   := Regs.CX;              { word }
  71.     ClustersPerDrive := Regs.DX;              { word }
  72.     BytePointer      := ptr(Regs.DS,Regs.BX); { pointer to Drive Type byte }
  73.     DriveType        := BytePointer^;         { dereference pointer }
  74. {}end; { function GetDriveData }
  75.  
  76. {}procedure WriteDiskData(Drive : word);
  77.  
  78.   var
  79.     B1,                     { dummy }
  80.     DriveType  : byte;      { returned from DOS function 01Ch }
  81.     DriveID    : char;      { drive letter }
  82.     W1,W2      : word;      { dummy }
  83.     TypeString : string;
  84.     DiskBytes,              { total bytes on disk }
  85.     FreeBytes  : longint;   { free  bytes on disk }
  86.  
  87.   begin { WriteDiskData }
  88.     if GetDriveData(Drive,B1,W1,W2,DriveType) then  { valid drive }
  89.       begin
  90.         DriveID  := chr(Drive + (ord('A') - 1));
  91.         DiskBytes:= DiskSize(Drive);  { function in DOS unit }
  92.         FreeBytes:= DiskFree(Drive);  { function in DOS unit }
  93.         case DriveType of             { 3.5" types unknown }
  94.           $FF : TypeString:= 'DSDD, 8 sector';
  95.           $FE : TypeString:= 'SSDD, 8 sector';
  96.           $FD : TypeString:= 'DSDD, 9 sector';
  97.           $FC : TypeString:= 'SSDD, 9 sector';
  98.           $F9 : TypeString:= 'DSQD,15 sector';
  99.           $F8 : TypeString:= 'Fixed Disk    ';
  100.           $CD : TypeString:= 'EXCEPTION TYPE'
  101.         else
  102.                 TypeString:= HexString(DriveType) + ' Unknown ';
  103.         end; { case }
  104.         writeln(DriveID,': ',TypeString,' ',
  105.                 DiskBytes:9,' total bytes. ',FreeBytes:9,' bytes free.');
  106.       end;
  107. {}end; { procedure WriteDiskData }
  108.  
  109. (*((((((((((((((((((((   O U T E R   B L O C K   ))))))))))))))))))))*)
  110.  
  111. BEGIN
  112.   writeln('DiskInfo v1.0: (c)1987 by BoRowiec Ltd.');
  113.   writeln;
  114.   for DriveCount:= (ord('A') - 64) to (ord('Z') - 64) do { drives A - Z }
  115.     WriteDiskData(DriveCount);
  116. END.
  117.