Program Rental CD sederhana dengan pascal

program RENTAL_CD;
uses wincrt;
type info=^data_cd;
     data_cd=record
              kode    :string;
              judul   :string;
              jenis:string;
              peminjam :string;
              hargasewa:string;
              next   :info;
     end;
type alamat=^info;
var
 awal,akhir:info;
 pil:char;
 x,y,z:integer;
 head:info;
 pilihan,stop:char;
 procedure buat_data;
begin
 awal:=nil;
end;

function baca:info;
var
 x:info;
begin
 new(x);
 with x^do
 begin
  gotoxy(25,4);writeln('  MASUKKAN DATA CD  ');
  gotoxy(23,5);writeln('÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷÷');
  gotoxy(20,7);write('KODE CD       : ');readln(kode);
  gotoxy(20,8);write('JUDUL CD      : ');readln(judul);
  gotoxy(20,9);write('JENIS CD      : ');readln(jenis);
  gotoxy(20,10);write('PEMINJAM      : ');readln(peminjam);
  gotoxy(20,11);write('HARGA SEWA CD : ');readln(hargasewa);
  next:=nil;
 end;
 baca:=x;
end;

procedure tambah(x:integer);
var
 new:info;
begin
 clrscr;
 if x<>0 then
 begin
  new:=baca;
  if awal=nil then
   awal:=new
  else
   akhir^.next:=new;
   akhir:=new;
 end;
end;

procedure hapus;
begin
 clrscr;
 if awal<>nil then
 begin
  awal:=awal^.next;
  gotoxy(21,20);writeln('DATA PERTAMA TELAH TERHAPUS');
  gotoxy(35,25);writeln('TEKAN ENTER! ');
 end
 else
 begin
  clrscr;
  gotoxy(25,20);writeln('TIDAK ADA DATA UNTUK DIHAPUS');
  gotoxy(35,25);writeln('TEKAN ENTER! ');
 end;
 repeat until keypressed;
end;

procedure search;
var
 found:boolean;
 no_kode:string;
 x:info;
begin
 clrscr;
 x:=awal;
 if x=nil then
 begin
  gotoxy(25,20);writeln('TIDAK ADA DATA RENTAL CD');
  gotoxy(35,25);writeln('TEKAN ENTER!');
  readln;
 end
 else
 begin
  found:=false;
  gotoxy(15,15);write('MASUKKAN KODE CD YANG ANDA CARI : ');readln(no_kode);
  while (not found) and(x<>nil) do
  begin
   if x^.kode=no_kode then
   begin
    clrscr;
    gotoxy(15,9);writeln('DATA CD BERDASARKAN KODE : ',no_kode,' ADALAH');
    gotoxy(20,11);write('KODE CD                 : ',x^.kode);
    gotoxy(20,12);write('JUDUL CD                : ',x^.judul);
    gotoxy(20,13);write('JENIS CD                : ',x^.jenis);
    gotoxy(20,14);write('PEMINJAM                : ',x^.peminjam);
    gotoxy(20,15);write('HARGA SEWA CD           : ',x^.hargasewa);
    gotoxy(13,20);writeln('TEKAN ENTER!');
    found:=true;
   end;
   x:=x^.next;
  end;
  if not found then
  begin
   clrscr;
   gotoxy(13,7);writeln('TIDAK ADA DATA CD SESUAI KODE CD YANG ANDA MASUKKAN');
   gotoxy(35,15);writeln('TEKAN ENTER!');
  end;
  readln;
 end;
end;

procedure traversal;
var
 x:info;
 y:integer;
begin
 clrscr;
 y:=1;
 x:=awal;
 if x=nil then
 begin
  gotoxy(13,7);writeln('TIDAK ADA DATA CD SESUAI KODE CD YANG ANDA MASUKKAN');
  gotoxy(35,15);writeln('TEKAN ENTER!');
 end
 else
 begin
 gotoxy(10,5);writeln('DATA RENTAL CD YANG TELAH DIMASUKKAN');
 gotoxy(9,7); writeln('+++++++++++++++++++++++++++++++++++++++++');
  while x<>nil do
  begin
  writeln;
  writeln('DATA RENTAL CD KE: ',y);writeln;
   writeln('KODE CD          : ',x^.kode);
   writeln('JUDUL CD         : ',x^.judul);
   writeln('JENIS CD         : ',x^.jenis);
   writeln('PEMINJAM         : ',x^.peminjam);
   writeln('HARGA SEWA CD    : ',x^.hargasewa);
   writeln;
   x:=x^.next;
   inc(y);
  end;
 end;
 repeat until keypressed;
