Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/PHONE.ZIP/PHONE.PAS

Pascal/Delphi Source File | 1987-01-27 | 14.4 KB | 498 lines

(*   THIS PROGRAM PUROSES ARE :
          1. READ IN A TEXT FILE (INFILE) AND SORT IT
          2. READ IN A SEARCH FILE (SEARCH)
          3. IF GIVEN A NAME OR A TELEPHONE NUMBER, SEARCH
             IT TO SEE IF THE NAME OR NUMBER EXIST.
          4. PRINT THE ANSWER IN AN OUTPUT FILE (OUTFILE)

      THE PROGRAM ITSELF IS DIVIDED INTO 11 DIFFERENT PARTS.

   PROCEDURE 1 : THIS IS A BINARY SEARCH FUNCTION THAT SEARCHES FOR NAMES.
   (SEARCHER)
   PROCEDURE 2 : THIS PROCEDURE STORES PHONE NUMBERS.
   (INSERTPHONE)
   PROCEDURE 3 : THIS PROCEDURE INSERTS LAST NAMES.
   (INSERTLN)
   PROCEDURE 4 : THIS PROCEDURE INSERTS FIRST NAMES.
   (INSERTFN)
   PROCEDURE 5 : THIS PROCEDURE READS THE DATA FROM THE INPUT FILE (INFILE).
   (READTEXT)
   PROCEDURE 6 : THIS PROCEDURE READS IN THE NAMES FROM THE SEARCH
   (READNAME)         FILE (SEARCH).
   PROCEDURE 7 : THIS PROCEDURE PRINTS OUT THE SEARCHED INFORMATIONS TO
   (WRITEOUT)         AN OUTPUT FILE (OUTFILE).
   PROCEDURE 8 : THIS PROCEDURE IS A FUNCTION THAT SEARCHES FOR FIRST NAME.
   (FIRSTSEARCH)
   PROCEDURE 9 : THIS PROCEDURE IS A FUNCTION THAT SEARCHES FOR TELEPHONE
   (PHONESEARCH)      NUMBER.
   PROCEDURE 10 : THIS PROCEDURE CHECKS THE FIRST CHARACTER OF THE SEARCH
   (WORDNUMSEARCH)     FILE AND SENDS THEM TO EITHER
                       PROCEDURE 8 OR PROCEDURE 9.
   PROCEDURE 11 : THIS IS THE MAIN PROCEDURE.


   NOTE : THIS WORK WITH BERKELEY PASCAL. (HAVE NOT TRY THIS WITH TURBO) *)


PROGRAM TELEPHONE(INFILE,OUTFILE,SEARCH);

CONST
  BLANK           = ' ';
  MAX             = 20;
  MAXLASTNAME     = 20;
  MAXLASTNAMES    = 30;
  MAXSAMELASTNAME = 20;
  MAXFIRSTNAME    = 20;
  MAXSTREET       = 45;
  MAXCITY         = 20;
  MAXSTATE        = 2;
  MAXPHONE        = 200;

TYPE
  LASTNAMEHOLDER  = PACKED ARRAY[1..MAXLASTNAME] OF CHAR;
  FIRSTNAMEHOLDER = PACKED ARRAY[1..MAXFIRSTNAME] OF CHAR;
  STREETHOLDER    = PACKED ARRAY[1..MAXSTREET] OF CHAR;
  CITYHOLDER      = PACKED ARRAY[1..MAXCITY] OF CHAR;
  STATEHOLDER     = PACKED ARRAY[1..MAXSTATE] OF CHAR;
  ONEPERSON = RECORD
                FIRSTNAME : FIRSTNAMEHOLDER;
                STREET   : STREETHOLDER;
                CITY      : CITYHOLDER;
                STATE     : STATEHOLDER;
                ZIPCODE   : INTEGER;
                PHINDEX   : INTEGER
              END;

   LASTNAMES = RECORD
                 LASTNAME       : LASTNAMEHOLDER;
                 LASTENTRY      : INTEGER;
                 SAMELASTNAME   : ARRAY[1..MAXSAMELASTNAME] OF ONEPERSON
               END;

   STRUCTURE = ARRAY[1..MAXLASTNAMES] OF LASTNAMES;
   PHONEBLOCK = RECORD
                  PHONE         : INTEGER;
                  LASTINDEX     : INTEGER;
                  FIRSTINDEX    : INTEGER
                END;

   PHONES = ARRAY[1..MAXPHONE] OF PHONEBLOCK;
   WORDS = SET OF CHAR;

