home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 31 / CDASC_31_1996_juillet_aout.iso / vrac / fsp131.zip / FSP.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-12  |  14KB  |  528 lines
  1. {$M 5120,0,655360}
  2. {$N-,E- no math support needed}
  3. {$X- function calls may not be discarded}
  4. {$I- disable I/O checking (trap errors by checking IOResult)}
  5.  
  6. PROGRAM FSP;
  7. USES DOS; {for Registers}
  8. CONST
  9.   ProgramName = 'FSP (Free SPace), v1.31 - DOS Multiple Hard Disk Space Utilization Utility.';
  10.   AuthorsName = 'Freeware, copyright(c) May 12th, 1996 by David Daniel Anderson/ Reign Ware.';
  11.   ChartHeader = 'DRIVE        ALLOCATED     FREE SPACE    TOTAL SPACE   FREE %   LABEL';
  12.   ChartWidth = 75;
  13.   lf = #13#10;
  14.   Black =         0;
  15.   Blue =          1;
  16.   Green =         2;
  17.   Cyan =          3;
  18.   Red =           4;
  19.   Magenta =       5;
  20.   Brown =         6;
  21.   LightGray =     7;
  22.   DarkGray =      8;
  23.   LightBlue =     9;
  24.   LightGreen =   10;
  25.   LightCyan =    11;
  26.   LightRed =     12;
  27.   LightMagenta = 13;
  28.   Yellow =       14;
  29.   White =        15;
  30.  
  31. { GetDriveType return values.  REQUIRES DOS 3.x or greater}
  32.  
  33.   dtError     = 0; { Drive physically isn't available }
  34.   dtRemote    = 1; { Remote (network) disk drive }
  35.   dtFixed     = 2; { Fixed (hard) disk drive }
  36.   dtRemovable = 3; { Removable (floppy) disk drive }
  37.   dtBadVer    = $FF; { Invalid DOS version (DOS 3.x required) }
  38.  
  39. VAR
  40.   TS, TF, TU : REAL;     {bytes of Total space Size/Free/Used}
  41.   BaseOfScreen : WORD;
  42.   Output_Redirected : BOOLEAN;
  43. {-----------------------------------------------------------------------------}
  44. PROCEDURE ShowUsage;
  45. BEGIN
  46.   WriteLn (ProgramName);
  47.   WriteLn (AuthorsName+lf);
  48.   WriteLn ('Usage: FSP [/K] [/N] [/F]'+lf);
  49.   WriteLn ('Where: /K = Keep screen (don''t clear)');
  50.   WriteLn ('       /N = report Network drives also');
  51.   WriteLn ('       /F = report Floppy drives also');
  52.   Halt (1);
  53. END;
  54.  
  55. FUNCTION RPad (bstr: STRING; len: BYTE): STRING;
  56. BEGIN
  57.   WHILE (Length (bstr) < len) DO
  58.     bstr := bstr + #32;
  59.   RPad := bstr;
  60. END;
  61.  
  62. FUNCTION LPad (bstr: STRING; len: BYTE): STRING;
  63. BEGIN
  64.   WHILE (Length (bstr) < len) DO
  65.     bstr := #32+bstr;
  66.   LPad := bstr;
  67. END;
  68.  
  69. FUNCTION WhereX: BYTE; ASSEMBLER;
  70. (* Routine from SWAG *)
  71. ASM
  72.   MOV AH, 3     {Ask For current cursor position}
  73.   MOV BH, 0     { On page 0 }
  74.   Int 10h       { Return inFormation in DX }
  75.   Inc DL        { Bios Assumes Zero-based. Crt.WhereX Uses 1 based }
  76.   MOV AL, DL    { Return X position in AL For use in Byte Result }
  77. END;
  78.  
  79. FUNCTION WhereY: BYTE; ASSEMBLER;
  80. (* Routine from SWAG *)
  81. ASM
  82.   MOV AH, 3    {Ask For current cursor position}
  83.   MOV BH, 0    { On page 0 }
  84.   Int 10h      { Return inFormation in DX }
  85.   Inc DH       { Bios Assumes Zero-based. Crt.WhereY Uses 1 based }
  86.   MOV AL, DH   { Return Y position in AL For use in Byte Result }
  87. END;
  88.  
  89. PROCEDURE GotoXY (X, Y: BYTE); ASSEMBLER;
  90. (* Routine from SWAG *)
  91. ASM
  92.   MOV DH, Y    { DH = Row (Y) }
  93.   MOV DL, X    { DL = Column (X) }
  94.   Dec DH       { Adjust For Zero-based Bios routines }
  95.   Dec DL       { Turbo Crt.GotoXY is 1-based }
  96.   MOV BH, 0    { Display page 0 }
  97.   MOV AH, 2    { Call For SET CURSOR POSITION }
  98.   Int 10h
  99. END;
  100.  
  101. PROCEDURE GetBaseOfScreen; ASSEMBLER;
  102. ASM
  103.   MOV  BaseOfScreen, $B000
  104.   MOV  AX, $0F00
  105.   INT  $10
  106.   CMP  AL, 2
  107.   JE   @XXX
  108.   CMP  AL, 7
  109.   JE   @XXX
  110.   MOV  BaseOfScreen, $B800
  111.   @XXX:
  112. END;
  113.  
  114. PROCEDURE FastWrite (X,Y: WORD; ColorAttr: BYTE; CONST MsgText: STRING); ASSEMBLER;
  115. (* From: Jens Larsson, found in SWAG *)
  116. ASM
  117.   dec   X
  118.   dec   Y
  119.  
  120.   mov   AX, Y
  121.   mov   CL, 5
  122.   shl   AX, CL
  123.   mov   DI, AX
  124.   mov   CL, 2
  125.   shl   AX, CL
  126.   add   DI, AX
  127.   shl   X, 1
  128.   add   DI, X
  129.  
  130.   mov   AX, BaseOfScreen;
  131.   mov   ES, AX
  132.   xor   CH, CH
  133.   push  DS
  134.   lds   SI, MsgText
  135.   lodsb
  136.   mov   CL, AL
  137.   mov   AH, ColorAttr
  138.   jcxz  @@END
  139. @@l1:
  140.   lodsb
  141.   stosw
  142.   loop  @@L1
  143. @@end:
  144.   pop   DS
  145. END;
  146.  
  147. PROCEDURE QWrite (Column, Line, fColor, bColor: BYTE; CONST fStr: STRING);
  148. VAR
  149.   NumCol : WORD ABSOLUTE $0040 : $004A; { Number of CRT columns (1-based) }
  150.   StrLen : BYTE ABSOLUTE fStr;
  151.   Color  : BYTE;
  152.  
  153. BEGIN
  154.   IF Output_Redirected THEN
  155.     Write (fStr)
  156.   ELSE BEGIN
  157.     Color := fColor OR (bColor sHL 4);
  158.     FastWrite (Column, Line, Color, fStr);
  159.     GotoXY (WhereX+(StrLen MOD NumCol), WhereY+(StrLen DIV NumCol));
  160.   END;
  161. END;
  162.  
  163. PROCEDURE ClrScr; ASSEMBLER;
  164. (* Routine from SWAG *)
  165. ASM
  166.   MOV AH, 0Fh
  167.   Int 10h
  168.   MOV AH, 0
  169.   Int 10h
  170. END;
  171.  
  172. FUNCTION Comma (r : REAL) : STRING; {Used in WriteDriveInfo & WriteTotalInfo}
  173. VAR s : STRING [14];                {Insert commas to break up number string}
  174.   l : SHORTINT;
  175. BEGIN
  176.   Str (r : 0 : 0, s);
  177.   l := (Length (s) - 2);
  178.   WHILE (l > 1) DO BEGIN
  179.     Insert (',', s, l);
  180.     Dec (l, 3);
  181.   END;
  182.   Comma := s;
  183. END;
  184.  
  185. FUNCTION LeadingZero (w : WORD) : STRING;
  186. VAR  s : STRING;
  187. BEGIN
  188.   Str (w : 0, s);
  189.   IF (Length (s) = 1) THEN
  190.     s := '0'+s;
  191.   LeadingZero := s;
  192. END;
  193.  
  194. PROCEDURE UpperCase(VAR UpStr :STRING); ASSEMBLER;
  195. (* Routine to convert string to uppercase, from SWAG *)
  196. ASM
  197.   Push ES                       {  Save Registers to be used            }
  198.   Push DI
  199.   Push CX
  200.   LES DI,UpStr                  {  Point ES:DI to string to be converted}
  201.   Sub CX,CX                     {  Clear CX                             }
  202.   Mov CL,ES:[DI]                {  Load Length of string for looping    }
  203.   Cmp CX,0                      {  Check for a clear string             }
  204.   JE @Exit                      {  If it was then exit                  }
  205. @ReadStr:
  206.   Inc DI                        {  Point to next Character              }
  207.   Cmp BYTE PTR ES:[DI],'z'      {  If Character above 'z' jump to end of}
  208.   Ja @LoopEnd                   {  loop.                                }
  209.   Cmp BYTE PTR ES:[DI],'a'      {  if below 'a' jump to end of loop.    }
  210.   Jb @LoopEnd
  211.   Sub BYTE PTR ES:[DI],32       {  If not make it upper case            }
  212. @LoopEnd:
  213.   Loop @ReadStr                 {  Loop Until done                      }
  214. @Exit:
  215.   Pop CX                        {  Restore registers                    }
  216.   Pop DI
  217.   Pop ES
  218. END;{UpperCase}
  219.  
  220. FUNCTION UpStr (Source: STRING): STRING;
  221. BEGIN
  222.   UpperCase (Source);
  223.   UpStr := Source;
  224. END;
  225.  
  226. FUNCTION OutputRedirected : BOOLEAN;
  227. (* FROM SWAG *)
  228. VAR
  229.   Regs : REGISTERS;
  230.   Handle : WORD ABSOLUTE Output;
  231. BEGIN
  232.   WITH Regs DO
  233.   BEGIN
  234.     AX := $4400;
  235.     BX := Handle;
  236.     MsDos (Regs);
  237.     IF (DL AND $82) = $82
  238.       THEN OutputRedirected := FALSE
  239.       ELSE OutputRedirected := TRUE;
  240.   END; {With Regs}
  241. END; {OutputRedirected}
  242.  
  243. FUNCTION DriveSize (D : BYTE) : LONGINT; { -1 not found, 1=>1 Giga }
  244. (* FROM SWAG *)
  245. VAR
  246.   Regs : REGISTERS;
  247. BEGIN
  248.   WITH Regs DO
  249.   BEGIN
  250.     AH := $36;
  251.     DL := D;
  252.     Intr ($21, Regs);
  253.     IF AX = $FFFF THEN
  254.       DriveSize := - 1 { Drive not found }
  255.     ELSE
  256.       IF (DX = $FFFF) OR (LONGINT (AX) * CX * DX = 1073725440)
  257.         THEN DriveSize := 1
  258.         ELSE DriveSize := LONGINT (AX) * CX * DX;
  259.   END;
  260. END;
  261.  
  262. FUNCTION DriveFree (D : BYTE) : LONGINT; { -1 not found, 1=>1 Giga }
  263. (* FROM SWAG *)
  264. VAR
  265.   Regs : REGISTERS;
  266. BEGIN
  267.   WITH Regs DO
  268.   BEGIN
  269.     AH := $36;
  270.     DL := D;
  271.     Intr ($21, Regs);
  272.     IF AX = $FFFF THEN
  273.       DriveFree := - 1 { Drive not found }
  274.     ELSE
  275.       IF (BX = $FFFF) OR (LONGINT (AX) * BX * CX = 1073725440)
  276.         THEN DriveFree := 1
  277.         ELSE DriveFree := LONGINT (AX) * BX * CX;
  278.   END;
  279. END;
  280.  
  281. FUNCTION GetDriveType(Drive : BYTE) : BYTE; ASSEMBLER;
  282. ASM
  283.   MOV AH,30h
  284.   INT 21h
  285.   CMP AL,3
  286.   JGE @@1
  287.   MOV AL,dtBadVer
  288.   JMP @@4
  289. @@1:
  290.   MOV BL,Drive
  291.   MOV AX,4409h
  292.   INT 21h
  293.   JNC @@2
  294.   MOV AL,dtError
  295.   JMP @@5
  296. @@2:
  297.   CMP AL,True
  298.   JNE @@3
  299.   MOV AL,dtRemote
  300.   JMP @@5
  301. @@3:
  302.   MOV AX,4408h
  303.   INT 21h
  304.   CMP AL,True
  305.   JNE @@4
  306.   MOV AL,dtFixed
  307.   JMP @@5
  308. @@4:
  309.   MOV AL,dtRemovable
  310. @@5:
  311. END; { GetDriveType }
  312.  
  313. FUNCTION IsCDROM (DRIVE: BYTE): BOOLEAN;
  314. (* FROM SWAG *)
  315. CONST
  316.   CDROM_INTERRUPT = $2f;
  317. VAR
  318.   Regs : REGISTERS;
  319.  
  320.   { Returns a code indicating whether a particular logical  }
  321.   { unit is supported by the Microsoft CD-ROM Extensions    }
  322.   { module (MSCDEX).                                        }
  323.  
  324. BEGIN
  325.   Regs. AX := $150b;
  326.   Regs. BX := $0000;
  327.   Regs. CX := DRIVE-1;
  328.   Intr (CDROM_INTERRUPT, Regs);
  329.   IsCDROM := (Regs. AX <> $0000) AND (Regs. BX = $adad);
  330. END;
  331.  
  332. FUNCTION IsDriveValid (cDrive : BYTE): BOOLEAN;
  333. { ** portion of a SWAG snippet -- modified for FSP
  334.  
  335.   Parameters: cDrive is the drive letter to check: 1 to 26 (A to Z).
  336.  
  337.   Returns: Function returns True only if the given drive is valid, and it
  338.   is not SUBSTituted.
  339. }
  340. VAR
  341.   rCPU: DOS. REGISTERS;
  342.   bLocal,
  343.   bSUBST : BOOLEAN;
  344. BEGIN
  345.   bLocal := FALSE;
  346.   bSUBST := FALSE;
  347.   IsDriveValid := FALSE;
  348.  
  349.   rCPU. BX := cDrive;
  350.   rCPU. AX := $4409;
  351.   { --- Call the Dos IOCTL (InOutConTroL)-Functions --- }
  352.   Intr ($21, rCPU);
  353.   IF NOT ((rCPU. AX AND fCarry) = fCarry)
  354.     THEN BEGIN { --- drive is valid, check status --- }
  355.       bLocal := ((rCPU. DX AND $1000) = $0000);
  356.       IF bLocal THEN bSUBST := ((rCPU. DX AND $8000) = $8000);
  357.       IF (NOT bSUBST) THEN IsDriveValid := TRUE;
  358.     END;
  359. END; { IsDriveValid }
  360.  
  361. PROCEDURE WriteDTInf;            {Called by WriteHeader to write Date & Time.}
  362. CONST
  363.   Mon : ARRAY [1..12] OF STRING [9] =
  364.   ('January', 'February', 'March', 'April', 'May', 'June', 'July',
  365.   'August', 'September', 'October', 'November', 'December');
  366.   comma = #44;
  367.   space = #32;
  368.   colon = #58;
  369. VAR
  370.   Year, Month, Day, dow,
  371.   Hour, Min,   Sec, hund : WORD;
  372.   DStr                   : STRING [8];
  373.   YStr                   : STRING [4];
  374.   DateStr                : STRING [ChartWidth - 8];
  375.   OFFSET                 : BYTE;
  376. BEGIN
  377.   GetDate (Year, Month, Day, dow);
  378.   GetTime (Hour, Min, Sec, hund);
  379.   Str (Day, DStr);
  380.   Str (Year, YStr);
  381.   DateStr := Mon [Month]+space+DStr+comma+space+YStr;
  382.   OFFSET := Length (DateStr);
  383.   DateStr [0] := Chr (ChartWidth - 8);
  384.   FillChar (DateStr [OFFSET+1], (ChartWidth - (OFFSET+8)), space);
  385.   QWrite (WhereX, WhereY, LightBlue, Black,
  386.     (DateStr+LeadingZero(Hour)+colon+LeadingZero(Min)+colon+LeadingZero(Sec)));
  387.   WriteLn;
  388. END;
  389.  
  390. PROCEDURE WriteHeader;                 {Called by main.}
  391. VAR
  392.   hyphens : STRING [ChartWidth];
  393. BEGIN
  394.   QWrite (WhereX, WhereY, White, Blue, ProgramName); WriteLn;
  395.   QWrite (WhereX, WhereY, White, Blue, AuthorsName); WriteLn;
  396.  
  397.   WriteDTInf;
  398.   QWrite (WhereX, WhereY, LightCyan, Black, ChartHeader); WriteLn;
  399.  
  400.   hyphens [0] := Chr (ChartWidth);
  401.   FillChar (hyphens [1], ChartWidth, '-');
  402.   QWrite (WhereX, WhereY, LightCyan, Black, hyphens); WriteLn;
  403. END;
  404.  
  405. PROCEDURE WriteSizes (u, f, s : REAL);
  406. BEGIN
  407.   QWrite (WhereX, WhereY, LightRed, Black, LPad (Comma (U), 15));
  408.   QWrite (WhereX, WhereY, LightGreen, Black, LPad (Comma (F), 15));
  409.   QWrite (WhereX, WhereY, LightMagenta, Black, LPad (Comma (S), 15));
  410. END;
  411.  
  412. PROCEDURE WritePercent (Free, Space : REAL);     { Called by WriteDriveInfo  }
  413.                                                  {         & WriteTotalInfo. }
  414. VAR
  415.   PF : REAL;          {integer of Percentage Free, initially 10 x %}
  416.   wStr : STRING [ChartWidth];
  417. BEGIN
  418.   IF (Space > 0)
  419.     THEN PF := 100 * (Free / Space)    {Using 100 to give hundredths of %}
  420.     ELSE PF := 0;
  421.   Str (PF : 8 : 2, wStr);
  422.   QWrite (WhereX, WhereY, White, Black, wStr+'%');
  423. END;
  424.  
  425. PROCEDURE WriteDriveInfo (DriveNumber : BYTE);    {Called by main.}
  426. VAR
  427.   DS, DF, DU  : LONGINT;   {bytes of *partition* space Size/Free/Used}
  428.   VolLabel    : SEARCHREC;
  429.   VolName     : STRING [12];
  430.   DriveLetter : CHAR;
  431.   DotPos      : BYTE;
  432. BEGIN
  433.   DriveLetter := Chr (DriveNumber+64);
  434.  
  435.   DS := DriveSize (DriveNumber);
  436.   IF (DS < 0) THEN
  437.   BEGIN
  438.     DS := 0;
  439.     DF := 0;
  440.   END
  441.   ELSE
  442.     DF := DriveFree (DriveNumber);
  443.  
  444.   DU := DS-DF;
  445.   TS := TS+DS;
  446.   TF := TF+DF;
  447.   TU := TU+DU;
  448.  
  449.   QWrite (WhereX, WhereY, Yellow, Black, DriveLetter+' -=>  ');
  450.  
  451.   WriteSizes (DU, DF, DS);
  452.   WritePercent (DF, DS);
  453.  
  454.   FindFirst (DriveLetter+':\*.*', $8, VolLabel);
  455.   IF (DosError <> 0) THEN
  456.     VolName := '* none *'
  457.   ELSE BEGIN
  458.     VolName := VolLabel. Name;
  459.     DotPos := Pos ('.', VolName);
  460.     IF (DotPos <> 0) THEN
  461.       VolName := RPad (Copy (VolName, 1, DotPos-1), 8) + Copy (VolName, DotPos+1, 3);
  462.       { remove period if present, and pad first part of volume name }
  463.   END;
  464.   QWrite (WhereX, WhereY, Yellow, Black, '   '+VolName);
  465.   WriteLn;
  466. END;
  467.  
  468. PROCEDURE WriteTotalInfo;                          {Called by main.}
  469. VAR
  470.   EQLine : STRING [ChartWidth];
  471. BEGIN
  472.   EQLine [0] := Chr (ChartWidth);
  473.   FillChar (EQLine [1], ChartWidth, '=');
  474.   QWrite (WhereX, WhereY, LightGray, Black, EQline);
  475.   WriteLn;
  476.  
  477.   QWrite (WhereX, WhereY, Yellow, Black, 'TOTALS=');
  478.   WriteSizes (TU, TF, TS);
  479.   WritePercent (TF, TS);
  480.   WriteLn;
  481. END;
  482.  
  483. PROCEDURE GetParams (VAR ChkFlp, ChkNet: BOOLEAN);
  484. VAR
  485.   CmdLine  : STRING;
  486. BEGIN
  487.   CmdLine := UpStr (STRING (Ptr (PrefixSeg, $0080)^));
  488.   IF (Pos ('?', CmdLine) > 0) THEN
  489.     ShowUsage;
  490.  
  491.   IF NOT (Pos ('/K', CmdLine) > 0) THEN ClrScr;
  492.   ChkNet := (Pos ('/N', CmdLine) > 0);
  493.   ChkFlp := (Pos ('/F', CmdLine) > 0);
  494.   TS := 0;  TF := 0;  TU := 0; { initialize global variables also }
  495.   GetBaseOfScreen;                            { ditto }
  496.   Output_Redirected := OutputRedirected;      { ditto }
  497. END;
  498. {=============================================================================}
  499.  
  500. VAR
  501.   DriveNum,                 { loop counter, drive }
  502.   DriveType : BYTE;         { Type of drive: Fixed, Remote (Net) or Removable }
  503.   ChkFlp,
  504.   ChkNet,
  505.   bSUBST,                   { drive local/remote?; SUBSTed or not? }
  506.   CHECK    : BOOLEAN;       { Check this drive? }
  507.  
  508. BEGIN
  509.   GetParams (ChkFlp, ChkNet); {& init global vars}
  510.   WriteHeader;
  511.   FOR DriveNum := 1 TO 26 DO   { Check all drives, up to 'Z' }
  512.     IF IsDriveValid (DriveNum) THEN
  513.     BEGIN
  514.       DriveType := GetDriveType (DriveNum);
  515.       IF (DriveType <> dtError) AND (NOT IsCDROM (DriveNum)) THEN
  516.       BEGIN
  517.         CHECK := FALSE;
  518.         CASE DriveType OF
  519.           dtFixed  : CHECK := TRUE;
  520.           dtRemote : IF (ChkNet) THEN CHECK := TRUE;
  521.           dtRemovable : IF (ChkFlp) THEN CHECK := TRUE;
  522.         END;
  523.         IF CHECK THEN WriteDriveInfo (DriveNum);
  524.       END;
  525.     END;
  526.   WriteTotalInfo;  {using global vars}
  527. END.
  528.