UAS Arsip

program uasarsip;

{$APPTYPE CONSOLE}

uses
  SysUtils;
var
filestr: text;
c: array [1..100] of string ;
z,x:string;

poschar, p: integer;
zs,huruf: string;
awalspasi: boolean;


nc: integer;
k,cs: string;

m,n:integer;

begin
  { TODO -oUser -cConsole Main : Insert code here }

readln (x);
writeln;

{algoritma mengambil kalimat}
awalspasi:= false;
p:= length (x);
poschar:= 1;
while poschar <= p do
  begin
    huruf:= copy (x, poschar, 1);
    if huruf=' ' then zs:= ''
    else
     if huruf='/' then
       if awalspasi = false then
       begin
         z:= zs;
         awalspasi:= true;
       end
        else z:= z + ' '+ zs
     else
     zs:=zs +huruf;
  poschar:=poschar+1;
  end;
writeln (z);

{algoritma memasukkan tiap kata ke dalam array}
nc:=1;
p:= length (z);
poschar:= 1;
while poschar <= p do
  begin
    k:= copy (z, poschar, 1);
    if k=' ' then
     begin
       c[nc]:=cs;
       cs:='';
       nc:=nc+1
     end
     else
      cs:= cs+k;
  poschar:=poschar+1;
  end;
c[nc]:=cs;

for i:= 1 to nc do
writeln (c[i]);
assign (filestr, 'c:/data/uasoutput.txt');
rewrite (filestr);
writeln(filestr, z);
for i:= 1 to nc do
begin
writeln (filestr,c[i]);
end;
close (filestr);

writeln;

readln;
end.

Algoritma 2 Contoh SOAL Pemrograman

program SoalUas2;

{$APPTYPE CONSOLE}

uses
  SysUtils;
var

filestr: text;
x,z:string;
jumlaha: array [1..700] of integer;
poschar,p: integer;
zs,huruf: string;
hurchar:char;
awalspasi: boolean;
ask,m:integer;

begin
  { TODO -oUser -cConsole Main : Insert code here }
assign (filestr,'c:/data/input.txt');
reset (filestr);
while not eof(filestr) do
begin
  readln (filestr, x);
  writeln (x);
end;
close (filestr);

writeln;

awalspasi:= false;
p:= length (x);
poschar:= 1;
while poschar <= p do
  begin
    huruf:= copy (x, poschar, 1);
    if huruf=' ' then zs:= ''
    else
     if huruf='/' then
       if awalspasi = false then
       begin
         z:= zs;
         awalspasi:= true;
       end
        else z:= z + ' '+ zs
      else
      zs:=zs +huruf;
  poschar:=poschar+1;
  end;
writeln (z);

assign (filestr,'c:/data/output.txt');
rewrite (filestr);
writeln(filestr, z);
close (filestr);

writeln;

p:= length (z);
for poschar:= 1 to p do
begin
  hurchar:= z[poschar];
  for m:= 32 to 126 do
  begin
    ask:= ord(hurchar);
    if m=ask then jumlaha[ask]:= jumlaha[ask]+1;
  end;
end;


for m:= 32 to 126 do
  begin
    if jumlaha[m]>0 then
    writeln (chr(m),' ',jumlaha[m]);
  end;


readln;


end.

Algoritma 1 Contoh SOAL Pemrograman

program soalUAS;

{$APPTYPE CONSOLE}

uses
  SysUtils;
var
filestr: text;
a: array [1..100] of string ;
jumlaha: array [1..100] of integer;
ketemu,poschar,p: integer;
zs,huruf: string;
awalspasi: boolean;
i,j:integer;
nilaicari:string;
z,x:string;

begin
  { TODO -oUser -cConsole Main : Insert code here }
assign (filestr,'c:/data/input.txt');
reset (filestr);
while not eof(filestr) do
begin
  readln (filestr, x);
  writeln (x);
end;
close (filestr);

writeln;

