Program Searching Data dengan Pascal

Program mencari suatu data (SEARCH) dengan menggunkan bahasa pemrograman Turbo Pascal.

Berikut contoh program, dalam kasus pencarian data pegawai  yang telah diinput :

program searching;
uses crt;

const
nmax = 50;

type
rdata = record
nip : integer;
nama : string[30];
bagian : string[20];
gaji : longint;
end;
adata = array [1..nmax] of rdata;

var
data : adata;
plh, ch : char;
n : integer;

{ini buat ngurutkan data terlebih dulu...}
procedure insertsort(var a :adata; n : integer);
var
pass, i : integer;
temp, temp4 : integer;
temp1, temp2 : string;
begin
for pass := 2 to n do
begin

temp := a[pass].nip;
temp1 := a[pass].nama;
temp2 := a[pass].bagian;
temp4 := a[pass].gaji;
i := pass-1;

while ((temp1)) do

begin
a[i+1].nip := a[i].nip;
a[i+1].nama := a[i].nama;
a[i+1].bagian := a[i].bagian;
a[i+1].gaji := a[i].gaji;
i := i-1;
end;

if (temp < a[i].nip) then
begin
a[i+1].nip := a[i].nip;
a[i+1].nama := a[i].nama;
a[i+1].bagian := a[i].bagian;
a[i+1].gaji := a[i].gaji;
i := i-1;
end;


a[i+1].nip := temp;
a[i+1].nama := temp1;
a[i+1].bagian := temp2;
a[i+1].gaji := temp4;


end;
end;


{prosedur untuk meminta input data}
procedure inputData(var A:adata; var ndata : integer);
var
i : integer;
begin
clrscr;
writeln('--- Input Data ---');
repeat
writeln;
write('Berapa banyak data? ');
readln(ndata);
if ndata>0 then
begin
writeln;
for i:=1 to ndata do
begin
writeln('Pegawai Ke-',i);
write('NIP : '); readln(A[i].nip);
write('Nama : '); readln(A[i].nama);
write('Bagian : '); readln(A[i].bagian);
write('Gaji : '); readln(A[i].gaji);
writeln;
end;
end
else
writeln('Input salah !!!')
until(n>0);
end;

function menu : char;
var
c : char;
begin
clrscr;
writeln('--- Menu Searching ---');
writeln;
writeln('1. Sequential Searching');
writeln('2. Binary Searching');
writeln('3. Keluar Program');
repeat
writeln;
write('Pilih >> ');
c := readkey;
writeln(c);
if not (c in ['1','2','3']) then
writeln('Input Salah !!!');
until(c in ['1','2','3']);
menu := c;
end;

procedure sequential(A : adata; ndata : integer);
var
i : integer;
nonip :integer;
begin
clrscr;
writeln('--- Sequential Searching ---');
writeln;
write('Masukkan NIP pegawai yang ingin dicari : ');
readln(nonip);
insertsort(a,n);
writeln;

{rutin kode utama}
i:=1;
while ((A[i].nip<=ndata)) do
i := i+1;
if (A[i].nip=nonip) then
begin
writeln('Data ditemukan !!!');
writeln('NIP : ',A[i].nip);
writeln('Nama : ',A[i].nama);
writeln('Bagian : ',A[i].bagian);
writeln('Gaji : ',A[i].gaji);
end
else
writeln('Data tidak ditemukan !!!');
end;

procedure binary(A : adata; ndata : integer);
var
bawah, tengah, atas : integer;
nonip : integer;
found : boolean;
begin
clrscr;
writeln('--- Binary Searching ---');
writeln;
write('Masukkan NIP pegawai yang ingin dicari : ');
readln(nonip);
insertsort(a,n);
writeln;

{rutin kode utama}
bawah := 1;
atas := ndata;
found := false;
while ((not found) and (atas>=bawah)) do
begin
tengah := (bawah+atas) div 2;
if (A[tengah].nip=nonip) then
found := true
else
if (A[tengah].nip>nonip) then
atas := tengah-1
else
bawah := tengah+1
end;

if (found) then
begin
writeln('Data ditemukan !!!');
writeln('NIP : ',A[tengah].nip);
writeln('Nama : ',A[tengah].nama);
writeln('Bagian : ',A[tengah].bagian);
writeln('Gaji : ',A[tengah].gaji);
end
else
writeln('Data tidak ditemukan !!!');
end;

{program utama}
begin
inputData(data,n);
ch := '2';
repeat
if (ch='2') then
plh := menu;

case plh of
'1' : sequential(data,n);
'2' : binary(data,n);
'3' : exit;
end;
writeln;
repeat
writeln;
writeln('Tekan >> 1: Cari lagi!, 2: Kembali ke Menu, 3: Keluar Program');
write(' >> ');
ch := readkey;
if not (ch in ['1','2','3']) then
writeln('Input Salah !!!');
until(ch in['1','2','3']);
until(ch='3');
end.