home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / SHSUCD11.ZIP / NBSTAT.ADA < prev    next >
Encoding:
Text File  |  1995-06-30  |  4.4 KB  |  129 lines

  1. --************************************************************************
  2. --
  3. --  NBStat.ADA               Version 3.0
  4. --
  5. --  A copyright-reserved, free use program.  Use at your own risk.
  6. --  (c)John H. McCoy, 1994,1995, Sam Houston St. Univ., TX 77341-2206
  7. --************************************************************************
  8.  
  9. with text_io; use text_io;
  10. with types; use types;
  11. with netbios; use netbios;
  12. with system; use system;
  13. with text_handler; use text_handler;
  14. with arg;
  15.  
  16. procedure NBStat is
  17.  
  18. type Adapt_Stats is
  19.   record
  20.     NodeName               : bytes(0..5);
  21.     Fill1                  : bytes(6..9);
  22.     ReportPeriod           : W;
  23.     CRCErrors              : W;
  24.     AlignErrors            : W;
  25.     Collisions             : W;
  26.     TransAbort             : W;
  27.     OkTrans                : DW;
  28.     OkRcvs                 : DW;
  29.     Retrans                : W;
  30.     OutOfResources         : W;
  31.     Fill2                  : bytes(32..39);
  32.     CmdBlksFree            : W;
  33.     MaxNCBs                : W;
  34.     MaxCBs                 : W;
  35.     Fill3                  : bytes(46..49);
  36.     SessionsPending        : W;
  37.     MaxSessionsPending     : W;
  38.     MaxSessions            : W;
  39.     MaxPktSize             : W;
  40.     NameTblEntries         : W;
  41.   end record;
  42.  
  43.    Status       : Adapt_Stats;
  44.    NCB          : NetBiosCmdBlks;
  45.    AdapterName    : string16 := "SHSU-CD-SERVER  ";
  46.    CMD_Parm_Error : exception;
  47.  
  48. function to_caps (C: character) return character is
  49. begin
  50.   if (C >= 'a' and C<= 'z') then
  51.     return character'val(character'pos(C) -32);
  52.   else
  53.     return c;
  54.   end if;
  55. end to_caps;
  56.  
  57. procedure get_parms is
  58.   parm: text(60);
  59. begin
  60.   for i in 2..arg.count loop      -- first arg is program name
  61.     set(parm, arg.data(i));       -- convert string argument to text object.
  62.  
  63.     if not empty(parm) then
  64.       if value(parm)(1) = '-' or value(parm)(1) = '/' then
  65.         if length(parm) >= 4 then
  66.           case value(parm)(2) is
  67.             when 'a'|'A' =>
  68.               if length(parm) > 19 then
  69.                 put_line("Server name to long.  Max is 16 characters.");
  70.                 raise CMD_Parm_Error;
  71.               else
  72.                 AdapterName := (others=> ' ');
  73.                 AdapterName(1..length(parm)-3) := value(parm)(4..length(parm));
  74.                 for i in 1..16 loop
  75.                   AdapterName(i) := to_caps(AdapterName(i));
  76.                 end loop;
  77.               end if;
  78.             when others =>
  79.               put_line("Unknown parameter """ & value(parm) & """");
  80.               raise CMD_Parm_Error;
  81.           end case;
  82.         else
  83.           put_line("Invalid parameter """ & value(parm) & """");
  84.           raise CMD_Parm_Error;
  85.         end if;
  86.       else
  87.         put_line("Parameter """ & value(parm) & """ doesn't start with - or /.");
  88.         raise CMD_Parm_Error;
  89.       end if;
  90.     end if;
  91.  
  92.   end loop;
  93.  
  94. end get_parms;
  95.  
  96. begin
  97.  
  98.    get_parms;
  99.  
  100.    NCB.Bufferlength := status'size/8;
  101.    NCB.BufferPtr  := Status'address;
  102.    NCB.Command    := NB_AdapterStatus;
  103.    NCB.ReturnCode := NB_NetBiosNotLoaded;
  104.    NCB.CallName   := AdapterName;
  105.    NetBiosCall(SA_to_ncbAccess(Ncb'address));
  106.  
  107.  case NCB.ReturnCode is
  108.   when NB_Ok | NB_IncompleteReceive=>
  109.    put_line("Adapter Name:"&AdapterName);
  110.    put_line("Up Time Minutes:"&word'image(W_to_Word(Status.ReportPeriod)));
  111.    put_line("Max Pkt Size:"&word'image(W_to_Word(Status.MaxPktSize)));
  112.    put_line("Free Cmd Blks:"&word'image(W_to_Word(Status.CmdBlksFree)));
  113.    put_line("Max Sessions:"&word'image(W_to_Word(Status.MaxSessions)));
  114.    put_line("Sessions Pending:"&word'image(W_to_Word(Status.SessionsPending)));
  115.    put_line("Name Table Entries:"&word'image(W_to_Word(Status.NameTblEntries)));
  116.    put_line("CRCErrors:"&word'image(W_to_Word(Status.CRCErrors)));
  117.    put_line("AlignErrors:"&word'image(W_to_Word(Status.AlignErrors)));
  118.    put_line("Collisions:"&word'image(W_to_Word(Status.Collisions)));
  119.    put_line("TransAbort:"&word'image(W_to_Word(Status.TransAbort)));
  120.    put_line("Retrans:"&word'image(W_to_Word(Status.Retrans)));
  121.    put_line("OutOfResources:"&word'image(W_to_Word(Status.OutOfResources)));
  122.    put_line("OkTrans:"&long_integer'image(DW_to_long(Status.OkTrans)));
  123.    put_line("OkRcvs:"&long_integer'image(DW_to_long(Status.OkRcvs)));
  124.   when others =>
  125.    put_line("Can't get status of "& AdapterName);
  126.  end case;
  127. exception
  128.   when CMD_Parm_Error => put_line("Only paramater allowed is /A:AdapterName");
  129. end NBStat;