*Cách có sử dụng chương trình con:

uses crt;

var st:string;

{--------------chuong-trinh-con---------------}

function doixau(st:string):string;

var i,d:integer;

begin

   d:=length(st);

   for i:=1 to d do

     st[i]:=upcase(st[i]);

   doixau:=st;

end;

{-------------chuong-trinh-chinh---------------}

begin

clrscr;

write('Nhap xau:'); readln(st);

writeln('Xau doi sang chu hoa la: ',doixau(st));

readln;

end.

*Cách không sử dụng chương trình con:

uses crt;

var st:string;

i,d:integer;

begin

clrscr;

write('Nhap xau:'); readln(st);

d:=length(st);

for i:=1 to d do 

 st[i]:=upcase(st[i]);

writeln('Xau sau khi doi la: ',st);

readln;

end.

const fi='songuyen.txt';

fo='kluan.txt';

var f1,f2:text;

n:integer;

begin

assign(f1,fi); reset(f1);

assign(f2,fo); rewrite(f2);

readln(f1,n);

if n mod 2=0 then writeln(f2,'La so chan')

else writeln(f2,'La so le');

close(f1);

close(f2);

end.

Program HOC24;

var i,n: integer;

t: real;

begin

write('Nhap N: '); readln(n);

for i:=1 to n do t:=t+i;

write('Trung binh cong tu 1 den ',n,' la: ',t/n:1:2);

readln

end.

uses crt;

var i,n,t:integer;

begin

clrscr;

write('Nhap n='); readln(n);

t:=0;

for i:=1 to n do 

  t:=t+i;

writeln(t/n:4:2);

readln;

end.

Program HOC24;

var i,n,d,b,t: integer;

begin

write('Nhap so tu nhien N: '); readln(n);

d:=0; t:=0;

while n<>0 do

begin

b:=n mod 10;

d:=d+1;

t:=t+b;

n:=n div 10;

end;

writeln(n,' co ',d,' chu so');

write('Tong cac chu so chu n la: ',t);

readln

end.

*Cách khác

uses crt;

var n,i,d,x,y,t:integer;

st:string;

begin

clrscr;

write('Nhap n='); readln(n);

str(n,st);

d:=length(st);

writeln('So chu so cua ',n,' la: ',d);

t:=0;

for i:=1 to d do

  begin

val(st[i],x,y);

t:=t+x;

end;

writeln('Tong cac chu so cua ',n,' la: ',t);

readln;

end.

Program HOC24;

const fi='cau2.inp';

fo='cau2.out';

var dt,a,b,c: integer;

procedure ip;

begin

assign(f,fi);

reset(f); 

read(f,a,b,c);

close(f);

end;

procedure out;

begin

assign(f,fo);

rewrite(f);

dt:=b*b-4*a*c;

if dt>0 then write(f,'Phuong trinh co 2 nghiem phan biet');

if dt<0 then write(f,'Phuong trinh vo nghiem');

if dt=0 then write(f,'Phuong trinh co 2 nghiem kep');

close(f);

end;

begin

ip;

out;

end.

*Cách khác:

const fi='cau2.inp';

fo='cau2.out';

var f1,f2:text;

a,b,c,delta:real;

begin

assign(f1,fi); reset(f1);

assign(f2,fo); rewrite(f2);

readln(f1,a,b,c);

delta:=sqr(b)-4*a*c;

if delta<0 then writeln(f2,'Phuong trinh vo nghiem');

if delta=0 then writeln(f2,'Phuong trinh co nghiem kep la: ',-b/2*a:4:2);

if delta>0 then 

begin

writeln(f2,'Nghiem thu nhat la: ',(-b-sqrt(delta))/2*a:4:2);

writeln(f2,'Nghiem thu hai la: ',(-b+sqrt(delta))/2*a:4:2);

end;

close(f1);

close(f2);

end.

uses crt;

var a:array[1..100]of integer;

i,n,x,dem:integer;

begin

clrscr;

write('Nhap n='); readln(n);

for i:=1 to n do 

 begin

write('A[',i,']='); readln(a[i]);

end;

write('Nhap x='); readln(x);

dem:=0;

for i:=1 to n do 

if a[i]=x then inc(dem);

writeln(dem);

readln;

end.

const fi='bai25.inp';

fo='bai25.out';

var f1,f2:text;

a:array[1..1000]of integer;

i,n,dem,dem1,d:integer;

kt:boolean;

begin

assign(f1,fi); reset(f1);

assign(f2,fo); rewrite(f2);

readln(f1,n);

for i:=1 to n do 

  read(f1,a[i]);

dem:=0;

dem1:=0;

for i:=1 to n do 

  if a[i] mod 2=0 then inc(dem)

else inc(dem1);

writeln(f2,'So luong so chan la: ',dem);

writeln(f2,'So luong so le la: ',dem1);

d:=abs(a[2]-a[1]);

kt:=true;

for i:=2 to n do

  if abs(a[i]-a[i-1])<>d then

begin

kt:=false;

break;

end;

if kt=true then writeln(f2,'Day la day cap so cong')

else writeln(f2,'Day khong la day cap so cong');

close(f1);

close(f2);

end.

const fi='dulieu.txt';

fo='ketqua.txt';

var f1,f2:text;

a:array[1..100]of integer;

i,n:integer;

begin

assign(f1,fi); reset(f1);

assign(f2,fo); rewrite(f2);

n:=0;

while not eof(f1) do

begin

inc(n);

read(f1,a[n]);

end;

for i:=1 to n do 

  if a[i] mod 3=0 then write(f2,a[i]:4);

close(f1);

close(f2);

end.