home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / INFOP125.ZIP / PAGE_09.INC < prev    next >
Encoding:
Text File  |  1990-08-10  |  9.5 KB  |  398 lines
  1. procedure page_09;
  2.  
  3. const
  4.   weekday: array[0..6] of string[9] = ('Sunday', 'Monday', 'Tuesday',
  5.       'Wednesday', 'Thursday', 'Friday', 'Saturday');
  6.  
  7. var
  8.   xbool : boolean;
  9.   xbyte : byte;
  10.   xchar : char;
  11.   xstring1 : string;
  12.   xstring2 : string;
  13.   xword1 : word;
  14.   xword2 : word;
  15.   xword3 : word;
  16.   xword4 : word;
  17.   xword5 : word;
  18.   listseg, listofs: word;
  19.   filecount, usedfiles: word;
  20.  
  21.   procedure showecho(a : word);
  22.     var
  23.       xbyte : byte;
  24.  
  25.     begin
  26.     xbyte:=mem[DOScseg : a];
  27.     case xbyte of
  28.       $00 : writeln('off');
  29.       $FF : writeln('on')
  30.     else
  31.       unknown('status', xbyte, 2)
  32.     end
  33.     end; {showecho}
  34.  
  35.   procedure showbufs(a : word);
  36.     const
  37.       bufsmax = 99;
  38.  
  39.     var
  40.       i : 0..bufsmax + 1;
  41.       xbool : boolean;
  42.       xword1 : word;
  43.       xword2 : word;
  44.       xword3 : word;
  45.  
  46.     begin
  47.     if osmajor < 4 then
  48.       begin
  49.       i:=0;
  50.       xword1:=MemW[DOScseg : a];
  51.       xword2:=MemW[DOScseg : a + 2];
  52.       xbool:=false;
  53.       repeat
  54.         if i <= bufsmax then
  55.           begin
  56.           if xword1 < $FFFF then
  57.             begin
  58.             inc(i);
  59.             xword3:=xword1;
  60.             xword1:=memw[xword2 : xword3];
  61.             xword2:=memw[xword2 : xword3 + 2]
  62.             end
  63.           else
  64.             begin
  65.             xbool:=true;
  66.             writeln(i)
  67.             end
  68.           end
  69.         else
  70.           begin
  71.           xbool:=true;
  72.           dontknow
  73.           end
  74.       until xbool
  75.       end
  76.     else
  77.       with regs do
  78.         begin
  79.         AX:=$5200;
  80.         MsDos(regs);
  81.         Write(MemW[ES:BX + $3F]:5);
  82.         caption3('Read-ahead');
  83.         Writeln(MemW[ES:BX + $41])
  84.         end
  85.     end; {showbufs}
  86.     (*  BIX ms.dos/secrets #2  *)
  87.  
  88.   begin (* procedure page_09 *)
  89.   with regs do
  90.     begin
  91.     AH:=$52;
  92.     MsDos(regs);
  93.     listseg:=ES;
  94.     listofs:=BX
  95.     end;
  96.   window(1, 3, twidth div 2, tlength - 2);
  97.   caption2('DOS version');
  98.   showvers;
  99.   caption2('OEM serial number');
  100.   with regs do
  101.     begin
  102.     AX:=$3000;
  103.     BX:=0;
  104.     MsDos(regs);
  105.     Writeln(hex(BH, 2))
  106.     end;
  107.   caption2('System date');
  108.   getdate(xword1, xword2, xword3, xword4);
  109.   if xword4 < 7 then
  110.     Write(weekday[xword4])
  111.   else
  112.     write('(', hex(xword4, 4), ')');
  113.   write(', ');
  114.   xword5:=cbw(country[0], country[1]);
  115.   xchar:=chr(country[11]);
  116.   case xword5 of
  117.     $0001: writeln(xword3, xchar, xword2, xchar, xword1);
  118.     $0002: writeln(xword1, xchar, xword2, xchar, xword3)
  119.   else
  120.     writeln(xword2, xchar, xword3, xchar, xword1)
  121.   end;
  122.   caption2('System time');
  123.   gettime(xword1, xword2, xword3, xword4);
  124.   if country[17] and 1 = 0 then
  125.     case xword1 of
  126.       0: Write('12');
  127.       1..12: zeropad(xword1);
  128.       13..23: Write(xword1 - 12)
  129.     end
  130.   else
  131.     zeropad(xword1);
  132.   write(chr(country[13]));
  133.   zeropad(xword2);
  134.   write(chr(country[13]));
  135.   zeropad(xword3);
  136.   write(chr(country[9]));
  137.   zeropad(xword4);
  138.   if country[17] and 1 = 0 then
  139.     if xword1 > 11 then
  140.       Write(' pm')
  141.     else
  142.       Write(' am');
  143.   writeln;
  144.   caption2('Command load paragraph');
  145.   writeln(hex(prefixseg, 4));
  146.   getcbreak(xbool);
  147.   offoron('Ctrl-C check', xbool);
  148.   getverify(xbool);
  149.   offoron('Disk verify', xbool);
  150.   caption2('Switch prefix character');
  151.   writeln(switchar);
  152.   caption2('\DEV\ prefix for devices');
  153.   with regs do begin
  154.     AX:=$3702;
  155.     MSDOS(regs);
  156.     if DL = $00 then
  157.       writeln('required')
  158.     else
  159.       writeln('optional')
  160.   end;
  161.   caption2('Reset boot');
  162.   xword1:=memw[BIOSdseg : $72];
  163.   case xword1 of
  164.     $0000: Writeln('cold');
  165.     $1234, $1200, $EDCB: Writeln('bypass memory test');
  166.     $4321: Writeln('preserve memory');
  167.     $5678: Writeln('system suspended');
  168.     $9ABC{-25924}: Writeln('manufacturing test mode'); (*!$9ABC*)
  169.     $ABCD{-21555}: Writeln('system POST loop mode') (*!$ABCD*)
  170.   else
  171.     unknown('flag', xword1, 4)
  172.   end;
  173.   caption2('Boot disk was');
  174.   if osmajor >=4 then
  175.     with regs do
  176.       begin
  177.       AX:=$3305;
  178.       MsDos(regs);
  179.       Writeln(Chr(DL+$40), ':')
  180.       end
  181.   else
  182.     dontknow;
  183. (*  Byte 12:12 p.178  *)
  184.   with regs do begin
  185.     caption2('DOS critical flag');
  186.     AX:=$5D06;
  187.     MSDOS(regs);
  188.     segofs(DS, SI);
  189.     writeln
  190.   end;
  191.   caption2('DOS busy flag    ');
  192.   segofs(DOScseg, DOScofs);
  193.   writeln;
  194.   caption2('Printer echo');
  195.   case osmajor of
  196.     3 : case osminor div 10 of
  197.       0 : dontknow;
  198.       1..3 : showecho($02AC)
  199.       else
  200.         dontknow
  201.     end;
  202.       4 : showecho($02FE);
  203.   else
  204.       dontknow
  205.   end;
  206. (*  BIX ms.dos/secrets #501  *)
  207.   caption2('PrtSc status');
  208.   xbyte:=mem[BIOSdseg : $0100];
  209.   case xbyte of
  210.     $00 : writeln('ready');
  211.     $01 : writeln('busy');
  212.     $FF : writeln('error on last PrtSc')
  213.     else
  214.       unknown('status', xbyte, 2)
  215.   end;
  216.   caption2('Memory allocation');
  217.   with regs do begin
  218.     AX:=$5800;
  219.     MSDOS(regs);
  220.     case AL of
  221.       0: Writeln('first fit');
  222.       1: Writeln('best fit');
  223.       2: Writeln('last fit')
  224.     else
  225.       dontknow
  226.     end
  227.   end;
  228.   caption2('DOS buffers');
  229.   case osmajor of
  230.     3 : case osminor div 10 of
  231.           0 : showbufs($013F);
  232.           1..3 : showbufs($0038)
  233.         else
  234.           dontknow
  235.         end;
  236.     4 : showbufs(0)
  237.   else
  238.     dontknow
  239.   end;
  240.   caption2('File handle table ');
  241.   xword1:=memw[prefixseg : $0036];
  242.   xword2:=memw[prefixseg : $0034];
  243.   segofs(xword1, xword2);
  244.   Writeln;
  245.   caption3('length');
  246.   xword2:=MemW[listseg:listofs + 4];
  247.   xword1:=MemW[listseg:listofs + 6];
  248.   xbool:=false;
  249.   filecount:=0;
  250.   repeat
  251.     xword4:=MemW[xword1:xword2];
  252.     xword3:=MemW[xword1:xword2 + 2];
  253.     filecount:=filecount + MemW[xword1:xword2 + 4];
  254.     if xword4 = $FFFF then
  255.       xbool:=true
  256.     else
  257.       begin
  258.       xword1:=xword3;
  259.       xword2:=xword4
  260.       end
  261.   until xbool;
  262.   Write(filecount:3);
  263.   caption3('used');
  264.   usedfiles:=0;
  265.   xword1:=MemW[PrefixSeg: $36];
  266.   xword2:=MemW[PrefixSeg: $34];
  267.   while Mem[xword1 : xword2] < $FF do begin
  268.     inc(usedfiles);
  269.     inc(xword2)
  270.   end;
  271.   writeln(usedfiles:3);
  272.   caption2('File Control Blocks');
  273.   Writeln;
  274.   caption3('amount');
  275.   if (osmajor = 4) or ((osmajor = 3) and (osminor > 0)) then
  276.     begin
  277.     xword3:=MemW[listseg:listofs + $1E];
  278.     xword2:=MemW[listseg:listofs + $1A];
  279.     xword1:=MemW[listseg:listofs + $1C]
  280.     end
  281.   else
  282.     begin
  283.     xword3:=MemW[listseg:listofs + $26];
  284.     xword2:=MemW[listseg:listofs + $22];
  285.     xword1:=MemW[listseg:listofs + $24]
  286.     end;
  287.   Write(MemW[xword1:xword2 + 4]:3);
  288.   caption3('protected');
  289.   Write(xword3:3);
  290.   window(1 + twidth div 2, 3, twidth, tlength - 2);
  291.   caption2('Stacks');
  292.   if osmajor = 3 then
  293.     dontknow
  294.   else
  295.     begin
  296.     xword1:=MemW[listseg:listofs - 2];
  297.     xword4:=0; {# of stacks}
  298.     xword5:=0; {size of stacks}
  299.     if (Mem[xword1:0] <> $4D) or (MemW[xword1:1] <> 8) then
  300.       dontknow
  301.     else
  302.       begin
  303.       xword2:=$10;
  304.       xbool:=false;
  305.       repeat
  306.         xchar:=Chr(Mem[xword1:xword2]);
  307.         if xchar = 'S' then
  308.           begin
  309.           xword3:=MemW[xword1:xword2 + 1];
  310.           xword4:=Mem[xword3:2];
  311.           xword5:=Mem[xword3:6]
  312.           end;
  313.         if (xchar = 'M') or (xchar = 'Z') then
  314.           xbool:=true;
  315.         xword2:=xword2 + (MemW[xword1:xword2 + 3] * $10) + $10;
  316.       until xbool;
  317.       Writeln;
  318.       caption3('amount');
  319.       Write(xword4:3);
  320.       caption3('size each (bytes)');
  321.       Writeln(xword5:3);
  322.       end
  323.   end;
  324.   Writeln;
  325.   TextColor(LightCyan);
  326.   Write('------ International Information -----');
  327.   Writeln;
  328.   caption2('Global code page');
  329.   with regs do begin
  330.     AX:=$6601;
  331.     MSDOS(regs);
  332.     if AL = $01 then begin
  333.       writeln;
  334.       caption3('Active ');
  335.       writeln(BX : 5);
  336.       caption3('Default');
  337.       writeln(DX : 5)
  338.     end else
  339.       writeln('N/A')
  340.   end;
  341.   caption2('Country code');
  342.   writeln(ccode);
  343.   caption2('Thousands separator character');
  344.   writeln(chr(country[7]));
  345.   caption2('Decimal separator character');
  346.   writeln(chr(country[9]));
  347.   caption2('Data-list separator character');
  348.   writeln(chr(country[22]));
  349.   caption2('Date format');
  350.   xword1:=cbw(country[0], country[1]);
  351.   xchar:=chr(country[11]);
  352.   case xword1 of
  353.     0: writeln('USA (mm', xchar, 'dd', xchar, 'yy)');
  354.     1: writeln('Europe (dd', xchar, 'mm', xchar, 'yy)');
  355.     2: writeln('Japan (yy', xchar, 'mm', xchar, 'dd)')
  356.   else
  357.     unknown('format', xword1, 4)
  358.   end;
  359.   caption3('Separator character');
  360.   writeln(xchar);
  361.   caption2('Time format');
  362.   if (country[17] and $01) = $00 then
  363.     write('12')
  364.   else
  365.     write('24');
  366.   writeln('-hour');
  367.   caption3('Separator character');
  368.   writeln(chr(country[13]));
  369.   caption2('Currency format');
  370.   xstring1:='xxxx';
  371.   insert(chr(country[7]), xstring1, 2);
  372.   xstring1:=xstring1 + chr(country[9]);
  373.   for i:=1 to country[16] do
  374.     xstring1:=xstring1 + 'y';
  375.   xstring2:='';
  376.   i:=2;
  377.   xchar:=chr(country[i]);
  378.   while (i <= 6) and (xchar > #0) do begin
  379.     xstring2:=xstring2 + xchar;
  380.     inc(i);
  381.     xchar:=chr(country[i])
  382.   end;
  383.   case country[15] and $03 of
  384.     $00 : xstring1:=xstring2 + xstring1;
  385.     $01 : xstring1:=xstring1 + xstring2;
  386.     $02 : xstring1:=xstring2 + ' ' + xstring1;
  387.     $03 : xstring1:=xstring1 + ' ' + xstring2;
  388.     $04 : begin
  389.       delete(xstring1, 6, 1);
  390.       insert(xstring2, xstring1, 6)
  391.     end
  392.   end;
  393.   writeln(xstring1);
  394.   caption2('Case map call address');
  395.   segofs(cbw(country[20], country[21]), cbw(country[18], country[19]));
  396.   writeln
  397. end;
  398.