Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)

Paste

Pasted by hitagi ( 16 years ago )
program l6v2;
 uses
  crt;
 type
  t_dbe=   record
       phn:byte;
       rmn:byte;
       nm:array[1..4] of string[15];
      end;
        t_dba=   array[1..20] of t_dbe;
 var
  dba:   t_dba;
  path:   string;
  ans:   char;
  searchbyte, io: byte;
        searchstring: string;

    procedure readdb(var db: t_dba; path: string; var ioerror: byte);
     var
         dbf:  file of t_dbe;
            i:   byte;
     begin
         assign(dbf, path);
   {$I-}
   reset(dbf);
   {$I+}
      ioerror:=IOResult;
            writeln(ioerror);
            if ioerror=0
             then
                    for i:=1 to 20 do
               read(dbf, dba[i])
        end;

    procedure writedb(var db: t_dba; path: string; var ioerror: byte);
     var
         dbf:  file of t_dbe;
            i:   byte;
     begin
            assign(dbf, path);
   {$I-}
   rewrite(dbf);
   {$I+}
      ioerror:=IOResult;
            if ioerror=0
             then
                    for i:=1 to 20 do
               write(dbf, dba[i])
        end;

    procedure showdb(db: t_dba);
     var
         i:   byte;
        begin
         writeln('ÉÍÍÍÍÍÑÍÍÍÍÍÍÍÑÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
         writeln('º No. ³ Phone ³ Room ³ Name 1          ³ Name 2          ³ Name 3          ³ Name 4          º');
            writeln('ÇÄÄÄÄÄÅÄÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ');
   for i:=1 to 20 do
             writeln('º ', i:3, ' ³ ', db[i].phn:5, ' ³ ', db[i].rmn:4, ' ³ ', db[i].nm[1]:15, ' ³ ', db[i].nm[2]:15, ' ³ ', db[i].nm[3]:15, ' ³ ', db[i].nm[4]:15, ' º');
            writeln('ÈÍÍÍÍÍÏÍÍÍÍÍÍÍÏÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ')
        end;

    procedure editdbentry(var db: t_dba; entry: byte);
        begin
            write('Input phone number (', db[entry].phn, '): ');
   readln(dba[entry].phn);
   write('Input room number (', db[entry].rmn, '): ');
   readln(dba[entry].rmn);
   write('Input 1st name (', db[entry].nm[1], '): ');
   readln(dba[entry].nm[1]);
   write('Input 2nd name (', db[entry].nm[2], '): ');
   readln(dba[entry].nm[2]);
   write('Input 3rd name (', db[entry].nm[3], '): ');
   readln(dba[entry].nm[3]);
   write('Input 4th name (', db[entry].nm[4], '): ');
   readln(dba[entry].nm[4])
        end;

    procedure createdb(var db: t_dba);
     var
         i:   byte;
        begin
         for i:=1 to 20 do
             begin
                 clrscr;
                    writeln('Entry no. ', i);
                    editdbentry(db, i)
                end
        end;

    procedure editdb(var db: t_dba);
     var
         i:   byte;
     begin
         write('Input column number: ');
            readln(i);
            editdbentry(db, i)
        end;

 procedure searchdbphone(db: t_dba; search: byte);
     var
         i:   byte;
        begin
         for i:=1 to 20 do
             if (db[i].phn=search)
                 then
                     writeln('º ', i:3, ' ³ ', db[i].phn:5, ' ³ ', db[i].rmn:4, ' ³ ', db[i].nm[1]:15, ' ³ ', db[i].nm[2]:15, ' ³ ', db[i].nm[3]:15, ' ³ ', db[i].nm[4]:15, ' º');
        end;

 procedure searchdbroom(db: t_dba; search: byte);
     var
         i:   byte;
        begin
         for i:=1 to 20 do
             if (db[i].rmn=search)
                 then
                     writeln('º ', i:3, ' ³ ', db[i].phn:5, ' ³ ', db[i].rmn:4, ' ³ ', db[i].nm[1]:15, ' ³ ', db[i].nm[2]:15, ' ³ ', db[i].nm[3]:15, ' ³ ', db[i].nm[4]:15, ' º');
        end;

    procedure searchdbname(db: t_dba; search: string);
     var
         i:   byte;
        begin
         for i:=1 to 20 do
             if (db[i].nm[1]=search) or (db[i].nm[2]=search) or (db[i].nm[3]=search) or (db[i].nm[4]=search)
                 then
                     writeln('º ', i:3, ' ³ ', db[i].phn:5, ' ³ ', db[i].rmn:4, ' ³ ', db[i].nm[1]:15, ' ³ ', db[i].nm[2]:15, ' ³ ', db[i].nm[3]:15, ' ³ ', db[i].nm[4]:15, ' º');
        end;

begin
 clrscr;
 write('Path to DB file: ');
 readln(path);
 readdb(dba, path, io);
    clrscr;
    writeln('DB file: ', path);
    writeln;
    if io=0
     then
         begin
             writeln('1: Edit database;');
    writeln('2: Search by phone number;');
    writeln('3: Search by room number;');
    writeln('4: Search by name;');
                ans:=readkey;
                clrscr;
                writeln('DB file: ', path);
                writeln;
                case ans of
                 '1':
                     begin
                            showdb(dba);
                            writeln;
                            editdb(dba)
                        end;
                    '2':
                     begin
                            write('Input phone number to search: ');
                            readln(searchbyte);
                            searchdbphone(dba, searchbyte)
                        end;
                    '3':
                     begin
                         write('Input room number to search: ');
                            readln(searchbyte);
                            searchdbroom(dba, searchbyte)
                        end;
                    '4':
                     begin
                         write('Input name to search: ');
                            readln(searchstring);
                            searchdbname(dba, searchstring)
                        end
                end
            end
        else 
            begin
             writeln('1: Create new database;');
                writeln('or any other key to exit.');
                ans:=readkey;
                case ans of
                 '1':
                     createdb(dba);
             end
            end;
 if ans='1'
  then
           writedb(dba, path, io);
end.

 

Revise this Paste

Children: 25130
Your Name: Code Language: