tổng hợp những bài tập passcal nâng cao bồi dưỡng.

BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 1


BÀI TẬP CHƯƠNG 4: CẤU TRÚC DỮ LIỆU MẢNG



Bài 1 :
Giải hệ phương trình tuyến tính hai ẩn dng ma trận :
a
11
x + a
12
y = c
1

a
21
x + a
22
y = c
2
GIẢI
Uses Crt;
Var a: array[1 2, 1 2] of real;
c: array[1 2] of real;
d, dx, dy, x, y: real;

BEGIN

Clrscr;
Writeln('Giai he phuong tring tuyen tinh hai an:');
Writeln(' a11x+a12y=c1');
Writeln(' a21x+a22y=c2');
Writeln('Nhap cac he so cua he phuong trinh');
Write('a11='); Readln(a[1,1]);
Write('a12='); Readln(a[1,2]);
Write('c1='); Readln(c[1]);
Write('a21='); Readln(a[2,1]);
Write('a22='); Readln(a[2,2]);
Write('c2='); Readln(c[2]);
d:=a[1,1]*a[2,2] - a[2,1] * a[1,2];
dx:=c[1]*a[2,2] - c[2] * a[1,2];
dy:=a[1,1]*c[2] - a[2,1] * c[1];
If d=0 then Writeln(' He vo nghiem hoac vo so nghiem')
Else
Begin
x:=dx/d; y:=dy/d;
Writeln('He co nghiem duy nhat :');
Writeln('x=', x:0:2, ' ; y=', y:0:2);
End ;
Readln;
END .
Bài 2 :
Lập phương trình tạo ra một mảng chứa bảng cửu chương .
Uses Crt ;
Var a : Array[1 10, 2 9] Of Byte ;
i, j : Byte ;
BEGIN
Clrscr ;

For i := 1 To 10 Do
For j := 2 To 9 Do a[i, j] := i*j ;
Writeln(' Bang cuu chuong : ') ; Writeln ;
For i := 1 To 10 Do
For j := 2 to 9 do Write ( j:4 , 'x' , i:2 , '=' , a[i , j]:2) ;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 2

(* hết 80 cột tự động xuống hng *)
Readln ;
END .
Bài 3 :
Viết chương trình nhập hai số nguyn dương m , n . Sau đĩ tính trung bình cộng bình phương cc số
nguyn từ m đến n .
Var m , n , k , s : Word ;
tb : real ;

BEGIN
Writeln('Nhap 2 so nguyen duong m, n :') ;
Write (' m = ') ; Readln(m) ;
Write (' n = ') ; Readln(n);
If m > n Then (* đỗi chỗ để m <= n *)
Begin
k := m ; m := n ; n := k ;
End ;
s := 0 ;
For k := m To n do s := s + sqr(k) ;
tb := s / (n - m + 1) ;
Writeln ('Trung bàinh cong bàimh phuong cac so '

+ 'nguyen tu m den n la: ', tb:12:2);
Readln ;
END .
Bài 4 :
Viết chương trình nhập từ bn phím cc phần tử của một mảng hai chiều . Kích thước của mảng được
nhập trước từ bn phím .
Var m , n , i , j : Byte ;
a : Array[1 100, 1 100] Of Real;

BEGIN
Write ('Nhap cac kich thuoc cua mang hai chieu : ') ;
Write (' So hang m = ') ; Readln(m) ;
Write (' So cot n = ') ; Readln(n) ;
Writeln (' Nhap cac phan tu cua mang : ') ;
For i := 1 To m Do
For j := 1 To n Do
Begin
Write ('a[', i:2, ', ' , j:2 ,']=') ; Readln(a[i, j]) ;
End ;
Readln ;
END .
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 3

Bài 5 :
Dy số sau được gọi l dy Fibonaci :
a
1
= 1

a
2
= 1
a
3
= 2
a
4
= 3
. . .
a
n
= a
n-1
+ a
n-2

Viết chương trình tính 20 số Fibonaci đầu tin v đưa ra kết quả vo một mảng 20 phần tử .
Var
a : Array[1 20] Of Byte ;
i : Byte ;

BEGIN
a[1] :=1;
a[2] :=1;
For i:=3 to 20 do a[i]:=a[i-1]+a[i-2] ;
END .
Bài 6 :
Dy số a
n

được định nghĩa như sau :
a
1
= 1
a
2
= 2
. . .
a
n
= 2a
n-1
+ a
n-2
( n > 2 )
Hy lập chương trình tính v gn gi trị của dy vo bàiến mảng .
Var a : Array [1 100] Of Word ;
i, N : Byte ;
S : Real ;

BEGIN
Write (' Nhap so N>=2 : ') ; Readln(n) ;
a[1] := 1 ;
a[2] := 2 ;
For i := 3 To N Do a[i] := 2*a[i-1]+a[i-2] ;
S := 0 ;
For i := 1 to N do S := S+1/sqr(a[i]) ;
Writeln (' S = ', S:12:6) ;
Readln ;
END .

