TYPE
    NBase_record = RECORD
      Deleted     : Boolean;
      _PREFIX     : String[ 2];
      _AREA       : String[ 1];
      _SUFFIX     : String[ 3];
      _NAME       : String[10];
      _NETNBR     : String[ 4];
      _LOGDATE    : String[10];
      _FNAME      : String[10];
      _LNAME      : String[20];
      _ADDRESS    : String[30];
      _CITY       : String[25];
      _STATE      : String[ 2];
      _ZIP        : String[ 5];
      _PHONE      : String[12];
      _BIRTHDATE  : String[10];  { Date field }
      _SPOUSE     : String[10];
      _SP_BIRTH   : String[ 5];  { Month/Day field }
    END;

VAR
    NBase : NBase_record;
    m_PREFIX : String;
    m_AREA : String;
    m_SUFFIX : String;
    FilterValue : String;
    m_Found : Boolean;
    Choice : Char;
    AddMode : Boolean;
    EditMode : Boolean;
    MRecNo : LongInt;
    OurWorkArea : Byte;

PROCEDURE HelpScreen;
{ Displays a list of menu commands when <F1> or "H" is pressed }
VAR ScreenBuffer : Array[1..2000] OF Word;
BEGIN
  FillPage(@ScreenBuffer); { save contents of current screen }
  Window(5,4,75,23);
  Set_Color_To(Black,LightGray,Black,LightGray);
  ClrScr;
  WriteLn('                         Menu Commands');
  WriteLn;
  WriteLn('  N - Next      Skips to and displays next record in file');
  Writeln('                Down Arrow key performs same function');
  WriteLn('  P - Prev      Skips back one and displays prior record');
  WriteLn('                Up Arrow key performs same function');
  WriteLn('  T - Top       Displays first record in file');
  WriteLn('  O - Bottom    Displays last record in file');
  WriteLn('  G - Go        Positions database on selected record by number');
  WriteLn('  S - Search    Allows searching for imbedded string in key field');
  WriteLn('  F - Find      Finds the first record with matching key field');
  WriteLn('  L - Filter    Limits view of database to records whose key fields');
  WriteLn('                contain a filter value');
  WriteLn('  E - Edit      Allows modification of currently displayed record');
  WriteLn('  A - Add       Allows input and appends a new record into database');
  WriteLn('  B - Browse    Spreadsheet-like view of database');
  WriteLn('<ESC> Quit      Return to NET login process');
  WriteLn;
  Wait('                        Press any key to return...');
  Window(1,1,80,25);
  DisplayPage(@ScreenBuffer); { restore prior screen }
  Set_Color_To(LightGray,Black,Black,LightGray);
END;   { HelpScreen }


{$F+} PROCEDURE EditHelp; { called by SAYGET4.TPU }
{ Displays a help screen when <F1> is pressed while editing }
VAR ScreenBuffer : Array[1..2000] OF Word;
BEGIN
  FillPage(@ScreenBuffer); { save contents of current screen }
  Set_Color_To(Black,LightGray,Black,LightGray);
  Window(5,3,75,23);
  ClrScr;
  WriteLn('                          Editing Commands');
  WriteLn;
  WriteLn('      <Ctrl-R> or <PgUp>  Move to beginning of first field');
  WriteLn('      <Ctrl-C>  Move to beginning of last field');
  WriteLn('      <Ctrl-E> or <Up Arrow> Move to beginning of prior field');
  WriteLn('      <Ctrl-X> or <Dn Arrow> Move to beginning of next field');
  WriteLn('      <Ctrl-V> or <Ins>  Toggle insert/overwrite mode');
  WriteLn('      <Ctrl-G> or <Del>  Delete character at cursor');
  WriteLn('      <Ctrl-T>  Delete word to right of cursor ');
  WriteLn('      <Ctrl-Y>  Delete all characters to right of cursor');
  WriteLn('      <Ctrl-U>  Restore prior data (Undo)');
  WriteLn('      <Ctrl-S> or <Lft Arrow> Move cursor left one character');
  WriteLn('      <Ctrl-D> or <Rt Arrow> Move cursor right one character');
  WriteLn('      <Ctrl-W> or <PgDn> Exit edit session');
  WriteLn('      <Esc>     Abandon edit');
  WriteLn('      <Home>    Move cursor to first character in field');
  WriteLn('      <End>     Move cursor to last charcter in field');
  WriteLn;
  Wait('                        Press any key to return...');
  Window(1,1,80,25);
  DisplayPage(@ScreenBuffer); { restore prior screen }
  Set_Color_To(LightGray,Black,Black,LightGray);
