membuat database pada pascal

mmm...
ini salah satu program koperasi yang menggunakan program pascal dan memasukan data inputan kedalam bentuk text yang berekstensi .dat
lumayan agak rumit juga programnya, tapi untuk bahan pelajaran apa salahnya kalau di share ??
check this sources :


program penjualan;
uses crt ;

 type
 data=record
 no,jumlah:integer;
 nama_barang:string;
 harga,harga_barang:real;
 end;

 var
 rdata:array[1..100]of data;
 filedata:file of data;
 f:data;
 nomor:integer;
 datacari:string;

procedure judul;
begin
writeln('       KOPERASI MAHASISWA "KHARISMA KARAWANG"');
writeln('        jl. Pangkal Perjuangan KM.1 By Pass');
writeln('                    KARAWANG');
writeln('******************************************************************');
writeln;

end;

procedure tambah;
var
i:integer;
lagi:char;
begin
clrscr;
judul;
writeln('Masukan data tambahan');
assign(filedata,'jual.dat');
 reset(filedata);
 seek(filedata,filesize(filedata));
  write('Nama barang : ');
  readln(f.nama_barang);
  write('harga:');
  readln(f.harga);
  write('jumlah :');
  readln(f.jumlah);
  f.harga_barang:=f.harga*f.jumlah;
  write(filedata,f);
  close(filedata);
end;

procedure hapus;
var
i,j:integer;
nm:string;
begin

assign(filedata,'jual.dat');
 reset(filedata);
 j:=0;
 while not Eof(filedata) do
  begin
     inc(j);
     read(filedata,rdata[j]);
  end;

 writeln('Masukan nama barang yang di hapus :');
 readln(nm);
 i:=1;
while(i<=j)and (rdata[i].nama_barang<>nm) do
inc(i);
  if nm=rdata[i].nama_barang then
   begin
   dec(j);
    for i:=i to j do
     rdata[i]:=rdata[i+1];
     rewrite(filedata);
     for i:=1 to j do
     write(filedata,rdata[i]);
     writeln(' Tekan enter untuk memulai menghapus');
     readln;
     writeln(' S U K S E S ');
   end
   else
   writeln('MAAF data tidak di temukan ');
   readln;
   close(filedata);
  end;

procedure edit_data;
var
i,p:integer;
lagi:char;
dataedit:string;

begin


assign(filedata,'jual.dat');
reset(filedata);
writeln('masukan nama data yang akan di edit [tulis dengan huruf kecil] : ');
readln(dataedit);
i:=1;
while not Eof(filedata) do
begin
read(filedata,rdata[i]);
begin
if dataedit = rdata[i].nama_barang then
 begin

  p:=filepos(filedata);writeln(p);
  p:=p-1;
  seek(filedata,p);
  writeln('input data pengganti :');
   writeln('no ',i:2);
   write('nama barang :');read(rdata[p].nama_barang);
   write('harga       :');read(rdata[p].harga);
   write('jumlah      :');read(rdata[p].jumlah);
   rdata[p].harga_barang:=rdata[p].harga*rdata[p].jumlah;
   write(filedata,rdata[p]);
 end ;
end;
i:=i+1;
end;
close(filedata);
end;




procedure in_data_barang;
var i:integer;
    lagi:char;
begin
i:=1;
assign(filedata,'jual.dat');
 rewrite(filedata);
 reset(filedata);
 begin
repeat
 begin
   clrscr;
   judul;
   writeln('input dengan huruf kecil');
   writeln('no ',i);
   write('nama barang :');readln(rdata[i].nama_barang);
   write('harga       :');readln(rdata[i].harga);
   write('jumlah      :');readln(rdata[i].jumlah);
   rdata[i].harga_barang:=rdata[i].harga*rdata[i].jumlah;
   write(filedata,rdata[i]);
   writeln;
   writeln('ingin masukan data lagi [y/t] : ');
   readln(lagi);
   i:=i+1;
 end;
 until ((lagi='t') or (lagi='T'));
 close(filedata);

 end;

 end;


procedure tampil_daftar_barang;
var i:integer;

begin
assign(filedata,'jual.dat');
reset(filedata);
      writeln('DAFTAR BARANG DI ATAS Rp 1.000.000 ');
  writeln('=============================================================');
  writeln('NO   NAMA BARANG                          HARGA/S   JUMLAH   ');
  writeln('=============================================================');