VAR
  DIRECTORY : STRUCTURE;
  BUFFER    : ONEPERSON;
  PHONELIST : PHONES;
  INFILE    ,
  OUTFILE   ,
  SEARCH    : TEXT;
  TEMPFIRST : FIRSTNAMEHOLDER;
  TEMPLAST  : LASTNAMEHOLDER;
  CH        : CHAR;
  PH          ,
  I           ,
  RPH         ,
  NAMECOUNTER ,
  PHONECOUNT  ,
  FIRSTINDEX  ,
  LASTINDEX   ,
  INDEX       : INTEGER;
  CHARACTERS  : WORDS;

(*                 FUNCTION SEARCH                         *)

FUNCTION SEARCHER(NAMECOUNTER:INTEGER;TEMPLAST:LASTNAMEHOLDER):INTEGER;

VAR
  POINT      ,
  LEFTSIDE   ,
  RIGHTSIDE  : INTEGER;
  FINISH     : BOOLEAN;

BEGIN
  LEFTSIDE  := 1;
  RIGHTSIDE := NAMECOUNTER;
  FINISH    := FALSE;
  WHILE (LEFTSIDE <= RIGHTSIDE) AND (NOT FINISH) DO
   BEGIN
     POINT := (LEFTSIDE + RIGHTSIDE) DIV 2;
     IF DIRECTORY[POINT].LASTNAME = TEMPLAST
       THEN FINISH := TRUE
       ELSE IF DIRECTORY[POINT].LASTNAME > TEMPLAST
              THEN RIGHTSIDE := POINT - 1
              ELSE LEFTSIDE := POINT + 1
   END;
  IF LEFTSIDE < RIGHTSIDE
    THEN SEARCHER := POINT
    ELSE SEARCHER := 0
END;

(*                 PROCEDURE STORE PHONE NUMBERS            *)

PROCEDURE INSERTPHONE(VAR PHONECOUNT:INTEGER;VAR LASTINDEX,FIRSTINDEX:
                      INTEGER;PH : INTEGER);

VAR
  I     ,
  J     ,
  COUNT : INTEGER;
  FINISH : BOOLEAN;

BEGIN
  COUNT := PHONECOUNT;
  FINISH := FALSE;
  WHILE (COUNT >= 1) AND (NOT FINISH) DO
    IF PHONELIST[COUNT].PHONE < PH
      THEN FINISH := TRUE
      ELSE BEGIN
             PHONELIST[COUNT + 1] := PHONELIST[COUNT];
             I := PHONELIST[COUNT + 1].FIRSTINDEX;
             J := PHONELIST[COUNT + 1].LASTINDEX;
             DIRECTORY[J].SAMELASTNAME[I].PHINDEX := COUNT + 1;
             COUNT := COUNT - 1
           END;
   PHONELIST[COUNT + 1].PHONE := PH;
   PHONELIST[COUNT + 1].LASTINDEX := LASTINDEX;
   DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].PHINDEX := COUNT + 1;
   PHONELIST[COUNT + 1].FIRSTINDEX := FIRSTINDEX;
   PHONECOUNT := PHONECOUNT + 1
END;

(*                 PROCEDURE INSERT LAST NAME              *)

PROCEDURE INSERTLN(VAR NAMECOUNTER:INTEGER;BUFFER : ONEPERSON;
                   TEMPLAST : LASTNAMEHOLDER;VAR LASTINDEX : INTEGER);

VAR
  J      ,
  COUNT  ,
  COUNTER : INTEGER;
  FINISH  : BOOLEAN;