END;   { EditHelp }
{$F-}


{$F+} FUNCTION Filter : Boolean; { called by DBF4.TPU }
 { Returns True if FilterValue is equal to the SUFFIX field. }
BEGIN
  Filter := (POS(FilterValue,Upper(NBase._SUFFIX)) > 0) OR (dBOF OR dEOF);
END;   { Filter }
{$F-}

PROCEDURE Set_Filter;
 { Instructs DBF4.TPU to use the user defined Filter function (above). }
BEGIN
  FilterValue := '';
  SayGet(1,25,' Enter SUFFIX for data filter: ',FilterValue,_S,3,0);
  Picture('@!');
  ReadGets;
  ClearEOL(1,25);
  IF EditResult > 0 THEN Exit;
  Set_Rotor_Off;
  IF Length(FilterValue) = 0 THEN Set_Filter_To(NIL)
  ELSE
    BEGIN
      Set_Filter_To(@Filter);
      Set_Rotor_On;
      GoTop;
      IF dEOF THEN
        BEGIN
          Set_Filter_To(NIL);
          Set_Rotor_Off;
        END;
    END;
END;   { Set_Filter }


{$F+} FUNCTION KeyMaker : String; { called by INDEX4.TPU }
BEGIN
  KeyMaker := Upper(NBase._AREA + NBase._SUFFIX + NBase._PREFIX);
END;  { KeyMaker }
{$F-}

PROCEDURE Search_SUFFIX;
 { Sequential search of entire file to find m_SUFFIX in SUFFIX }
 { Searches faster if no index is active. }
BEGIN
  m_SUFFIX := '';
  SayGet(1,25,' Enter SUFFIX to locate: ',m_SUFFIX,_S,3,0);
  Picture('@!');
  Set_Repaint_Off;  { leave field in reverse video on screen }
  ReadGets;
  Set_Repaint_On;   { restore default setting }
  IF EditResult > 0 THEN
    BEGIN
      ClearEOL(1,25);
      Exit;
    END;
  IF Length(M_SUFFIX) > 0 THEN
    BEGIN
      MRecNo := RecNo; { save current position }
      m_Found := False;
      GoTop;            { start at top of file (omit as desired) }
      REPEAT
        IF POS(m_SUFFIX,Upper(NBase._SUFFIX)) > 0 THEN
           m_Found := True
        ELSE Skip(1);
        AT(75,25,SInteger(RecNo,0));
      UNTIL m_Found OR dEOF;
      IF Not m_Found THEN
        BEGIN
          GO(MRecNo); { re-position file }
          ClearEOL(1,25);
          Wait(M_SUFFIX+' not found.  Press any key...');
        END;
    END;
  ClearEOL(1,25);
END;   { Search_SUFFIX }


PROCEDURE Find_SUFFIX; { Direct access via index }
BEGIN
  m_PREFIX := '';
  m_AREA   := '';
  m_SUFFIX := '';
  SayGet(1,25,' PREFIX : ',m_PREFIX,_S,2,0);
  Picture('@!');
  SayGet(20,25,'AREA : ',m_AREA,_S,1,0);
  Picture('@!');
  SayGet(30,25,'SUFFIX : ',m_SUFFIX,_S,3,0);
  Picture('@!');
  ReadGets;
  ClearEol(1,25);
  IF EditResult > 0 THEN Exit;
  IF Length(M_SUFFIX) > 0 THEN
    Find(m_AREA + m_SUFFIX + m_PREFIX);
  IF NOT Found THEN
    BEGIN
      GoToXY(1,25);
      Wait(' Not in database.  Press any key...');
      ClearEol(1,25);
    END;
END;   { Find_SUFFIX }