awalspasi:= false;
p:= length (x);
poschar:= 1;
while poschar <= p do
  begin
    huruf:= copy (x, poschar, 1);
    if huruf=' ' then zs:= ''
    else
     if huruf='/' then
       if awalspasi = false then
       begin
         z:= zs;
         awalspasi:= true;
       end
        else z:= z + ' '+ zs
      else
      zs:=zs +huruf;
  poschar:=poschar+1;
  end;
writeln (z);

assign (filestr,'c:/data/output.txt');
rewrite (filestr);
writeln(filestr, z);
close (filestr);

writeln;

p:= length (z);
poschar:= 2;
i:=2;

huruf:= copy (z, 1, 1);
a[1]:= huruf;
jumlaha[1]:= 1;
while poschar <=p do
begin
    huruf:= copy (z, poschar, 1);   {poschar +1}
    nilaicari:= huruf;
    j:=i-1;
  ketemu:=0;
  repeat
    begin
        if nilaicari = a[j] then
    begin
            jumlaha[j]:= jumlaha[j]+1;
      ketemu:=1;
    end;
        j:=j-1;
  end;
    until ((ketemu=1) or (j=0)) ;

  if ketemu=0 then
  begin
        a[i]:= nilaicari;
        jumlaha[i]:= 1;
        i:= i+1;

  end;
  poschar:= poschar +1;

end;



for j:= 1 to i-1 do
writeln (a[j],' ',jumlaha[j]);
readln;


end.

Algoritma Kombinasi Bilangan Bulat

Tuliskan algoritma untuk menampilkaan semua solusi bilangan bulat tidak negatif dari persamaan berikut:
x+y+z = 25
yang dalam hal ini, x>= 0, y>=0 dan z>=0

jawab:

var
x,y,z: integer;


begin
for x:= 0 to 5 do
    for y:= 0 to 5 do
        for z:= 0 to 5 do
         if x+y+z = 5 then
          writeln (x,' ',y,' ',z);

readln;
end.

Algoritma Menghitung Jarak Tanggal Menggunakan Pascal

program jaraktanggal;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type tanggal = record
                hh: integer;
                bb: integer;
                tt: integer;
               end;

var
tanggal1: tanggal;
tanggal2: tanggal;
Rtanggal: tanggal;
begin
  { TODO -oUser -cConsole Main : Insert code here }
write ('masukkan tanggal pertama berdasarkan hari-bulan-tahun: ');
read (tanggal1.hh); read(tanggal1.bb); read(tanggal1.tt);
write ('masukkan tanggal kedua berdasarkan hari-bulan-tahun: ');
read (tanggal2.hh); read(tanggal2.bb); readln(tanggal2.tt);

if tanggal2.hh>tanggal1.hh then
  Rtanggal.hh:= tanggal2.hh-tanggal1.hh
  else
  begin
    tanggal2.hh:=tanggal2.hh+ 30;
    rtanggal.hh:= tanggal2.hh-tanggal1.hh;
    tanggal2.bb:=tanggal2.bb-1
  end;

if tanggal2.bb> tanggal1.bb then
 rtanggal.bb:= tanggal2.bb-tanggal1.bb
 else
   begin
   rtanggal.bb:= tanggal2.bb+12-tanggal1.bb;
    tanggal2.tt:=tanggal2.tt-1;
    end;

Rtanggal.tt:= tanggal2.tt - tanggal1.tt;
writeln ('jarak tanggal pertama dengan kedua adalah, ', Rtanggal.hh,'-', Rtanggal.bb, '-', Rtanggal.tt);
readln;
end.

konversi ke hari menggunkan Pascal

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type hari = record
            jj: real;
            mm: real;
            dd: real;
            end;
var
h: hari;
konv: real;

begin
  { TODO -oUser -cConsole Main : Insert code here }
write ('jam: '); readln (h.jj);
write ('menit: '); readln (h.mm);
write ('deik: '); readln (h.dd);
konv:= (h.jj/24) + (h.mm/24*1/60) + (h.dd/24*1/60*1/60);
writeln (konv:2:2);
readln;
end.