BEGIN
  COUNT := NAMECOUNTER;
  FINISH := FALSE;
  WHILE (COUNT >= 1) AND (NOT FINISH) DO
    IF DIRECTORY[COUNT].LASTNAME < TEMPLAST
      THEN FINISH := TRUE
      ELSE BEGIN
             DIRECTORY[COUNT + 1] := DIRECTORY[COUNT];
             FOR COUNTER := 1 TO DIRECTORY[COUNT + 1].LASTENTRY DO
               BEGIN
                 J := DIRECTORY[COUNT + 1].SAMELASTNAME[COUNTER].PHINDEX;
                 PHONELIST[J].LASTINDEX := COUNT + 1
               END;
             COUNT := COUNT - 1
           END;
   DIRECTORY[COUNT + 1].LASTNAME := TEMPLAST;
   DIRECTORY[COUNT + 1].SAMELASTNAME[1] := BUFFER;
   DIRECTORY[COUNT + 1].LASTENTRY := 1;
   LASTINDEX := COUNT + 1;
   NAMECOUNTER := NAMECOUNTER + 1
END;

(*                 PROCEDURE INSERT FIRST NAME             *)

PROCEDURE INSERTFN(INDEX : INTEGER; BUFFER : ONEPERSON;
                   VAR FIRSTINDEX : INTEGER);

VAR
  POINT   ,
  COUNT   : INTEGER;
  FINISH  : BOOLEAN;

BEGIN
  POINT := DIRECTORY[INDEX].LASTENTRY;
  FINISH := FALSE;
  WHILE (POINT >= 1) AND (NOT FINISH) DO
    IF DIRECTORY[INDEX].SAMELASTNAME[POINT].FIRSTNAME < BUFFER.FIRSTNAME
      THEN FINISH := TRUE
      ELSE BEGIN
             DIRECTORY[INDEX].SAMELASTNAME[POINT + 1] :=
               DIRECTORY[INDEX].SAMELASTNAME[POINT];
             COUNT := DIRECTORY[INDEX].SAMELASTNAME[POINT + 1].PHINDEX;
             PHONELIST[COUNT].FIRSTINDEX := POINT + 1;
             POINT := POINT - 1
           END;
  DIRECTORY[INDEX].LASTENTRY := DIRECTORY[INDEX].LASTENTRY + 1;
  FIRSTINDEX := POINT + 1;
  DIRECTORY[INDEX].SAMELASTNAME[POINT + 1] := BUFFER
END;

(*                 PROCEDURE  READ TEXT                    *)

PROCEDURE READTEXT(VAR BUFFFER:ONEPERSON;
                   VAR TEMPLAST : LASTNAMEHOLDER; VAR PH :INTEGER);

CONST
  BLANK = ' ';

VAR
  J, COUNTER : INTEGER;

BEGIN
  J := 0;
  IF NOT EOF(INFILE)
    THEN BEGIN
           FOR COUNTER := 1 TO MAX DO
             BEGIN
               TEMPLAST[COUNTER]         := BLANK;
               BUFFER.FIRSTNAME[COUNTER] := BLANK;
               BUFFER.CITY[COUNTER]      := BLANK
             END;
           FOR COUNTER := 1 TO MAXSTREET DO
             BUFFER.STREET[COUNTER] := BLANK;
           BUFFER.STATE := '  ';
           REPEAT
             J := J + 1;
             READ(INFILE,TEMPLAST[J])
           UNTIL (TEMPLAST[J] = BLANK) OR (J = MAXLASTNAME);
           CH := BLANK;
           IF (TEMPLAST[J] <> BLANK) AND (J= MAXLASTNAME)
             THEN REPEAT
                    READ(INFILE,CH)
                  UNTIL CH = BLANK;
           WHILE CH = BLANK DO
             READ(INFILE,CH);
           J := 1;
           BUFFER.FIRSTNAME[J] := CH;
           WHILE NOT EOLN(INFILE) DO
             BEGIN
               J := J + 1;
               READ(INFILE,BUFFER.FIRSTNAME[J])
             END;
           READLN(INFILE);
           J := 0;
           WHILE NOT EOLN(INFILE) DO
             BEGIN
               J := J +  1;
               READ(INFILE,BUFFER.STREET[J])
             END;
           READLN(INFILE);
           J := 0;
           WHILE NOT EOLN(INFILE) DO
             BEGIN
               J := J + 1;
               READ(INFILE,BUFFER.CITY[J])
             END;
           READLN(INFILE);
           J := 0;
           WHILE NOT EOLN(INFILE) DO
             BEGIN
               J := J + 1;
               READ(INFILE,BUFFER.STATE[J])
             END;
           READLN(INFILE);
           READLN(INFILE,BUFFER.ZIPCODE);
           READLN(INFILE,PH,CH,RPH);
           PH := PH * 1000 + RPH
         END
     ELSE PH := 0
 END;

