home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR3 / FSP101.ZIP / FSP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-26  |  6KB  |  184 lines
  1. PROGRAM FSP;
  2. {------------------------------------------------------------------------------
  3.  
  4.                                 REVISION HISTORY
  5.  
  6. v1.00  : 1993/07/14.  First public release.  DDA
  7. v1.01  : 1993/12/26.  Now discards data from FIRST CD-ROM drive.  DDA
  8.  
  9. ------------------------------------------------------------------------------}
  10.  
  11. USES Crt, Dos;                       {Crt for colors, Dos for DiskSize/Free.}
  12. CONST
  13.    ProgData = 'FSP- Free DOS Multiple Hard Disk Space Utilization Utility.';
  14.    ProgDat2 = 'v1.01: (c) 93/12/26; by David Daniel Anderson - Reign Ware.';
  15.    ProgDat3 = 'DRIVE       ALLOCATED    FREE SPACE    TOTAL SPACE   FREE %';
  16. VAR
  17.    DriveCounter      : Byte;
  18.  
  19.    TS,TF,TU : LongInt;  {integer of Total space Size/Free/Used}
  20.                         {maximum disk size of LongInt: 2 147 483 647 }
  21.  
  22.  
  23. FUNCTION Comma(i : LongInt) : String; {Used in WriteDriveInfo & WriteTotalInfo}
  24. VAR w : String[14];                  {Insert commas to break up number string.}
  25.     c : ShortInt;
  26. BEGIN
  27.     Str(i,w);
  28.  
  29.     c := (Length(w) - 3);
  30.     WHILE c > 0 DO
  31.     BEGIN
  32.       Insert(',',w,c+1);
  33.       c := c - 3
  34.     END;
  35.  
  36.     Comma := w;
  37. END;
  38.  
  39. FUNCTION LeadingZero(w : Word) : String;  {Called by WriteDTInf to write time.}
  40. VAR  s : String;
  41. BEGIN
  42.      Str(w:0,s);
  43.      IF Length(s) = 1 THEN
  44.        s := '0' + s;
  45.      LeadingZero := s;
  46. END;
  47.  
  48. PROCEDURE WriteDTInf;            {Called by WriteHeader to write Date & Time.}
  49. CONST
  50.   Mon : Array [1..12] of String[9] =
  51.         ('January','February','March','April','May','June','July',
  52.          'August','September','October','November','December');
  53. VAR
  54.      Year,Month,Day, dow,
  55.      Hour,Min,Sec, hund    : Word;
  56.      i                     : ShortInt;
  57.      DStr,
  58.      YStr,
  59.      DateStr               : String[20];
  60. BEGIN
  61.      GetDate(Year,Month,Day,dow);
  62.      GetTime(Hour,Min,Sec,hund);
  63.      Str(Day,DStr);
  64.      Str(Year,YStr);
  65.      DateStr := Mon[Month] + ' ' + DStr + ', ' + YStr;
  66.      Write(DateStr);
  67.      FOR i := Length(DateStr) to 50 DO         {Fill the line with spaces.}
  68.          Write(' ');
  69.      WriteLn(LeadingZero(Hour),':',
  70.              LeadingZero(Min),':',
  71.              LeadingZero(Sec));
  72. END;
  73.  
  74. PROCEDURE WriteHeader;                 {Called by main.}
  75. VAR  i : ShortInt;
  76. BEGIN
  77.      TextBackGround(Blue);  TextColor(White);
  78.      WriteLn(ProgData);                                   {...a constant...}
  79.      WriteLn(ProgDat2);                                   {...a constant...}
  80.      TextBackGround(Black); TextColor(LightBlue);
  81.      WriteDTInf;
  82.      TextColor(LightCyan);
  83.      WriteLn(ProgDat3);                                   {...a constant...}
  84.      FOR i := 1 to 59 DO                         {Draw a line of hyphens.}
  85.          Write('-');
  86.      WriteLn;
  87. END;
  88.  
  89. PROCEDURE WritePercent(TFree,TSpace : LongInt);   {Called by WriteDriveInfo  }
  90.                                                   {        & WriteTotalInfo. }
  91. VAR  SPF : String[8];          {String of Percentage Free}
  92.      PF  : Integer;       {integer of Percentage Free, initially 10 x %}
  93. BEGIN
  94.      PF := Round(1000 * (TFree / TSpace));    {Using 1000 to give tenths of %}
  95.      Str(PF,SPF);
  96.      Insert('.',SPF,(Length(SPF)));   {Insert period for tenths of a percent.}
  97.      TextColor(White);         WriteLn(SPF:8,'%');
  98. END;
  99.  
  100. PROCEDURE WriteInColor(u,f,s : LongInt);
  101. BEGIN
  102.      TextColor(LightRed);      Write(Comma(U):14);
  103.      TextColor(LightGreen);    Write(Comma(F):14);
  104.      TextColor(Magenta);       Write(Comma(S):15);
  105. END;
  106.  
  107. PROCEDURE WriteDriveInfo;                   {Called by main.}
  108. VAR  DS,DF,DU : LongInt;        {integer of Disk space Size/Free/Used}
  109. BEGIN
  110.      DS := DiskSize(DriveCounter);
  111.      DF := DiskFree(DriveCounter);
  112.      DU := DS - DF;
  113.      TS := TS + DS;    TF := TF + DF;    TU := TU + DU;
  114.  
  115.      TextColor(Yellow);        Write(Chr(DriveCounter+64),' -->  ');
  116.      WriteInColor(DU,DF,DS);
  117.      WritePercent(DF,DS);                          {...a procedure...}
  118.  
  119.      Inc (DriveCounter);
  120. END;
  121.  
  122. PROCEDURE WriteTotalInfo;                          {Called by main.}
  123. VAR  i : ShortInt;
  124. BEGIN
  125.      TextColor(LightGray);
  126.      FOR i := 1 to 59 DO                         {Draw a line of equals.}
  127.          Write('=');
  128.          WriteLn;
  129.  
  130.      TextColor(Yellow);        Write('TOTALS=');
  131.      WriteInColor(TU,TF,TS);
  132.      WritePercent(TF,TS);                          {...a procedure...}
  133. END;
  134.  
  135. {=============================================================================}
  136. { Gets the first installed CD-ROM drive letter in a system.
  137.   Part of the Heartware Toolkit v2.00 (HTdisk.PAS) for Turbo Pascal.
  138.   Author: Jose Almeida. P.O.Box 4185. 1504 Lisboa Codex. Portugal.
  139.           I can also be reached at RIME network, site ->TIB or #5314.
  140.   Feel completely free to use this source code in any way you want, and, if
  141.   you do, please don't forget to mention my name, and, give me and Swag the
  142.   proper credits. }
  143.  
  144. FUNCTION First_CD_ROM_Drive : byte;
  145. { DESCRIPTION:
  146.     Gets the first installed CD-ROM drive letter in a system.
  147.   SAMPLE CALL:
  148.     NB := First_CD_ROM_Drive;
  149.   RETURNS:
  150.     0 : drive A
  151.     1 : drive B
  152.     and so on... }
  153.  
  154. var
  155.   HTregs : registers;
  156.  
  157. BEGIN { First_CD_ROM_Drive }
  158.   HTregs.AX := $1500;
  159.   HTregs.BX := $0000;
  160.   Intr($2F,HTregs);
  161.   First_CD_ROM_Drive := HTregs.CL;
  162. END; { First_CD_ROM_Drive }
  163. {=============================================================================}
  164.  
  165. var FirstCD : byte ;
  166.  
  167. BEGIN
  168.      TS := 0;  TF := 0;  TU := 0;
  169.      DriveCounter := 3;
  170.      FirstCD      := First_CD_ROM_Drive+1;
  171.      IF ParamStr(1) = '' THEN ClrScr;{Clear screen unless ANY parameter given.}
  172.  
  173.      WriteHeader;                           {...a procedure...}
  174.  
  175.      WHILE (( DiskFree(DriveCounter) ) <> -1) DO
  176.        IF ( not ( FirstCD = DriveCounter )) THEN
  177.           WriteDriveInfo                    {...a procedure...}
  178.        ELSE
  179.           Inc (DriveCounter);
  180.  
  181.      WriteTotalInfo;                        {...a procedure...}
  182.      NormVideo;
  183. END.
  184.