Senin, 19 Desember 2011

Mencari suatu data dari file (penyimpanan) di pascal

Mungkin yang sudah atau yang lagi belajar pascal akan dan pasti bertemu dengan yang namanya "file" dalam pemerograman pascal, baik itu file bertipe, tidak bertipe atau file text, berikut ini sedikit program mencari suatu data barang yang sebelumnya data barang sudah di inputkan oleh user, agar tidak lupa dan mudah diingat maka saya tulis saja disini.. :D


Program Berkas_data_barang;
uses crt;
type datbar = record
kobar  : integer;
nabar  : string;
harga  : longint;
end;
var
filedatbar : file of datbar;
data       : datbar;
pil, ul    : char;


Procedure bukafile;
begin
Assign (filedatbar,'datbar.TXT');
{$I-};
Reset (filedatbar);
{$I+};
End;

procedure tambah;
var
lagi : char;
ada  : boolean;
i    : integer;
nocr : word;
Begin
ul         := 'Y';
Lagi       := 'Y';
clrscr;

bukafile;
if IOResult <> 0 then
rewrite (filedatbar);

repeat
clrscr;
ada := false;
i := 0;
write ('No kode barang : '); readln (nocr);
while (ada = false) and (i<> filesize(filedatbar)) do
begin
seek (filedatbar,i);
read (filedatbar,data);
if data.kobar=nocr then
ada := true
else
inc (i);
end;
if (ada = true) then
begin
write ('Kode barang', nocr, 'ini sudah ada..!!');
end
else
begin
seek (filedatbar,filesize(filedatbar));
data.kobar := nocr;
write ('nama barang : '); readln (data.nabar);
write ('Silahkan masukan harga : '); readln (data.harga);
write (filedatbar,data);
end;
write ('tambah data lagi [Y/T] : '); lagi := Upcase (Readkey);
until lagi <> 'Y';
close (filedatbar);
end;

Procedure tampil;
var
i    : integer;
Begin
ul := 'Y';
bukafile;
if IoResult <> 0 Then
write ('Maaf Data masih kosong')
else
begin;
i := 0;
while not EOF (filedatbar) do
begin
Inc (i);
Read(filedatbar,data);
writeln ('Kode barangnya adalah : ', data.kobar);
writeln ('Nama barangnya adalah : ', data.nabar);
writeln ('Harga' , data.nabar ,' adalah     : Rp.', data.harga);
writeln (' ');
end;
close (filedatbar);
end;
end;

Procedure cari_barang;
var
i, ko : integer;
lagi     : char;
Begin
ul := 'Y';
lagi := 'Y';
Repeat
Write ('Silahkan Masukan Kode barang yang anda Cari : ');
readln (ko);
bukafile; {pemanggilan Prosedur buka file}
If IoResult <> 0 Then
write ('Maaf Mas Bro kode barang tidak ada..!')
else
begin
i := 0;
while not EOF (filedatbar) do
begin
read (filedatbar,data);
if data.kobar = ko then
begin
Inc (i);
writeln ('Kode barangnya adalah : ', data.kobar);
writeln ('Nama barangnya adalah : ', data.nabar);
writeln ('Harga' , data.nabar ,' adalah     : Rp.', data.harga);
writeln (' ')
end;

end;
close (filedatbar);
end;
writeln;
Write ('Mau mencari barang lagi.. ??? '); lagi :=upcase (readkey);
until lagi <> 'Y';
end;


Begin
clrscr;
repeat
writeln ('DAFTAR MENU PROGRAM');
writeln;
write ('1. Tambah data barang.');
writeln;
write ('2. Tampilkan semua data barang.');
writeln;
write ('3. Tampilkan data barang berdasarkan kode barang.');
writeln;
write ('4. Keluar.');
writeln;
Write ('Silahkan Masukan No. menu = '); readln (pil);
case pil of
'1'    : tambah;
'2'    : tampil;
'3'    : cari_barang;
end;
until (ul <> 'Y') or (pil='4');

end.

2 komentar: