Make your own free website on Tripod.com
CYBER ARMY
Pascal scripts

HOME

WarGames
Email Bombers
SubSeven
Chat&boot-camps
Cracking
Game Room
Hacking Neopets
Dangerouse about
Documents
Viruses
Eye Tricks
maken animations
Telecope
C plus plus
NEWS
Millionare
Massege Board
Basic HTML
links to us
computer languages
Proxys
COBOL
Pascal scripts
QBasic
computer quest
Black-book-of-hackers
WARCHIVES
Files
Lamers
Hackers
what is Cyber-Army
Contact me
Cyber army Album
Votes

Learn the Scripts of pascal and advance it.

1)Program urut;
uses crt;
var i,j,a:integer;
begin
for i := 1 to 5 do
begin
a := 1;
for j:= 1 to i do
begin
write(a,' ');
a := a + 2;
end;
writeln;
end;
readln;
end.

2)PROGRAM LOOPING;
USES CRT;
LABEL 10;
VAR I,c : INTEGER;
BIL1,BIL2 :INTEGER;
BEGIN
CLRSCR;
BIL1:=1; BIL2:=1;
write('Masukkan bilangan : ');readln(c);
FOR I :=1 TO c DO
BEGIN
WRITE(BIL1); BIL1 :=BIL1 + 2;
IF I = c THEN
BEGIN
WRITE(' =');
GOTO 10;
END;
IF I MOD 2= 1 THEN
BEGIN WRITE(' - ');BIL2:=BIL2 - BIL1;END
ELSE
BEGIN WRITE(' + '); BIL2:=BIL2+BIL1;END;
10: END;
WRITE (' ',BIL2);
READLN;

END.

3)Program keren;
uses crt;
type data = record
nama : string[20];
npm  : string[8];
ket  : string[6];
n1,n2,n3 : integer;
rat : real;
end;
var lucu : array[1..50]of data;
a,b,c : integer;
i : char;
procedure input;
begin
repeat
clrscr;
write('Jumlah data = ');readln(b);
for a := 1 to b do
begin
with lucu[a] do
begin
writeln('Jumlah = ',a);
write('Nama Mahasiswa : ');readln(nama);
write('N P M          : ');readln(npm);
write('Nilai ke - 1   : ');readln(n1);
write('Nilai ke - 2   : ');readln(n2);
write('Nilai ke - 3   : ');readln(n3);
rat := (n1 + n2 + n3)/3;
writeln('Rata - rata = ',rat:0:0);
if rat >= 60 then
ket := 'Lulus' else
ket := 'gagal';
end;
end;
write('Data ada yang salah (y/t)? ');readln(i);
until (i='t') or (i='T')
end;
Procedure table;
begin
clrscr;
writeln(' ':25,'DAFTAR NILAI MAHASISWA');
writeln(' ':25,'----------------------');
writeln;
writeln('==============================================================================');
writeln(' No  Nama Mahasiswa    NPM    Nilai1  Nilai2  Nilai3  Rata - rata  Keterangan');
writeln('==============================================================================');
for a := 1 to b do
begin
with lucu[a] do
begin
writeln(a:3,nama:15,npm:9,n1:7,n2:7,n3:7,rat:10:0,ket:13);
end;
end;
writeln('==============================================================================');
readln;
end;

begin
input;
table;
end.

4)
program apotik;
uses crt;
const l = 'a01';
			m = 'a02';
			n = 'a03';
type pel = record
				nama : string[17];
				alamat : string[20];
				obat : string[4];
				jumlah,harga : integer;
		 end;
		 d_pel = file of pel;

var mn : array [1..100] of pel;
		daf_pel : d_pel;
		hari : string;
		i,j,s : integer;
		f : string;
		k : char;

function garis (n,c : integer) : string;
var i : integer;
		g : string;
		begin
			g := '';
			for i := 1 to n do
				g := concat(g,chr(c));
				garis := g
		end;


