home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / windows / infop141.zip / PAGE_09.PAS < prev    next >
Pascal/Delphi Source File  |  1990-12-08  |  10KB  |  396 lines
  1. procedure page_09;
  2.   const
  3.     weekday: array[0..6] of string[9] = ('Sunday', 'Monday', 'Tuesday',
  4.         'Wednesday', 'Thursday', 'Friday', 'Saturday');
  5.  
  6.   var
  7.     foundit, xbool: boolean;
  8.     xbyte: byte;
  9.     xchar: char;
  10.     xstring1: string;
  11.     xstring2: string;
  12.     xword1: word;
  13.     xword2: word;
  14.     xword3: word;
  15.     xword4: word;
  16.     xword5: word;
  17.     xword6: 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(decimal);
  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.       xword3:=xword1 + MemW[xword1:3] + 1;
  299.       xword2:=xword1 + 1;
  300.       xbool:=false;
  301.       repeat
  302.         xchar:=Chr(Mem[xword2:0]);
  303.         if xchar = 'S' then
  304.           begin
  305.           xword4:=MemW[xword2 + 1:2];
  306.           xword5:=MemW[xword2 + 1:6];
  307.           xbool:=true;
  308.           end;
  309.         if (xchar = 'M') or (xchar = 'Z') then
  310.           xbool:=true;
  311.         xword2:=xword2 + MemW[xword2:3] + 1;
  312.         if xword2 >= xword3 then
  313.          xbool:=true;
  314.       until xbool;
  315.       Writeln;
  316.       caption3('amount');
  317.       Write(xword4:3);
  318.       caption3('size each (bytes)');
  319.       Writeln(xword5:3);
  320.       end
  321.     end;
  322.   Writeln;
  323.   TextColor(LightCyan);
  324.   Write('------ International Information -----');
  325.   Writeln;
  326.   caption2('Global code page');
  327.   with regs do begin
  328.     AX:=$6601;
  329.     MSDOS(regs);
  330.     if AL = $01 then begin
  331.       writeln;
  332.       caption3('Active ');
  333.       writeln(BX : 5);
  334.       caption3('Default');
  335.       writeln(DX : 5)
  336.     end else
  337.       writeln('N/A')
  338.   end;
  339.   caption2('Country code');
  340.   writeln(ccode);
  341.   caption2('Thousands separator character');
  342.   writeln(chr(country[7]));
  343.   caption2('Decimal separator character');
  344.   writeln(decimal);
  345.   caption2('Data-list separator character');
  346.   writeln(chr(country[22]));
  347.   caption2('Date format');
  348.   xword1:=cbw(country[0], country[1]);
  349.   xchar:=chr(country[11]);
  350.   case xword1 of
  351.     0: writeln('USA (mm', xchar, 'dd', xchar, 'yy)');
  352.     1: writeln('Europe (dd', xchar, 'mm', xchar, 'yy)');
  353.     2: writeln('Japan (yy', xchar, 'mm', xchar, 'dd)')
  354.   else
  355.     unknown('format', xword1, 4)
  356.   end;
  357.   caption3('Separator character');
  358.   writeln(xchar);
  359.   caption2('Time format');
  360.   if (country[17] and $01) = $00 then
  361.     write('12')
  362.   else
  363.     write('24');
  364.   writeln('-hour');
  365.   caption3('Separator character');
  366.   writeln(chr(country[13]));
  367.   caption2('Currency format');
  368.   xstring1:='xxxx';
  369.   insert(chr(country[7]), xstring1, 2);
  370.   xstring1:=xstring1 + decimal;
  371.   for i:=1 to country[16] do
  372.     xstring1:=xstring1 + 'y';
  373.   xstring2:='';
  374.   i:=2;
  375.   xchar:=chr(country[i]);
  376.   while (i <= 6) and (xchar > #0) do begin
  377.     xstring2:=xstring2 + xchar;
  378.     inc(i);
  379.     xchar:=chr(country[i])
  380.   end;
  381.   case country[15] and $03 of
  382.     $00 : xstring1:=xstring2 + xstring1;
  383.     $01 : xstring1:=xstring1 + xstring2;
  384.     $02 : xstring1:=xstring2 + ' ' + xstring1;
  385.     $03 : xstring1:=xstring1 + ' ' + xstring2;
  386.     $04 : begin
  387.       delete(xstring1, 6, 1);
  388.       insert(xstring2, xstring1, 6)
  389.     end
  390.   end;
  391.   writeln(xstring1);
  392.   caption2('Case map call address');
  393.   segofs(cbw(country[20], country[21]), cbw(country[18], country[19]));
  394.   writeln
  395. end;
  396.