PROCEDURE WriteStatusLine;
BEGIN
  IF AddMode THEN
  AT(2,2,'Record # '+SInteger(RecNo+1,4)+' of '+SInteger(RecCount+1,4)+'      File: '+DBF+'      Last Update: '+LUpdate)
  ELSE
  AT(2,2,'Record # '+SInteger(RecNo,4)+' of '+SInteger(RecCount,4)+'      File: '+DBF+'      Last Update: '+LUpdate);
  IF dBOF OR dEOF THEN RingBell;
END;   { WriteStatusLine }

PROCEDURE NetLogForm;
begin
  clrscr;
  AT(11, 5,'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
  AT(11, 6,'³  Prefix Area Suffix  Nickname                 Net #  ³');
  AT(11, 7,'³                                                      ³');
  AT(11, 8,'³                                                      ³');
  AT(11, 9,'³  Name                                                ³');
  AT(11,10,'³  Address  .                                          ³');
  AT(11,11,'³           .                          .   .           ³');
  AT(11,12,'³                                                      ³');
  AT(11,13,'³  Phone    .                     Birthday  .          ³');
  AT(11,14,'³                                                      ³');
  AT(11,15,'³  Spouse name  .                 Birthday  .          ³');
  AT(11,16,'³                                                      ³');
  AT(11,17,'³  Last Log Date : .                                   ³');
  AT(11,18,'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  AT(1,23,'N)ext P)rev T)op B(O)t G)o S)rch F)ind L)imit E)dit A)dd D)el B)row Pa(C)k <ESC>');
  AT(34,24,'<F1> = Help');
end;

PROCEDURE DoGetsWith_NETNBR;
BEGIN
  WriteStatusLine;
  IF EditMode OR AddMode THEN ClearEOL(1,23);
  IF AddMode THEN ClearRecord;
  WITH NBase DO
    BEGIN
      IF deleted THEN AT(10,3,'DELETED')
      ELSE AT(10,3,'       ');
      SayGet(16, 7,'', _PREFIX, _S, 3, 0);
      picture('@!');
      SayGet(22, 7,'', _AREA, _S, 1, 0);
      picture('9');
      SayGet(27, 7,'', _SUFFIX, _S, 3, 0);
      picture('@!');
      SayGet(34, 7,'', _NAME, _S, 10, 0);
      SayGet(59, 7,'', _NETNBR, _S, 4, 0);
      SayGet(23, 9,'', _FNAME, _S, 10, 0);
      SayGet(35, 9,'', _LNAME, _S, 20, 0);
      SayGet(23,10,'', _ADDRESS, _S, 30, 0);
      SayGet(23,11,'', _CITY, _S, 25, 0);
      SayGet(50,11,'', _STATE, _S, 2, 0);
      picture('!!');
      SayGet(54,11,'', _ZIP, _S, 5, 0);
      picture('99999');
      SayGet(23,13,'', _PHONE, _S, 12, 0);
      picture('999-999-9999');
      SayGet(55,13,'', _BIRTHDATE, _D, 8, 0);
      SayGet(27,15,'', _SPOUSE, _S, 10, 0);
      SayGet(55,15,'', _SP_BIRTH, _S, 5, 0);
      picture('99/99');
      At(30,17,_LOGDATE);
      IF EditMode OR AddMode THEN
        BEGIN
          ReadGets;  { edit the fields defined with SayGet() }
          IF EditResult <= 0 THEN
            BEGIN
              IF AddMode THEN
                BEGIN
                  Append;
                  AddMode := False;
                  WriteStatusLine;
                END
              ELSE Replace;
            END
        END
      ELSE ClearGets; { just display the fields }
    END;
END;       { DoGetsWith_NETNBR }


PROCEDURE MakeFile(NewFile : String);
VAR
    DataBase  : DbfRecord;
    FieldList : FieldArray;