i:=1;
while not Eof(filedata) do
begin
 read(filedata,rdata[i]);

 if (rdata[i].harga)>=1000000 then
    begin
  write(i);
  write('    ',rdata[i].nama_barang:10);
  write('                       ',rdata[i].harga:10:0);
  write('     ',rdata[i].jumlah:2);
  writeln;
 i:=i+1;
 end;
 end;writeln;
 end;



procedure cetak_daftar_barang;
var i,pilih:integer;
    total:real;
begin
repeat
clrscr;
assign(filedata,'jual.dat');
reset(filedata);
 total:=0;
 begin
judul;
writeln('DAFTAR PENJUALAN ');
writeln('==========================================================================');
writeln('NO   NAMA BARANG                          HARGA/S   JUMLAH    HARGA BARANG');
writeln('==========================================================================');
i:=1;

while not Eof(filedata) do

 begin
 read(filedata,rdata[i]);

  write(i);
  write('    ',rdata[i].nama_barang:10);
  write('                       ',rdata[i].harga:10:0);
  write('     ',rdata[i].jumlah:2);
  write('      ',rdata[i].harga_barang:8:0);
  writeln;
  total:=total+rdata[i].harga_barang;
  i:=i+1;
 end;


writeln('---------------------------------------------------------------------');
writeln('                                         TOTAL PENJUALAN   ; ',total:3:0);
writeln;
writeln;
tampil_daftar_barang;
end;
writeln('-- Pilihan --');
writeln('**************************');
writeln('1. Tambah data penjualan');
writeln('2. Hapus data penjualan');
writeln('3. Edit data penjualan');
writeln('4. Ke MENU Utama');
writeln('**************************');
readln(pilih);
case pilih of
 1:tambah;
 2:hapus;
 3:edit_data;
 end;
 until(pilih =4);
end;

procedure cari;
var
i,jumlah:integer;
cocok,nama:string;
harga,harga_barang:real;
begin
 assign(filedata,'jual.dat');
 reset(filedata);
  cocok:=datacari;

   begin
   i:=1;
   while not Eof(filedata)do
    begin
    read(filedata,rdata[i]);
    if cocok=rdata[i].nama_barang then
     begin
     nama:=rdata[i].nama_barang;
     harga:=rdata[i].harga;
     jumlah:=rdata[i].jumlah;
     harga_barang:=rdata[i].harga_barang;
    end;
     end;
     i:=i+1;
     end;
if(nama='')then
 begin
  writeln(' MAAF DATA TIDAK TERSEDIA')
  end
  else
  begin
  judul;
  writeln('DAFTAR PENCARIAN ');
writeln('======================================================================');
writeln(' NAMA BARANG                          HARGA/S   JUMLAH    HARGA BARANG');
writeln('======================================================================');
  writeln;
  write(nama:10);
  write(                   harga:35:0);
  write(jumlah:8);
  write(harga_barang:12:0);
  writeln;
  writeln('-------------------------------------------------------------------------');
  writeln;
  end;
nama:='';
harga:=0;
jumlah:=0;
harga_barang:=0;
end;


procedure cek_data_barang;
var
lagi:char;
begin
 repeat
 clrscr;
judul;
writeln('Masukan Nama Data yang di cari [tulis dengan huruf kecil] : ');
readln(datacari);
clrscr;
cari;

writeln('Apakah ingin mencari data lagi ? [y/ t] ');
readln(lagi);
writeln;
until (lagi='T')or (lagi='t');
end;


begin

repeat
clrscr;
judul;
  writeln('-- MENU --');
  writeln('************************');
  writeln('1. IN DATA BARANG');
  writeln('2. CEK DATA BARANG');
  writeln('3. CETAK DAFTAR BARANG');
  writeln('4. E X I T');
  writeln('************************');
  writeln;
writeln('Pilih Jenis Transaksi = ');
readln(nomor);
  clrscr;
case nomor of
  1:in_data_barang;
  2:cek_data_barang;
  3:cetak_daftar_barang;

end;
until nomor=4;
end.

buat temen-temen yang ingin program tersebut dalam bentuk ekstensi .pas dan textnya dalam bentuk .dat


Jangan Cuma Copy Paste Terus Senyum, Tapi Coba Pelajari Dan Cobalah Berkreasi.

Informasi