Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ECO30603.ZIP/ECO30603.LZH/ECOLIBII/DEMOS/NOVELL/SERVLIST.PAS

Pascal/Delphi Source File | 1992-12-17 | 5.9 KB | 227 lines

{$A-,B-,D-,E-,F+,I-,L-,N-,O-,R-,S-,V-}
{$M 65520, 0, 655360}
uses
  eco_lib, crt, dos, eco_novl

  ;



const
  first : boolean =  true;
  func  : boolean = false;
  maxorigin       =    60;


type
  str62 = string[62];
  ori_artype = array[1..maxorigin] of str62;



var
  really                 :   boolean;
  station,
  retcode,
  volume_number,
  conntype,
  drive_num,
  server_num,
  count,
  handle_num             :   integer;
  node, username,
  volume_name,
  server,
  name, datetime,
  hex_id,
  realname,
  pathname,
  boot,
  version,
  network,
  fromfield,
  export,
  subject,
  retitem,
  socket                 :    string;
  tofield,
  edctrl                 : _editctrl;
  x, y, f, b, errlev     :      byte;
  i, selkey              :      word;

  { scan object variables }
  replysecurity, back,
  foundori               :      byte;
  object_type,
  replytype,
  replyflag,
  replyproperties        :   integer;
  lastseen, replyid      :   longint;
  object_name, replyname :    string;

  fout                   :      text;

  listpickptr            :  _pickptr;

  origin                 : ^ori_artype;


  {$F+}
  function order(var data1, data2): boolean; far;
  begin
    order := string(data1) < string(data2)
  end;
  {$F-}



  function select_origin : byte;
  begin
    selkey := $00; retitem := '';
    {if first then begin}
      listpickptr := __makesel(
        {coord}    19, 5, 61, 16,
        {fore}             white,
        {back}              back,
        {fore}             black,
        {back}             white,
        {keyptr}             nil,
        {itemlen}             22,
        {# of item}     foundori,
        {itemsize}            62,
        {numcols}              1,
        {nuspace}              1,
        {arptr}           origin,
        {ispointers}       false
      );
      if first then begin
        __bandwin(false, 19, 5, 61, 16, white, back, sh_default, bt_single);
        __betwscn(19, 61, 4, white, back, '[ Sorted Servers ]');
        __write(5, 07, yellow, black, '');
        __write(5, 15, yellow, black, '');
        __write(3, 10, yellow, black, '<ESC>');
        __write(2, 12, yellow, black, '<ENTER>');
      end;
    {end;}
    first := false;
    select_origin := __picksel(listpickptr, retitem, selkey);
    __zapsel(listpickptr);
  end;


  function __keep32127(s: string): string;
  var
    t : string;
    i :   byte;

  begin
    t := '';
    for i := 1 to length(s) do if ord(s[i]) in [32..127] then t := t + s[i];
    __keep32127 := t;
  end;



begin
  x := wherex; y := wherey;
  __savscn(scn1);
  gotoxy(1, 25); __stdio; __setblwin(false);

  back := blue;
  if baseofscreen = $b000 then back := black;

  boot := __up(getenv('boot'));

  getstation(station, retcode);       { pull your station number fm network }
  getuser(station, username, retcode);{ pull your current userid fm network }
  get_realname(username, realname, retcode);
  getnode(node, retcode);    { pull your network physical id / never changes }
  get_internet_address(station, network, node, socket, retcode);
  getservername(server, retcode);
  getconnectioninfo(station, name, hex_id, conntype, datetime, retcode);
  gethexid(name, hex_id, retcode);
  new(origin); fillchar(origin^, sizeof(origin^), #0); __setblwin(false);
  __cls;

  if (
    __inparams('/?', i) or __inparams('-?', i) or __inparams('?', i)
  ) then begin
    writeln;
    writeln('   ', __progname, ' for Novell Netware by Floor A.C. Naaijkens - Version 0.01ß');
    writeln('   ', __rep(60, '─'));
    writeln;
    writeln('   Usage');
    writeln('     ', __progname, ' Chooses from servers. Basta.');
    writeln('     ', __rep(length(__progname), ' '), ' Ends on errlev 255 if error.');
    writeln('     ', __rep(length(__progname), ' '), ' Ends on errlev 254 if no bootdisc.');
    writeln('     ', __rep(length(__progname), ' '), ' Ends on errlev 0 if OK.');
    halt;
  end;

  (*
  writeln('FOUND SERVERS:'); func := true;
  for count := 1 to 8 do begin
    get_file_server_name(count, server);
    if server <> '' then begin
      set_preferred_connection_id(count);
      getserverinfo;
      get_server_version(version);
      writeln('  ', server, ' under ', version);
      with serverinfo do writeln(
        '  MAX: ', connections_max, '; USED: ', connections_in_use,
        '; PEAK: ', peak_connections_used, '.'
      );
    end;
  end;
  *)

  lastseen := -1;      { -1 means start at first entry }
  object_type := 4;    {1=users 2=group 3=print server 4=file server}
  object_name := '*';  {wildcard '*' means everyone}
  retcode := 0;
  getserverinfo;
  count := 0;

  foundori := 0;
  while retcode = 0 do begin
    scan_object(
      lastseen, object_type, object_name,
      replyid, replytype, replyname, replyflag, replysecurity,
      replyproperties, retcode
    );
    if (retcode = 0) and (__nw(__keep32127(replyname)) <> '') then begin
      inc(foundori);
      origin^[foundori] := __up(__nw(__keep32127(replyname)));
      lastseen := replyid;
    end;
  end;
  errlev := 255;
  { sorteren }


  __qsortsrt(origin, foundori, sizeof(str62), @order);
  for i := 1 to foundori do origin^[i] := __juststr(
    __num(i), '0', 2, _right_just_str
  ) + ': ' + __juststr(origin^[i], ' ', 35, _right_just_str);

  i := select_origin;

  if i > 0 then begin
    export := __nw(copy(origin^[i], 10, 52));
    writeln('Selected: ', export);
    if __existpath(upcase(boot[1]) + ':') then begin
      assign(fout, 'c:\set$$$.bat'); rewrite(fout); errlev := 0;
      writeln(fout, '@echo off');
      writeln(fout, 'SET SERVER=', export);
      close(fout);
    end else begin
      errlev := 254;
    end;
  end else begin writeln('Quit!'); export := '' end;

  __resscn(scn1);
  if errlev = 254 then writeln(export);
  gotoxy(x, y);
  halt(errlev);
end.