Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ECO30603.ZIP/ECO30603.LZH/ECOLIBBS/eco_node.pas

Pascal/Delphi Source File | 1993-03-09 | 8.5 KB | 287 lines

(*
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   EFTPNODE was Conceived, Designed and Written     ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   Accesses the 1Mb+ nodelist quickly, without      ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   building large indexes.                          ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓   (Optionally builds a small index, not needed)    ░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
    ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
*)
{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
{$M 65520, 0, 655360}

unit eco_node;

interface
uses
  crt, dos, eco_lib

  ;



const
  maxnets = 500;


type
  tbuf = array[1..49152] of char;
  indextype = array[1..6, 1..maxnets] of record net: word; line: word end;

  nodelistobj = object { data must not be altered directly }
    idx       :    boolean;
    oindex,
    onodel    :     string;
    bin       :      ^tbuf;
    path      :     string;
    tin       :       text;
    this,
    thissize  :    longint;

    indexes   :  indextype;
    curzone   :       word;
    indexfile : file of indextype;
    curzones  : array[1..6] of word;

    { ========== externals =========== }
    function  init(nodelist: string; compile: boolean): boolean;
    function  getnode(st: string): string;
    procedure done(removeindex: boolean);
    { ========== internals =========== }
    function  cvtnode(s: string): string;
    function  getline(l: integer): string; { nice for overrides }
    procedure compilenodes;
    function  seektextpos(z, n: word): boolean;
  end;







implementation











  procedure __expandnum(
    node : string; var tozone, tonet, tonode, topoint: word
  );
  var                      { zzzzz:nnnnn/nnnnn.ppppp }
    i, j : byte;           { eg.  '12:5003/1222.000' }

  begin
    i := pos(':', node);
    tozone := __str(copy(node, 1, i - 1));
    j := pos('/', node); if j=0 then j := pos('\', node);
    tonet  := __str(copy(node, i + 1, j - i - 1));
    i := pos('.', node);
    if i > 0 then tonode := __str(copy(node, j+1, i-j-1)) else
      tonode := __str(copy(node, j+1, length(node)-j));
    topoint := __str(copy(node, i + 1, length(node) - i));
  end; { __expandnum }



  function __extractpath(s : string): string; { eindigt op \ }
  var i : byte;
  begin
    i := length(s); while (s[i] <> '\') and (i > 1) do dec(i);
    __extractpath := copy(s, 1, i);
  end;




const
  dontcare  = -1;
  untouched =  0;


  function nodelistobj.getline(l: integer): string;
  var stt: string;
  begin
    readln(tin, stt);
    inc(this); inc(thissize, length(stt)+2);
    if l = untouched then getline := stt else
      if l > untouched then getline := __up(copy(stt, 1, l)) else
        getline := '';
  end;



  procedure nodelistobj.compilenodes;
  var
    seconds,
    nodes, i :   word;
    stt      : string;

  begin
    nodes := 0;
    if wherey > 20 then begin for i := 1 to 4 do writeln; gotoxy(1, 20) end;
    writeln('  AMERICA  EUROPA   OCEANIA   LATINA   AFRICA    ASIA');
    gotoxy(1, wherey+2); write('  Nodes/sec: '); gotoxy(1, wherey-2);
    starttimer(1);
    while not(eof(tin)) do begin
      readln(tin, stt); inc(this); stt := __up(stt);
      if (copy(stt, 1, 5) = 'ZONE,') then begin
        curzone := __str(copy(stt, 6, 1)); inc(nodes);
      end else if (copy(stt, 1, 5) = 'HOST,') then begin
        inc(curzones[curzone]); inc(nodes);
        stt := copy(stt, 6, 6);
        with indexes[curzone, curzones[curzone]] do begin
          net := __str(copy(stt, 1, pos(',', stt)-1));
          line := this;
        end;
        if nodes mod 7 = 0 then begin
          gotoxy(1, wherey);
          write(
            curzones[1]:7, '  ', curzones[2]:7, '  ', curzones[3]:7, '  ',
            curzones[4]:7, '  ', curzones[5]:7, '  ', curzones[6]:7
          );
          gotoxy(14, wherey+2);
          stt := getlaptime(1);
          seconds := __str(copy(stt, 7, 2));
          seconds := seconds + 60 * __str(copy(stt, 4, 2));
          if seconds > 0 then write(trunc(nodes/seconds), '  ');
          gotoxy(14, wherey-2);
        end;
      end else if not(
        (stt[1] = ';') or (copy(stt, 1, 5) = 'HOLD,') or
        (copy(stt, 1, 5) = 'DOWN,') or (copy(stt, 1, 7) = 'REGION,')
      ) then inc(nodes);
    end;
    stt := stoptimer(1);
    assign(indexfile, oindex); rewrite(indexfile);
    write(indexfile, indexes); close(indexfile);
    gotoxy(1, wherey);
    write(
      curzones[1]:7, '  ', curzones[2]:7, '  ', curzones[3]:7, '  ',
      curzones[4]:7, '  ', curzones[5]:7, '  ', curzones[6]:7
    );
    writeln; writeln;
    seconds := __str(copy(stt, 7, 2));
    seconds := seconds + 60 * __str(copy(stt, 4, 2));
    writeln(
      'Compiled ', stt, '  ',
      trunc(nodes/seconds), ' nodes/second.', '  ',
      nodes, ' nodes, ',
      curzones[1]+curzones[2]+curzones[3]+curzones[4]+curzones[5]+curzones[6],
      ' nets total.'
    );
  end;



  function nodelistobj.seektextpos(z, n: word): boolean;
  var i, j, lin : word;
  begin
    if idx then begin
      i := 1; lin := 0;
      while (i < maxnets+1) and (indexes[z, i].net <> n) do inc(i);
      if i < maxnets+1 then begin
        lin := indexes[z, i].line;
        for j := 1 to lin do getline(dontcare);
        seektextpos := true;
      end else seektextpos := false;
    end else seektextpos := false;
  end;




  function nodelistobj.cvtnode(s: string): string;
  var i : byte;
  begin
    for i := 1 to length(s) do if s[i] = '_' then s[i] := ' ';
    cvtnode := s;
  end;



  function nodelistobj.getnode(st: string): string;
  var zone, net, node, topoint: word;
  begin
    this := 0; thissize := 0; curzone := 2; reset(tin);
    __expandnum(st, zone, net, node, topoint);
    if not(seektextpos(zone, net)) then begin
      st := '';
      while (
        not(eof(tin)) and
        (pos('ZONE,' + __num(zone) + ',', st) = 0)
      ) do st := getline(10);
      st := '';
      while (
        not(eof(tin)) and
        (pos('HOST,'+__num(net), st) = 0)
      ) do st := getline(10);
    end;
    st := '';
    while (
      not(
        eof(tin) or (copy(st, 1, 5) = 'ZONE,') or (copy(st, 1, 5) = 'HOST,')
      ) and
      (pos(',' + __num(node) + ',', st) = 0)
    ) do st := getline(untouched);
    if not(
      eof(tin) or (copy(st, 1, 5) = 'ZONE,') or (copy(st, 1, 5) = 'HOST,')
    ) then getnode := cvtnode(st) else getnode := '';
  end;



  function nodelistobj.init(nodelist: string; compile: boolean): boolean;
  var i : word;
  begin
    onodel := nodelist;
    init := __existfil(nodelist);
    new(bin);
    assign(tin, onodel); reset(tin); settextbuf(tin, bin^);
    this := 0; thissize := 0; curzone := 2;
    fillchar(indexes, sizeof(indexes), 0);
    for i := 1 to 6 do curzones[i] := 0;
    oindex := __normfil(__backapp(__extractpath(paramstr(0))) + 'EFTPNODE.IDX');
    if compile then writeln('Index: ', __slashfil(oindex));
    idx := false;
    if compile then compilenodes;
    if __existfil(oindex) then begin
      assign(indexfile, oindex); reset(indexfile);
      read(indexfile, indexes); close(indexfile); idx := true;
    end;
  end;



  procedure nodelistobj.done(removeindex: boolean);
  begin
    dispose(bin); if removeindex then erase(indexfile)
  end;




{happy}end.{unit}