home *** CD-ROM | disk | FTP | other *** search
/ Hacker Chronicles 2 / HACKER2.BIN / 444.NETBASE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-07-12  |  12KB  |  387 lines
  1. {----------------------------------------------------------------------------
  2.     NBASE.PAS for Turbo Pascal.  For use with NBase.DBF  (dBASE III)
  3.     DBF structure translation and program generated by TOPAZ.
  4.  ---------------------------------------------------------------------------}
  5.  
  6. PROGRAM Edit_NBase;
  7.  
  8. USES CRT,DBF4,INDEX4,SAYGET4,BROWSE4,VIDPOP;
  9.  
  10. TYPE
  11.     NBase_record = RECORD
  12.       Deleted     : Boolean;
  13.       _PREFIX     : String[ 2];
  14.       _AREA       : String[ 1];
  15.       _SUFFIX     : String[ 3];
  16.       _NAME       : String[10];
  17.       _NETNBR     : String[ 4];
  18.       _LOGDATE    : String[10];
  19.       _FNAME      : String[10];
  20.       _LNAME      : String[20];
  21.       _ADDRESS    : String[30];
  22.       _CITY       : String[25];
  23.       _STATE      : String[ 2];
  24.       _ZIP        : String[ 5];
  25.       _PHONE      : String[12];
  26.       _BIRTHDATE  : String[10];  { Date field }
  27.       _SPOUSE     : String[10];
  28.       _SP_BIRTH   : String[ 5];  { Month/Day }
  29.     END;
  30.  
  31. VAR
  32.     NBase : NBase_record;
  33.     m_PREFIX : String;
  34.     m_AREA   : String;
  35.     m_SUFFIX : String;
  36.     FilterValue : String;
  37.     m_Found : Boolean;
  38.     Choice : Char;
  39.     AddMode : Boolean;
  40.     EditMode : Boolean;
  41.     MRecNo : LongInt;
  42.     OurWorkArea : Byte;
  43.     filename : string[64];
  44.  
  45. {$F+} FUNCTION Filter : Boolean; { called by DBF4.TPU }
  46.  { Returns True if FilterValue is equal to the SUFFIX field. }
  47. BEGIN
  48.   Filter := (POS(FilterValue,Upper(NBase._SUFFIX)) > 0) OR (dBOF OR dEOF);
  49. END;   { Filter }
  50. {$F-}
  51.  
  52. PROCEDURE Set_Filter;
  53.  { Instructs DBF4.TPU to use the user defined Filter function (above). }
  54. BEGIN
  55.   SayGet(1,25,' Enter filter value: ',FilterValue,_S,3,1);
  56.   Picture('@!');
  57.   ReadGets;
  58.   ClearEOL(1,25);
  59.   IF EditResult > 0 THEN Exit;
  60.   Set_Rotor_Off;
  61.   IF Length(FilterValue) = 0 THEN Set_Filter_To(NIL)
  62.   ELSE
  63.     BEGIN
  64.       Set_Filter_To(@Filter);
  65.       Set_Rotor_On;
  66.       GoTop;
  67.       IF dEOF THEN
  68.         BEGIN
  69.           Set_Filter_To(NIL);
  70.           Set_Rotor_Off;
  71.         END;
  72.     END;
  73. END;   { Set_Filter }
  74.  
  75. {$F+} FUNCTION KeyMaker : String; { called by INDEX4.TPU }
  76. BEGIN
  77.   KeyMaker := Upper(NBase._AREA + NBase._SUFFIX + NBase._PREFIX);
  78. END;  { KeyMaker }
  79. {$F-}
  80.  
  81. PROCEDURE Search_SUFFIX;
  82.  { Sequential search of entire file to find m_SUFFIX in SUFFIX }
  83.  { Searches faster if no index is active. }
  84. BEGIN
  85.   m_SUFFIX := '';
  86.   SayGet(1,25,' Enter SUFFIX to locate: ',m_SUFFIX,_S,3,1);
  87.   Picture('@!');
  88.   Set_Repaint_Off;  { leave field in reverse video on screen }
  89.   ReadGets;
  90.   Set_Repaint_On;   { restore default setting }
  91.   IF EditResult > 0 THEN
  92.     BEGIN
  93.       ClearEOL(1,25);
  94.       Exit;
  95.     END;
  96.   IF Length(M_SUFFIX) > 0 THEN
  97.     BEGIN
  98.       MRecNo := RecNo; { save current position }
  99.       m_Found := False;
  100.       GoTop;            { start at top of file (omit as desired) }
  101.       REPEAT
  102.         IF POS(m_SUFFIX,Upper(NBase._SUFFIX)) > 0 THEN
  103.            m_Found := True
  104.         ELSE Skip(1);
  105.         AT(75,25,SInteger(RecNo,0));
  106.       UNTIL m_Found OR dEOF;
  107.       IF Not m_Found THEN
  108.         BEGIN
  109.           GO(MRecNo); { re-position file }
  110.           ClearEOL(1,25);
  111.           Wait(M_SUFFIX+' not found.  Press any key...');
  112.         END;
  113.     END;
  114.   ClearEOL(1,25);
  115. END;   { Search_SUFFIX }
  116.  
  117.  
  118. PROCEDURE Find_SUFFIX; { Direct access via index }
  119. BEGIN
  120.   m_PREFIX := '';
  121.   m_AREA   := '';
  122.   m_SUFFIX := '';
  123.   SayGet(1,25,' PREFIX : ',m_PREFIX,_S,2,1);
  124.   Picture('@!');
  125.   SayGet(20,25,'AREA : ',m_AREA,_S,1,1);
  126.   Picture('@!');
  127.   SayGet(30,25,'SUFFIX : ',m_SUFFIX,_S,3,1);
  128.   Picture('@!');
  129.   ReadGets;
  130.   ClearEol(1,25);
  131.   IF EditResult > 0 THEN Exit;
  132.   IF Length(M_SUFFIX) > 0 THEN
  133.     Find(m_AREA + m_PREFIX + m_SUFFIX);
  134.   IF NOT Found THEN
  135.     BEGIN
  136.       GoToXY(1,25);
  137.       Wait(' Not in database.  Press any key...');
  138.       ClearEol(1,25);
  139.     END;
  140. END;   { Find_SUFFIX }
  141.  
  142.  
  143. PROCEDURE WriteStatusLine;
  144. BEGIN
  145.   IF AddMode THEN
  146.   AT(2,2,'Record # '+SInteger(RecNo+1,4)+' of '+SInteger(RecCount+1,4)+'      File: '+DBF+'      Last Update: '+LUpdate)
  147.   ELSE
  148.   AT(2,2,'Record # '+SInteger(RecNo,4)+' of '+SInteger(RecCount,4)+'      File: '+DBF+'      Last Update: '+LUpdate);
  149.   IF dBOF OR dEOF THEN RingBell;
  150. END;   { WriteStatusLine }
  151.  
  152.  
  153. PROCEDURE NetLogForm;
  154. begin
  155.   clrscr;
  156.   AT(11, 5,'┌──────────────────────────────────────────────────────┐');
  157.   AT(11, 6,'│  Prefix Area Suffix  Nickname                 Net #  │');
  158.   AT(11, 7,'│                                                      │');
  159.   AT(11, 8,'│                                                      │');
  160.   AT(11, 9,'│  Name                                                │');
  161.   AT(11,10,'│  Address  1234546789012345678901234567890            │');
  162.   AT(11,11,'│           1234567890123456789012345  12  12345       │');
  163.   AT(11,12,'│                                                      │');
  164.   AT(11,13,'│  Phone    xxx-xxx-xxxx          Birthday  xx/xx/xx   │');
  165.   AT(11,14,'│                                                      │');
  166.   AT(11,15,'│  Spouse name  1234567890        Birthday  xx/xx/xx   │');
  167.   AT(11,16,'│                                                      │');
  168.   AT(11,17,'│  Last Log Date :                                     │');
  169.   AT(11,18,'└──────────────────────────────────────────────────────┘');
  170.   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 Q)uit');
  171.   AT(34,24,'<F1> = Help');
  172. end;
  173.  
  174. PROCEDURE DoGetsWith_NBase;
  175. BEGIN
  176.   WriteStatusLine;
  177.   IF EditMode OR AddMode THEN ClearEOL(1,23);
  178.   IF AddMode THEN ClearRecord;
  179.   WITH NBase DO
  180.     BEGIN
  181.       IF deleted THEN AT(10,3,'DELETED')
  182.       ELSE AT(10,3,'       ');
  183.       SayGet(16, 7,'', _PREFIX, _S, 3, 0);
  184.       picture('@!');
  185.       SayGet(22, 7,'', _AREA, _S, 1, 0);
  186.       picture('9');
  187.       SayGet(27, 7,'', _SUFFIX, _S, 3, 0);
  188.       picture('@!');
  189.       SayGet(34, 7,'', _NAME, _S, 10, 0);
  190.       SayGet(59, 7,'', _NETNBR, _S, 4, 0);
  191.       SayGet(23, 9,'', _FNAME, _S, 10, 0);
  192.       SayGet(35, 9,'', _LNAME, _S, 20, 0);
  193.       SayGet(23,10,'', _ADDRESS, _S, 30, 0);
  194.       SayGet(23,11,'', _CITY, _S, 25, 0);
  195.       SayGet(50,11,'', _STATE, _S, 2, 0);
  196.       picture('!!');
  197.       SayGet(54,11,'', _ZIP, _S, 5, 0);
  198.       picture('99999');
  199.       SayGet(23,13,'', _PHONE, _S, 12, 0);
  200.       picture('999-999-9999');
  201.       SayGet(55,13,'', _BIRTHDATE, _D, 8, 0);
  202.       SayGet(27,15,'', _SPOUSE, _S, 10, 0);
  203.       SayGet(55,15,'', _SP_BIRTH, _D, 8, 0);
  204.       picture('99/99');
  205.       At(30,17,_LOGDATE);
  206.       IF EditMode OR AddMode THEN
  207.         BEGIN
  208.           ReadGets;  { edit the fields defined with SayGet() }
  209.           IF EditResult <= 0 THEN
  210.             BEGIN
  211.               IF AddMode THEN
  212.                 BEGIN
  213.                   Append;
  214.                   AddMode := False;
  215.                   WriteStatusLine;
  216.                 END
  217.               ELSE Replace;
  218.             END
  219.         END
  220.       ELSE ClearGets; { just display the fields }
  221.     END;
  222. END;       { DoGetsWith_NETNBR }
  223.  
  224. PROCEDURE MakeFile(NewFile : String);
  225. VAR
  226.     DataBase  : DbfRecord;
  227.     FieldList : FieldArray;
  228. BEGIN
  229.   WriteLn('Creating '+NewFile+'...');
  230.   FillChar(FieldList,SizeOf(FieldList), 0);
  231.   FieldList[1].Name := 'PREFIX';
  232.   FieldList[1].Typ  := 'C';
  233.   FieldList[1].Len  := 2;
  234.   FieldList[2].Name := 'AREA';
  235.   FieldList[2].Typ  := 'C';
  236.   FieldList[2].Len  := 1;
  237.   FieldList[3].Name := 'SUFFIX';
  238.   FieldList[3].Typ  := 'C';
  239.   FieldList[3].Len  := 3;
  240.   FieldList[4].Name := 'NAME';
  241.   FieldList[4].Typ  := 'C';
  242.   FieldList[4].Len  := 10;
  243.   FieldList[5].Name := 'NETNBR';
  244.   FieldList[5].Typ  := 'C';
  245.   FieldList[5].Len  := 4;
  246.   FieldList[6].Name := 'LOGDATE';
  247.   FieldList[6].Typ  := 'D';
  248.   FieldList[7].Name := 'FNAME';
  249.   FieldList[7].Typ  := 'C';
  250.   FieldList[7].Len  := 10;
  251.   FieldList[8].Name := 'LNAME';
  252.   FieldList[8].Typ  := 'C';
  253.   FieldList[8].Len  := 20;
  254.   FieldList[9].Name := 'ADDRESS';
  255.   FieldList[9].Typ  := 'C';
  256.   FieldList[9].Len  := 30;
  257.   FieldList[10].Name := 'CITY';
  258.   FieldList[10].Typ  := 'C';
  259.   FieldList[10].Len  := 25;
  260.   FieldList[11].Name := 'STATE';
  261.   FieldList[11].Typ  := 'C';
  262.   FieldList[11].Len  := 2;
  263.   FieldList[12].Name := 'ZIP';
  264.   FieldList[12].Typ  := 'C';
  265.   FieldList[12].Len  := 5;
  266.   FieldList[13].Name := 'PHONE';
  267.   FieldList[13].Typ  := 'C';
  268.   FieldList[13].Len  := 12;
  269.   FieldList[14].Name := 'BIRTHDATE';
  270.   FieldList[14].Typ  := 'D';
  271.   FieldList[15].Name := 'SPOUSE';
  272.   FieldList[15].Typ  := 'C';
  273.   FieldList[15].Len  := 10;
  274.   FieldList[16].Name := 'SP_BIRTH';
  275.   FieldList[16].Typ  := 'D';
  276.   CreateDBF(DataBase, NewFile, 16, @FieldList);
  277. END;
  278.  
  279. PROCEDURE INITIALIZE;
  280. BEGIN
  281.   Set_Escape_On;   { affects SayGet commands }
  282.   Set_Safety_Off;  { affects Pack command }
  283.   Set_Odometer_On; { affects Index_On command }
  284.   Set_Rotor_To(1,1);
  285.   Set_Rotor_Off;
  286.   Select(0);       { choose first available work area }
  287.   OurWorkArea := CurrentArea;
  288.   if ParamCount = 1
  289.     then
  290.         filename := ParamStr(1)
  291.     else
  292.       begin
  293.         writeln('Usage: NET d:\path\filename');
  294.         writeln('             do not include .DBF extension');
  295.         halt;
  296.       end;
  297.   ClrScr;
  298.   IF NOT FileExists(filename+'.DBF') THEN
  299.   begin
  300.     writeln('Creating new file');
  301.     MakeFile(filename+'.DBF');
  302.   end;
  303.  
  304.   USE(filename+'.DBF', @NBase, SizeOf(NBase)); { open the file }
  305.  
  306.   IF NOT FileExists(filename+'.IND') THEN
  307.       Index_On(@KeyMaker, filename+'.IND');
  308.   Set_Index_To(@KeyMaker, filename+'.IND',1);
  309.  
  310.   IF RecCount = 0 THEN Append; { don't allow an empty database }
  311.  
  312.   EditMode := False;
  313.   AddMode  := False;
  314.   FilterValue := '';
  315. END;  { Initialize }
  316.  
  317. BEGIN
  318.   Initialize;
  319.   Select(OurWorkArea);
  320.   Set_Color_To(LightGray,Black,Black,LightGray);
  321.   ClrScr;
  322.   Set_Cursor_Off;
  323.   NetLogForm;
  324.   REPEAT
  325.     DoGetsWith_NBase;  { display (or edit) the current record }
  326.     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 Q)uit');
  327.     REPEAT
  328.       Choice := ReadKey;       { get user request }
  329.       IF Choice = CHR(0) THEN  { user pressed a special key }
  330.         BEGIN
  331.           Choice := ReadKey;
  332.           Case Choice Of
  333.             'P' : Choice := 'N';  { map down-arrow to "Next"   }
  334.             'H' : Choice := 'P';  { map up-arrow to "Previous" }
  335.             ELSE Choice := ' ';   { ignore other special keys  }
  336.           END;
  337.         END;
  338.       Choice := UpCase(Choice);
  339.     UNTIL POS(Choice,'ABCDEFGLNOPQST') > 0;
  340.     EditMode := False;
  341.     AddMode  := False;
  342.     CASE Choice OF
  343.       'N' : BEGIN
  344.               Skip(1);
  345.               IF dEOF THEN GoBottom;
  346.             END;
  347.       'P' : Skip(-1);
  348.       'E' : EditMode := True;
  349.       'A' : AddMode  := True;
  350.       'D' : { toggle the "Deleted" flag }
  351.             IF NBase.Deleted THEN RecallRec ELSE DeleteRec;
  352.       'T' : GoTop;     { position database at first record }
  353.       'O' : GoBottom;  { position database at last record }
  354.       'B' : BEGIN
  355.               Browse('');
  356.               NetLogForm;
  357.             END;
  358.       'S' : Search_SUFFIX;  { user defined }
  359.       'F' : Find_SUFFIX;    { user defined }
  360.       'L' : Set_Filter; { user defined }
  361.       'G' : BEGIN  { GO }
  362.               MRecNO := 1;
  363.               SayGet(1,25,' Enter record number: ',MRecNo,_LI,6,0);
  364.               Range('1',SInteger(RecCount,0));
  365.               Set_Repaint_Off;
  366.               ReadGets;
  367.               Set_Repaint_On;
  368.               IF EditResult <= 0 THEN GO(MRecNo);
  369.               AT(1,25,Space(78));
  370.              END;
  371.       'C' : BEGIN  { Pack }
  372.               ClrScr;
  373.               WriteLn('Removing deleted records...');
  374.               Set_Talk_On;
  375.               Pack;
  376.               WriteLn('Re-indexing database...');
  377.               Index_On(@KeyMaker, 'NBASE');
  378.               GoTop;
  379.               NetLogForm;
  380.              END;
  381.     END; { Case }
  382.   UNTIL choice = 'Q';
  383.   Set_Cursor_On;
  384.   CloseDatabases;
  385.   ClrScr;
  386. END.
  387.