home *** CD-ROM | disk | FTP | other *** search
/ Hacker Chronicles 2 / HACKER2.BIN / 466.NETFILES.PAS < prev    next >
Pascal/Delphi Source File  |  1989-11-19  |  20KB  |  634 lines
  1. TYPE
  2.     NBase_record = RECORD
  3.       Deleted     : Boolean;
  4.       _PREFIX     : String[ 2];
  5.       _AREA       : String[ 1];
  6.       _SUFFIX     : String[ 3];
  7.       _NAME       : String[10];
  8.       _NETNBR     : LongInt;     { width= 4 }
  9.       _LOGDATE    : String[10];  { Date field }
  10.       _NBRLOGINS  : LongInt;     { width= 4 }
  11.       _STATUS     : String[ 1];
  12.       _JOINED     : String[ 9];
  13.       _FNAME      : String[10];
  14.       _LNAME      : String[20];
  15.       _ADDR       : String[30];
  16.       _CITY       : String[25];
  17.       _STATE      : String[ 2];
  18.       _ZIP        : String[ 5];
  19.       _PHONE      : String[12];
  20.       _BIRTHDATE  : String[ 8];
  21.       _SPOUSE     : String[10];
  22.       _SP_BIRTH   : String[ 5];
  23.       _COMMENT1   : String[40];
  24.       _COMMENT2   : String[40];
  25.     END;
  26.  
  27. VAR
  28.     NBase : NBase_record;
  29.     m_PREFIX : String;
  30.     m_AREA : String;
  31.     m_SUFFIX : String;
  32.     FilterValue : String;
  33.     m_Found : Boolean;
  34.     Choice : Char;
  35.     AddMode : Boolean;
  36.     EditMode : Boolean;
  37.     MRecNo : LongInt;
  38.     OurWorkArea : Byte;
  39.  
  40. PROCEDURE EditColors;
  41. begin
  42.   Set_Color_To(say_f,say_b,get_f,get_b);
  43. end;
  44.  
  45. PROCEDURE HelpColors;
  46. begin
  47.   Set_Color_To(aux_f,aux_b,norm_f,norm_b);
  48. end;
  49.  
  50. PROCEDURE HelpScreen;
  51. { Displays a list of menu commands when <F1> or "H" is pressed }
  52. VAR ScreenBuffer : Array[1..2000] OF Word;
  53. BEGIN
  54.   FillPage(@ScreenBuffer); { save contents of current screen }
  55.   Window(5,4,75,23);
  56.   HelpColors;
  57.   ClrScr;
  58.   WriteLn('                         Menu Commands');
  59.   WriteLn;
  60.   WriteLn('  N - Next      Skips to and displays next record in file');
  61.   Writeln('                Down Arrow key performs same function');
  62.   WriteLn('  P - Prev      Skips back one and displays prior record');
  63.   WriteLn('                Up Arrow key performs same function');
  64.   WriteLn('  T - Top       Displays first record in file');
  65.   WriteLn('  O - Bottom    Displays last record in file');
  66.   WriteLn('  G - Go        Positions database on selected record by number');
  67.   WriteLn('  S - Search    Allows searching for imbedded string in key field');
  68.   WriteLn('  F - Find      Finds the first record with matching key field');
  69.   WriteLn('  E - Edit      Allows modification of currently displayed record');
  70.   WriteLn('  A - Add       Allows input and appends a new record into database');
  71.   WriteLn('  B - Browse    Spreadsheet-like view of database');
  72.   WriteLn('<ESC> Quit      Return to NET login process');
  73.   WriteLn;
  74.   Wait('                        Press any key to return...');
  75.   Window(1,1,80,25);
  76.   DisplayPage(@ScreenBuffer); { restore prior screen }
  77.   EditColors;
  78. END;   { HelpScreen }
  79.  
  80.  
  81. {$F+} PROCEDURE EditHelp; { called by SAYGET4.TPU }
  82. { Displays a help screen when <F1> is pressed while editing }
  83. VAR ScreenBuffer : Array[1..2000] OF Word;
  84. BEGIN
  85.   FillPage(@ScreenBuffer); { save contents of current screen }
  86.   HelpColors;
  87.   Window(5,3,75,23);
  88.   ClrScr;
  89.   WriteLn('                          Editing Commands');
  90.   WriteLn;
  91.   WriteLn('      <Ctrl-R> or <PgUp>  Move to beginning of first field');
  92.   WriteLn('      <Ctrl-C>  Move to beginning of last field');
  93.   WriteLn('      <Ctrl-E> or <Up Arrow> Move to beginning of prior field');
  94.   WriteLn('      <Ctrl-X> or <Dn Arrow> Move to beginning of next field');
  95.   WriteLn('      <Ctrl-V> or <Ins>  Toggle insert/overwrite mode');
  96.   WriteLn('      <Ctrl-G> or <Del>  Delete character at cursor');
  97.   WriteLn('      <Ctrl-T>  Delete word to right of cursor ');
  98.   WriteLn('      <Ctrl-Y>  Delete all characters to right of cursor');
  99.   WriteLn('      <Ctrl-U>  Restore prior data (Undo)');
  100.   WriteLn('      <Ctrl-S> or <Lft Arrow> Move cursor left one character');
  101.   WriteLn('      <Ctrl-D> or <Rt Arrow> Move cursor right one character');
  102.   WriteLn('      <Ctrl-W> or <PgDn> Exit edit session');
  103.   WriteLn('      <Esc>     Abandon edit');
  104.   WriteLn('      <Home>    Move cursor to first character in field');
  105.   WriteLn('      <End>     Move cursor to last charcter in field');
  106.   WriteLn;
  107.   Wait('                        Press any key to return...');
  108.   Window(1,1,80,25);
  109.   DisplayPage(@ScreenBuffer); { restore prior screen }
  110.   EditColors;
  111. END;   { EditHelp }
  112. {$F-}
  113.  
  114. {$F+} PROCEDURE AutoHelp;
  115. begin
  116.   ClearEol(1,23);
  117.   case SGFieldCode of
  118.     1  : AT(10,23,'Enter 1-2 character prefix');
  119.     2  : AT(10,23,'Enter numeral call sign area');
  120.     3  : AT(10,23,'Enter 1-3 character suffix');
  121.     4  : AT(10,23,'Enter name used for QSOs');
  122.     5  : AT(10,23,'Enter 1-4 digit net number');
  123.     6  : AT(10,23,'Enter date joined');
  124.     7  : AT(10,23,'Date of last login (filled in by NET)');
  125.     8  : AT(10,23,'Number of logins (filled in by NET)');
  126.     9  : AT(10,23,'Status A-active I-inactive S-silent " " non-member');
  127.     10 : AT(10,23,'Enter first name');
  128.     11 : AT(10,23,'Enter last name');
  129.     12 : AT(10,23,'Enter street address');
  130.     13 : AT(10,23,'Enter city');
  131.     14 : AT(10,23,'Enter state abbreviation');
  132.     15 : AT(10,23,'Enter 5 number zip code');
  133.     16 : AT(10,23,'Enter phone number, including area code');
  134.     17 : AT(10,23,'Enter birthdate');
  135.     18 : AT(10,23,'Enter spouse name');
  136.     19 : AT(10,23,'Enter month/day of spouse birthday');
  137.     20,21 : AT(10,23,'Enter comments');
  138.   end;
  139. end;
  140. {$F-}
  141.  
  142.  
  143. {$F+} FUNCTION KeyMaker : String; { called by INDEX4.TPU }
  144. BEGIN
  145.   KeyMaker := Upper(NBase._AREA + NBase._SUFFIX + NBase._PREFIX);
  146. END;  { KeyMaker }
  147. {$F-}
  148.  
  149. PROCEDURE Search_SUFFIX;
  150.  { Sequential search of entire file to find m_SUFFIX in SUFFIX }
  151.  { Searches faster if no index is active. }
  152. BEGIN
  153.   m_SUFFIX := '';
  154.   SayGet(1,25,' Enter SUFFIX to locate: ',m_SUFFIX,_S,3,0);
  155.   Picture('@!');
  156.   Set_Repaint_Off;  { leave field in reverse video on screen }
  157.   ReadGets;
  158.   Set_Repaint_On;   { restore default setting }
  159.   IF EditResult > 0 THEN
  160.     BEGIN
  161.       ClearEOL(1,25);
  162.       Exit;
  163.     END;
  164.   IF Length(M_SUFFIX) > 0 THEN
  165.     BEGIN
  166.       MRecNo := RecNo; { save current position }
  167.       m_Found := False;
  168.       GoTop;            { start at top of file (omit as desired) }
  169.       REPEAT
  170.         IF POS(m_SUFFIX,Upper(NBase._SUFFIX)) > 0 THEN
  171.            m_Found := True
  172.         ELSE Skip(1);
  173.         AT(75,25,SInteger(RecNo,0));
  174.       UNTIL m_Found OR dEOF;
  175.       IF Not m_Found THEN
  176.         BEGIN
  177.           GO(MRecNo); { re-position file }
  178.           ClearEOL(1,25);
  179.           Wait(M_SUFFIX+' not found.  Press any key...');
  180.         END;
  181.     END;
  182.   ClearEOL(1,25);
  183. END;   { Search_SUFFIX }
  184.  
  185.  
  186. PROCEDURE Find_SUFFIX; { Direct access via index }
  187. BEGIN
  188.   m_PREFIX := '';
  189.   m_AREA   := '';
  190.   m_SUFFIX := '';
  191.   SayGet(1,25,' PREFIX : ',m_PREFIX,_S,2,0);
  192.   Picture('@!');
  193.   SayGet(20,25,'AREA : ',m_AREA,_S,1,0);
  194.   Picture('@!');
  195.   SayGet(30,25,'SUFFIX : ',m_SUFFIX,_S,3,0);
  196.   Picture('@!');
  197.   ReadGets;
  198.   ClearEol(1,25);
  199.   IF EditResult > 0 THEN Exit;
  200.   IF Length(M_SUFFIX) > 0 THEN
  201.     Find(m_AREA + m_SUFFIX + m_PREFIX);
  202.   IF NOT Found THEN
  203.     BEGIN
  204.       GoToXY(1,25);
  205.       Wait(' Not in database.  Press any key...');
  206.       ClearEol(1,25);
  207.     END;
  208. END;   { Find_SUFFIX }
  209.  
  210.  
  211. PROCEDURE WriteStatusLine;
  212. BEGIN
  213.   IF AddMode THEN
  214.   AT(2,2,'Record # '+SInteger(RecNo+1,4)+' of '+SInteger(RecCount+1,4)+'   '+DBF+'  Updated: '+LUpdate)
  215.   ELSE
  216.   AT(2,2,'Record # '+SInteger(RecNo,4)+' of '+SInteger(RecCount,4)    +'   '+DBF+'  Updated: '+LUpdate);
  217.   IF dBOF OR dEOF THEN RingBell;
  218. END;   { WriteStatusLine }
  219.  
  220. PROCEDURE PromptLine;
  221. begin
  222.   AT(4,23,'N)ext P)rev T)op B(O)t G)o S)rch F)ind E)dit A)dd D)el B)row Pa(C)k <ESC>');
  223.   AT(34,24,'<F1> = Help');
  224. end;
  225.  
  226. PROCEDURE NetLogForm;
  227. begin
  228.   clrscr;
  229.   AT(11, 5,'┌──────────────────────────────────────────────────────┐');
  230.   AT(11, 6,'│  Prefix Area Suffix  Nickname     Net #      Joined  │');
  231.   AT(11, 7,'│                                                      │');
  232.   AT(11, 8,'│                                                      │');
  233.   AT(11, 9,'│  Last Login             Total Logins       Status    │');
  234.   AT(11,10,'│                                                      │');
  235.   AT(11,11,'│  Name                                                │');
  236.   AT(11,12,'│  Address                                             │');
  237.   AT(11,13,'│                                                      │');
  238.   AT(11,14,'│                                                      │');
  239.   AT(11,15,'│  Phone                          Birthday             │');
  240.   AT(11,16,'│                                                      │');
  241.   AT(11,17,'│  Spouse name                    Birthday             │');
  242.   AT(11,18,'│                                                      │');
  243.   AT(11,19,'│  Comments                                            │');
  244.   AT(11,20,'│                                                      │');
  245.   AT(11,21,'└──────────────────────────────────────────────────────┘');
  246.   PromptLine;
  247. end;
  248.  
  249. PROCEDURE DoGetsWith_NETNBR;
  250. BEGIN
  251.   WriteStatusLine;
  252.   IF EditMode OR AddMode THEN ClearEOL(1,23);
  253.   IF AddMode THEN ClearRecord;
  254.   WITH NBase DO
  255.     BEGIN
  256.       IF deleted THEN AT(10,3,'DELETED')
  257.       ELSE AT(10,3,'       ');
  258.       SayGet(16, 7,'', _PREFIX, _S, 2, 0);
  259.         picture('@!');
  260.         Set_AutoHelp_To(@AutoHelp);
  261.       SayGet(22, 7,'', _AREA, _S, 1, 0);
  262.         picture('9');
  263.         Set_AutoHelp_To(@AutoHelp);
  264.       SayGet(27, 7,'', _SUFFIX, _S, 3, 0);
  265.         picture('@!');
  266.         Set_AutoHelp_To(@AutoHelp);
  267.       SayGet(34, 7,'', _NAME, _S, 10, 0);
  268.         Set_AutoHelp_To(@AutoHelp);
  269.       SayGet(48, 7,'', _NETNBR, _I, 4, 0);
  270.         Set_AutoHelp_To(@AutoHelp);
  271.       SayGet(55, 7,'', _JOINED, _S, 9, 0);
  272.         Set_AutoHelp_To(@AutoHelp);
  273.       SayGet(25, 9,'',_LOGDATE, _D, 8, 0);
  274.         Set_AutoHelp_To(@AutoHelp);
  275.       SayGet(50, 9,'',_NBRLOGINS, _I, 4, 0);
  276.         Set_AutoHelp_To(@AutoHelp);
  277.       SayGet(63, 9,'',_STATUS, _S, 1, 0);
  278.         picture('!');
  279.         Set_AutoHelp_To(@AutoHelp);
  280.       SayGet(23,11,'', _FNAME, _S, 10, 0);
  281.         Set_AutoHelp_To(@AutoHelp);
  282.       SayGet(35,11,'', _LNAME, _S, 20, 0);
  283.         Set_AutoHelp_To(@AutoHelp);
  284.       SayGet(23,12,'', _ADDR, _S, 30, 0);
  285.         Set_AutoHelp_To(@AutoHelp);
  286.       SayGet(23,13,'', _CITY, _S, 25, 0);
  287.         Set_AutoHelp_To(@AutoHelp);
  288.       SayGet(50,13,'', _STATE, _S, 2, 0);
  289.         picture('!!');
  290.         Set_AutoHelp_To(@AutoHelp);
  291.       SayGet(54,13,'', _ZIP, _S, 5, 0);
  292.         picture('99999');
  293.         Set_AutoHelp_To(@AutoHelp);
  294.       SayGet(23,15,'', _PHONE, _S, 12, 0);
  295.         picture('999-999-9999');
  296.         Set_AutoHelp_To(@AutoHelp);
  297.       SayGet(55,15,'', _BIRTHDATE, _D, 8, 0);
  298.         Set_AutoHelp_To(@AutoHelp);
  299.       SayGet(27,17,'', _SPOUSE, _S, 10, 0);
  300.         Set_AutoHelp_To(@AutoHelp);
  301.       SayGet(55,17,'', _SP_BIRTH, _S, 5, 0);
  302.         picture('99/99');
  303.         Set_AutoHelp_To(@AutoHelp);
  304.       SayGet(23,19,'',_COMMENT1, _S, 40, 0);
  305.         Set_AutoHelp_To(@AutoHelp);
  306.       SayGet(23,20,'',_COMMENT2, _S, 40, 0);
  307.         Set_AutoHelp_To(@AutoHelp);
  308.  
  309.       IF EditMode OR AddMode THEN
  310.         BEGIN
  311.           ReadGets;  { edit the fields defined with SayGet() }
  312.           IF EditResult <= 0 THEN
  313.             BEGIN
  314.               IF AddMode THEN
  315.                 BEGIN
  316.                   Append;
  317.                   AddMode := False;
  318.                   WriteStatusLine;
  319.                 END
  320.               ELSE Replace;
  321.             END;
  322.           PromptLine;
  323.         END
  324.       ELSE ClearGets; { just display the fields }
  325.     END;
  326. END;       { DoGetsWith_NETNBR }
  327.  
  328. PROCEDURE MakeFile(NewFile : String);
  329. VAR
  330.     DataBase  : DbfRecord;
  331.     FieldList : FieldArray;
  332. BEGIN
  333.   WriteLn('Creating '+NewFile+'...');
  334.   FillChar(FieldList,SizeOf(FieldList), 0);
  335.   FieldList[1].Name := 'PREFIX';
  336.   FieldList[1].Typ  := 'C';
  337.   FieldList[1].Len  := 2;
  338.   FieldList[2].Name := 'AREA';
  339.   FieldList[2].Typ  := 'C';
  340.   FieldList[2].Len  := 1;
  341.   FieldList[3].Name := 'SUFFIX';
  342.   FieldList[3].Typ  := 'C';
  343.   FieldList[3].Len  := 3;
  344.   FieldList[4].Name := 'NAME';
  345.   FieldList[4].Typ  := 'C';
  346.   FieldList[4].Len  := 10;
  347.   FieldList[5].Name := 'NETNBR';
  348.   FieldList[5].Typ  := 'N';
  349.   FieldList[5].Len  := 4;
  350.   FieldList[5].Dec  := 0;
  351.   FieldList[6].Name := 'LOGDATE';
  352.   FieldList[6].Typ  := 'D';
  353.   FieldList[7].Name := 'NBRLOGINS';
  354.   FieldList[7].Typ  := 'N';
  355.   FieldList[7].Len  := 4;
  356.   FieldList[7].Dec  := 0;
  357.   FieldList[8].Name := 'STATUS';
  358.   FieldList[8].Typ  := 'C';
  359.   FieldList[8].Len  := 1;
  360.   FieldList[9].Name := 'JOINED';
  361.   FieldList[9].Typ  := 'C';
  362.   FieldList[9].Len  := 9;
  363.   FieldList[10].Name := 'FNAME';
  364.   FieldList[10].Typ  := 'C';
  365.   FieldList[10].Len  := 10;
  366.   FieldList[11].Name := 'LNAME';
  367.   FieldList[11].Typ  := 'C';
  368.   FieldList[11].Len  := 20;
  369.   FieldList[12].Name := 'ADDR';
  370.   FieldList[12].Typ  := 'C';
  371.   FieldList[12].Len  := 30;
  372.   FieldList[13].Name := 'CITY';
  373.   FieldList[13].Typ  := 'C';
  374.   FieldList[13].Len  := 25;
  375.   FieldList[14].Name := 'STATE';
  376.   FieldList[14].Typ  := 'C';
  377.   FieldList[14].Len  := 2;
  378.   FieldList[15].Name := 'ZIP';
  379.   FieldList[15].Typ  := 'C';
  380.   FieldList[15].Len  := 5;
  381.   FieldList[16].Name := 'PHONE';
  382.   FieldList[16].Typ  := 'C';
  383.   FieldList[16].Len  := 12;
  384.   FieldList[17].Name := 'BIRTHDATE';
  385.   FieldList[17].Typ  := 'C';
  386.   FieldList[17].Len  := 8;
  387.   FieldList[18].Name := 'SPOUSE';
  388.   FieldList[18].Typ  := 'C';
  389.   FieldList[18].Len  := 10;
  390.   FieldList[19].Name := 'SP_BIRTH';
  391.   FieldList[19].Typ  := 'C';
  392.   FieldList[19].Len  := 5;
  393.   FieldList[20].Name := 'COMMENT1';
  394.   FieldList[20].Typ  := 'C';
  395.   FieldList[20].Len  := 40;
  396.   FieldList[21].Name := 'COMMENT2';
  397.   FieldList[21].Typ  := 'C';
  398.   FieldList[21].Len  := 40;
  399.   CreateDBF(DataBase, NewFile, 21, @FieldList);
  400. END;
  401.  
  402.  
  403. PROCEDURE MaintainNetLog;
  404. var  SavedVideo : array[1..2000] of word;
  405. BEGIN
  406.   FillPage(@SavedVideo);
  407.   Select(OurWorkArea);
  408.   Set_FKey(F1,@EditHelp);
  409.   EditColors;
  410.   NetLogForm;
  411.   Set_Cursor_Off;
  412.   if top_pntr = 0
  413.     then GoTop
  414.     else if checkins[curr_pntr].list_nbr = 1
  415.            then Go(new_list[checkins[curr_pntr].position]^.recnbr)
  416.            else Go(net_list[checkins[curr_pntr].position]^.recnbr);
  417.   REPEAT
  418.     DoGetsWith_NETNBR;  { display (or edit) the current record }
  419.     REPEAT
  420.       Choice := ReadKey;       { get user request }
  421.       IF Choice = CHR(0) THEN  { user pressed a special key }
  422.         BEGIN
  423.           Choice := ReadKey;
  424.           Case Choice Of
  425.             'P' : Choice := 'N';  { map down-arrow to "Next"   }
  426.             'H' : Choice := 'P';  { map up-arrow to "Previous" }
  427.             ';' : Choice := 'H';  { map F1 to "Help" }
  428.             ELSE Choice := ' ';   { ignore other special keys  }
  429.           END;
  430.         END;
  431.       Choice := UpCase(Choice);
  432.     UNTIL POS(Choice,'ABCDEFGHNOPST'+^[) > 0;
  433.     EditMode := False;
  434.     AddMode  := False;
  435.     CASE Choice OF
  436.       'N' : BEGIN
  437.               Skip(1);
  438.               IF dEOF THEN GoBottom;
  439.             END;
  440.       'P' : Skip(-1);
  441.       'E' : EditMode := True;
  442.       'A' : AddMode  := True;
  443.       'D' : { toggle the "Deleted" flag }
  444.             IF NBase.Deleted THEN RecallRec ELSE DeleteRec;
  445.       'H' : HelpScreen;
  446.       'T' : GoTop;     { position database at first record }
  447.       'O' : GoBottom;  { position database at last record }
  448.       'B' : BEGIN
  449.               Browse('NOMODIFY, LOCK 3');
  450.               NetLogForm;
  451.             END;
  452.       'S' : Search_SUFFIX;  { user defined }
  453.       'F' : Find_SUFFIX;    { user defined }
  454.       'G' : BEGIN  { GO }
  455.               MRecNO := 1;
  456.               SayGet(1,25,' Enter record number: ',MRecNo,_LI,6,0);
  457.               Range('1',SInteger(RecCount,0));
  458.               Set_Repaint_Off;
  459.               ReadGets;
  460.               Set_Repaint_On;
  461.               IF EditResult <= 0 THEN GO(MRecNo);
  462.               AT(1,25,Space(78));
  463.              END;
  464.       'C' : BEGIN  { Pack }
  465.               ClrScr;
  466.               WriteLn('Removing deleted records...');
  467.               Set_Talk_On;
  468.               Pack;
  469.               WriteLn('Re-indexing database...');
  470.               Index_On(@KeyMaker, DBfilename + '.IND');
  471.               GoTop;
  472.               NetLogForm;
  473.              END;
  474.     END; { Case }
  475.   UNTIL choice = ^[;
  476.   Set_Cursor_On;
  477.   DisplayPage(@SavedVideo);
  478. END;
  479.  
  480. procedure read_file;
  481. var Nrec     : integer;
  482. BEGIN
  483.   EditColors;
  484.   NormColor;
  485.   Set_Escape_On;   { affects SayGet commands }
  486.   Set_Safety_Off;  { affects Pack command }
  487.   Set_Odometer_On; { affects Index_On command }
  488.   Set_Century_Off;
  489.   ClrScr;
  490.   Select(0);       { choose first available work area }
  491.   OurWorkArea := CurrentArea;
  492.   if ParamCount = 1
  493.     then
  494.         DBfilename := ParamStr(1)
  495.     else
  496.       begin
  497.         restore_entry_screen;
  498.         writeln('Usage: NET d:\path\filename');
  499.         writeln('             do not include .DBF extension');
  500.         halt;
  501.       end;
  502.  
  503.   IF NOT FileExists(DBfilename+'.DBF') THEN
  504.   begin
  505.     writeln('Creating new file');
  506.     MakeFile(DBfilename+'.DBF');
  507.   end;
  508.  
  509.   USE(DBfilename+'.DBF', @NBase, SizeOf(NBase)); { open the file }
  510.   IF RecCount = 0 THEN Append; { don't allow an empty database }
  511.   EditMode := False;
  512.   AddMode  := False;
  513.   m_SUFFIX := '';
  514.   FilterValue := '';
  515.   ClrScr;
  516.   NRec := 1;
  517.   Write('Reading record: ');
  518.   while NOT dEOF do
  519.   begin
  520.     if NBase._STATUS <> 'S' then
  521.     with net_list[NRec]^ do
  522.       begin
  523.         prefix := NBase._PREFIX;
  524.         area   := NBase._AREA;
  525.         suffix := NBase._SUFFIX;
  526.         name   := NBase._NAME;
  527.         net_nbr := NBase._NETNBR;
  528.         recnbr := RecNo;
  529.         log_time := '';
  530.         inc(Nrec);
  531.       end;
  532.     gotoxy(17,1);write(RecNo);
  533.     skip(1);
  534.   end;
  535.   writeln;
  536.  
  537.   nbr_calls := NRec - 1;
  538.   sort(net_list,nbr_calls);
  539.   writeln;
  540.  
  541.   GoTop;
  542.   IF NOT FileExists(DBfilename+'.IND') THEN
  543.       Index_On(@KeyMaker, DBfilename+'.IND');
  544.   Set_Index_To(@KeyMaker, DBfilename+'.IND',1);
  545.   GoTop;
  546.   ClrScr;
  547. end;
  548.  
  549.  
  550. procedure save_logins;
  551. var i : integer;
  552.     textfile : text;
  553.     textbuff : array[0..1023] of char;
  554. begin
  555.   textcolor(status_f);
  556.   textbackground(norm_b);
  557.   for i := 1 to nbr_calls do
  558.     if (net_list[i]^.xref <> 0) then
  559.       with net_list[i]^ do
  560.         log_date := SystemDate;
  561.   window(32,8,79,16);
  562.   ClrScr;
  563.   assign(textfile,todays_log_name);
  564.   SetTextBuf(textfile,textbuff);
  565.   {$I-}
  566.   rewrite(textfile);
  567.   {$I+}
  568.   if (IOresult <> 0)
  569.   then
  570.     begin
  571.       writeln(#7,'Unable to open login file.');
  572.       delay(2000);
  573.       exit;
  574.     end
  575.   else
  576.     begin
  577.       writeln('Writing login file.');
  578.       writeln(textfile,'Logins for ',SystemDate,'');
  579.       writeln(textfile,'Callsign   Name   net #   time');
  580.       writeln;
  581.       writeln;
  582.       for i := 1 to top_pntr do
  583.         with checkins[i] do
  584.           if (list_nbr = 0)
  585.             then with net_list[position]^ do
  586.                       writeln(textfile,
  587.                          Trim(prefix) + area + suffix : 6,
  588.                          name : 10,
  589.                          net_nbr : 5,
  590.                          hr_min : 9)
  591.             else with new_list[position]^ do
  592.                       writeln(textfile,
  593.                          Trim(prefix) + area + suffix : 6,
  594.                          name : 10,
  595.                          net_nbr : 5,
  596.                          hr_min : 9);
  597.       close(textfile);
  598.     end;
  599.   ClrScr;
  600.   window(1,1,80,25);
  601. end;
  602.  
  603. procedure write_file;
  604. var  point,i : integer;
  605.      key : char;
  606.      combine : boolean;
  607. begin
  608.   window(32,8,79,16);
  609.   textcolor(status_f);
  610.   textbackground(norm_b);
  611.   ClrScr;
  612.   GoTop;
  613.   write('Updating Record # ');
  614.   for i := 1 to nbr_calls do
  615.     with net_list[i]^ do
  616.     if xref <> 0 then
  617.     with NBase do
  618.       begin
  619.         Go(recnbr);
  620.         gotoxy(19,1); write(RecNo:4);
  621.         _LOGDATE := log_date;
  622.         _NBRLOGINS := _NBRLOGINS + 1;
  623.         REPLACE;
  624.       end;
  625.   ClrScr;
  626.   window(1,1,80,25);
  627. end;
  628.  
  629. procedure UpdateDataBase;
  630. begin
  631.   save_logins;
  632.   write_file;
  633. end;
  634.