procedure input;
var c : integer;
begin
	clrscr;
	writeln('Apotik X Y Z');writeln;
	writeln('Input transaksi');
	write('Hari ini : ');readln(hari);
	assign(daf_pel,hari);
	rewrite(daf_pel);
	clrscr;
	write('Jumlah data : ');readln(s);
	repeat
		clrscr;
		writeln(' ':13,'Apotik X Y Z');
		writeln(' ':13,'Input data');writeln;
		for i := 1 to s do
		with mn[i] do
			begin
				writeln;
				write('Supplier   : ');readln(nama);
				write('Alamat     : ');readln(alamat);
				write('Jenis Obat : ');readln(obat);
				if obat = 'A01' then  c := 1
				else
				if obat = l then c := 1
				else
				if obat = 'A02' then  c := 2
				else
				if obat = m then c:= 2
				else
				if obat = 'A03' then 	c := 3
				else
				if obat = n then c := 3
				else
					c := 4;
				case c of
				1: harga := 6000;
				2: harga := 7000;
				3: harga := 5000;
				4: f := 'Tidak ada.....'
			end;
			write('Jumlah     : ');readln(jumlah);
		end;
		write('Akan mengisi data lagi ?(Y/T) : ');readln(k);
	until not(k in['Y','y']);
	write(daf_pel,mn[i]);
close(daf_pel)
end;


procedure baca;
var a : integer;
begin
	clrscr;
	assign(daf_pel,hari);
	reset(daf_pel);
	j := filesize(daf_pel);
	writeln(' ':18,'APOTIK X Y Z');
	writeln(' ':18,'------------');
	writeln; writeln(garis(74,55));
	write('|     Supplier     |        Alamat       | Obat |');
	writeln('   Jumlah   |   Harga   |');
	writeln(garis(74,45));
	read(daf_pel,mn[i]);
	for i := 1 to s do
		begin
		with mn[i] do
			begin
				gotoxy(1,wherey); write('| ',nama);
				gotoxy(19,wherey); write(' | ',alamat);
				gotoxy(42,wherey); write('| ',obat);
				gotoxy(49,wherey); write('| ',jumlah);
				gotoxy(62,wherey); write('|  ',harga,'     |');
			end;
		writeln;
		end;
	writeln(garis(74,45));
	readln;
	close(daf_pel);
end;

begin
	input;
	baca;
end.



5)
program baca_sector;
uses dos , crt;
const
	jumlahtrack = 40;
	readservice = 2;
type
	buffer = array[1..5000] of char;
var
	jmlsec,dskasl,nm_sc_awl : integer;
	dskbuffer : buffer;
	trck,side,i,bffrsz : integer;
procedure bacasector (side,trck,drive : integer;
											var dskbuffer : buffer);
var
	regs : registers;
begin
	with regs do
		begin
			ax := (readservice shl 8) + jmlsec;
			cx := (trck shl 8) + nm_sc_awl;
			dx := (side shl 8) + drive;
			es := seg (dskbuffer[1]);
			bx := ofs (dskbuffer[1]);
			intr ($13,regs);
			for i := 1 to bffrsz do write(dskbuffer[1]);
		end;
end;
begin
	clrscr;
	write('Mau baca disk pada drive apa ');
	write('(0 = A, 1 = B, 2 = C, 3 = D, 4 = E, dst.) ?');readln(dskasl);
	write('Side yang mana (0 atau 1) ?');readln(side);
	write('Track ke berapa(0 - 39 or lebih) ?');readln(trck);
	write('Mulai sector berapa (1 - 9 or lebih) ?');readln(nm_sc_awl);
	write('Berapa sector yang mau di baca (1 - 9) ?');readln(jmlsec);
	bffrsz := jmlsec*512;
	bacasector (side,trck,dskasl,dskbuffer);
end.

6)
Program hebat_sekali;
uses crt;
const jumlah_mk = 5;
type nama = string[15];
			nilai = record
					nama_mhs : string[17];
					no_mhs	 : string[9];
					nilai_ujian 	 : array[1..jumlah_mk] of integer;
					n_rata	   : real;
					nilai_huruf			 : char
			end;
			d_nilai = file of nilai;
var daf_nilai : d_nilai;
		pilihan	  : char;
		nama_berkas : string;