Bài 7 :
Nhập số tự nhin N v viết chương trình tạo mảng bao gồm N số nguyn tố đầu tin .
var
a:array[1 100,1 100]of byte;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 4

n,i,j,k,l,ba:byte;
d:boolean;

BEGIN
write(' Nhap kich thuoc cua mang hai chieu NxN. N = ');readln(n);
for i:=1 to n do
for j:=1 to n do
begin
ba:=0;
repeat
d:=FALSE;
if j>1 then for k:=1 to j-1 do
if a[i,k]=ba then d:=true;
if i>1 then for k:=1 to i-1 do
if a[k,j]=ba then d:=true;
ba:=ba+1;
until not d;
a[i,j]:=ba-1;
end;
for i:=1 to n do
for j:=1 to n do write(a[i,j]:8);
readln;

END .
Bài 8 :
Viết chương trình nhập một bảng số 3 x 3 với điều kiện cc số được nhập sẽ hiện trn mn hình đng tại vị
trí của mình trn bảng số .
Uses Crt;
Var
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 5

a : array[1 3, 1 3] of integer ;
i, j: byte ;

BEGIN
Clrscr;
Writeln('Nhap mot bang so nguyen kich thuoc 3x3:');
Gotoxy(10, 4); Write(1);
Gotoxy(19, 4); Write(2);
Gotoxy(28, 4); Write(3);
Gotoxy(5, 6); Write(1);
Gotoxy(5, 8); Write(2);
Gotoxy(5,10); Write(3);
For i:=1 to 3 do
For j:=1 to 3 do
Begin
Gotoxy(9*j-1, 2*i+4); Read(a[i, j]);
Gotoxy(9*j-1, 2*i+4); ClrEol; Write(a[i, j]:6);
End;
Readln;
END .

Bài 9 :
a. a.

Viết chương trình nhập dữ liệu từ dy đối xứng vo mảng một chiều .
b. b.

Viết chương trình nhập dữ liệu l ma trận đối xứng vo mảng hai chiều .
a)
Var a: array [1 100] of integer;
n, i: byte;
Begin
Write('Nhap so phan tu cua day doi xung:');
Readln(n);
Writeln('Nhap cac phan tu cua day:');
For i:=1 to (n+1) div 2 do
Begin
Write('a[', i:2, ']='); Readln(a[i]);
a[n-i+1] := a[i];
End;
Readln ;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 6

END ;

b)
Var a: array [1 100, 1 100] of integer;
n, i, j: integer;
BEGIN

Write('Nhap kich thuoc cua mang doi xung: ');
Readln(n);
Write('Nhap cac phan tu cua mang:');
For i:=1 to n do
For j:=1 to i do
Begin
Write('a[', i:2, ',', j:2, ']='); Readln(a[i, j]);
a[j,i]:=a[i,j];
End;
Readln ;
END ;
BÀI TẬP CHƯƠNG 5: XU KÝ TỰ


Bài 1 :

Lập trình đếm số lần xuất hiện ở mỗi loại kí tự thuộc bảng chữ ci tiếng Anh trong một xu kí tự Str .


Var A: array [ 'A' 'Z'] of integer;
S: string;
ch: char;
i: integer;
BEGIN
Write(' Cho mot xau ki tu : '); Readln(s);
For ch:= 'A' to 'Z' do A[ch]:=0;
For i:=1 to length(s) do
Begin
If Upcase(S[i]) in (['A' 'Z']) then
Begin

S[i]:= Upcase(S[i]);
A[S[i]]:= A[S[i]]+1;
End;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 7

End;
For ch:= 'A' to 'Z' do
Writeln('So lan xuat hien cua ',ch,' trong xau la: ', A[ch]:4) ;
Readln ;
END .
Bài 2 :

Cho số tự nhin n v xu cĩ độ di n . Hy bàiến đổi xu đ cho bằng cch thay đổi trong đĩ :

a. a.

Tất cả cc dấu ! bằng dấu chấm .

b. b.

Mỗi một nhĩm cc dấu chấm liền nhau bằng một dấu chấm .

c. c.

Một nhĩm cc dấu chấm đứng liền nhau bằng dấu ba chấm .

a )
Var S: string;

i: byte;

BEGIN
Write(' Cho mot xau ki tu S = '); Readln(S);
For i:=1 to length(S) do
If S[i] = '!' then S[i]:= '.';
Write( ' Chuoi sau khi da bàien doi la : ', S);
Readln;
END .

b )
Uses crt;
Var S : string;
i : byte;

BEGIN
Clrscr;
Write(' Cho mot xau ki tu S = '); Readln(S);
i:=1;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 8

While i< length(S) do
If (S[i]='.')and(S[i+1]='.') then Delete(S,i,1)
Else inc(i);
Write('Chuoi sau khi da bàien doi la: ' ,S);
Readln;
END .

c )
Uses crt;
Var S: string;
i, j: byte;

