amazing, Mr An

@Nguyễn Quốc An

làm chung 1 bài bạn

Program HOC24;

const fi='SNENXAU.INP';

var d: array['A'..'z'] of integer;

i,j,t,l: byte;

s1,s2: string;

f: text;

c: char;

procedure ip;

begin

assign(f,fi);

reset(f);

readln(f,s1);

read(f,s2);

close(f);

end;

BEGIN

ip;

for i:=1 to length(s1) do

if s1[i] in ['A'..'z'] then inc(d[s1[i]]);

for c:='A' to 'z' do

if d[c]>0 then write(d[c],c);

writeln;

t:=0;

for i:=1 to length(s2) do

begin

if s2[1] in ['A'..'z'] then

begin

write(s2[1]);

delete(s2,1,1);

end;

if (s2[i] in ['A'..'z']) and (s2[i-1] in ['A'..'z'])

then write(s2[i]);

if s2[i] in ['0'..'9'] then

begin

val(s2[i],l);

t:=t*10+l;

end;

if not(s2[i] in ['0'..'9']) then

for j:=1 to t do

begin

write(s2[i]);

t:=0;

end;

end;

readln

end.

uses crt;

var a,b,c,d,tb:real;

begin

clrscr;

write('Nhap diem cua ban:'); readln(a,b,c,d);

tb:=(a+b+c+d)/7;

if tb>=8 then writeln('Gioi');

if (6,5<=tb) and (tb<8) then writeln('Kha');

if (5<=tb) and (tb<6,5) then writeln('Trung Binh');

if tb<5 then writeln('Yeu');

readln;

end.

n=55

Bài 1:

uses crt;

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

n,i,j,tam:integer;

begin

clrscr;

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

for i:=1 to n do

begin

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

end;

for i:=1 to n-1 do

for j:=i+1 to n do

if a[i]>a[j] then

begin

tam:=a[i];

a[i]:=a[j];

a[j]:=tam;

end;

writeln('Day so sau khi sap xep la: ');

for i:=1 to n do

write(a[i]:4);

readln;

end.

Bài 2:

const fi='chucai.inp';
fo='chucai.equ';
var f1,f2:text;
s:array[1..255]of string;
dem,dem1,i,j:integer;
x:shortstring;
begin
assign(f1,fi); reset(f1);
assign(f2,fo); rewrite(f2);
dem:=0;
while not eof(f1) do
begin
inc(dem);
readln(f1,s[dem]);
end;
for i:=1 to dem do
begin
dem1:=0;
x:=s[i];
for j:=1 to length(x) do
if (x[j] in ['a'..'z']) or (x[j]in ['A'..'Z']) then inc(dem1);
writeln(f2,dem1);
end;
close(f1);
close(f2);
end.

Program HOC24;

const fi='dodai.inp';

fo='xau.out';

var s: array[1..5] of string;

i: integer;

f: text;

procedure ip;

begin

assign(f,fi);

reset(f);

for i:=1 to 5 do readln(f,s[i]);

close(f);

end;

procedure out;

begin

assign(f,fo);

rewrite(f);

for i:=1 to 5 do writeln(f,length(s[i]));

close(f);

end;

begin

ip;

out;

end.

Bài 1:

uses crt;

var st:string;

d,i:integer;

begin

clrscr;

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

d:=length(st);

writeln('Cac ki tu thuong trong xau ',st,' la: ');

for i:=1 to d do

if st[i] in['a'..'z'] then write(st[i]:4);

readln;

end.

Bài 2:

uses crt;
var st:string;
d,i,kt:integer;
begin
clrscr;
write('Nhap xau:'); readln(st);
d:=length(st);
kt:=0;
for i:=1 to d do
if st[i]<>st[d-i+1] then kt:=1;
if kt=0 then writeln('Xau doi xung')
else writeln('Xau khong doi xung');
readln;
end.

uses crt;

var e:array[1..200]of integer;

x,i,dem:integer;

begin

clrscr;

repeat

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

until (0<x) and (x<=200);

for i:=1 to x do

begin

repeat

write('E[',i,']='); readln(e[i]);

until e[i]>0;

end;

dem:=0;

for i:=1 to x do

if e[i] mod 5=0 then inc(dem);

writeln(dem);

readln;

end.