Đăng ngày: 23:41 20-01-2009
{Khi nguoi ta muon lam viec voi nhieu du lieu cung kieu, nhat
la cac kieu cong kenh, va muon luu giu lau dai cac du lieu do
tren dia, thi thuong phai su dung den kieu File (Tep). Co 3
kieu tep chinh: Tep du lieu (File of ), Tep van
ban (Text) va Tep khong dinh kieu. Sau day la mot vi du minh
hoa cach lam viec voi Tep du lieu. Trong ma nguon, cac tu moi
ve kieu Tep duoc viet IN HOA}
(*-----------------------------------------------------------*)
uses crt;
type str20 = string[20];
KieuThiSinh = record
Ten : str20;
Toan,Ly,Hoa : real
end;
KieuTep = FILE OF KieuThiSinh;
const TenTep : str20 = 'ThiSinh.dat';
var DsThiSinh : KieuTep;
Ts : KieuThiSinh;
CongViec : char;
ok : boolean;
(*-------------------- cac chuong trinh con ----------------*)
procedure CapNhat(var X:KieuTep; Ten:str20);
begin
Ten:=TenTep;
ASSIGN(X,Ten); {Dat/Goi ten tep la bien Ten}
{$I-} {Bao chuong trinh dich: Tu day, neu gap loi thi khong
lam "rum beng" bao loi do choet ra man hinh, ma dua
Ma loi vao bien mac dinh IOResult kieu boolean co san
de nguoi lap trinh xu ly tiep. IOResult=0 la khong
co loi vao ra}
RESET(X); {Mo Tep tren dia ra de doc du lieu tu dia}
if IORESULT<>0 then REWRITE(X) {Co loi thi tao Tep moi}
else SEEK(X,FILESIZE(X)); {Trai lai dua dau doc/ghi den vi
tri sau phan tu cuoi cung cua Tep.
Chu y: Cac phan tu cua Tep thi
duoc dem tu 0. FileSize(X) la tong
so cac phan tu cua Tep. Thu tuc
Seek(X,k) la dua dau doc/ghi den
phan tu co Stt=k}
{$I+} {Bao chuong trinh dich: Tu nay lai bao loi binh thuong}
clrscr;
writeln('Cap nhat Thi sinh: Nhap Ten = Entrer de thoat!');
repeat
write('Nhap Ten = '); readln(Ts.Ten);
while (Ts.Ten[1]=' ') and (length(Ts.Ten)>0) do
delete(Ts.Ten,1,1);
if Ts.Ten<>'' then
begin
write('Vao diem Toan, Ly, Hoa = ');
readln(Ts.Toan,Ts.Ly,Ts.Hoa);
WRITE(X,Ts); {In ban ghi thi sinh vao dia, noi dau
doc/ghi dang tro vao, roi nhich dau
doc/ghi sang vi tri tiep theo}
end;
until Ts.Ten='';
CLOSE(X); {Danh dau het Tep tren dia}
{Ban co gang tuong tuong va tu minh hoa tren giay cac thao
tac tren thi moi de hieu. Nho rang cac hoat dong cua may
tinh xu ly thong tin chu yeu la dua du lieu tu noi nay den
noi khac: Ban phim, Bo nho, CPU, Man hinh, Dia,...}
end;
procedure MoTep(var X:kieuTep; Ten:str20; var Y:boolean);
begin
ClrScr;
ASSIGN(X,Ten);
{$I-}
RESET(X);
Y:=IORESULT=0;
if not(Y) then
begin
writeln('Khong tim thay Tep!');
readkey;
end;
{$I+}
end;
procedure InDanhSach(var X:KieuTep; Ten:str20);
{Tuy X la tham tri, nhung la bien tep nen Turbo Pascal
bat phai dung nhu tham bien}
var Tong:real;
begin
MoTep(X,Ten,ok);
if not(ok) then exit;
clrscr;
writeln('Danh sach cac Thi sinh - Bang diem');
writeln('Stt Ten '+
'Toan Ly Hoa Tong');
while not(EOF(X)) do
begin
READ(X,Ts);
Tong:=Ts.Toan+Ts.Ly+Ts.Hoa;
writeln(FILEPOS(X):3,' ',
{FILEPOS(X) la stt phan tu cua tep X ma
dau doc/ghi dang tro vao}
Ts.Ten,'':20-length(Ts.Ten),
{Tuc la viet Ten roi cach ra mot khoang
dai 20 tru di do dai cua Ten, de viet
diem Toan se thang cot voi nhau!}
Ts.Toan:5:1,Ts.Ly:5:1,Ts.Hoa:5:1,Tong:6:1);
end;
writeln('Danh sach co tat ca ',FILESIZE(X),' Thi sinh!');
CLOSE(X);
readkey
end;
procedure SuaChua(var X:KieuTep; Ten:str20);
var k : word;
cot,dong : byte;
begin
MoTep(X,Ten,ok);
if not(ok) then exit;
clrscr;
writeln('Sua chua Bang diem:');
write('Sua Thi sinh co STT = ');
cot:=wherex;
dong:=wherey;
repeat
gotoxy(cot,dong);
ClrEol;
readln(k)
until k in [1..FILESIZE(X)];
SEEK(X,k-1); {dau doc/ghi tro vao k-1 thi STT = k}
writeln('Du lieu cu la:');
writeln('Stt Ten '+
'Toan Ly Hoa');
READ(X,Ts);
writeln(FILEPOS(X):3,' ',
Ts.Ten,'':20-length(Ts.Ten),
Ts.Toan:5:1,Ts.Ly:5:1,Ts.Hoa:5:1);
writeln('Nay sua lai thanh:');
write('Nhap Ten = ');
readln(Ts.Ten);
while (Ts.Ten[1]=' ') and (length(Ts.Ten)>0) do
delete(Ts.Ten,1,1);
WITH Ts DO {Dung tu khoa with Ts do de bo Ts. khi viet
Ts. , chi can viet }
if Ten<>'' then
begin
write('Vao diem Toan, Ly, Hoa = ');
readln(Toan,Ly,Hoa);
SEEK(X,k-1);
WRITE(X,Ts);
end;
CLOSE(X);
end;
procedure XoaBo(var X:KieuTep; Ten:str20);
var k : word;
cot,dong : byte;
Y : KieuTep;
ch : char;
begin
MoTep(X,Ten,ok);
if not(ok) then exit;
clrscr;
writeln('Xoa bot mot muc trong Bang diem:');
write('Xoa Thi sinh co STT = ');
cot:=wherex;
dong:=wherey;
repeat
gotoxy(cot,dong);
ClrEol;
readln(k)
until k in [1..FILESIZE(X)];
SEEK(X,k-1); {dau doc/ghi tro vao k-1 thi STT = k}
writeln('Du lieu hien thoi la:');
writeln('Stt Ten '+
'Toan Ly Hoa');
READ(X,Ts);
writeln(FILEPOS(X):3,' ',
Ts.Ten,'':20-length(Ts.Ten),
Ts.Toan:5:1,Ts.Ly:5:1,Ts.Hoa:5:1);
writeln('Ban co chac chan muon xoa di khong?-(C/K) ');
repeat
ch:=UpCase(readkey)
until ch in ['C','K'];
if ch='K' then exit;
ASSIGN(Y,'Phu'); {Mo mot Tep phu de dua cac muc co
stt<>k sang}
REWRITE(Y); {Mo Tep phu de bat dau ghi cac ban ghi Ts}
while NOT(EOF(X)) do
begin
READ(X,Ts);
if FILEPOS(X)<>k then WRITE(Y,Ts);
{Tuc la neu STT<>k thi ghi vao Tep Y}
end;
CLOSE(X); {Dong Tep X}
ERASE(X); {Xoa Tep X}
CLOSE(Y); {Dong Tep Y}
RENAME(Y,'ThiSinh.dat'); {Doi Tep phu thanh tep chinh}
end;
procedure SapXep(var X:kieuTep; Ten:str20);
{Vi du sap xep Tong diem Toan+Ly+Hoa giam dan}
var Tsi,Tsj : kieuThiSinh;
i,j,n : word;
begin
MoTep(X,Ten,ok);
if not(ok) then exit;
clrscr;
writeln('Dang sap xep lai Tep...');
n:=FILESIZE(X);
for i:=1 to n-1 do
for j:=i+1 to n do
begin
SEEK(X,i-1); {Den stt=i}
READ(X,Tsi); {Doc du lieu ra bien Tsi}
SEEK(X,j-1); {Den stt=j}
READ(X,Tsj); {Doc du lieu ra bien Tsj}
if Tsi.Toan+Tsi.Ly+Tsi.Hoa
begin
SEEK(X,i-1); {Den stt=i}
WRITE(X,Tsj); {Viet Tsj vao thay cho Tsi}
SEEK(X,j-1); {Den stt=j}
WRITE(X,Tsi); {Viet Tsi vao thay cho Tsj}
end;
end;
CLOSE(X); {Dong Tep lai}
writeln('Da sap xep xong!');
end;
procedure TraDiem(var X:kieuTep; Ten:str20);
var dem : word;
PhanTen : str20;
k,LPT,i,L : byte;
function StrUpcase(S:str20):str20;
var i,L:byte;
begin
L:=length(S);
for i:=1 to L do S[i]:=Upcase(S[i]);
StrUpcase:=S;
end;
begin
MoTep(X,Ten,ok);
if not(ok) then exit;
ClrScr;
writeln('Nhap mot phan ten de tra diem. OK.');
write('Phan ten = ');
readln(PhanTen);
PhanTen:=StrUpcase(PhanTen);
LPT:=length(PhanTen);
writeln('Du lieu hien thoi la:');
writeln('Stt Ten '+
'Toan Ly Hoa');
dem:=0;
textcolor(15);
while not(EOF(X)) do
begin
READ(X,Ts);
k:=pos(PhanTen,StrUpcase(Ts.Ten));
if k>0 then
begin
dem:=dem+1;
L:=length(Ts.Ten);
write(FILEPOS(X):3,' ');
for i:=1 to L do
begin
if (i in [k..k+LPT-1]) then TextColor(12)
else TextColor(15);
write(Ts.Ten[i]);
end;
writeln('':20-length(Ts.Ten),
Ts.Toan:5:1,Ts.Ly:5:1,Ts.Hoa:5:1);
end;
end;
textcolor(7);
if dem=0 then writeln('Khong co thi sinh nao nhu vay!')
else writeln('Co tat ca ',dem,' thi sinh theo yeu cau.');
readkey;
CLOSE(X);
end;
procedure Menu(var ch:char);
begin
clrscr;
writeln('Cac cong viec voi Danh sach Thi sinh?');
writeln('0.- Thoat ve DOS');
writeln('1.- Cap nhat Danh sach');
writeln('2.- Cho xem lai Danh sach');
writeln('3.- Sua chua Thong tin');
writeln('4.- Xoa bot Thi sinh');
writeln('5.- Sap xep lai Danh sach');
writeln('6.- Tra diem thi');
write('Ban chon cong viec so may? ');
repeat
ch:=readkey
until ch in ['0'..'6',#27];
if ch=#27 then ch:='0';
end;
(*--------------- CT chinh ----------------*)
BEGIN
textmode(c80);
repeat
Menu(CongViec);
case CongViec of
'0':exit;
'1':CapNhat(DsThiSinh,TenTep);
'2':InDanhSach(DsThiSinh,TenTep);
'3':SuaChua(DsThiSinh,TenTep);
'4':XoaBo(DsThiSinh,TenTep);
'5':SapXep(DsThiSinh,TenTep);
'6':TraDiem(DsThiSinh,TenTep);
end;
until CongViec='0'
END.
lightsmok 23:33 05-06-2009
Bai cua Bach Hop nen lam nhu sau, neu chi cot tap tep n so nguyen: Khong dung mang ton bo nho, Khi nhap n phai kiem tra, Phai su dung unit crt...
uses crt;
var i,n,a : integer;
f : file of integer;
procedure nhap;
begin
write('so phan tu n= ');
readln(n);
if (n<1) or (n>100) then nhap;
assign(f,'dl.dat');
rewrite(f);
for i:=1 to n do
begin
write('Phan tu thu ',i,' la: ');
readln(a);
write(f,a);
end;
close(f);
end;
begin
ClrScr;
nhap;
writeln('Tep da tao xong! Go mot phim de thoat...');
readkey;
end.
bách hợp -P3T 23:02 04-06-2009
type mang=array[1..100] of integer;
var a:mang;
i,n:integer;
f:file of integer;
procedure nhap;
begin
write('so phan tu n= ');readln(n);
assign(f,'dl.dat');
rewrite(f);
for i:=1 to n do
begin
readln(a[i]);
write(f,a[i]);
end;
close(f);
end;
begin
nhap;
readln;
end.
em cám ơn thầy
Huan 23:58 10-04-2009
sontung 02:55 23-03-2009