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.