program Kriptography;
Uses wincrt;
var
i, pilihan : byte;
kata : string;
label
a, b, c ;
begin
gotoxy(25,5);writeln(‘=========================================’);
gotoxy(25,6);writeln(‘ Contoh Program Enkripsi & Dekripsi ‘);
gotoxy(25,7);writeln(‘=========================================’);
gotoxy(33,8);writeln(‘ == By ==’);
gotoxy(25,9);writeln(‘=========================================’);
gotoxy(32,10);writeln(‘ narkovic ‘);
gotoxy(32,11);writeln(‘ STT DUTA BANGSA@2009 – cikarang ‘);
gotoxy(25,16);writeln(‘=========================================’);
gotoxy(38,17); readkey;
a:
clrscr;
gotoxy(25,5);writeln(‘=========================================’);
gotoxy(35,6);writeln(‘ MENU ‘);
gotoxy(25,7);writeln(‘=========================================’);
gotoxy(27,8);writeln(‘1. Enkripsi & Dekripsi’);
gotoxy(27,9);writeln(‘2. Exit ‘);
gotoxy(27,10);write(‘Pilihan Anda : ‘);readln(pilihan);
case pilihan of
1: begin
clrscr;
gotoxy(25,4); write (‘Tuliskan kata : ‘); readln(kata);
gotoxy(24,5); writeln(‘=========================================’);
gotoxy(30,8); writeln(‘program enkripsi’);
gotoxy(24,9); writeln(‘=========================================’);
for i:=1 to length(kata) do ;
begin
kata[i]:=chr(ord(kata[i])+6);
end;
gotoxy(24,10); writeln(‘hasil enkripsi : ‘,kata);
gotoxy(24,11); writeln(‘=========================================’);
gotoxy(24,13);write(‘tekan enter untuk mendekripsi’);readln;
gotoxy(30,15); writeln(‘program dekripsi’);
gotoxy(24,16); writeln(‘=========================================’);
for i:=1 to length(kata) do
begin
kata[i]:=chr(ord(kata[i])-6);
end;
gotoxy(24,17); writeln(‘hasil dekripsi : ‘,kata);
gotoxy(24,18); writeln(‘=========================================’);
gotoxy(21,20); write(‘Tekan enter untuk kembali ke menu’); readln;
goto a;
end;
2: begin
clrscr;
gotoxy(33,12); writeln(‘ ..::::.. ‘);
gotoxy(33,13); writeln(‘ Terima kasih ‘);
gotoxy(39,14); readkey;
donewincrt;
end;
end;
end.
Program untuk mendifinisikan array buah berisi 3 deret dengan type string *)
(*menginisialisasi isi inputan buah dari user*)
(*Seluruh isi buah berurutan mulai dari deret 1 sampai dengan 3*)
program array_dengan_while_do;
uses wincrt; {untuk tp for dos ganti libnya dengan crt}
var
buah :array[1..3] of string;
i:integer;
begin
i:=1;
while i<4 do {membatasi inputan sampai dengan 3 deret}
begin
write(‘Masukkan buah buahan ke’,i,’:’);readln(buah[i]);
i :=i+1;
end;
(*menampilkan isi Buah secara berurutan*)
clrscr;
writeln(‘+++++++++++++++++++++++++++++++++++++++++++++’);
writeln(‘Isi buah buahan yang dimasukkan tadi adalah :’);
writeln(‘+++++++++++++++++++++++++++++++++++++++++++++’);
i :=1;
while (i<4) do {membatasi keluaran sampai dengan 3 deret}
begin
writeln(‘Buah ke’,i,’:’,buah[i]);
i :=i+1;
end;
end.
program pembuatan_record;
uses crt;
procedure garis;
begin
writeln(’==============================================’);
end;
type
reckaryawan=record
jab,nip,nama:string;
gol:integer;
gapok,tunj:real;
end;
var pegawai:reckaryawan;
total:real;
begin
clrscr;
writeln(’ LAPORAN PERHITUNGAN GAJI KARYAWAN PT MAJU TAK GENTAR’);
garis;
writeln;
write(’Masukan NIP Karyawan : ‘);readln(pegawai.nip);
write(’Masukan Nama Karyawan : ‘);readln(pegawai.nama);
write(’Golongan[1/2/3] : ‘);readln(pegawai.gol);
garis;
case pegawai.gol of
1:
begin
pegawai.jab:=’Staf dan Tetap’;
pegawai.gapok:=900000;
end;
2:
begin
pegawai.jab:=’Staf dan Kontrak’;
pegawai.gapok:=700000;
end;
3:
begin
pegawai.jab:=’Kontrak’;
pegawai.gapok:=500000;
end;
end;
if pegawai.jab=’Staf dan Tetap’ then
pegawai.tunj:=25/100*pegawai.gapok
else
if pegawai.jab=’Staf dan Kontrak’ then
pegawai.tunj:=10/100*pegawai.gapok
else
pegawai.tunj:=0;
total:=(pegawai.gapok)+(pegawai.tunj);
writeln(’Jabatan Karyawan : ‘,pegawai.jab);
writeln(’Gaji Pokok : ‘,pegawai.gapok:8:0);
writeln(’Tunjangan : ‘,pegawai.tunj:8:0);
garis;
writeln(’Total Gaji Karyawan : ‘,total:8:0);
readln;
end.
program pembuatan_record;
uses crt;
procedure garis;
begin
writeln(’==============================================’);
end;
type
reckaryawan=record
jab,nip,nama:string;
gol:integer;
gapok,tunj:real;
end;
var pegawai:reckaryawan;
total:real;
begin
clrscr;
writeln(’ LAPORAN PERHITUNGAN GAJI KARYAWAN PT MAJU TAK GENTAR’);
garis;
writeln;
write(’Masukan NIP Karyawan : ‘);readln(pegawai.nip);
write(’Masukan Nama Karyawan : ‘);readln(pegawai.nama);
write(’Golongan[1/2/3] : ‘);readln(pegawai.gol);
garis;
; case pegawai.gol of
1:
begin
pegawai.jab:=’Staf dan Tetap’;
pegawai.gapok:=900000;
end;
2:
begin
pegawai.jab:=’Staf dan Kontrak’;
pegawai.gapok:=700000;
end;
3:
begin
pegawai.jab:=’Kontrak’;
pegawai.gapok:=500000;
end;
end;
if pegawai.jab=’Staf dan Tetap’ then
pegawai.tunj:=25/100*pegawai.gapok
else
if pegawai.jab=’Staf dan Kontrak’ then
pegawai.tunj:=10/100*pegawai.gapok
else
pegawai.tunj:=0;
total:=(pegawai.gapok)+(pegawai.tunj);
writeln(’Jabatan Karyawan : ‘,pegawai.jab);
writeln(’Gaji Pokok : ‘,pegawai.gapok:8:0);
writeln(’Tunjangan : ‘,pegawai.tunj:8:0);
garis;
writeln(’Total Gaji Karyawan : ‘,total:8:0);
readln;
end.
1: Program Menghitung_Luas_dan_Keliling;
2: var alas, tinggi, sisimiring, luas, keliling: real;
3: Begin
4: writeln(‘MENGHITUNG LUAS DAN KELILING SEGITIGA’);
5: writeln(‘————————————-’);
6: write(‘Masukkan alas : ‘);readln(alas);
7: write(‘Masukkan tinggi : ‘);readln(tinggi);
8: luas:= 0.5*alas*tinggi;
9: sisimiring:=sqrt(sqr(alas)+sqr(tinggi));
10: keliling:= alas+tinggi+sisimiring;
11: writeln;
12: writeln(‘luas segitiga : ‘, luas:0:2);
13: writeln(‘keliling segitiga : ‘, keliling:0:2);
14: readln;
Procedure Assign (var f, NamaFile: string);
Procedure Rewrite (var f);
Procedure Reset(var f);
Procedure Close(var f);
Procedure Write(var f, var1 [, var2, …, varn]);
Procedure Read(var f, var1 [, var2, …, varn]);
Function Eof(var f): Boolean;
Function FilePos(var f): longint;
Function FileSize(var f): longint;
Procedure Seek(var f, N: longint);
Procedure Truncate(var f);
Function Eoln(var f:text):boolean;
Function SeekEoln(var f:text):boolean;
Function SeekEof(var f:text):boolean;
Procedure Flush(var f:text);
Procedure SetTextBuf(var f:text, var buf[, ukuran: word]);
Penjelasannya di bawah ini:
Pengacuan suatu file melalui variabel file. Setiap ingin melakukan manipulasi atau yang lainya, harus melakukan ini dulu
Apabila file tidak ada, maka file itu akan terbentuk. Tetapi bila ada, maka isi file itu akan hilang.
Membuka file yang sudah ada, tetapi tidak menghapus isinya
Menutup suatu file (lakukan setelah setelah file itu di manipulasi)
Mengisi file dengan data. (apabila filenya bertipe text, maka writeln bisa digunakan)
Membaca isi file. (apabila filenya bertipe text, maka readln bisa digunakan untuk membaca perbaris)
Memeriksa akhir file. Hasilnya akan True bila posisinya diakhir dan False apabila tidak diakhir. Biasa digunakan untuk membaca/mengubah data.
Mengetahui posisi file sekarang. Penomoran data mulai dari 0.
Mengetahui jumlah data yang ada.
Memindahkan posisi file. Data pertama bernilai 0.
Menghapus data dari posisi sekarang sampai akhir file
Menghasilkan status akhir baris file teks. Nilainya akan true kalau diakhir baris atau Eof memberikan nilai True.
Sama seperti Eoln, tetapi spasi dan tab diabaikan.
Sama seperti Eof, tetapi mengabaikan spasi, tab ataupun tanda akhir baris
Mengosongkan penyangga (buffer) file teks yang dibuka
untuk keluaran (perekaman). Prosedur ini menjamin bahwa data yang direkam benar-benar telah disimpan ke file (normalnya, data akan disimpan ke file kalau penyangga file sudah penuh)
Menentukan ukuran penyangga yang digunakan file.
Dipanggil setelah assign. Semakin besar semakin cepat pemrosesannya,
defaultnya 128 byte.
Bila ada tulisan var f, itu artinya variabel file.
NamaFile artinya nama databasenya (bila perlu pathnya).
var1 artinya variabel yang bersesuaian dengan tipe filenya.
N artinya data ke-N. Bila dalam bentuk fungsi, maka ia akan mengembalikan nilai tergantung jenisnya (apabila boolean maka akan mengembalikan True atau False, bila longint akan mengembalikan angka).
Waahhh… banyak yach? emang gitulah… Bahkan ada
lagi yang lain loh untuk file tak bertipe. Prosedur
dan fungsi di atas gua ambil dari bukunya pak Ir. Abdul Kadir, Pemrograman Pascal. Bukunya bagus juga, ada 2 jilid tebel-tebel tapinya 😀 . O iya, di sini gua gak ngasih contohnya loh… abis kepanjangan kalo ditulis di sini.Untuk contoh-contoh penggunaan prosedur dan fungsi di atas bisa di lihat di Program 9.
Program Menghitung_Luas_dan_Keliling;
var alas, tinggi, sisimiring, luas, keliling: real;
Begin
writeln(‘MENGHITUNG LUAS DAN KELILING SEGITIGA’);
writeln(‘————————————-’);
write(‘Masukkan alas : ‘);readln(alas);
write(‘Masukkan tinggi : ‘);readln(tinggi);
luas:= 0.5*alas*tinggi;
sisimiring:=sqrt(sqr(alas)+sqr(tinggi));
keliling:= alas+tinggi+sisimiring;
writeln;
writeln(‘luas segitiga : ‘, luas:0:2);
writeln(‘keliling segitiga : ‘, keliling:0:2);
readln;
end.
Program JenisBilangan;
var bil: longint;
begin
writeln(‘MENENTUKAN JENIS BILANGAN’);
writeln(‘————————-’);
write(‘Masukkan angka: ‘);readln(bil);
if ((bil=2) or (bil=3) or (bil=5) or (bil=7)) then
write(‘bilangan prima’)
else if ((bil mod 2 <> 0) and (bil mod 3 <> 0) and (bil mod 5 <> 0) and (bil mod 7 <> 0)) then
write(‘bilangan prima’)
else write(‘bukan bilangan prima’);
if bil mod 2 = 0 then
writeln(‘ dan genap’)
else
writeln(‘ dan ganjil’);
readln;
end.
Program BilanganTerbesar;
Var bil1, bil2, bil3 :real;
Begin
Write(‘Masukkan Bilangan Pertama : ‘);Readln(bil1);
Write(‘Masukkan Bilangan Kedua : ‘);Readln(bil2);
Write(‘Masukkan Bilangan Ketiga : ‘);Readln(bil3);
If (bil1=bil2) and (bil2=bil3) then
Writeln(‘Semua bilangan yang anda masukkan sama bbesar ‘,bil1:0:0)
Else If (bil1=bil2) or (bil1=bil3) or (bil2=bil3) then
Begin
If bil1=bil2 then
Begin
Writeln(‘Bilangan Pertama dan Kedua Adalah Sama’);
If Bil1 < bil3 then
Writeln(‘Bilangan Terbesar Adalah ‘,bil3:0:0)
Else
Writeln(‘Bilangan Terbesar Adalah ‘,bil1:0:0)
End
Else If bil1=bil3 then
Begin
Writeln(‘Bilangan Pertama dan Ketiga Adalah Sama’);
If Bil1 < bil2 then
Writeln(‘Bilangan Terbesar Adalah ‘,bil2:0:0)
Else
Writeln(‘Bilangan Terbesar Adalah ‘,bil1:0:0)
End
Else If bil2=bil3 then
Begin
Writeln(‘Bilangan Kedua dan Ketiga Adalah Sama’);
If Bil1 < bil3 then
Writeln(‘Bilangan Terbesar Adalah ‘,bil3:0:0)
Else
Writeln(‘Bilangan Terbesar Adalah ‘,bil1:0:0)
End
End
Else If bil1 > bil2 then
begin
If bil1 > bil3 then
Writeln(‘Bilangan terbesar adalah ‘,bil1:0:0)
Else
Writeln(‘Bilangan terbesar adalah ‘,bil3:0:0);
End
Else If bil1 < bil2 then
Begin
If bil2 > bil3 then
Writeln(‘Bilangan terbesar adalah ‘,bil2:0:0)
Else
Writeln(‘Bilangan terbesar adalah ‘,bil3:0:0);
End;
readln;
End.
1: Program Pengurutan;
2: var i, j: integer;
3: k : longint;
4: a: array[1..5] of longint;
5: begin
6: writeln(‘PROGRAM MENGGURUTKAN ANGKA’);
7: writeln(‘————————–’);
8: for i:=1 to 4 do
9: begin
10: write(‘Masukkan bilangan ke- ‘, i, ‘ : ‘);readln(a[i])
11: end;
12: for j:=2 to 4 do
13: begin
14: k:=a[j];
15: i:=j-1;
16: while (i>0) and (a[i]>k) do
17: begin
18: a[i+1]:=a[i];
19: i:=i-1;
20: end;
21: a[i+1]:=k
22: end;
23: for i:=1 to 4 do
24: writeln(a[i]);
25: readln;
26: end.
1: Program BintangTangga;
2: const akhir=18;
3: var baris, kolom: integer;
4: begin
5: for baris:=1 to akhir do
6: begin
7: for kolom:=1 to baris do
8: write(‘*’);
9: writeln;
10: end;
11: readln;
12: end.
1: Program BintangKubus;
2: uses crt;
3: Var i, j, x, y:integer;
4: Begin
5: clrscr;
6: Write(‘Masukkan Dimensi Kubus: ‘);Readln(x);
7: y:=0;
8: For i:=1 to x do
9: Begin
10: for j:=1 to x do
11: Begin
12: y:=y+1;
13: write(y:4);
14: if y mod x=0 then
15: Writeln;
16: End;
17: End;
18: readkey;
19: End.
1: Program Gabung;
2: uses crt;
3: var pilih: integer;
4: Procedure luas;
5: {copy dan paste program 1}
6: end;
7: Procedure JenisBilangan;
8: {copy dan paste program 2}
9: end;
10: Procedure Pengurutan;
11: {copy dan paste program 4}
12: End;
13: begin {program utama}
14: repeat
15: clrscr;
16: writeln(‘ PILIHAN’);
17: writeln(‘——————————————-’);
18: writeln(‘ 1. Menghitung Luas’);
19: writeln(‘ 2. Jenis Bilangan’);
20: writeln(‘ 3. Pengurutan’);
21: writeln(‘ 4. Exit’);
22: writeln(‘——————————————-’);
23: writeln;
24: writeln;
25: write(‘ Pilih Angka untuk Memilih Pilihan : ‘);
26: readln(pilih);
27: case pilih of
28: 1 : luas;
29: 2 : JenisBilangan;
30: 3 : Pengurutan;
31: 4 : exit;
32: end;
33: until pilih = 4;
34: end.
1: Program Array_dan_Record;
2: type dmhs=record
3: nrp:string[10];
4: nama:string[25];
5: alamat:string[50];
6: end;
7: var data:array[1..3] of dmhs;
8: i:integer;
9: begin
10: for i:=1 to 3 do
11: begin
12: write(‘nrp : ‘);readln(data[i].nrp);
13: write(‘nama : ‘);readln(data[i].nama);
14: write(‘alamat : ‘);readln(data[i].alamat);
15: end;
16: writeln;
17: writeln(‘Data ditampilkan’);
18: for i:=1 to 3 do
19: begin
20: writeln(‘nrp : ‘, data[i].nrp);
21: writeln(‘nama : ‘, data[i].nama);
22: writeln(‘alamat : ‘, data[i].alamat);
23: end;
24: readln;
25: end.
1: var nama : string;
2: urutan, posisi: integer;
3: begin
4: nama:=’Dijas Keren’;
5: writeln(‘Yang ini delete’);
6: for urutan:=1 to 11 do
7: begin
8: posisi:= 13 – urutan;
9: delete(nama, posisi, 1);
10: writeln(nama);
11: end;
12: writeln;
13: nama:=’DijasKeren’;
14: writeln(‘Yang ini insert’);
15: writeln(‘Sebelum di Insert : ‘, nama);
16: insert(‘-’, nama, 6);
17: writeln(‘Setelah di Insert : ‘, nama);
18: readln;
19: end.
1: program pembalik_kata;
2: var kata,hasil,tmp:string; i:integer;
3: begin
4: write(‘Kata : ‘);readln(kata);
5: hasil:=”;
6: for i :=length(kata) downto 1 do
7: begin
8: tmp:=copy(kata,i,1);
9: hasil:=hasil+tmp;
10: end;
11: write(‘Dibalik ‘,hasil);
12: readln;
13: end.
1: Program Tutorial3_for;
2: var i: Integer;
3: Begin
4: For i:=1 to 5 do
5: writeln(‘ini yang ke ‘, i);
6: End.
1: Program Tutorial3_while;
2: var i: Integer;
3: Begin
4: i:=1;
5: while i < 5 do
6: begin
7: writeln(‘ini yang ke ‘, i);
8: i:=i+1;
9: end;
10: End.
1: Program Tutorial3_while;
2: var pilih: char;
3: Begin
4: i:=1;
5: repeat
6: writeln(‘ini yang ke ‘,i);
7: i:=i+1;
8: until i<0;
9: End
uses Crt;
var
x,y,z : longint;
lagi : char;
namak : string[20];
begin
lagi := ‘y’;
while (lagi = ‘y’) or (lagi = ‘Y’) do
begin
clrscr;
write(‘Siapa Nama Anda..?’); ReadLn(namak);
writeLn;
write(‘Hallo ‘,namak,’, Coba kamu’);
WriteLn(‘ masukan nilai x,y dan z ‘);
writeLn(‘pada operasi matematika ini.’);
writeLn;
writeLn(‘Operasi matematika X^2 + y^2 + z =….. ‘);
write(‘masukan nilai x..= ‘); ReadLn(x);
write(‘masukan nilai y..= ‘); ReadLn(y);
write(‘masukan nilai z..= ‘); ReadLn(z);
writeLn;
writeLn(‘nilai operasi x^2 + y^2 + z adalah : ‘,x*x+y*y+z);
writeLn;
write(‘Mau hitung lagi apa tidak (y/t), ‘,namak,’ ? ‘);
readLn(lagi);
end;
end.
Filed under: Pascal | Tagged: Pascal | Leave a comment »
Agusjakaswara's Blog 