. . .Fince Tinus Waruwu. . .: 2011-07-03

Sabtu, 09 Juli 2011

Menggunakan File dan Searching pada pascal

uses wincrt;

type dosen=record

kode :string[3];

nama :string[30];

pendidikan :string[10];

keahlian :string[20];

end;

var

fdsn :file of dosen;

rdsn :dosen;

i :byte;

lg :char;

ketemu :Boolean;

xkode :string[3];

procedure opendosen;

begin

assign (fdsn,'d:\dosen.dat');

{$I-} reset(fdsn);

{$I+}if Ioresult <>0then rewrite(fdsn);

end;

begin

opendosen;

repeat

clrscr;

ketemu :=false;

i:=1; seek(fdsn,0);

gotoxy(10,3);write('kode dosen :');readln(xkode);

while not eof(fdsn) do

begin

seek(fdsn,i-1);read(fdsn,rdsn);

if rdsn.kode= xkode then

begin;

ketemu:=true;

gotoxy(10,5);write('nama :',rdsn.nama);

gotoxy(10,6);write('pendidikan:',rdsn.pendidikan);

gotoxy(10,7);write('keahlian :',rdsn.keahlian);

gotoxy(10,9);write('Data ini sudah ada!');

end;

inc(i);

end;

if not ketemu then

begin

gotoxy(10,11);write('nama :');readln(rdsn.nama);

gotoxy(10,12);write('pendidikan :');readln(rdsn.pendidikan);

gotoxy(10,13);write('keahlian :');readln(rdsn.keahlian);

rdsn.kode:=xkode;

seek (fdsn, filesize(fdsn));

write(fdsn,rdsn);

end;

gotoxy(10,15);write('input lagi[Y/T]:');readln(lg);

until upcase(lg)='T';

close (fdsn);

end.

Minggu, 03 Juli 2011

Quiz/ Kamis

Nama : Fince Tinus Waruwu

NPM : 1002040

Kelas : MI-P1001

Soal No 3

Uses wincrt;
Type Karyawan = Record
Kode : String[5];
Jabatan : String [15];
Status : String [10];
end;
Var
fkar : file of karyawan;
rkar : karyawan;
lg : Char ;
i,j,pil : Integer;
Gaji : Longint;
Tunjangan : Real;
Tkeluarga : Real;
Total : Real;
procedure openkaryawan;
Begin
Assign (fkar,'c:\karyawan.dat');
{$I-} Reset (fkar);
{$I+} if IOresult <>0 then Rewrite (fkar);
End;
Procedure Menu;
begin
clrscr;
clrscr;
gotoxy (10,5);write ('MENU UTAMA');
gotoxy (10,6);write ('-----------------------------');
gotoxy (10,7);write ('[1].Input Laporan Gaji Karyawan');
gotoxy (10,8);write ('[2].Output karyawan');
gotoxy (10,9);write ('[3].Keluar karyawan');
gotoxy (10,10);write ('------------------------------');
gotoxy (10,11);write ('pilihan:');readln (Pil);
end;

Procedure Inputkaryawan;
begin
clrscr;
openkaryawan;
repeat
gotoxy (30,5);write ('input Karyawan');
gotoxy (30,6);write ('-----------------');
gotoxy (30,7);write ('Kode');readln (rkar.kode);
gotoxy (30,8);write ('Status');readln (rkar.Status);
gotoxy (30,9);write ('------------------------------');
gotoxy (30,10);write ('Input Lagi [Y/T]:');Readln (lg);
Seek (fkar, filesize (fkar));
write (fkar,rkar);clrscr;
Until Upcase (lg)=('T');
end;
procedure outputkaryawan;
Begin
clrscr;
i:=1 ; openkaryawan;
gotoxy (3,1);write ('Laporan Gaji Karyawan');
gotoxy (3,2);write ('--------------------------------------');
gotoxy (3,3);write ('No Kode Jabatan Tunjangan ');
gotoxy (3,4);write ('--------------------------------------');
Seek (fkar,0);
while not Eof(fkar) do
Begin
Seek (fkar,i-1); read (fkar,rkar);
if rkar.Kode='K001' then
begin
rkar.Jabatan:='Supervriser'; Gaji:= 3000000
end
Else if rkar.Kode='K002' then
begin
rkar.Jabatan:='Sekretaris'; Gaji:= 2500000
end
Else if rkar.Kode='K003' then
begin
rkar.Jabatan:='Bendahara'; Gaji:= 2000000
end
Else if rkar.Kode='K004' then
begin
rkar.Jabatan:='Sales'; Gaji:= 1500000;

gotoxy (3,4+i);write(i:2,' ',rkar.kode,' ',rkar.Jabatan);
gotoxy (20,4+i);write(Gaji:8);

if Gaji= 3000000 then Tunjangan:= 0.35 * 3000000
else if Gaji= 2500000 then Tunjangan:= 0.20 * 2500000
else if Gaji= 2000000 then Tunjangan:= 0.10 * 2000000
else Tunjangan:= 0.5 * 1500000;

gotoxy (30,4+i);write(Tunjangan:9);
if rkar.Status='Menikah' Then
begin
TKeluarga:= 0.15 * Gaji ;
end
else if rkar.Status='Belum Menikah' then
begin
Tkeluarga:=0;
Total:= Gaji + Tunjangan + Tkeluarga;
gotoxy (40,4+i);write (Total:10:0);
inc (i);
end;
READLN;
end;
begin
pil:=0;
while pil <>3 do
begin
menu;
case pil of
1 : Inputkaryawan;
2 : outputkaryawan;
end;
close (fkar);
end ;
end.

Soal No 4

uses wincrt;
type dokter=record
     kode         :string[3];
     nama         :string[20];
     specialis    :string[20];
     end;

var
   fdok         :file of dokter;
   rdok         :dokter;
   i            :byte;
   xkd          :string[3];
   lg           :char;
   ketemu       :Boolean;

procedure opendokter;
begin
     clrscr;
    assign(fdok,'c:\dokterr.dat');
    {$I-} reset (fdok);
    {$I+} if ioresult<>0 then rewrite(fdok);
end;

begin
    clrscr;
    opendokter;
    repeat
         i:=1;
         ketemu:=false;
         gotoxy(40,3);write('kode:');readln(xkd);
         seek (fdok,0);
         while not eof(fdok) do
         begin
             seek (fdok,i-1);read(fdok,rdok);
             if rdok.kode=xkd then
             begin
                 gotoxy(40,4);write('nama:',rdok.nama);
                 gotoxy(40,5);write('specialis:',rdok.specialis);
                 ketemu:=true;
             end;
             inc(i);
         end;
         rdok.kode:=xkd;
         if not ketemu then
         begin
             gotoxy(40,8);write('nama:');readln(rdok.nama);
             gotoxy(40,9);write('specialis:');readln(rdok.specialis);
             seek (fdok,filesize(fdok));
             write(fdok,rdok);
         end;
         gotoxy(40,10);write('input lagi[Y/T]:');readln(lg);
    until upcase(lg)='T';
    close(fdok);
end.

Sabtu, 09 Juli 2011

Menggunakan File dan Searching pada pascal

Minggu, 03 Juli 2011

Quiz/ Kamis

Program Searching