home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / STEVEUT.ZIP / PORTS.PAS < prev    next >
Pascal/Delphi Source File  |  1984-05-22  |  3KB  |  110 lines
  1. program portest_code (input,output);
  2.  
  3. function inport (x : word) : byte; external;
  4. procedure cls; external;
  5. procedure locate (row, column : integer); external;
  6.  
  7. var
  8.    count   :   word;
  9.    b       :   byte;
  10.    w       :   word;
  11.    c       :   array [wrd(0)..255] of word;   { save the profile }
  12.    headc   :   word;
  13.    skipchar:   char;      {  an inkey$ function-like var waste   }
  14.  
  15. procedure header_1;
  16.  
  17. var
  18.    i : integer;
  19.  
  20. begin
  21.    writeln ;
  22.    for i := 1 to 8 do
  23.        write ('  Port Val');
  24.    writeln
  25. end;  { procedure }
  26.  
  27. procedure header_2;
  28.  
  29. var
  30.    i : integer;
  31.  
  32. begin
  33.    writeln ;
  34.    for i := 1 to 8 do
  35.        write (' Val Count');
  36.    writeln
  37. end;   { procedure }
  38.  
  39. procedure initialize;
  40.  
  41. begin   { initialization }
  42.    count := 0;
  43.    headc := 0;
  44.    for b := 0 to 255 do
  45.        c [b] := 0;         { profile count cleared  }
  46.    cls;                    { cleanup screen         }
  47.    locate (1,1);
  48.    writeln;
  49.    writeln;
  50.    writeln ('Following ports may be active:');
  51.    header_1
  52. end;
  53.  
  54. procedure scan_all_ports;
  55.  
  56. begin
  57.    for w := 0 to maxword do     { predeclared ; like maxint  }
  58.        begin
  59.            b := inport (w);     { get value from asm routine }
  60.            c [b] := c [b] + 1;  { add to the profile value   }
  61.            if not (b in [wrd(0),78,110,188,202,203,207,254,255]) then
  62.                begin
  63.                    write (w : 6, b : 4);   { show port and number  }
  64.                    count := count  + 1;
  65.                    headc := headc  + 1;
  66.                    if headc > 159 then
  67.                        begin
  68.                            writeln;
  69.                            locate (25,70);
  70.                            write ('More...');
  71.                            read (skipchar);
  72.                            headc := 0;
  73.                            cls;      {  refresh screen   }
  74.                            locate (1,1);
  75.                            header_1
  76.                        end
  77.                end
  78.    end;
  79.    header_1
  80. end;   { procedure  }
  81.  
  82. procedure cleanup;
  83.  
  84. begin
  85.    locate (25,1);
  86.    write ('Strike any key for profile');
  87.    read (skipchar);
  88.    cls;
  89.    writeln;
  90.    writeln;
  91.    writeln ('The most common false input values have been omitted');
  92.    writeln;
  93.    writeln ('Profile of values returned for all ports:');
  94.    header_2;
  95.    for b := 0 to 255 do
  96.        write (b : 4, c[b] : 6);
  97.    header_2;
  98.    writeln ;
  99.    writeln (count : 5, ' Port(s) may possibly be active');
  100.    writeln;
  101.    writeln;
  102.    writeln ('Finished.')
  103. end;   { procedure }
  104.  
  105. begin
  106.    initialize;
  107.    scan_all_ports;
  108.    cleanup
  109. end.
  110.