(*                 PROCEDURE READ NAMES                    *)

PROCEDURE READNAME(VAR TEPLST : LASTNAMEHOLDER;
                   VAR TEMPFIRST : FIRSTNAMEHOLDER);

VAR
  J : INTEGER;

BEGIN
  I := 0;
  FOR J := 1 TO MAX DO
    BEGIN
      TEMPLAST[J] := BLANK;
      TEMPFIRST[J] := BLANK
    END;
  REPEAT
    I := I + 1;
    READ(SEARCH,TEMPLAST[J])
  UNTIL (TEMPLAST[J] = BLANK) OR (I = MAXLASTNAME);
  CH := BLANK;
  IF (TEMPLAST[I] <> BLANK) AND ( I = MAXLASTNAME)
    THEN REPEAT
           READ(SEARCH,CH)
         UNTIL CH = BLANK;
  WHILE CH = BLANK DO
    READ(SEARCH,CH);
  I := 1;
  TEMPFIRST[I] := CH;
  WHILE NOT EOLN(SEARCH) DO
    BEGIN
      I := I + 1;
      READ(SEARCH,TEMPFIRST[I])
    END
END;

(*                 PROCEDURE WRITE OUT TEXT                *)

PROCEDURE WRITEOUT(J : INTEGER);

BEGIN
  IF J = 0
    THEN BEGIN

  WRITELN(OUTFILE,'SEARCHING PHONE UMBER => ',PH:8);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].LASTNAME);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].FIRSTNAME);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].STREET);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].CITY);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].STATE);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].ZIPCODE:5)

         END
    ELSE BEGIN

  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].LASTNAME);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].FIRSTNAME);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].STREET);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].CITY);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].STATE);
  WRITELN(OUTFILE,DIRECTORY[LASTINDEX].SAMELASTNAME[FIRSTINDEX].ZIPCODE:5);
  WRITELN(OUTFILE,PHONELIST[J].PHONE)

          END
END;

(*                 PROCEDURE FIRST NAME SEARCH             *)

FUNCTION FIRSTSEARCH(TEMPLAST : FIRSTNAMEHOLDER;POINT1 : INTEGER):INTEGER;

VAR
  I, J, POINT,
  LEFTSIDE,
  RIGHTSIDE : INTEGER;
  FINISH    : BOOLEAN;

BEGIN
  I := DIRECTORY[POINT1].LASTENTRY;
  LEFTSIDE := 1;
  RIGHTSIDE := 1;
  FINISH := FALSE;
  WHILE (LEFTSIDE <= RIGHTSIDE) AND (NOT FINISH) DO
   BEGIN
     POINT := (LEFTSIDE + RIGHTSIDE) DIV 2;
     IF DIRECTORY[POINT].SAMELASTNAME[POINT].FIRSTNAME = TEMPFIRST
       THEN FINISH := TRUE
       ELSE IF DIRECTORY[POINT1].SAMELASTNAME[POINT].FIRSTNAME < TEMPFIRST
              THEN LEFTSIDE := POINT + 1
              ELSE RIGHTSIDE := POINT - 1
   END;
  IF LEFTSIDE > RIGHTSIDE
    THEN FIRSTSEARCH := 0
    ELSE BEGIN
           FIRSTSEARCH := POINT;
           J := DIRECTORY[POINT1].SAMELASTNAME[POINT].PHINDEX;
           WRITEOUT(J)
         END
END;

(*                 FUNCTION PHONE SEARCH                   *)

FUNCTION PHONESEARCH(PH, PHONECOUNT : INTEGER):INTEGER;

