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