BEGIN
Clrscr;
Write('Nhap xau S='); Readln(S);
i:=1;
While i<=Length(S) do
Begin
If S[i]='.' then
Begin
j:=i;
While (S[i]='.')and(i<=length(S)) do inc(i);
dec(i);
If (i-j)=1 then insert('.',S,i)
Else
If (i-j)>2 then
Begin
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 9

Delete(S,j+2,i-j-2); i:=j+1;
End;
End ;
Inc(i);
End;
Write('Chuoi sau khi bàien doi la: ',S);

Readln;
END .
Bài 3 :

Cho số tự nhin n v một dy cc kí tự S
1
, S
2
, … , S
n
. Hy tìm số tự nhin I đầu tin sao cho cc kí tự S
i
, S
i+1

đều l chữ ci a . Nếu trong dy khơng cĩ những cặp như vậy thì thơng bo .

Var S: string;
i: integer;

BEGIN
Write(' Cho mot xau ki tu : '); Readln(S);
i:= pos('aa', S); {tìm vị trí xu con 'aa' trong S}
If i<>0 then Writeln(' Ton tai "aa" tai vi tri ', i)
Else Writeln(' Khong ton tai .') ;
Readln;
END .
Bài 4 :

Cho số tự nhin n v dy cc kí tự S

1
, S
2
, … , S
n
. Bàiết rằng trong dy cĩ ít nhất một dấu phẩy . Hy tìm số
tự nhin i sao cho :

a. a.

S
i
l dấu phẩy đầu tin .

b. b.

S
i
l dấu phầy cuối cng .

a )
Var S: string;
i: integer;

BEGIN
Write('Cho mot xau S co dau ",": '); Readln(S);
i:= pos(',', S); (* vị trí của dấu ',' trong S *)
If i<> 0 then Write(' Vi tri thoa man la: ', i);
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 10

Readln;
END .

b )
Var S: string;
i: integer;

BEGIN
Write('Cho mot xau S co dau ",": '); Readln(S);
i:= length(S);
While (i>=1)and(S[i] <> ',' ) do i:=i -1;
If i>=1 then Write('So thu tu thoa man la: ', i)
Else Write('Khong ton tai.');
Readln;
END .


Bài 5 :

Viết chương trình nhập một xu kí tự , sau đĩ chỉ ra xem xu đĩ cĩ phải l xu đối xứng khơng ( xu đối xứng
l xu cĩ cc kí tự giống nhau v đối xứng nhau qua điểm giữa xu , ví dụ ‘ABBA’ hoặc ‘ABCBA’ ) .
Uses Crt;
Var St : string;
dx : Boolean;
i, len: byte;

BEGIN
Clrscr;

Write(' Nhap xau St = '); Readln(St);
dx:= True;
i:=1;
len:= Length(St);
While dx and (i<=(len div 2)) do
Begin
dx:=(St[i] = St[len - i+1]);
inc(i);
End;
If dx then Write(' St la xau doi xung ')
Else Write(' St khong phai la xau doi xung ') ;
Readln;
END .


Bài 6 :

Cho một xu kí tự S . Hy viết chương trình tính xem trong S cĩ bao nhiu loại kí tự khc nhau ( phn bàiệt
chữ in hoa với chữ in thường ) . Ví dụ với S l “Pascal” ta cĩ đp số l 5 .
Var S: string;
i, j, dem: integer;
t: boolean;

BEGIN
Write('Cho mot xau ki tu S: '); Readln(S);
dem:=0;
For i:=1 to length(S) do
Begin
t:=false;
For j:=1 to i-1 do if (S[j]=S[i]) then t:=true;

If not t then dem:= dem+1;
End;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 11

Write('So ki tu khac nhau cua xau S la: ', Dem);
Readln;
END .

Bài 7 :

Viết chương trình nhập một xu kí tự v bàiến đổi chng thnh tồn chữ in hoa .
Var S : string;
i : integer;

BEGIN
Write('Cho mot xau ky tu: '); Readln(S);
For i:=1 to length(S) do
If S[i] in ['a' 'z'] then S[i]:= Upcase(S[i]);
Write('Chuoi sau khi da bàien doi la: ', S);
Readln;
END .
Bài 8 :

Họ tn một học sinh được nhập từ bn phím . Bạn hy viết chương trình điều chỉnh lại cc kí tự đầu của cc
từ đơn trong tn của học sinh ấy trở thnh chữ in hoa .
Uses crt;
Const Chu=['a' 'z'];
Var Hoten: string;

i,len: byte;