VAR
  J, POINT,
  LEFTSIDE,
  RIGHTSIDE : INTEGER;
  FINISH    : BOOLEAN;

BEGIN
  J := 0;
  LEFTSIDE := 1;
  RIGHTSIDE := PHONECOUNT - 1;
  FINISH := FALSE;
  WHILE (LEFTSIDE <= RIGHTSIDE) AND ( NOT FINISH) DO
   BEGIN
     POINT := ( LEFTSIDE + RIGHTSIDE) DIV 2;
     IF PHONELIST[POINT].PHONE = PH
       THEN FINISH := TRUE
       ELSE IF PHONELIST[POINT].PHONE > PH
              THEN RIGHTSIDE := POINT - 1
              ELSE LEFTSIDE := POINT + 1
   END;
  IF LEFTSIDE > RIGHTSIDE
    THEN PHONESEARCH := 0
    ELSE BEGIN
           PHONESEARCH := POINT;
           FIRSTINDEX := PHONELIST[POINT].FIRSTINDEX;
           LASTINDEX  := PHONELIST[POINT].LASTINDEX;
           WRITEOUT(J)
         END
END;

(*           PROCDURE WORDS AND NUMBER SEARCH              *)

PROCEDURE WORDNUMSEARCH;

VAR
  POINT1, POINT2, PHONEPT : INTEGER;

BEGIN
  RESET(SEARCH);
  REWRITE(OUTFILE);
  WHILE NOT EOF(SEARCH) DO
    BEGIN
      IF SEARCH^ IN ['A'..'Z','a'..'z']
        THEN BEGIN
               READNAME(TEMPLAST,TEMPFIRST);
               POINT1 := SEARCHER(NAMECOUNTER,TEMPLAST);
               IF POINT1 <> 0
                 THEN POINT2 := FIRSTSEARCH(TEMPFIRST,POINT1);
               IF (POINT1 = 0) OR (POINT2 = 0)
                 THEN WRITELN(OUTFILE,TEMPLAST,TEMPFIRST,' IS NOT LISTED.');
               WRITELN(OUTFILE);
               READLN(SEARCH)
             END
        ELSE BEGIN
               READ(SEARCH,PH,CH,RPH);
               READLN(SEARCH);
               PH := PH * 1000 + RPH;
               PHONEPT := PHONESEARCH(PH,PHONECOUNT);
               IF PHONEPT = 0
                 THEN BEGIN
                        WRITE(OUTFILE,'TELEPHONE NUMBER ');
                        WRITELN(OUTFILE,PH:8,' IS NOT LISTED.')
                      END;
               WRITELN(OUTFILE)
             END
  END
END;

(*                     MAIN PROGRAM                        *)

BEGIN
  RESET(INFILE);
  READTEXT(BUFFER,TEMPLAST,PH);
  DIRECTORY[1].LASTNAME := TEMPLAST;
  DIRECTORY[1].LASTENTRY := 1;
  BUFFER.PHINDEX         := 1;
  DIRECTORY[1].SAMELASTNAME[1] := BUFFER;
  PHONELIST[1].PHONE := PH;
  PHONELIST[1].LASTINDEX := 1;
  PHONELIST[1].FIRSTINDEX := 1;
  PHONECOUNT := 1;
  WHILE PH <> 0 DO
    BEGIN
      INDEX := SEARCHER(NAMECOUNT,TEMPLAST);
      IF INDEX <> 0
        THEN BEGIN
               LASTINDEX := INDEX;
               INSERTFN(INDEX,BUFFER,FIRSTINDEX)
             END
        ELSE BEGIN
               INSERTLN(NAMECOUNTER,BUFFER,TEMPLAST,LASTINDEX);
               FIRSTINDEX := 1
             END;
      INSERTPHONE(PHONECOUNT,LASTINDEX,FIRSTINDEX,PH);
      FOR I := 1 TO MAX DO
        BEGIN
          BUFFER.FIRSTNAME[I] := BLANK;
          TEMPLAST[I] := BLANK
        END;
      READTEXT(BUFFER,TEMPLAST,PH)
    END;
    WORDNUMSEARCH
END.