home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / HTMIX20.ZIP / DMI.ZIP / MI.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-07-10  |  9.2 KB  |  306 lines
  1. program MemoryInfo;
  2. {┌──────────────────────────────── INFO ────────────────────────────────────┐}
  3. {│ File    : MI.PAS                                                         │}
  4. {│ Author  : Harald Thunem                                                  │}
  5. {│ Purpose : Provide information about RAM, extended and expanded memory.   │}
  6. {│ Updated : July 2 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. uses Dos,
  22.      Screen,
  23.      Keyboard,
  24.      Strings;
  25.  
  26. var  Regs        : registers;
  27.      TotalRAM,
  28.      AvailRAM,
  29.      TotalXMS,
  30.      PagesInst,
  31.      PagesAvail,
  32.      TotalEXP,
  33.      AvailEXP,
  34.      SystemEXP,
  35.      OtherEXP,
  36.      i,NumHandles: word;
  37.      EXTInfo,
  38.      EXPInstalled: boolean;
  39.      EXPVersion  : string;
  40.      PList       : array[1..512] of record
  41.                                       Handle,Pages: word;
  42.                                     end;
  43.  
  44. procedure GetRAMInfo;
  45. {┌──────────────────────────────────────────────────────────────────────────┐}
  46. {│  Get Random Access Memory information                                    │}
  47. {└──────────────────────────────────────────────────────────────────────────┘}
  48. begin
  49.   FillChar(Regs,SizeOf(Regs),$00);
  50.   Intr($12,Regs);
  51.   TotalRAM := Regs.AX;                { Total RAM on system (usually 640 Kb) }
  52.   AvailRAM := (MemAvail div 1000)+24; { Available RAM, 24 Kb used by program }
  53. end;
  54.  
  55.  
  56. procedure GetEXPInfo;
  57. {┌──────────────────────────────────────────────────────────────────────────┐}
  58. {│  Get expanded memory information                                         │}
  59. {└──────────────────────────────────────────────────────────────────────────┘}
  60. var v1,v2: byte;
  61. begin
  62.   { Check if installed expanded memory }
  63.   FillChar(Regs,SizeOf(Regs),$00);
  64.   Regs.AH := $40;
  65.   Intr($67,Regs);
  66.   EXPInstalled := (Regs.AH = 0);
  67.  
  68.   if not EXPInstalled then
  69.     Exit;
  70.  
  71.   { Check number of installed and available 16K pages }
  72.   FillChar(Regs,SizeOf(Regs),$00);
  73.   Regs.AH := $42;
  74.   Intr($67,Regs);
  75.   PagesInst  := Regs.DX;
  76.   PagesAvail := Regs.BX;
  77.   TotalEXP   := 16*PagesInst;  { Total expanded in KBytes     }
  78.   AvailEXP   := 16*PagesAvail; { Available expanded in KBytes }
  79.  
  80.   { Get LIM version number }
  81.   FillChar(Regs,SizeOf(Regs),$00);
  82.   Regs.AH := $46;
  83.   Intr($67,Regs);
  84.   v1 := Regs.AL shr 4;
  85.   v2 := Regs.AL and $0F;
  86.   EXPVersion := StrL(v1)+'.'+StrL(v2);
  87.  
  88.   { Get number of pages occupied by each handle }
  89.   FillChar(Regs,SizeOf(Regs),$00);
  90.   Regs.AH := $4D;
  91.   Regs.ES := Seg(PList);
  92.   Regs.DI := Ofs(PList);
  93.   Intr($67,Regs);
  94.   NumHandles := Regs.BX;
  95.   SystemEXP := 16*PList[1].Pages;
  96.   OtherEXP := 0;
  97.   for i := 2 to NumHandles do
  98.     OtherEXP := OtherEXP + 16*PList[i].Pages;
  99. end;
  100.  
  101.  
  102. procedure GetXMSInfo;
  103. {┌──────────────────────────────────────────────────────────────────────────┐}
  104. {│  Get extended memory in KBytes                                           │}
  105. {└──────────────────────────────────────────────────────────────────────────┘}
  106. var b1,b2: word;
  107. begin
  108.   Port[$70] := $30;
  109.   b1 := Port[$71];
  110.   Port[$70] := $31;
  111.   b2 := Port[$71];
  112.   TotalXMS := (b2 shl 8) + b1;
  113. end;
  114.  
  115.  
  116. procedure QuitProgram(b: byte);
  117. begin
  118.   SetCursor(CursorUnderline);
  119.   case b of
  120.     1: GotoRC(16,1);
  121.     2: begin
  122.          Fill(25,1,1,80,White+BlackBG,' ');
  123.          GotoRC(24,1);
  124.        end;
  125.     3: GotoRC(15,1);
  126.   end;
  127.   Halt(0);
  128. end;
  129.  
  130.  
  131. procedure AddSmallShadow(Row,Col,Rows,Cols: byte);
  132. var i,Attr: byte;
  133. begin
  134.   for i := 1 to Cols do
  135.   begin
  136.     Attr := ReadAttr(Row+Rows,Col+i) and $F0;
  137.     WriteStr(Row+Rows,Col+i,Attr,'▀');
  138.   end;
  139.   for i := 1 to Rows-1 do
  140.   begin
  141.     Attr := ReadAttr(Row+i,Col+Cols) and $F0;
  142.     WriteStr(Row+i,Col+Cols,Attr,'█');
  143.   end;
  144.   Attr := ReadAttr(Row,Col+Cols) and $F0;
  145.   WriteStr(Row,Col+Cols,Attr,'▄');
  146. end;
  147.  
  148.  
  149. procedure DrawInfo;
  150. const Max=60;
  151. var   MBUsed,
  152.       MBFree,
  153.       FractionFree,
  154.       FractionUsed : single;
  155.       Start,
  156.       i,m          : byte;
  157.       s            : string;
  158.  
  159.   procedure WritePList(Num,Row,Col,Attr: byte);
  160.   begin
  161.     with PList[Num] do
  162.     s := ' '+StrLF(Handle,3)+'    '+StrLF(Pages,4)+'  '+StrLF(16*Pages,5)+' ';
  163.     WriteStr(Row,Col,Attr,s);
  164.   end;
  165.  
  166. begin
  167.   ClrScr;
  168.   SetCursor(CursorOff);
  169.   if not EXTInfo then
  170.     Explode(1,1,15,80,White+BlueBG,DoubleBorder)
  171.     else if TotalEXP<=0 then
  172.       Explode(1,1,16,80,White+BlueBG,DoubleBorder)
  173.     else Explode(1,1,25,80,White+BlueBG,DoubleBorder);
  174.   Fill(2,5,3,72,White+CyanBG,' ');
  175.   Box(2,6,3,70,White+CyanBG,SingleBorder,' ');
  176.   AddSmallShadow(2,5,3,72);
  177.   WriteC(3,40,SameAttr,'Memory Information');
  178.  
  179.   WriteStr(6,5,White+GreenBG,' RAM      ');
  180.   AddSmallShadow(6,5,1,10);
  181.   FractionFree := AvailRAM / TotalRAM;
  182.   FractionUsed := 1-FractionFree;
  183.   m := Max;
  184.   for i := 1 to m do
  185.   begin
  186.     WriteStr(6,16+i,Yellow,'█');
  187.     WriteStr(7,17+i,Blue+BlackBG,'▄');
  188.     WriteStr(6,17+i,Blue+BlackBG,'▀');
  189.     Delay(4);
  190.   end;
  191.   m := Round(Max*FractionUsed);
  192.   for i := 1 to m do
  193.   begin
  194.     WriteStr(6,16+i,LightCyan+BlueBG,'▒');
  195.     Delay(5);
  196.   end;
  197.   WriteStr(8,17,LightCyan+BlueBG,'▒▒▒');
  198.   WriteEos(White+BlueBG,'  Used');
  199.   AddSmallShadow(8,17,1,3);
  200.   WriteStr(10,17,Yellow,'███');
  201.   WriteEos(White+BlueBG,'  Free');
  202.   AddSmallShadow(10,17,1,3);
  203.   Fill(8,40,3,37,White+GreenBG,' ');
  204.   AddSmallShadow(8,40,3,37);
  205.   WriteStr( 8,40,SameAttr,'    Total system RAM - '+StrLF(TotalRAM,3)+' Kbytes');
  206.   WriteStr( 9,40,SameAttr,'  - Used RAM         - '+StrLF(TotalRAM-AvailRAM,3)+' Kbytes');
  207.   WriteStr(10,40,SameAttr,'  = Available RAM    - '+StrLF(AvailRAM,3)+' Kbytes');
  208.  
  209.   if not EXTInfo then
  210.   begin
  211.     WriteStr(13,15,White+CyanBG,' MI /X   to get info about extended/expanded memory ');
  212.     AddSmallShadow(13,15,1,52);
  213.     QuitProgram(3);
  214.   end;
  215.   WriteStr(12,5,White+RedBG,' EXTENDED ');
  216.   AddSmallShadow(12,5,1,10);
  217.   if TotalXMS<=0 then
  218.   begin
  219.     WriteStr(12,17,White+RedBG,' Not available ');
  220.     AddSmallShadow(12,17,1,15);
  221.   end
  222.   else begin
  223.     s := ' '+StrL(TotalXMS)+' Kbytes (from CMOS) ';
  224.     WriteStr(12,17,White+RedBG,s);
  225.     AddSmallShadow(12,17,1,Length(s));
  226.   end;
  227.  
  228.   WriteStr(14,5,White+MagentaBG,' EXPANDED ');
  229.   AddSmallShadow(14,5,1,10);
  230.   if TotalEXP<=0 then
  231.   begin
  232.     WriteStr(14,17,White+MagentaBG,' Not available ');
  233.     AddSmallShadow(14,17,1,15);
  234.     QuitProgram(1);
  235.   end;
  236.   FractionFree := AvailEXP / TotalEXP;
  237.   FractionUsed := 1-FractionFree;
  238.   m := Max;
  239.   for i := 1 to m do
  240.   begin
  241.     WriteStr(14,16+i,Yellow,'█');
  242.     WriteStr(15,17+i,Blue+BlackBG,'▄');
  243.     WriteStr(14,17+i,Blue+BlackBG,'▀');
  244.     Delay(4);
  245.   end;
  246.   m := Round(Max*FractionUsed);
  247.   for i := 1 to m do
  248.   begin
  249.     WriteStr(14,16+i,LightCyan+BlueBG,'▒');
  250.     Delay(5);
  251.   end;
  252.   Fill(16,17,8,60,White+MagentaBG,' ');
  253.   AddSmallShadow(16,17,8,60);
  254.   WriteStr(17,19,SameAttr,'EMM Version : LIM '+EXPVersion);
  255.   WriteStr(19,19,SameAttr,'Total EMS memory   :   '+StrLF(TotalEXP,4)+' Kb');
  256.   WriteStr(20,19,SameAttr,'Reserved by system : - '+StrLF(SystemEXP,4)+' Kb');
  257.   WriteStr(21,19,SameAttr,'Allocated          : - '+StrLF(OtherEXP,4)+' Kb');
  258.   WriteStr(22,19,SameAttr,'Available          : = '+StrLF(AvailEXP,4)+' Kb');
  259.   WriteStr(17,52,SameAttr,'Handle  Pages   Size');
  260.   Fill(19,52,4,20,White+LightGrayBG,' ');
  261.   m := NumHandles;
  262.   if m > 4 then m := 4;
  263.   for i := 1 to m do
  264.     WritePList(i,18+i,52,White+LightGrayBG);
  265.   i := 1;
  266.   Start := 1;
  267.   WritePList(i,19+i-Start,52,White+BlackBG);
  268.   if NumHandles<=1 then
  269.     QuitProgram(2)
  270.   else WriteC(25,40,Black+CyanBG,' '+#24+#25+'-Up/Down   Esc-Quit ');
  271.   repeat
  272.     InKey(Ch,Key);
  273.     WritePList(i,19+i-Start,52,White+LightGrayBG);
  274.     case Key of
  275.       UpArrow  : if i>1 then Dec(i);
  276.       DownArrow: if i<NumHandles then Inc(i);
  277.     end;
  278.     if i<Start then
  279.     begin
  280.       ScrollDown(19,52,4,20,White+BlackBG);
  281.       Dec(Start);
  282.     end;
  283.     if i>Start+3 then
  284.     begin
  285.       ScrollUp(19,52,4,20,White+BlackBG);
  286.       Inc(Start);
  287.     end;
  288.     WritePList(i,19+i-Start,52,White+BlackBG);
  289.   until Key=Escape;
  290.   QuitProgram(2);
  291. end;
  292.  
  293.  
  294. begin
  295.   EXTInfo := false;
  296.   if ParamCount=1 then
  297.     if (ParamStr(1)='/x') or (ParamStr(1)='/X') then
  298.       EXTInfo:=true;
  299.   GetRAMInfo;
  300.   if EXTInfo then
  301.   begin
  302.     GetEXPInfo;
  303.     GetXMSInfo;
  304.   end;
  305.   DrawInfo;
  306. end.