home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / HTMIX20.ZIP / DMI.ZIP / DI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-11  |  4.8 KB  |  163 lines
  1. program DiskInfo;
  2. {┌──────────────────────────────── INFO ────────────────────────────────────┐}
  3. {│ File    : DI.PAS                                                         │}
  4. {│ Author  : Harald Thunem                                                  │}
  5. {│ Purpose : Gives relevant information about the harddisk.                 │}
  6. {│ Updated : July 10 1992                                                   │}
  7. {└──────────────────────────────────────────────────────────────────────────┘}
  8.  
  9. {────────────────────────── Compiler directives ─────────────────────────────}
  10. {$A+   Word align data                                                       }
  11. {$B-   Short-circuit Boolean expression evaluation                           }
  12. {$E-   Disable linking with 8087-emulating run-time library                  }
  13. {$G+   Enable 80286 code generation                                          }
  14. {$R-   Disable generation of range-checking code                             }
  15. {$S-   Disable generation of stack-overflow checking code                    }
  16. {$V-   String variable checking                                              }
  17. {$X-   Disable Turbo Pascal's extended syntax                                }
  18. {$N+   80x87 code generation                                                 }
  19. {$D-   Disable generation of debug information                               }
  20. {────────────────────────────────────────────────────────────────────────────}
  21.  
  22. uses Dos,
  23.      Screen,
  24.      Strings;
  25.  
  26.  
  27. var  TotalSpace,
  28.      UsedSpace,
  29.      FreeSpace  : longint;
  30.      Drive      : byte;
  31.      DriveLetter: char;
  32.      s          : string;
  33.  
  34.  
  35. procedure GetInfo;
  36. begin
  37.   Write('Analyzing drive ',DriveLetter,'...');
  38.   TotalSpace := DiskSize(Drive);
  39.   FreeSpace := DiskFree(Drive);
  40.   UsedSpace := TotalSpace-FreeSpace;
  41. end;
  42.  
  43.  
  44. procedure AddSmallShadow(Row,Col,Rows,Cols: byte);
  45. var i,Attr: byte;
  46. begin
  47.   for i := 1 to Cols do
  48.   begin
  49.     Attr := ReadAttr(Row+Rows,Col+i) and $F0;
  50.     WriteStr(Row+Rows,Col+i,Attr,'▀');
  51.   end;
  52.   for i := 1 to Rows-1 do
  53.   begin
  54.     Attr := ReadAttr(Row+i,Col+Cols) and $F0;
  55.     WriteStr(Row+i,Col+Cols,Attr,'█');
  56.   end;
  57.   Attr := ReadAttr(Row,Col+Cols) and $F0;
  58.   WriteStr(Row,Col+Cols,Attr,'▄');
  59. end;
  60.  
  61.  
  62. procedure Background;
  63. begin
  64.   ClrScr;
  65.   Explode(1,1,13,80,White+BlueBG,DoubleBorder);
  66.   Fill(2,5,3,72,White+CyanBG,' ');
  67.   Box(2,6,3,70,White+CyanBG,SingleBorder,' ');
  68.   AddSmallShadow(2,5,3,72);
  69.   WriteC(3,40,SameAttr,'Disk Information');
  70. end;
  71.  
  72.  
  73. function DotStr(l: longint): string;
  74. var s: string;
  75.     sl: byte;
  76. begin
  77.   s := StrL(l);
  78.   sl := Length(s);
  79.   if sl>3 then Insert(',',s,sl-2);
  80.   sl := Length(s);
  81.   if sl>7 then Insert(',',s,sl-6);
  82.   sl := Length(s);
  83.   if sl>11 then Insert(',',s,sl-10);
  84.   DotStr := s;
  85. end;
  86.  
  87.  
  88. procedure WriteInfo;
  89. const Max=72;
  90. var   MBUsed,
  91.       MBFree,
  92.       FractionFree,
  93.       FractionUsed : single;
  94.       i,m          : byte;
  95.       s            : string;
  96. begin
  97.   FractionFree := FreeSpace/TotalSpace;
  98.   FractionUsed := UsedSpace/TotalSpace;
  99.   WriteStr(6,5,Yellow+BlueBG,'Usage drive '+DriveLetter+':');
  100.   m := Max;
  101.   for i := 1 to m do
  102.   begin
  103.     WriteStr(7,4+i,Yellow,'█');
  104.     WriteStr(8,5+i,Blue+BlackBG,'▄');
  105.     WriteStr(7,5+i,Blue+BlackBG,'▀');
  106.     Delay(4);
  107.   end;
  108.   m := Round(Max*FractionUsed);
  109.   for i := 1 to m do
  110.   begin
  111.     WriteStr(7,4+i,LightCyan+BlueBG,'▒');
  112.     Delay(5);
  113.   end;
  114.  
  115.   MBUsed := 1E-06*UsedSpace;
  116.   WriteStr(9,5,LightCyan+BlueBG,'▒▒▒');
  117.   AddSmallShadow(9,5,1,3);
  118.   WriteStr(9,10,Yellow+BlueBG,'Used ('+StrRFD(MBUsed,5,1)+'MB)');
  119.  
  120.   MBFree := 1E-06*FreeSpace;
  121.   WriteStr(11,5,Yellow,'███');
  122.   AddSmallShadow(11,5,1,3);
  123.   WriteStr(11,10,Yellow+BlueBG,'Free ('+StrRFD(MBFree,5,1)+'MB)');
  124.  
  125.   s := DotStr(TotalSpace);
  126.   WriteStr( 9,40-Length(s),White+BlueBG,s+' bytes total disk space');
  127.  
  128.   s := DotStr(UsedSpace);
  129.   WriteStr(10,40-Length(s),White+BlueBG,s+' bytes currently allocated');
  130.   WriteStr(10,69,LightCyan+BlueBG,'('+StrRFD(100*FractionUsed,5,1)+'%)');
  131.  
  132.   s := DotStr(FreeSpace);
  133.   WriteStr(11,40-Length(s),White+BlueBG,s+' bytes available on disk');
  134.   WriteStr(11,69,LightCyan+BlueBG,'('+StrRFD(100*FractionFree,5,1)+'%)');
  135.  
  136.   GoToRC(13,1);
  137. end;
  138.  
  139.  
  140.  
  141. begin
  142.   WriteLn('Disk Information 2.0                                         Written by H.Thunem');
  143.   if ParamCount>1 then
  144.   begin
  145.     WriteLn('Example:  DU     {gives disk info on current drive}');
  146.     WriteLn('          DU C:  {gives disk info on drive C      }');
  147.     Halt(1);
  148.   end;
  149.   s := ParamStr(ParamCount);
  150.   DriveLetter := Upcase(s[1]);
  151.   Drive := Ord(DriveLetter)-64;
  152.   GetInfo;
  153.   if TotalSpace=-1 then
  154.   begin
  155.     WriteLn('Error reading Drive ',DriveLetter,'.  Halting program...');
  156.     Halt(1);
  157.   end;
  158.   SetCursor(CursorOff);
  159.   Background;
  160.   WriteInfo;
  161.   SetCursor(CursorUnderline);
  162. end.
  163.