function garis (n,c : integer) : string;
var i : integer;
		g : string;
begin
	g := '';
	for i := 1 to n do
		g := concat(g,chr(c));
	garis := g
end;

procedure kotak (x1,y1,x2,y2,kode : integer);
var i : integer;
begin
	gotoxy(x1,y1); writeln(chr(201),garis(x2-x1-1,205),chr(187));
	gotoxy(x1,y2); writeln(chr(200),garis(x2-x1-1,205),chr(188));
	for i := y1+1 to y2-1 do
		begin
			gotoxy(x1,i); writeln(chr(186));
			gotoxy(x2,i); writeln(chr(186))
		end;
	if kode in [1..2] then
		begin
			gotoxy(1,5); writeln(chr(199),garis(76,196),chr(182))
		end;
	if kode = 2 then
		begin
			gotoxy(1,3); writeln(chr(199),garis(76,196),chr(182));
			gotoxy(1,7); writeln(chr(199),garis(76,196),chr(182));
			gotoxy(1,21); writeln(chr(199),garis(76,196),chr(182));
		end
end;

function menu : char;
var p : char;
begin
	clrscr;
	kotak(1,1,78,23,1);
	gotoxy(30,3); writeln('DAFTAR MENU PILIHAN');
	gotoxy(20,8); writeln('A. MEMILIH BERKAS YANG AKAN DI OPERASIKAN');
	gotoxy(20,9); writeln('B. MEMASUKKAN DATA');
	gotoxy(20,10); writeln('C. MEMBETULKAN DATA');
	gotoxy(20,11); writeln('D. MENYISIPKAN RECORD');
	gotoxy(20,12); writeln('E. MENGHAPUS RECORD');
	gotoxy(20,13); writeln('F. MELIHAT ISI BERKAS');
	gotoxy(20,15); writeln('G. SELESAI');
	gotoxy(1,18); writeln(chr(199),garis(76,196),chr(182));
	repeat
		gotoxy(48,20); writeln(' ':10);
		gotoxy(30,20); write('PILIH SALAH SATU: ');
		p := upcase(readkey)
	until p in ['A'..'G'];
	menu := p
end;

procedure pilih_berkas (var bks : d_nilai; var nb : string);
var n_bks : string;
		baru 	: char;
		cek,b_baru : boolean;

function berkas_ada (nb:string) : boolean;
var b : d_nilai;
begin
	assign(b,nb);
	{$i-}
	reset(b);
	{$i+}
	berkas_ada := (ioresult = 0)
end;

begin
	b_baru := false; cek := true;
	while cek do
		begin
			clrscr;
			kotak(1,1,78,23,1);
			gotoxy(22,3); writeln('MEMILIH BERKAS YANG AKAN DI OPERASIKAN');
			kotak(18,10,62,17,0);
			gotoxy(20,12); write('Isikan nama berkas :.........');
			gotoxy(40,12);readln(nb);
			if not berkas_ada(nb) then
				begin
					b_baru := true;
					gotoxy(20,14); writeln('Berkas  di atas tidak ada');
					gotoxy(20,15); write('Apakah ini berkas baru ?');
					write(' <Y>a/<T>idak : '); baru := upcase(readkey);
					if baru <> 'Y' then
						cek := true
					else
						cek := false
				end
			else
				begin
					cek := false;b_baru := false
				end;
		end;
	assign(bks,nb);
	if b_baru then rewrite(bks)
	else reset(bks)
end;

procedure data (var nm : nilai; x1,y1 : integer);
var i : integer;
begin
	with nm do
		begin
			n_rata := 0.0;
			gotoxy(x1,y1); write('Nama Mahasiswa : ');readln(nama_mhs);
			gotoxy(x1,wherey); write('Nomor Mahasiswa : '); readln(no_mhs);
			for i := 1 to jumlah_mk do
				begin
					gotoxy(x1,wherey); write('Nilai ke ',i:2,'   : ');
					readln(Nilai_ujian[i]);
					n_rata := n_rata + nilai_ujian[i]
				end;
			n_rata := n_rata/jumlah_mk
		end;