BEGIN
Clrscr;
Write('Ho ten='); Readln(Hoten);
Len:=length(Hoten);
If Hoten[1] in Chu then Hoten[1]:=Upcase(Hoten[1]);
For i:=2 to len do
If (Hoten[i-1]=#32)and(Hoten[i] in Chu) then
Hoten[i]:=Upcase(Hoten[i]);
Write('Ho ten sau khi dieu chinh la: ', Hoten);
Readln;
END .
Bài 9 :

Viết chương trình nhập xu kí tự từ bn phím , sau đĩ gọt xu lại bằng cch cch xố đi cc kí tự trống ở hai
đầu của xu . Ví dụ nếu nhập xu “ Ha noi “ , thì kết quả sẽ l “Ha Noi” .
ar S: String;

BEGIN
Write('Cho mot xau ky tu: '); Readln(S);
While S[1] = #32 do Delete(S,1,1);
While (S[length(S)] = #32) do Delete(S,length(S),1);
Write('Chuoi sau khi da bàien doi la: ', S);
Readln;
END .
BÀI TẬP CHƯƠNG 6: DỮ LIỆU KIỂU TẬP

Bài 1 :

Bạn hy viết hm Card(A) đếm số phần tử của tập hợp A cho trước cĩ kiểu Set Of 0 99 .
(* hm đếm số phần tử của tập hợp *)
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 12

Uses Crt;
Type Tap=set of 0 99;
Const inp='Number.dat';
Var S : Tap;
i : byte;

Procedure Nhap;
Var a: byte; f: text;
Begin
S:=[];
Assign(f,inp); Reset(f);
While not SeekEoF(f) do
begin
Readln(f,a); If (a>=0)and(a<=99) then S:=S+[a];
End;
Close(f);
End;

Function Card(S: Tap): byte;
Var i,n: byte;
Begin
n:=0;

For i:=0 to 99 do If i in S then Inc(n);
Card:=n;
End;

BEGIN
Nhap;
Clrscr;
Write('Tap S co ',Card(S),' phan tu.');
Readln;
END.

Bài 2 :

Bạn hy lập chương trình tạo một tập hợp cc số nguyn chẵn kiểu Byte v loại khỏi nĩ cc số chia hết cho 3
. Kết quả thể hiện trn mn hình .
Uses Crt;
Const n=5;
Type
Danhsach=record
holot: string[25];
ten: string[10];
tuoi: 0 99;
lop: string[3];
End ;
Var ds: array [1 20] of Danhsach;
i,j: byte;
f: file of Danhsach;

Procedure Doi(i,j: byte);
Var tg: Danhsach;

Begin
tg:=ds[i];
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 13

ds[i]:=ds[j];
ds[j]:=tg;
End;

BEGIN
ClrScr;
Writeln('Nhap danh sach hoc sinh tu file data.dat : ');
Writeln;
Assign(f,'data.dat'); Reset(f);
For i:=1 to n do Read(f,ds[i]);
Close(f);
For i:=1 to n-1 do
For j:=i+1 to n do
begin
If (ds[i].ten>ds[j].ten) then Doi(i,j)
Else
If (ds[i].ten=ds[j].ten)and(ds[i].holot>ds[j].holot) then Doi(i,j);
end;
Writeln('Danh sach hoc sinh:');
For i:=1 to n do
With ds[i] do Writeln(holot:20,ten:11,tuoi:4,lop:5);
Writeln;
Write('Bam Enter de ket thuc ');
Readln;

END.
Bài 3 :

Xt chương trình sau :

Program B4 ;

Var

Thoat : Set Of Char = [‘e’ , ’E’] ;



BEGIN

Write (‘ Hay go E de ket thuc : ‘) ;

Repeat

Ch := Readkey ;

Until Ch in thoat ;

END .

Hy tìm v sửa lỗi trong chương trình đĩ .
Uses Crt;
Const
thoat: set of char=['e','E'];
Var

ch: char;

BEGIN
Write('Hay go E de thoat khoi chuong trinh: ');
Repeat
ch:=readkey;
Until ch in thoat;
END .

Bài 4 :

Bạn hy lập chương trình hiển thị một menu dạng sau trn mn hình


1. Xem

BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 14

2. 2.

Sua chua
3. 3.

Loai bo
4. 4.

Nhap them
5. 5.

Thoat
Lua chon cua ban : _
Sau đĩ đợi g phím . Chương trình phải đợi cho tới khi phím g vo l một trong cc chữ số 1 5 hoặc cc
chữ ci đầu của cc tuỳ chọn thì thơng bo phím g vo hợp lệ v kết thc chương trình . Trong chương trình
phải dng một tập hợp để kiểm tra việc nhập gi trị cho bàiến từ bn phím .
(* Hiển thị menu *)
Uses Crt;
Const
menu: set of char = ['1' '5','X','S','L','N','T'];
Var
ch: char;

BEGIN
Clrscr;
Writeln(' 1. Xem ');
Writeln(' 2. Sua chua ');
Writeln(' 3. Loai bo ');
Writeln(' 4. Nhap them');
Writeln(' 5. Thoat ');
Write('Lua chon cua ban: ');
Repeat
ch:=readkey; ch:=Upcase(ch);
Until ch in menu;
Writeln;
Write('Ban da chon:');
Case ch of
'1','X': Writeln(' 1. Xem ');
'2','S': Writeln(' 2. Sua chua ');
'3','L': Writeln(' 3. Loai bo ');

'4','N': Writeln(' 4. Nhap them');
'5','T': Writeln(' 5. Thoat ');
End;
Readln;
END.
Bài 5 :

Hy lập chương trình nhập vo một xu nhị phn . Cc kí tự nhập vo khơng hợp lệ bị bỏ qua .
(* nhập một xu nhị phn *)
Uses Crt;
Const bàit : set of char= ['0','1'];
Var ch: char;
st: string;

BEGIN
Clrscr;
st:='';
Write('Nhap vao mot xau nhi phan : ');
Repeat
ch:= Readkey;
If ch in bàit then
begin
st:=st+ch; Write(ch);
end
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 15

Else If ch<>#13 then Write(#7);
Until ch=#13;

Readln;
END.
Bài 6 :

Hy lập chương trình nhập vo một xu kí tự từ bn phím . Yu cầu cc kí tự nhập vo phải l cc chữ ci thuộc
bảng chữ ci tiếng Anh , bỏ qua cc phím khc .
(* Nhập một xu tồn cc chữ ci *)
Uses Crt;
Const A:set of char=['a' 'z','A' 'Z'];
Var ch: char;
st: string;

BEGIN
Clrscr;
st:='';
Writeln('Nhap vao mot xau toan cac chu cai:');
Repeat
ch:=Readkey;
If ch in A then
begin
st:=st+ch; write(ch);
End
Else if ch<>#13 then Write(#7);
If ch=#0 then ch:=Readkey;
Until ch = #13;
END .

Bài 7 :

Viết chương trình cĩ chức năng thm phần tử vo tập hợp trực tiếp từ bn phím v loại bớt phần tử khỏi tập

hợp cũng trực tiếp từ bn phím .
(* loai bo cac phan tu khoi tap hop *)
Uses Crt;
Var tap: set of char;
ch: char;

BEGIN
tap:=[];
Writeln('Nhap cac phan tu cho mot tap hop cac ki tu: ');
Repeat
ch:=ReadKey;
tap:=tap+[ch];
Writeln(ch);
Until not(ch in ['a' 'z']);
Writeln('Cac phan tu cua tap hop la:');
For ch:='a' to 'z' do
If ch in tap then Write(ch,' ');
Writeln;
Writeln('Ban muon bo cac phan tu nao khoi tap hop:');
Repeat
ch:=ReadKey;
tap:=tap-[ch];
Writeln(ch);
Until not(ch in ['a' 'z']);
Writeln('Cac phan tu con lai cua tap hop la:');
For ch:='a' to 'z' do
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 16

If ch in tap then Write(ch,' ');
Readln;
END .
BÀI TẬP CHƯƠNG 7: KIỂU RECORD



Bài 1 :

Thơng tin về mỗi học sinh gồm :

 
Họ đệm : một xu 25 kí tự .

 

Tn : một xu 10 kí tự .

 

Tuổi : một số nguyn hai chữ số .

 

Lớp : một xu hai chữ số v một chữ ci viết hoa

Hy lập chương trình nhập từ bn phím danh sch một lớp 15 học sinh vo một mảng bản ghi . Sau đĩ hiển
thị danh sch ln mn hình , mỗi người một dịng .

(* Nhập danh sch học sinh từ bn phím *)

Uses Crt;
Const n=15;
Type Danhsach=record
holot: string[25];
ten: string[10];
tuoi: 0 99;
lop: string[3];
End;
Var ds: array [1 n] of Danhsach;
i : byte;

BEGIN
ClrScr;
Writeln('Hay nhap danh sach hoc sinh : ');
Writeln;
For i:=1 to n do
Begin
Writeln('Thong tin hoc sinh thu ',i);
Write('Cho ho lot : '); Readln(ds[i].holot);
Write('Cho ten : '); Readln(ds[i].ten);
Write('Cho tuoi : '); Readln(ds[i].tuoi);
Write('Cho lop : '); Readln(ds[i].lop);
Writeln;
End;
Writeln('Danh sach hoc sinh :');
For i:=1 to n do
With ds[i] do Writeln(holot:20,ten:10,tuoi:4,lop:5);
Writeln;
Write('Bam Enter de ket thuc ');
Readln;

END.
Bài 2 :

Thơng tin về mỗi học sinh l một bản ghi gồm cc trường :

 

Họđệm : một xu 25 kí tự .

 

Tn : một xu 10 kí tự .

 

Tuổi : một số nguyn hai chữ số .

 

Lớp : một xu hai chữ số v một chữ ci viết hoa

BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 17

Một file bản ghi chứa một danh sch một lớp gồm 20 học sinh . Hy lập chương trình hiển thị danh sch ln
mn hình , mỗi người một dịng .

(* Doc tu mot file ban ghi *)
Uses Crt;

Const n=5;
Type Danhsach=record
holot: string[25];
ten: string[10];
tuoi: 0 99;
lop: string[3];
end;
Var ds: Danhsach;
i: byte;
f: file of Danhsach;

BEGIN
ClrScr;
Writeln('Danh sach hoc sinh tu file bai2.dat');
Writeln;
Assign(f,'bai2.dat'); Reset(f);
For i:=1 to n do
Begin
Read(f,ds);
With ds do Writeln(holot:20,ten:11,tuoi:4,lop:5);
End;
Close(f);
Writeln;
Write('Bam Enter de ket thuc ');
Readln;
END .
Bài 3 :

Một file bản ghi chứa một danh sch học sinh , thơng tin về mỗi học sinh giống như bài trn . Hy lập
chương trình tạo một file bản ghi khc chứa danh sch đĩ , mỗi bản ghi gồm cc trường :

 

Họtn : một xu 35 kí tự .

 

Tuổi : một số nguyn hai chữ số .

 

Khối : một số nguyn hai chữ số .

 

Lớp : một chữ ci viết hoa

(* Doi kieu ban ghi *)
Uses Crt;
Type Danhsach1=record
holot: string[25];
ten: string[10];
tuoi: 0 99;
lop: string[3];
End;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 18

Danhsach2=record

hoten: string[35];
tuoi: byte;
khoi: byte;
lop: char;
End;

Var ds1 : Danhsach1;
ds2 : Danhsach2;
f1 : file of Danhsach1;
f2 : file of Danhsach2;
c : integer;

BEGIN
ClrScr;
Writeln('Ghi tu file bai3.dat sang bai3n.dat:');
Writeln;
Assign(f1,'bai3.dat'); Reset(f1);
Assign(f2,'bai3n.dat'); Rewrite(f2);
While not Eof(f1) do
Begin
Read(f1,ds1);
With ds1 do
Begin
ds2.hoten:=holot+ten;
val(copy(lop,1,2),ds2.khoi,c);
ds2.tuoi:=tuoi;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 19

ds2.lop:=UpCase(lop[3]);
Write(f2,ds2);
End;
End;
Close(f1); Close(f2);
Writeln;
Writeln('Bam Enter de ket thuc!');
Readln;
END .


Bài 4 :

Một file bản ghi chứa một danh sch học sinh PTTH , thơng tin về mỗi học sinh ngồi cc trường Họđệm ,
Tn , Tuổi , Lớp giống như cc bài trn cịn cĩ thm trường Điểm chứa điểm trung bình của học sinh trong
năm học . Hy lập chương trình :

a. a.

Hiển thị ln mn hình danh sch những học sinh giỏi nhất của trường l những bạn cĩ điểm trung bình
từ 8.0 trở ln v cao nhất trong khối .

b. b.

Lập danh sch học sinh trong năm học mới , bàiết một học sinh cĩ điểm trung bình từ 5.0 trở ln thì
được ln lớp . Ch ý : lớp 10A ln lớp 11A , lớp 11A ln 12A Kết quả chứa trong file .

(* Khen thuong va len lop *)
Uses Crt;
Type Danhsach=record

holot: string[25];
ten: string[10];
tuoi: 0 99;
lop: string[3];
diem: real;
End;

Var ds: array [1 100] of Danhsach;
f: file of Danhsach;
n: integer;

Procedure Nhap;
Begin
Assign(f,'bai4.dat'); Reset(f);
n:=0;
While not Eof(f) do
Begin
n:=n+1; Read(f,ds[n]);
End;
Close(f);
End;

Procedure Timgioi;
Var i: integer;
max10,max11,max12: real;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 20

l: string;

Begin
max10:=0; max11:=0; max12:=0;
For i:=1 to n do With ds[i] do
Begin
l:=copy(lop,1,2);
If (l='10')and(diem>max10)and(diem>8.0) then max10:=diem
Else If (l='11')and(diem>max11)and(diem>8.0) then max11:=diem
Else If (l='12')and(diem>max12)and(diem>8.0) then max12:=diem;
End;
Writeln('Hoc sinh gioi nhat khoi 10 : ');
For i:=1 to n do With ds[i] do
If (copy(lop,1,2)='10')and(diem>=max10) then
Writeln(holot:20,ten:10,tuoi:4,lop:5,diem:5:1);
Writeln('Hoc sinh gioi nhat khoi 11 : ');
For i:=1 to n do With ds[i] do
If (copy(lop,1,2)='11')and(diem>=max11) then
Writeln(holot:20,ten:10,tuoi:4,lop:5,diem:5:1);
Writeln('Hoc sinh gioi nhat khoi 12 : ');
For i:=1 to n do With ds[i] do
If (copy(lop,1,2)='12')and(diem>=max12) then
Writeln(holot:20,ten:10,tuoi:4,lop:5,diem:5:1);
End;

Procedure Lenlop;
Var i: integer;
l: string;
f: file of Danhsach;
Begin
For i:=1 to n do With ds[i] do
Begin

l:=copy(lop,1,2);
If (l='10')and(diem>=5.0) then lop:='11'+lop[3]
Else If (l='11')and(diem>=5.0) then lop:='12'+lop[3]
Else If (l='12')and(diem>=5.0) then lop:='DTN';
End;
Assign(f,'bai4n.dat'); Rewrite(f);
For i:=1 to n do With ds[i] do
If lop<>'DTN' then Write(f,ds[i]);
Close(f);
End;

BEGIN
ClrScr;
Nhap;
Timgioi;
Lenlop;
Write('Bam ENTER de ket thuc ');
Readln;
END .
Bài 5 :

Cho file bản ghi f chứa dữ liệu về kho sch , dữ liệu về mỗi cuốn sch được chứa trong một bản ghi gồm
3 trường mang thơng tin về :

 

Họ tn tc giả : một xu 26 kí tự .

 

Tn sch : một xu 40 kí tự .

 

Năm xuất bản : một số nguyn 4 chữ số .

BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 21

Hăy lập chương trình nhập dữ liệu vo kho sch , sau đĩ tìm ra :
 

Những cuốn sch của một tc giả cho trước xuất bản vo một năm cho trước .
 

Những cuốn sch cĩ tn cho trước .
Kết quả hiện trn mn hình.

(* Tim kiem tren ban ghi *)
Uses Crt;
Type Danhsach=record
Tacgia: string[26];
Tensach: string[40];
NamXB: integer;
End;
Var ds: array [1 100] of Danhsach;
n : integer;
f : file of Danhsach;
M: Danhsach;

Procedure Nhap;
Begin
n:=0;
Assign(f,'bai5.dat'); Reset(f);
While not Eof(f) do
Begin
Inc(n); Read(f,ds[n]);
End;
Close(f);
End;

Procedure TheoTG;
Var tacgia: string;
namXB: integer;
i: integer;
Begin
Write('Cho ten tac gia : '); Readln(M.tacgia);
Write('Cho nam xuat ban : '); Readln(M.NamXB);
i:=1;
While (i<=n)and((ds[i].tacgia<>tacgia)or(ds[i].namXB<>namXB)) do i:=i+1;
If (i>n) then Writeln('Khong tim duoc')
Else Writeln(ds[i].tacgia:28,ds[i].tensach:42,ds[i].namXB:6);
End;

Procedure TheoTS;
Var ten: string;
i: integer;
Begin
Write('Cho ten sach : '); Readln(ten);

i:=1;
While (i<=n)and(ds[i].tensach<>ten) do i:=i+1;
If (i>n) then Writeln('Khong tim duoc')
Else Writeln(ds[i].tacgia:28,ds[i].tensach:42,ds[i].namXB:6);
End;

Procedure Timkiem;
Var c:char;
Begin
Writeln('1. Tim kiem theo tac gia va nam xuat ban.');
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 22

Writeln('2. Tim kiem theo ten sach');
Writeln;
Write('Ban chon [1/2] : ');
Repeat
c:=Readkey;
Until pos(c,'12')>0;
Writeln(c);
If c='1' then TheoTG Else TheoTS;
End;

BEGIN
ClrScr;
Nhap;
Timkiem;
Write('Ban Enter de ket thuc ');
Readln;

END.
Bài 6 :

File bản ghi F chứa danh sch cc ngy lễ trong một năm , mỗi bản ghi gồm ngy thng , tn ngy lễ v số ngy
được nghỉ . Hy lập chương trình nhập danh sch cc ngy lễ v tính :

 

Tổng số cc ngy lễ v tổng số cc ngy nghỉ lễ trong năm .

 

Tổng số cc ngy lễ v tổng số cc ngy nghỉ lễ trong quí 1 , quí 2 , …

Kết quả thể hiện trn mn hình .

(* Tinh so ngay le va ngay nghi trong nam ,qui *)
Uses Crt;
Type Danhsach=record
ngay: byte;
thang: byte;
ten: string[15];
songay: integer;
end;
Var ds: array [1 100] of Danhsach;
n: integer;
f: file of Danhsach;
snn,snnq1,snnq2,snnq3,snnq4: integer;
tsq1,tsq2,tsq3,tsq4: integer;

Procedure Nhap;
Begin
n:=0;
Assign(f,'bai6.dat'); Reset(f);
While not Eof(f) do
Begin
Inc(n); Read(f,ds[n]);
End;
Close(f);
End;

Procedure Tinh_ngay_nghi;
Var i: integer;
Begin
snn:=0;
snnq1:=0; tsq1:=0;
snnq2:=0; tsq2:=0;
snnq3:=0; tsq3:=0;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 23

snnq4:=0; tsq4:=0;
For i:=1 to n do With ds[i] do
Begin
Inc(snn,songay);
If (thang<3) then
Begin
Inc(snnq1,songay); Inc(tsq1);
End

Else If (thang<6) then
Begin
Inc(snnq2,songay); Inc(tsq2);
End;
If (thang<9) then
Begin
Inc(snnq3,songay); Inc(tsq3);
End ;
If (thang<12) then
Begin
Inc(snnq4,songay); Inc(tsq4);
End;
End;
End;

Procedure Inkq;
Var i: integer;
Begin
Writeln('So ngay le trong nam : ',n);
Writeln('Tong so ngay nghi le trong nam : ',snn);
Writeln;
Writeln('So ngay le trong qui 1 : ',tsq1);
Writeln('Tong so ngay nghi le trong qui 1 : ',snnq1);
Writeln('So ngay le trong qui 2 : ',tsq2);
Writeln('Tong so ngay nghi le trong qui 2 : ',snnq2);
Writeln('So ngay le trong qui 3 : ',tsq3);
Writeln('Tong so ngay nghi le trong qui 3 : ',snnq3);
Writeln('So ngay le trong qui 4 : ',tsq4);
Writeln('Tong so ngay nghi le trong qui 4 : ',snnq4);
Writeln;

End;
BEGIN
Clrscr;
Nhap;
Tinh_ngay_nghi;
Inkq;
Write('Ban Enter de ket thuc ');
Readln;
END.
BÀI TẬP CHƯƠNG 8: KIỂU FILE



Bài 1 :

Hy lập chương trình tạo một tệp số nguyn chứa cc số nguyn tố nhỏ hơn 10000 theo thứ tự tăng dần .
(* Tạo file số nguyn tố nhỏ hơn 10000 *)
Uses Crt;
Const N=10000;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 24

Var i , j : Integer;
f: File of Integer;
a: Array[2 N] of boolean;

BEGIN
For i:=2 to N do a[i]:=true;
i:=2;

Repeat
For j:=2 to (N div i) do a[i*j]:=false;
Repeat Inc(i) Until a[i] or (i>N);
Until i>N;
Assign(F,'C:\SoNT.dat'); Rewrite(F);
For i:=1 to N do If a[i] then Write(F,i);
Close(F);
clrscr;
Write(' Viet ra file "C:\SoNT" cac so nguyen to nho hon 10000 ');
Readln;
END .
Bài 2 :

Cho f l tệp văn bản chứa cc xu 10 kí tự . Hy lập chương trình nhập v hiển thị nội dung file đĩ ln mn
hình , mỗi xu một dịng , đầy trang mn hình thì dừng lại đợi g Enter mới hiển thị trang tiếp theo cho tới
hết.
(* Ghi v đọc file of String *)
Uses Crt;
Const INP='FoString.dat';
Type String10 = String[10];

Procedure Ghi;
Var f: file of String10; S: String10;
Begin
Assign(f,INP); Rewrite(f);
Writeln('Nhap vao f. Thoi nhap khi S='''' (go Enter)!');
Readln(S);
While (S<>'') do
Begin
Write(f,S);

Readln(S);
End;
Close(f);
End;

Procedure Doc;
Var f: file of String10; S: String10;
Begin
Clrscr;
Assign(f,INP); Reset(f);
While Not Eof(f) Do
Begin
Read(f,S);
Writeln(S);
If WhereY=25 then
Begin
Write('Press Enter to continue ');
Readln; Clrscr;
End;
End;
BÀI TẬP PASCAL CÓ LỜI GIẢI

Học Lê Trung (0168 995 4843) 25

Close(f);
Readln;
End;

BEGIN
Ghi;

Doc;
END.
Bài 3 :

Bạn hy viết chương trình cho php đọc dữ liệu từ bn phím v ghi thm vo cuối một tệp cc bản ghi .

(* Doc v ghi vo cuối tệp cc bản ghi *)
Uses Crt;
Const inp='Hocsinh.dat';
Type Hocsinh=Record
Ten : String[30];
Tuoi: Byte;
End;
Var F : file of Hocsinh;
Hs: Hocsinh;

BEGIN
Assign(f,inp); Reset(f);
Write('Ho va ten: '); Readln(Hs.Ten);
Write('Tuoi : '); Readln(Hs.Tuoi);
Seek(f,Filesize(F));
Write(f,Hs);
Close(f);
END .
Bài 4 :

Cho một văn bản chứa trong một text file f . Trong văn bản , tính từ tri sang phải , từ trn xuống dưới ,
kí tự # l kí hiệu xố đi một từ đứng ngay trước nĩ nếu cĩ . Ví dụ ‘#Ta#oi di ngu#h###hoc’ cĩ nghĩa l ‘Toi
di hoc’ . Bạn hy viết chương trình sửa lại file f theo quy ước trn .
(* Sửa văn bản *)

Uses Crt;
Const fi='vanban.txt';
Var f: text;
s: string;
ch: char;

Procedure docfile ( fi : String );
Var f : text ;
Begin
Assign(f,fi); Reset(f);
while not eof(f) do
Begin
Read(f,ch);
Write(ch);
End;
close(f) ;
writeln ;
End ;

BEGIN
Writeln(' Van ban ban dau doc tu file "vanban.txt" :') ;
docfile(fi) ;