home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / PASCAL.ZIP / PHONE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-01-04  |  19.9 KB  |  464 lines
  1.      label Menu;
  2.      const
  3.           Changing : Boolean = False;
  4.           Changed  : Boolean = False;
  5.           DiskFull : Boolean = False;
  6.           InRange  : Boolean = True;
  7.      type
  8.           Entry = record
  9.                First_name : String[20];
  10.                Last_Name : String[20];
  11.                Street_Address : String[25];
  12.                City : String[15];
  13.                State : String[2];
  14.                Zip_Code : String[10];
  15.                Home_Phone : String[17];
  16.                Business_Phone : String[17];
  17.                Occupation : String[25];
  18.           end;
  19.           Name = String[26];
  20.      var
  21.           First_Name,Last_name : String[20];
  22.           Street_Address,Occupation : String[25];
  23.           City : String[15];
  24.           Home_Phone,Business_Phone : String[17];
  25.           Zip_Code : String[10];
  26.           State : String[2];
  27.           Choice : Char;
  28.           DataFile : File of Entry;
  29.           Individual : Entry;
  30.           Search_Type,Search_For : String[30];
  31.  
  32. { FUNCTION TO CHECK AND SEE IF A FILE EXISTS ON THE LOGGED DISK }
  33.  
  34.      function Exist(FileName : Name) : boolean;
  35.           var
  36.                Fil : File;
  37.           begin
  38.                Assign(Fil,FileName);
  39.                {$I-}
  40.                Reset(Fil);
  41.                {$I+}
  42.                Exist := (IOresult = 0)
  43.           end;
  44.  
  45. { PROCEDURE TO CHECK LENGTH OF INPUT LINE AND PRINT ERROR MESSAGE }
  46.  
  47.      procedure Check_Length(Line : Name; Max_Len : Integer);
  48.           begin
  49.                GotoXY(1,18); ClrEol;
  50.                if length(Line) > Max_Len then
  51.                begin
  52.                     GotoXY(20,18);
  53.                     write(^G'Input Line TOO LONG.  Maximum length ',Max_Len);
  54.                     InRange := False;
  55.                     Exit;
  56.                end;
  57.                InRange := True;
  58.           end;
  59.  
  60. { PROCEDURE TO DIAL NUMBER WITH MODEM.  ATDT IS HAYES ATTENTION AND DIAL
  61.   WITH TONE COMMAND.  IF MODEM IS NON HAYES, CHANGE TO WHATEVER WORKS FOR
  62.   YOUR MODEM. }
  63.  
  64.      procedure Dial_Number(Home,Business : Name);
  65.           var
  66.                Continue : Char;
  67.           begin
  68.                GotoXY(1,22); ClrEol;
  69.                GotoXY(22,22);
  70.                write('(H)ome Phone    (B)usiness Phone');
  71.                read(Kbd,Continue);
  72.                case Continue of
  73.                     'H','h' : writeln(Aux,'ATDT' + Home);
  74.                     'B','b' : writeln(Aux,'ATDT' + Business);
  75.                end;
  76.                Delay(4000);
  77.                GotoXY(1,22); ClrEol;
  78.                GotoXY(23,22);
  79.                write('(ANY KEY) to HANG UP and CONTINUE    ');
  80.                read(Kbd,Continue);
  81.                writeln(Aux,'ATH');
  82.           end;
  83.  
  84. { PROCEDURE TO PRINT NAME, ADDRESS, AND PHONE NUMBERS ON PRINTER. }
  85.  
  86.      procedure Print_Name(First,Last,Address,Cty,St,Zip,HP,BP : Name);
  87.           begin
  88.                writeln(Lst);
  89.                writeln(Lst);
  90.                writeln(Lst,First,' ',Last);
  91.                writeln(Lst,Address);
  92.                writeln(Lst,Cty,', ',St,'   ',Zip);
  93.                writeln(Lst);
  94.                writeln(Lst,'    Home Phone : ',HP);
  95.                writeln(Lst,'Business Phone : ',BP);
  96.                write;
  97.           end;
  98.  
  99. { PROCEDURE TO ENTER NAMES AT END OF FILE.  FIRST CHECKS TO SEE IF DATA
  100.   FILE EXISTS.  THEN CHECKS TO BE SURE THERE IS ROOM ON THE DISK. }
  101.  
  102.      procedure Enter_Names;
  103.           var
  104.                Answer    : Char;
  105.                Test_Line : String[30];
  106.           begin
  107.                assign(DataFile,'PHONE.DTA');
  108.                if not Exist('PHONE.DTA') then Rewrite(DataFile);
  109.                Reset(DataFile);
  110.                {$I-} seek(DataFile,FileSize(DataFile)) {$I+};
  111.                DiskFull := (IOresult = $F0);
  112.                if DiskFull then
  113.                begin
  114.                     GotoXY(13,20); ClrEol;
  115.                     write(^G'DISK FULL. Exit Program And ERASE Unnecessary Files.');
  116.                     Exit;
  117.                end;
  118.                with Individual do
  119.                begin
  120.                     Repeat
  121.                          ClrScr;
  122.                          GotoXY(1,1); write('Enter First Name :');
  123.                          repeat
  124.                               GotoXY(35,1); ClrEol; read(Test_Line);
  125.                               Check_Length(Test_Line,20);
  126.                          until InRange;
  127.                          First_Name := Test_Line;
  128.                          GotoXY(1,2); write('Enter Last Name :');
  129.                          repeat
  130.                               GotoXY(35,2); ClrEol; read(Test_Line);
  131.                               Check_Length(Test_Line,20);
  132.                          until InRange;
  133.                          Last_Name := Test_Line;
  134.                          GotoXY(1,3); ClrEol; write('Enter Street Address :');
  135.                          repeat
  136.                               GotoXY(35,3); ClrEol; read(Test_Line);
  137.                               Check_Length(Test_Line,25);
  138.                          until InRange;
  139.                          Street_Address := Test_Line;
  140.                          GotoXY(1,4); write('Enter City :');
  141.                          repeat
  142.                               GotoXY(35,4); ClrEol; read(Test_Line);
  143.                               Check_Length(Test_Line,15);
  144.                          until InRange;
  145.                          City := Test_Line;
  146.                          GotoXY(1,5); write('Enter Two Letter State Code :');
  147.                          repeat
  148.                               GotoXY(35,5); ClrEol; read(Test_Line);
  149.                               Check_Length(Test_Line,2);
  150.                          until InRange;
  151.                          State := Test_Line;
  152.                          State[1] := UpCase(State[1]); State[2] := UpCase(State[2]);
  153.                          GotoXY(1,6); write('Enter Zip Code :');
  154.                          repeat
  155.                               GotoXY(35,6); ClrEol; read(Test_Line);
  156.                               Check_Length(Test_Line,10);
  157.                          until InRange;
  158.                          Zip_Code := Test_Line;
  159.                          GotoXY(1,20);
  160.                          writeln(^G'Enter Phone Numbers EXACTLY As You Would Dial Them.');
  161.                          writeln('Use Punctuation To Make Them More Readable If Desired.');
  162.                          write('Examples: 15551212  1-555-1212  1(615)555-1212  1/615/555-1212');
  163.                          GotoXY(1,7); write('Enter Home Phone Number :');
  164.                          repeat
  165.                               GotoXY(35,7); ClrEol; read(Test_Line);
  166.                               Check_Length(Test_Line,17);
  167.                          until InRange;
  168.                          Home_Phone := Test_Line;
  169.                          GotoXY(1,8); write('Enter Business Phone Number :');
  170.                          repeat
  171.                               GotoXY(35,8); ClrEol; read(Test_Line);
  172.                               Check_Length(Test_Line,17);
  173.                          until InRange;
  174.                          Business_phone := Test_Line;
  175.                          GotoXY(1,20); ClrEol; GotoXY(1,21); ClrEol;
  176.                          GotoXY(1,22); ClrEol;
  177.                          GotoXY(1,9); write('Enter Occupation :');
  178.                          repeat
  179.                               GotoXY(35,9); ClrEol; read(Test_Line);
  180.                               Check_Length(Test_Line,25);
  181.                          until InRange;
  182.                          Occupation := Test_Line;
  183.                          writeln; writeln;
  184.                          write('Are ALL Entries Correct (Y/N)? ');
  185.                          read(Kbd,Answer);
  186.                     Until Answer in ['Y','y'];
  187.                     write('Yes');
  188.                     write(DataFile,Individual);
  189.                     Flush(DataFile);
  190.                     Close(DataFile);
  191.                end;
  192.           end;
  193.  
  194.   { PROCEDURE TO CHANGE FIELDS IN RECORD.  CURSOR STARTS AT THE BEGINNING
  195.     OF EACH FIELD.  CHANGES OVERWRITE OLD DATA AND SCREEN IS REFRESHED.
  196.     ENTERING A CARRIAGE RETURN LEAVES FIELD UNCHANGED AND ADVANCES CURSOR
  197.     TO THE START OF THE NEXT FIELD.  AFTER EACH CHANGE THE CURSOR RETURNS
  198.     TO THE FIRST FIELD.  ENTERING A Q<CR> THERE WILL END CHANGES AND
  199.     REFRESH SCREEN }
  200.  
  201.      procedure Change_Names(FilRec : Integer);
  202.           var
  203.                Update : Name;
  204.           begin
  205.                GotoXY(1,22); ClrEol;
  206.                write('          (RETURN) Leaves Field Unchanged     (Q) For Last Name To Quit');
  207.                with Individual do
  208.                begin
  209.                     GotoXY(25,7); Read(Update);
  210.                     while (Update <> 'Q') and (Update <> 'q') do
  211.                     begin
  212.                          if Update <> '' then
  213.                          begin
  214.                               Last_Name := Update; Changed := True;
  215.                               Exit;
  216.                          end;
  217.                          GotoXY((length(Last_Name)+27),7); Read(Update);
  218.                          if Update <> '' then
  219.                          begin
  220.                               First_Name := Update; Changed := True;
  221.                               Exit;
  222.                          end;
  223.                          GotoXY(25,8); Read(Update);
  224.                          if Update <> '' then
  225.                          begin
  226.                               Street_Address := Update; Changed := True;
  227.                               Exit;
  228.                          end;
  229.                          GotoXY(25,9); Read(Update);
  230.                          if Update <> '' then
  231.                          begin
  232.                               City := Update; Changed := True;
  233.                               Exit;
  234.                          end;
  235.                          GotoXY((length(City)+27),9); Read(Update);
  236.                          if Update <> '' then
  237.                          begin
  238.                               State := Update; Changed := True;
  239.                               Exit;
  240.                          end;
  241.                          GotoXY((length(City)+31),9); Read(Update);
  242.                          if Update <> '' then
  243.                          begin
  244.                               Zip_Code := Update; Changed := True;
  245.                               Exit;
  246.                          end;
  247.                          GotoXY(25,11); Read(Update);
  248.                          if Update <> '' then
  249.                          begin
  250.                               Home_Phone := Update; Changed := True;
  251.                               Exit;
  252.                          end;
  253.                          GotoXY(25,12); Read(Update);
  254.                          if Update <> '' then
  255.                          begin
  256.                               Business_Phone := Update; Changed := True;
  257.                               Exit;
  258.                          end;
  259.                          GotoXY(25,14); Read(Update);
  260.                          if Update <> '' then
  261.                          begin
  262.                               Occupation := Update; Changed := True;
  263.                          end;
  264.                     end;
  265.                     Changing := False;
  266.                     if Changed then
  267.                     begin
  268.                          Seek(DataFile,FilRec);
  269.                          Write(DataFile,Individual);
  270.                          Changed := False;
  271.                     end;
  272.                end;
  273.           end;
  274.  
  275. { PROCEDURE TO SEARCH DATABASE BY INDIVIDUAL FIELD IN RECORD.  CHECKS
  276.   TO SEE IF DATABASE EXISTS FIRST. }
  277.  
  278.      procedure Search_Names;
  279.           label Rewrite;
  280.           var
  281.                I,J : Integer;
  282.                Continue : Char;
  283.                Search_Key : String[25];
  284.           begin
  285.                ClrScr; GotoXY(4,12);
  286.                write('Enter ',Search_Type,' : ');
  287.                readln(Search_Key);
  288.                assign(DataFile,'PHONE.DTA');
  289.                if not Exist('PHONE.DTA') then
  290.                begin
  291.                     writeln('**'^G'   CANNOT FIND DATA FILE   **');
  292.                     halt;
  293.                end;
  294.                reset(DataFile);
  295.                with Individual do
  296.                begin
  297.                     I := 0; ClrScr;
  298.                     GotoXY(12,7);
  299.                     write('FULL NAME :');
  300.                     GotoXY(7,8);
  301.                     write('STREET ADDRESS :');
  302.                     GotoXY(4,9);
  303.                     write('CITY, STATE & ZIP :');
  304.                     GotoXY(6,11);
  305.                     write('AREA/HOME PHONE :');
  306.                     GotoXY(2,12);
  307.                     write('AREA/BUSINESS PHONE :');
  308.                     GotoXY(11,14);
  309.                     write('OCCUPATION :');
  310.                     GotoXY(1,21);
  311.                     writeln(' ==============================================================================');
  312.                     writeln;
  313.                     write(' ==============================================================================');
  314.                     while not EOF(DataFile) do
  315.                     begin
  316.                          seek(DataFile,I); read(DataFile,Individual);
  317.                          case Choice of
  318.                               '1' : Search_For := First_Name;
  319.                               '2' : Search_For := Last_Name;
  320.                               '3' : Search_For := Street_Address;
  321.                               '4' : Search_For := City;
  322.                               '5' : Search_For := State;
  323.                               '6' : Search_For := Zip_Code;
  324.                               '7' : Search_For := Home_Phone;
  325.                               '8' : Search_For := Business_Phone;
  326.                               '9' : Search_For := Occupation;
  327.                          end;
  328.                          if(Copy(Search_For,1,Length(Search_Key)))
  329.                             = Search_Key then
  330.                          begin
  331. Rewrite:                      GotoXY(25,7); ClrEol;
  332.                               write(Last_Name + ', ' + First_Name);
  333.                               GotoXY(25,8); ClrEol;
  334.                               write(Street_Address);
  335.                               GotoXY(25,9); ClrEol;
  336.                               write(City + ', ' + State + '  ' + Zip_Code);
  337.                               GotoXY(25,11); ClrEol;
  338.                               write(Home_Phone);
  339.                               GotoXY(25,12); ClrEol;
  340.                               write(Business_Phone);
  341.                               GotoXY(25,14); ClrEol;
  342.                               write(Occupation);
  343.                               if Changing then
  344.                               begin
  345.                                    Change_Names(I);
  346.                                    Goto Rewrite;
  347.                               end;
  348.                               GotoXY(1,22); ClrEol;
  349.                               GotoXY(15,22);
  350.                               write(' (C)hange  (D)ial  (P)rint  (ANY KEY) to CONTINUE ');
  351.                               read(Kbd,Continue);
  352.                               case Continue of
  353.                                    'D','d' : Dial_Number(Home_Phone,
  354.                                              Business_Phone);
  355.                                    'P','p' : Print_Name(First_Name,Last_Name,
  356.                                              Street_Address,City,State,
  357.                                              Zip_Code,Home_Phone,
  358.                                              Business_Phone);
  359.                                    'C','c' : begin
  360.                                                   Changing := True;
  361.                                                   Change_Names(I);
  362.                                                   Goto Rewrite;
  363.                                              end;
  364.                               end;
  365.                          end;
  366.                          I := I + 1
  367.                     end;
  368.                     Close(DataFile);
  369.                end;
  370.           end;
  371.  
  372. { ************************************************************************
  373.   *                                                                      *
  374.   *                        MAIN PROGRAM                                  *
  375.   *                                                                      *
  376.   ************************************************************************ }
  377.  
  378.      begin
  379. Menu:     ClrScr;
  380.           writeln; writeln; writeln; writeln;
  381.           writeln('                      * What Do You Want To Search By *');
  382.           writeln('                      =================================');
  383.           writeln;
  384.           writeln('                             1) First Name');
  385.           writeln('                             2) Last Name');
  386.           writeln('                             3) Street Address');
  387.           writeln('                             4) City');
  388.           writeln('                             5) State');
  389.           writeln('                             6) Zip Code');
  390.           writeln('                             7) Home Phone');
  391.           writeln('                             8) Business Phone');
  392.           writeln('                             9) Occupation');
  393.           GotoXY(1,21);
  394.           writeln(' ==============================================================================');
  395.           writeln('              (1 thru 9) to Search   (E)nter Member   e(X)it to CP/M');
  396.           write(' ==============================================================================');
  397.           GotoXY(73,22);
  398.           readln(Choice);
  399.           Case Choice of
  400.                '1' : begin
  401.                         Search_Type := 'First Name';
  402.                         Search_Names;
  403.                    end;
  404.                '2' : begin
  405.                         Search_Type := 'Last Name';
  406.                         Search_Names;
  407.                    end;
  408.                '3' : begin
  409.                         Search_Type := 'Street Address';
  410.                         Search_Names;
  411.                    end;
  412.                '4' : begin
  413.                         Search_Type := 'City';
  414.                         Search_Names;
  415.                    end;
  416.                '5' : begin
  417.                         Search_Type := 'Two Letter State Code';
  418.                         Search_Names;
  419.                    end;
  420.                '6' : begin
  421.                         Search_Type := 'Zip Code';
  422.                         Search_Names;
  423.                    end;
  424.                '7' : begin
  425.                         Search_Type := 'Home Phone ###/###-####';
  426.                         Search_Names;
  427.                    end;
  428.                '8' : begin
  429.                         Search_Type := 'Business Phone ###/###-####';
  430.                         Search_Names;
  431.                    end;
  432.                '9' : begin
  433.                         Search_Type := 'Occupation';
  434.                         Search_Names;
  435.                    end;
  436.            'E','e' : Enter_Names;
  437.            'X','x' : begin
  438.                         ClrScr; GotoXY(1,10);
  439.                         write('Exit to CP/M (Y/N)? ');
  440.                         read(Kbd,Choice);
  441.                         case Choice of
  442.                              'Y','y' : begin
  443.                                             writeln('Yes');
  444.                                             writeln; writeln;
  445.                                             writeln('Program by Joseph Fall');
  446.                                             writeln('CIS 76555,37');
  447.                                             writeln('Turbo Pascal ver. 1.0');
  448.                                             writeln('May 1, 1985');
  449.                                             Halt;
  450.                                        end;
  451.                         else Goto Menu;
  452.                         end;
  453.                     end;
  454.            else    begin
  455.                         write(^G);
  456.                         goto Menu;
  457.                    end;
  458.            end;
  459.            goto Menu;
  460.       end.
  461.  
  462. write(^G);
  463.                         goto Menu;
  464.