end;

Procedure cetak_rekaman(rek : nilai; x1,y1 : integer );
var i : integer;
begin
	with rek do
		begin
			gotoxy(x1,y1); writeln('Nama Mahasiswa : ',nama_mhs);
			gotoxy(x1,wherey); writeln('Nomor Mahasiswa : ',no_mhs);
			for i:= 1 to jumlah_mk do
				begin
					gotoxy(x1,wherey);
					writeln('Nilai ke ',i:2,'   : ',nilai_ujian[i])
				end
		end
end;


Procedure konversi_nilai (var bks : d_nilai);
var nilai_mhs : nilai;
		i,j,n			: integer;
		sd,rata,b1,b2,b3,b4 : real;
begin
	n := filesize(bks); seek(bks,0);
	rata := 0.0;
	for i := 0 to n-1 do
		begin
			read(bks,nilai_mhs);
			rata := rata + nilai_mhs.n_rata
		end;
	rata := rata/n;
	sd := 0.0;
	seek(bks,0);
	for i := 1 to n-1 do
		begin
			read(bks,nilai_mhs);
			sd := sd + sqr(nilai_mhs.n_rata-rata);
		end;
	sd := sqrt(sd/(n-1));
	b1 := rata + 1.5 * sd; b2 := rata + 0.5 * sd;
	b3 := rata - 0.5 * sd; b4 := rata - 1.5 * sd;
	seek(bks,0);
	for i := 0 to n-1 do
		begin
			read(bks,nilai_mhs);
			with nilai_mhs do
				if n_rata >= b1 then nilai_huruf := 'A'
				else if (n_rata<b1) and (n_rata>=b2) then nilai_huruf := 'B'
				else if (n_rata<b2) and (n_rata>=b3) then nilai_huruf := 'C'
				else if (n_rata<b3) and (n_rata>=b4) then nilai_huruf := 'D'
				else nilai_huruf := 'E';
			seek(bks,i);
			write(bks,nilai_mhs)
		end;
end;

procedure isi_data (var bks : d_nilai; nb : string);
var nilai_mhs : nilai;
		i,n,j : integer;
		lagi  : char;
begin
	n := filesize(bks);
	seek(bks,n);
	repeat
		clrscr;
		kotak(1,1,78,23,2);
		gotoxy(19,2); writeln('MENGISI DATA DAN MENYIMPAN KE DALAM BERKAS');
		gotoxy(8,4); write('BERKAS YANG DI GUNAKAN: "',nb,'".   ');
		writeln('SEKARANG BERISI: ',n:3,'RECORD');
		gotoxy(21,6); writeln('SEKARANG MENGISI RECORD KE : ',n+1:3);
		data(nilai_mhs,20,9);
		write(bks,nilai_mhs);
		inc(n);
		gotoxy(20,22); write('Akan mengisi lagi? <Y>a/<T>idak: ');
		readln(lagi); lagi := upcase(lagi);
	until lagi <> 'Y' ;
	clrscr;
	kotak(1,1,78,23,0);
	kotak(17,10,62,14,0);
	gotoxy(19,12); write('Tunggu sebentar, sedang e..e.. nich');
	konversi_nilai(bks);
end;

procedure edit_data (var bks : d_nilai; nb :string);
var nm : nilai;
		n,i,j : integer;
		sb : char;
		nomor : string[9];
		ada : boolean;


procedure cek (var ada : boolean; var i : integer; no : string);
begin
	i := 0; ada := false;
	seek(bks,i);
	repeat
		read(bks,nm);
		if no = nm.no_mhs then ada := true
		else
			begin
				inc(i);
				if i < n then seek(bks,i)
			end
	until (i = n) or ada