BEGIN
  WriteLn('Creating '+NewFile+'...');
  FillChar(FieldList,SizeOf(FieldList), 0);
  FieldList[1].Name := 'PREFIX';
  FieldList[1].Typ  := 'C';
  FieldList[1].Len  := 2;
  FieldList[2].Name := 'AREA';
  FieldList[2].Typ  := 'C';
  FieldList[2].Len  := 1;
  FieldList[3].Name := 'SUFFIX';
  FieldList[3].Typ  := 'C';
  FieldList[3].Len  := 3;
  FieldList[4].Name := 'NAME';
  FieldList[4].Typ  := 'C';
  FieldList[4].Len  := 10;
  FieldList[5].Name := 'NETNBR';
  FieldList[5].Typ  := 'C';
  FieldList[5].Len  := 4;
  FieldList[6].Name := 'LOGDATE';
  FieldList[6].Typ  := 'D';
  FieldList[7].Name := 'FNAME';
  FieldList[7].Typ  := 'C';
  FieldList[7].Len  := 10;
  FieldList[8].Name := 'LNAME';
  FieldList[8].Typ  := 'C';
  FieldList[8].Len  := 20;
  FieldList[9].Name := 'ADDRESS';
  FieldList[9].Typ  := 'C';
  FieldList[9].Len  := 30;
  FieldList[10].Name := 'CITY';
  FieldList[10].Typ  := 'C';
  FieldList[10].Len  := 25;
  FieldList[11].Name := 'STATE';
  FieldList[11].Typ  := 'C';
  FieldList[11].Len  := 2;
  FieldList[12].Name := 'ZIP';
  FieldList[12].Typ  := 'C';
  FieldList[12].Len  := 5;
  FieldList[13].Name := 'PHONE';
  FieldList[13].Typ  := 'C';
  FieldList[13].Len  := 12;
  FieldList[14].Name := 'BIRTHDATE';
  FieldList[14].Typ  := 'D';
  FieldList[15].Name := 'SPOUSE';
  FieldList[15].Typ  := 'C';
  FieldList[15].Len  := 10;
  FieldList[16].Name := 'SP_BIRTH';
  FieldList[16].Typ  := 'C';
  FieldLIst[16].Len  := 5;
  CreateDBF(DataBase, NewFile, 16, @FieldList);
END;


