Aplikasi Algoritma Searching, Sorting, & Sequential File

Aplikasi Algoritma Searching, Sorting,  & Sequential File

Tugas praktikum dasar algoritma : program perpustakaan
dengan fitur :

• daftar buku
• tambah buku
• hapus buku
• edit buku
• dll.

Check this out !

program tugas;
uses crt;
type databuku=record
     judul,penulis,penerbit,tahun:string;
     end;
var
   book,temp :file of databuku;
   buku:databuku;
   n:integer;

procedure daftar;
begin
clrscr;
writeln('== 113120301 Tambah buku ==');
with buku do
  begin
    write('judul : '); readln(judul);
    write('penulis  : '); readln(penulis);
    write('penerbit  : '); readln(penerbit);
    write('tahun : ');readln(tahun);
  end;
write(book,buku);
writeln;
writeln('Tambah Buku Berhasil !!');
writeln;
readln;
end;

procedure lihat;
var
j : integer;
begin


 reset(book);
 j:=0;
 while not eof(book) do
   begin
     read(book,buku);
     with buku do
       begin
         writeln('judul : ',judul);
         writeln('penulis  : ',penulis);
         writeln('penerbit  : ',penerbit);
         writeln('tahun : ',tahun);
         j:=j+1;
       end;
      writeln;
   end;
   writeln('jumlah buku : ',j);
      writeln;
   readln;
end;

procedure hapus;
var
x : string;
z : integer;
y : integer;
cek : boolean;
begin
 y:=0;
 clrscr;
 writeln('--- 113120301 Hapus Buku ---');
 lihat;
 write('Judul buku yang akan dihapus : '); readln(x);
 assign(temp,'temp.dat');
 rewrite(temp);
 reset(book);
 z:=0;
  while not eof(book) do
    begin
      read(book, buku);
      if buku.judul = x then inc(z);
    end;

  if z = 0 then writeln('Data buku tidak ditemukan!')
  else
    begin
      reset(book);
      while not eof(book) do
        begin
          read(book, buku);
          if (buku.judul <> x) then write(temp, buku);
        end;

      reset(Temp);
      rewrite(book);
      while not eof(Temp) do
        begin
          read(Temp, buku);
          write(book, buku);
        end;
      rename(book,'book.dat');
      writeln('Data buku berhasil dihapus!');
    end;
  readln;
  close(temp);
end;

procedure edit;
var
x:string;
z:integer;
begin
 clrscr;
 writeln('--- 113120301 Edit Buku --- ');
 lihat;
 writeln;
 write('Judul buku yang akan di edit : ');readln(x);
 reset(book);
 z:=0;
 while not eof(book) do
    begin
      seek(book,z);
      read(book,buku);
      if (buku.judul = x) then
        begin
         seek(book,z);
         write('Judul : '); readln(buku.judul);
         write('Penulis : '); readln(buku.Penulis);
         write('Penerbit : '); readln(buku.Penerbit);
         write('Tahun Penerbitan : '); readln(buku.tahun);
         write(book,buku);
         write('Edit Buku Berhasil !');
         writeln; readln;
        end;
    z:=z+1;
    end;
end;

begin
clrscr;
 assign(book,'book.dat');
 {$I-} reset(book);
 {$I+}if ioresult <> 0 then
 rewrite(book)
 else seek(book,filesize(book));
 repeat
 clrscr;
 writeln('=== 113120301 program perpustakaan ===');
 writeln('1. Tambah buku');
 writeln('2. lihat buku');
 writeln('3. hapus buku  ');
 writeln('4. edit buku');
 writeln('5. keluar');
 write('pilihan anda : ');
 readln(n);

 case n of
    1: daftar;
    2: begin
    clrscr;
     writeln('=== 113120301 lihat buku ===');
    lihat;
    end;
    3: hapus;
    4: edit;
    5: exit;
end;
until n=5;
close(book);
end.