end;
begin
	n := filesize(bks);
	repeat;
		clrscr;
		kotak(1,1,78,23,2);
		gotoxy(25,2); writeln('PROSES MEMBETULKAN ISI RECORD');
		gotoxy(8,4); write('BERKAS YANG DI GUNAKAN: "',nb,'"');
		writeln(', SEKARANG BERISI: ',n:3,' RECORD');
		repeat
			gotoxy(50,6); writeln(' ':10);
			gotoxy(26,6); write('ISIKAN NOMOR MAHASISWA: ');
			readln(nomor);
			cek(ada,i,nomor);
		until ada;
		gotoxy(20,6); writeln(' ':55);
		seek(bks,i); read(bks,nm);
		for j := 6 to 20 do
			begin
				gotoxy(39,j); writeln(chr(179));
			end;
		gotoxy(39,5); writeln(chr(194)); gotoxy(39,21); writeln(chr(193));
		gotoxy(10,6); writeln('ISI RECORD KE: ',i+1:3);
		gotoxy(42,6); writeln('ISIKAN DATA PEMBETULAN DI BAWAH INI');
		gotoxy(1,7);
		writeln(chr(199),garis(37,196),chr(197),garis(38,196),chr(182));
		cetak_rekaman(nm,3,8); data(nm,41,8);
		repeat
			gotoxy(26,22); write('<S>impan/<B>atalkan: ');
			sb := upcase(readkey)
		until sb in ['S','B','s','b'];
		gotoxy(20,22); writeln(' ':55);
		if sb = 'S' then
			begin
				seek(bks,i);
				write(bks,nm)
			end;
		gotoxy(20,22); write('Akan membetulkan lagi? <Y>a/<T>idak: ');
		sb := upcase(readkey)
	until sb <> 'Y';
	konversi_nilai(bks)
end;


procedure sisip_rekaman (var bks : d_nilai; nb : string);
var rek_baru,rb : nilai;
		i,j,k,n			: integer;
		lagi				: char;
begin
	n := filesize(bks);
	repeat
		clrscr;
		kotak(1,1,78,23,2);
		gotoxy(28,2); writeln('MENYISIPKAN RECORD BARU');
		gotoxy(8,4); write('BERKAS YANG DI GUNAKAN: "',nb,'"');
		writeln(', SEKARANG BERISI: ',n:3,'RECORD'); gotoxy(13,6);
		writeln('Record baru akan ditempatkan sebagai record nomor: ');
		repeat
			gotoxy(68,6); write(' ':5);
			gotoxy(68,6); readln(k);
		until k in [1..n+1];
		data(rek_baru,20,9);
		if k = n+1 then
			begin
				seek(bks,n);
				write(bks,rek_baru)
			end
		else
			begin
				for j := n-1 downto k-1 do
					begin
						seek(bks,j);
						read(bks,rb); write(bks,rb);
					end;
				seek(bks,k-1); write(bks,rek_baru)
			end;
		inc(n);
		gotoxy(20,22); write('Akan menyisipkan lagi? <Y>a/<T>idak: ');
	until upcase(readkey) <> 'Y';
	konversi_nilai(bks)
end;


procedure hapus_rekaman (var bks : d_nilai; nb : string);
var nm	: nilai;
		bb	: d_nilai;
		i,j,n : integer;
		b1		: string;
		hapus : char;

procedure pindahkan;
begin
	read(bks,nm);
	write(bb,nm);
end;

begin
	repeat;
		clrscr;
		n := filesize(bks);
		kotak(1,1,78,23,2);
		gotoxy(23,2); writeln('MENGHAPUS RECORD DARI DALAM BERKAS');
		gotoxy(8,4); write('BERKAS YANG DI GUNAKAN: "',nb,'"');
		writeln('SEKARANG BERISI: ',n:3,' RECORD');
		gotoxy(24,6); write('Akan menghapus record nomor: ');
		repeat
			gotoxy(54,6); write(' ':5);
			gotoxy(54,6); readln(i);
		until i in [1..n];
		gotoxy(20,6); writeln(' ':50);
		gotoxy(28,6); writeln('ISI RECORD NOMOR: ',i:3);
		seek(bks,i-1); read(bks,nm); writeln;
		cetak_rekaman(nm,23,9);
		gotoxy(25,22); write('Jadi di hapus? <Y>a/<T>idak: ');
		if upcase(readkey) = 'Y' then
			begin
				gotoxy(19,22);
				write('TUNGGU SEBENTAR, SEDANG E..E.. NICH');
				assign(bb,'BUFFER'); rewrite(bb);
				if i = 1  then
					begin
						seek(bks,1);
						for j := 1 to n-1 do
							pindahkan
					end
				else if i = n then
					begin
						seek(bks,0);
						for j := 0 to n-2 do
							pindahkan
					end
				else
					begin
						seek(bks,0);
						for j := 0 to n-1 do
							if j <> i-1 then pindahkan
							else seek(bks,i)
					end;
				close(bks); close(bb);
				erase(bks); rename(bb,nb);
				assign(bks,nb); reset(bks)
		end;
	gotoxy(10,22); writeln(' ':65);
	gotoxy(23,22); write('Akan menghapus lagi? <Y>a/<T>idak: ');
	until upcase(readkey) <> 'Y';
	konversi_nilai(bks)