end;



begin
 repeat
  clrscr;
  gotoxy(10,2); writeln('_______________________SELAMAT DATANG____________________');
  gotoxy(10,10); writeln('@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@');
  gotoxy(10,11); writeln('@           +++++++ DAFTAR MENU UTAMA ++++++           @');
  gotoxy(10,12); writeln('@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@');
  gotoxy(10,13); writeln('@    1.º  MEMBUAT DAFTAR DATA RENTAL CD                @');
  gotoxy(10,14); writeln('@    2.º  MEMASUKKAN DATA RENTAL CD                    @');
  gotoxy(10,15); writeln('@    3.º  MENCARI DATA CD BERDASARKAN KODE CD          @');
  gotoxy(10,16); writeln('@    4.º  MENAMPILKAN SELURUH DATA RENTAL CD           @');
  gotoxy(10,17); writeln('@    5.º  MENGHAPUS DATA PERTAMA RENTAL CD             @');
  gotoxy(10,18); writeln('@    6.º  KELUAR                                       @');
  gotoxy(10,19); writeln('@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@');
  gotoxy(10,22);write('SILAHKAN MASUKKAN PILIHAN ANDA SESUAI DENGAN DAFTAR MENU : ');
  readln(pilihan);
  clrscr;
  case pilihan of
  '1': begin
            buat_data;
            gotoxy(20,10);writeln('ANDA TELAH MEMBUAT DAFTAR DATA RENTAL CD!');
            gotoxy(35,15);writeln('TEKAN ENTER! ');
            readln;
  end;
  '2': begin
            repeat
             clrscr;
             tambah(1);
             gotoxy(10,15);write('ANDA INGIN MEMASUKKAN DATA RENTAL CD? LAGI [Y/T]');
             stop:=readkey;
            until upcase(stop)='T';
           end;
  '3': begin
            clrscr;
            search;
           end;
  '4': traversal;

  '5': hapus;
  end;
 until upcase(pilihan)='6';
end.

Program Telegram Dengan Pascal

program Telegram;
uses crt;
var
FileName : String;
f,FileHasil : text;
s,t : string;
jmlKta : integer;
jmlTndBca : integer;
akhir : boolean;

function UbahTandaBaca(k : char):string;
var
i : integer;
s : string;
begin
i := ord(k);
case i of
33 : begin
s := ' seru';
inc(jmltndbca);
end;
34 : begin
s := ' petik dua';
inc(jmltndbca,2);
end;
37 : begin
s := ' persen';
inc(jmltndbca);
end;
39 : begin
s := ' petik satu';
inc(jmltndbca,2);
end;
40 : begin
s := ' buka kurung';
inc(jmltndbca,2);
end;
41 : begin
s := ' tutup kurung';
inc(jmltndbca,2);
end;
44 : begin
s := ' koma';
inc(jmltndbca);
end;
46 : begin
s := ' titik';
inc(jmltndbca);
akhir := true;
end;
58 : begin
s := 'titik dua';
inc(jmltndbca,2);
end;
59 : begin
s := 'titik koma';
inc(jmltndbca,2);
end;
else
s := k;
end;
UbahTandaBaca := s;
end;

function ubahKeTelegram(s:string):string;
var
i : integer;
t : string;
tm : string;
bru : boolean;
begin
bru := true;
t := '';
for i := 1 to length(s) do
begin
tm := UbahTandaBaca(s[i]);

if (tm = ' ') or (length(tm)>1) then
begin
if bru then
begin
inc(jmlkta);
bru := false;
end;
end else
begin
bru := true;
end;
t := t + tm;
if akhir then
break;
end;
ubahKeTelegram := t;
end;

begin
clrscr;
write('Input Nama File :');
readln(FileName);
clrscr;
assign(f,FileName);
reset(f);
readln(f,s);
assign(FileHasil,'Hasil.txt')
rewrite(FileHasil);
while (not eof(f)) and (not akhir) do
begin
t:=ubahKeTelegram(s);
writeln(t);
writeln(FileHasil,t);
readln(f,s);
end;
if not akhir then
begin
t := ubahKeTelegram(s);
writeln(t);
writeln(FileHasil,t);
end;
writeln ('*****************************************************');
writeln('Jumlah Kata yang bukan merupakan tanda baca = ',jmlkta);
writeln('Jumlah Kata yang merupakan tanda baca = ',jmltndbca);
writeln('Biaya Rp. 10 * ',jmlkta, ' = ',jmlkta*10);

close(FileHasil);
close(f);
readln;
end.