PROCEDURE MaintainNetLog;
var  SavedVideo : array[1..2000] of word;
BEGIN
  FillPage(@SavedVideo);
  Select(OurWorkArea);
  Set_FKey(F1,@EditHelp);
  Set_Color_To(LightGray,Black,Black,LightGray);
  NetLogForm;
  Set_Cursor_Off;
  if top_pntr = 0
    then GoTop
    else if checkins[curr_pntr].list_nbr = 1
           then Go(new_list[checkins[curr_pntr].position]^.recnbr)
           else Go(net_list[checkins[curr_pntr].position]^.recnbr);
  REPEAT
    DoGetsWith_NETNBR;  { display (or edit) the current record }
    REPEAT
      Choice := ReadKey;       { get user request }
      IF Choice = CHR(0) THEN  { user pressed a special key }
        BEGIN
          Choice := ReadKey;
          Case Choice Of
            'P' : Choice := 'N';  { map down-arrow to "Next"   }
            'H' : Choice := 'P';  { map up-arrow to "Previous" }
            ';' : Choice := 'H';  { map F1 to "Help" }
            ELSE Choice := ' ';   { ignore other special keys  }
          END;
        END;
      Choice := UpCase(Choice);
    UNTIL POS(Choice,'ABCDEFGHLNOPST'+^[) > 0;
    EditMode := False;
    AddMode  := False;
    CASE Choice OF
      'N' : BEGIN
              Skip(1);
              IF dEOF THEN GoBottom;
            END;
      'P' : Skip(-1);
      'E' : EditMode := True;
      'A' : AddMode  := True;
      'D' : { toggle the "Deleted" flag }
            IF NBase.Deleted THEN RecallRec ELSE DeleteRec;
      'H' : HelpScreen;
      'T' : GoTop;     { position database at first record }
      'O' : GoBottom;  { position database at last record }
      'B' : BEGIN
              Browse('NOMODIFY, LOCK 3');
              NetLogForm;
            END;
      'S' : Search_SUFFIX;  { user defined }
      'F' : Find_SUFFIX;    { user defined }
      'L' : Set_Filter; { user defined }
      'G' : BEGIN  { GO }
              MRecNO := 1;
              SayGet(1,25,' Enter record number: ',MRecNo,_LI,6,0);
              Range('1',SInteger(RecCount,0));
              Set_Repaint_Off;
              ReadGets;
              Set_Repaint_On;
              IF EditResult <= 0 THEN GO(MRecNo);
              AT(1,25,Space(78));
             END;
      'C' : BEGIN  { Pack }
              ClrScr;
              WriteLn('Removing deleted records...');
              Set_Talk_On;
              Pack;
              WriteLn('Re-indexing database...');
              Index_On(@KeyMaker, 'NBASE');
              GoTop;
              NetLogForm;
             END;
    END; { Case }
  UNTIL choice = ^[;
  Set_Cursor_On;
  DisplayPage(@SavedVideo);
END;

procedure read_file;
var filename : string[64];
BEGIN
  Set_Escape_On;   { affects SayGet commands }
  Set_Safety_Off;  { affects Pack command }
  Set_Odometer_On; { affects Index_On command }
  Set_Century_Off;
  ClrScr;
  Select(0);       { choose first available work area }
  OurWorkArea := CurrentArea;
  if ParamCount = 1
    then
        filename := ParamStr(1)
    else
      begin
        restore_entry_screen;
        writeln('Usage: NET d:\path\filename');
        writeln('             do not include .DBF extension');
        halt;
      end;

  IF NOT FileExists(filename+'.DBF') THEN
  begin
    writeln('Creating new file');
    MakeFile(filename+'.DBF');
  end;

  USE(filename+'.DBF', @NBase, SizeOf(NBase)); { open the file }
  IF RecCount = 0 THEN Append; { don't allow an empty database }
  EditMode := False;
  AddMode  := False;
  m_SUFFIX := '';
  FilterValue := '';
  ClrScr;
  Write('Reading record: ');
  while NOT dEOF do
  begin
    with net_list[RecNo]^ do
      begin
        prefix := NBase._PREFIX;
        area   := NBase._AREA;
        suffix := NBase._SUFFIX;
        name   := NBase._NAME;
        net_nbr := NBase._NETNBR;
        recnbr := RecNo;
        log_time := '';
      end;
    gotoxy(17,1);write(RecNo);
    skip(1);
  end;
  writeln;

  nbr_calls := RecCount;
  sort(net_list,nbr_calls);
  writeln;

  GoTop;
  IF NOT FileExists(filename+'.IND') THEN
      Index_On(@KeyMaker, filename+'.IND');
  Set_Index_To(@KeyMaker, filename+'.IND',1);
  GoTop;
  ClrScr;
end;


procedure save_logins;
var i : integer;
    textfile : text;
    textbuff : array[0..1023] of char;
begin
  textcolor(status_f);
  textbackground(norm_b);
  for i := 1 to nbr_calls do
    if (net_list[i]^.xref <> 0) then
      with net_list[i]^ do
        log_date := SystemDate;
  window(32,8,79,16);
  ClrScr;
  assign(textfile,todays_log_name);
  SetTextBuf(textfile,textbuff);
  {$I-}
  rewrite(textfile);
  {$I+}
  if (IOresult <> 0)
  then
    begin
      writeln(#7,'Unable to open login file.');
      delay(2000);
      exit;
    end
  else
    begin
      writeln('Writing login file.');
      writeln(textfile,'Logins for ',SystemDate,'');
      writeln(textfile,'Callsign   Name   net #   time');
      writeln;
      writeln;
      for i := 1 to top_pntr do
        with checkins[i] do
          if (list_nbr = 0)
            then with net_list[position]^ do
                      writeln(textfile,
                         Trim(prefix) + area + suffix : 6,
                         name : 10,
                         net_nbr : 5,
                         hr_min : 9)
            else with new_list[position]^ do
                      writeln(textfile,
                         Trim(prefix) + area + suffix : 6,
                         name : 10,
                         net_nbr : 5,
                         hr_min : 9);
      close(textfile);
    end;
  ClrScr;
  window(1,1,80,25);
end;

procedure write_file;
var  point,i : integer;
     key : char;
     combine : boolean;
begin
  window(32,8,79,16);
  textcolor(status_f);
  textbackground(norm_b);
  ClrScr;
  GoTop;
  write('Updating Record # ');
  for i := 1 to nbr_calls do
    with net_list[i]^ do
    if xref <> 0 then
    with NBase do
      begin
        Go(recnbr);
        gotoxy(19,1); write(RecNo:4);
        _LOGDATE := log_date;
        REPLACE;
      end;
  ClrScr;
  window(1,1,80,25);
end;

procedure UpdateDataBase;
begin
  save_logins;
  write_file;
end;