end;

procedure cetak_nilai (var bks : d_nilai);
var nilai_mhs : nilai;
		i,j,n			: integer;
		c					: char;
begin
	n := filesize(bks); seek(bks,0);
	clrscr;
	writeln(' ':18,'DAFTAR NILAI UJIAN "PEMROGRAMAN PASCAL"');
	writeln(' ':18,garis(39,45));
	writeln; writeln(garis(74,55));
	write('| No | Nama Mahasiswa | NO Mhs | N1 |');
	writeln(' N2 | N3 | N4 | N5 | Rata2 | Nilai |');
	writeln(garis(74,45));
	for j := 1 to n do
		begin
			read(bks,nilai_mhs);
			with nilai_mhs do
				begin
					gotoxy(1,wherey); write('| ',j:2,' | ',nama_mhs);
					gotoxy(23,wherey); write(' | ',no_mhs:5,' | ');
					for i := 1 to jumlah_mk do
						begin
							gotoxy(35+5*(i-1),wherey); write(nilai_ujian[i]:2,' | ')
						end;
					gotoxy(60,wherey);
					writeln(n_rata:5:2,' |  ',nilai_huruf,'  |')
				end
		end;
	writeln(garis(74,45));
	gotoxy(20,23); write('TEKAN <RETURN> UNTUK MENERUSKAN...');
	c := readkey
end;


procedure selesai (var bks : d_nilai);
begin
	close(bks);
	clrscr;
	kotak(1,1,78,23,0);
	gotoxy(23,11); writeln('TERIMA KASIH ATAS KEPERCAYAAN ANDA');
	gotoxy(23,12); writeln('			MENGGUNAKAN PROGRAM INI');
	gotoxy(23,13); writeln('	SELAMAT BELAJAR,	SUKSES SELALU');
	gotoxy(23,16); writeln('      	sanijiro',chr(3),chr(3),' si kaki angin');
	kotak(20,9,60,15,0)
end;


begin
	repeat
		clrscr; pilihan := menu;
		case pilihan of
		'A' : pilih_berkas(daf_nilai,nama_berkas);
		'B' : isi_data(daf_nilai,nama_berkas);
		'C' : edit_data(daf_nilai,nama_berkas);
		'D' : sisip_rekaman(daf_nilai,nama_berkas);
		'E' : hapus_rekaman(daf_nilai,nama_berkas);
		'F' : cetak_nilai(daf_nilai);
		'G' : selesai(daf_nilai)
	end;
	until pilihan = 'G'
end.



7)
program pegawai;
uses crt;
type pegawai = record
				nama 							: string[20];
				nomor,status 			: string[5];
				pokok,tunj				: longint;
				lembur,total,jam 	: longint;
			end;

var cek,kode 	: char;
		datain    : array[1..50] of pegawai;
		n,i				: integer;
		respon		: boolean;
		jumlah		: longint;

procedure garis(x1,x2,y1 : integer;str : string);
var n,i	: integer;
begin
	n := x2-x1;
	for i := 0 to n-1 do
	begin
		gotoxy(x1+i,y1);write(str);
	end;
end;

procedure writexy(x,y : integer; str : string);
begin
	gotoxy(x,y);write(str);
end;

function allcaps (str : string) : string;
var x : integer;
begin
	for x := 1 to length(str) do
	str[x] := upcase(str[x]);
	allcaps := str;
end;

procedure input;
begin
	textcolor(cyan);
	i := 1;
	repeat
		with datain[i] do
		begin
			clrscr;
			writexy(10,5,'PT. Extreme');
			writexy(10,6,'Jakarta');
			garis(4,78,7,#205);
			gotoxy(60,8);writeln('Data ke- ',i);
			inc(i);
			writexy(10,9,'Nama					: ');readln(nama);
			nama := allcaps(nama);
			repeat
				writexy(10,10,'NIP				: ');readln(nomor);
				nomor := allcaps(nomor);
				if nomor[1] = 'A' then kode := '1'
					else if nomor[1] = 'B' then kode := '2';
				case kode of
					'1' :
					begin
						status := 'Tetap';
						pokok := 350000;
						tunj := 400000;
					end;
					'2' :
					begin
						status := 'Honor';
						pokok := 250000;
						tunj := 200000;
					end;
				end;
			until (kode = '1') or (kode = '2');
			gotoxy(10,11);writeln('Status			: ',status);
			gotoxy(10,12);writeln('Gaji pokok	: ',pokok);
			gotoxy(10,13);writeln('Tunjangan	: ',tunj);
			repeat
				writexy(10,14,'Jam lembur	: ');readln(jam);
			until jam < 10;
			lembur := 15000 * jam;
			total := pokok + tunj + lembur;
			jumlah := total + jumlah;
		end;
			repeat
				writexy(33,24,'Masukkan data lagi (y/t) : ');
				cek := readkey; cek := upcase(cek);
			until (cek = 'Y') or (cek = 'T');
			case cek of
				'Y': respon := true;
				'T': respon := false;
			end;
	until not respon;
end;

procedure tampil;
begin
	clrscr;
	textcolor(cyan);
	writexy(10,2,'PT. Extreme');
	writexy(10,3,'Daftar Pegawai');
	garis(4,80,4,#196);
	writexy(5,5,'Nama');
	writexy(19,5,'NIP');
	writexy(27,5,'Status');
	writexy(38,5,'Gaji');
	writexy(47,5,'Tunjangan');
	writexy(61,5,'Lembur');
	writexy(74,5,'Total');
	for n := 1 to i-1 do
		begin
			with datain[n] do
			begin
				writexy(5,6+n,nama);
				gotoxy(18,6+n);write(nomor);
				gotoxy(27,6+n);write(status);
				gotoxy(33,6+n);write(pokok:10);
				gotoxy(45,6+n);write(tunj:10);
				gotoxy(57,6+n);write(lembur:10);
				gotoxy(70,6+n);write(total:10);
			end;
		end;
	garis(4,80,6,#205);
	garis(4,80,wherey+i,#196);
end;

begin
	textbackground(black);
	clrscr;
	repeat
		begin
			clrscr;
			input;
			tampil;
			writexy(61,wherey+1,'Jumlah = ');
			gotoxy(70,wherey);write(jumlah:10);
			repeat
				begin
					writexy(35,24,'Input Lagi (y/t) : ');
					cek := readkey; cek := upcase(cek);
				end;
			until (cek = 'Y') or (cek = 'T');
			case cek of
				'Y': respon := true;
				'T': respon := false;
			end;
		end;
	until not respon;
end.


8)
program peg2;
uses crt;
const	tot_minggu	= 25;
			tot_bulan		= 100;
			harga_jam		=	2000;
			line				= '-------------------------------------------------------------------------------';
type status = (e,p,d);
			gaji  = record
				nama 	: string[5];
				id		: string[3];
				dept	: string[5];
				case st : status of
				e : (sal,sal1,tot_work,tot_ot,tot,allow : longint);
				p : (sal_hour2,total_work2,total_ot,tot2,sal2 : longint; allow2 : char);
				d : (sal_hour3,total_work3,sal3 : longint; allow3,tot3 : char);
			end;
			tot_emp = 1..50;
			table = array[tot_emp] of gaji;

var tabel_salary : table;
		total : tot_emp;

procedure input(var tab : table;n : tot_emp);
var i,ij : byte;
		code : char;
begin
	for i := 1 to n do
		with tab[i] do
			begin
				writeln;
				writeln(' ':5,i:2,'# record data');
				writeln('-------------------------');writeln;
				write('Nama 			: ');readln(nama);
				write('No. Id			: ');readln(id);
				write('Divisi			: ');readln(dept);
				for ij := 1 to length(nama) do
				nama[ij] := upcase(nama[ij]);
				for ij := 1 to length(id) do
				id[ij] := upcase(id[ij]);
				for ij := 1 to length(dept) do
				dept[ij] := upcase(dept[ij]);
					repeat
						write('Status pegawai [A/B/C] : ');readln(code);
						code := upcase(code);
						gotoxy(wherex+33,wherey-1);
					until code in ['A','B','C'];
				case code of
				'A' : begin
								writeln('Peg. tetap');
								st := e;
								write('Waktu kerja sebulan : ');readln(tot_work);
								write('Gaji sebulan 			 : ');readln(sal1);
							end;
				'B' : begin
								writeln('Peg. sementara');
								st := p;
								write('Gaji per-jam 				:	');readln(sal_hour2);
								write('Waktu kerja seminggu : ');readln(total_work2);
							end;
				'C' : begin
								writeln('Pekerja harian');
								st := d;
								write('Bayaran per-jam			: ');readln(sal_hour3);
								write('Waktu kerja per-hari : ');readln(total_work3);
							end;
				end;
			end;
end;

procedure hitung(var tab : table;n : tot_emp);
var i : byte;
begin
	for i := 1 to total do
		with tab[i] do
			begin
				case st of
					e : begin
							allow := 500000;
							if (tot_work > tot_bulan) then
								begin
									tot_ot := tot_work - tot_bulan;
									tot := tot_ot * harga_jam;
									sal := sal1 + tot + 500000;
								end
							else
								begin
									tot := 0;
									sal := sal1 + 500000;
								end;
							end;
					p : begin
							allow2 := '-';
							if (total_work2 > tot_minggu) then
								begin
									total_ot := total_work2 - tot_minggu;
									tot2 := total_ot * harga_jam;
									sal2 := tot_minggu * sal_hour2 + tot2;
								end
							else
								begin
									tot2 := 0;
									sal2 := total_work2 * sal_hour2;
								end;
							end;
					d :	begin
								allow3 := '-';
								tot3 := '-';
								sal3 := total_work3 * sal_hour3;
							end;
				end;
			end;
end;

procedure cetak;
var i : byte;
begin
	clrscr;
	writeln(' ':15,'Daftar Karyawan PT. Mobisel Jakarta');
	writeln(' ':15,'-----------------------------------');writeln;
	writeln('No.  Name   Id.Num.   Div.   Status    Overtime	Allowance		Total Salary');
	writeln('-------------------------------------------------------------------------');
	for i := 1 to total do
		with tabel_salary[i] do
			begin
				gotoxy(1,i+5);write(i);
				gotoxy(5,i+5);write(nama);
				gotoxy(11,i+5);write(id);
				gotoxy(20,i+5);write(dept);
				gotoxy(27,i+5);
				case st of
					e : begin
								write('Peg. tetap',' ':5,tot);
								gotoxy(51,i+5);write(allow);
								gotoxy(62,i+5);write(sal);
							end;
					p : begin
								write('Peg. sementara',' ':2,tot2);
								gotoxy(51,i+5);write(allow2);
								gotoxy(62,i+5);write(sal2);
							end;
					d : begin
								write('Peg. harian',' ':6,tot3);
								gotoxy(51,i+5);write(allow3);
								gotoxy(62,i+5);write(sal3);
							end;
				end;
			end;
		writeln;write(line);
end;

begin
	clrscr;
	writeln('Input data pegawai');
	writeln('------------------');
	write('Total pegawai : ');readln(total);
	input(tabel_salary,total);
	hitung(tabel_salary,total);
	cetak;
end.



Enjoy programming pascal