bai tap phan 9

by **Profession_jamy** Sat Oct 30, 2010 9:18 am

Program Cat_Tap_tin;
Var
f,g1,g2 : File;
Buf : Array[1..63000] Of Byte;
Trungdiem : LongInt;
{-------------------------------------}
Procedure BaoLoi;
Begin
Writeln('Khong mo duoc tap tin');
Halt;
End;
{-------------------------------------}
Procedure MoTapTin;
Var
TenTT,TenTT1,TenTT2: String;
Begin
Write('-Ten tap tin nguon: ');
Readln(TenTT);
Write('-Ten tap tin dich 1: ');
Readln(TenTT1);
Write('-Ten tap tin dich 2: ');
Readln(TenTT2);
Assign(f,TenTT);
Reset(f,1);
Assign(g1,TenTT1);
Rewrite(g1,1);
Assign(g2,TenTT2);
Rewrite(g2,1);
If IOResult <> 0 Then
BaoLoi;
End;
{-------------------------------------}
Procedure TinhTrungDiem;
Begin
TrungDiem := (Filesize(f) Div 2);
End;
{-------------------------------------}
Procedure ChepNuaDau;
Var
S : LongInt;
Num,SoDoc,SoGhi : Word;
Begin
S :=TrungDiem;
Repeat
If Sizeof(Buf) <= S Then
Num := Sizeof(Buf)
Else
Num := S;
BlockRead(f,Buf, Num,SoDoc);
If IOResult <> 0 Then
BaoLoi;
BlockWrite(g1,Buf,SoDoc,SoGhi);
If IOResult <> 0 Then
BaoLoi;
Dec(S,Num);
Until S = 0;
Close(g1);
End;
{-------------------------------------}
Procedure ChepNuaSau;
Var
SoDoc,SoGhi : Word;
Begin
Seek(f,TrungDiem);
If IOResult <> 0 Then
BaoLoi;
Repeat
BlockRead(f,Buf, Sizeof(Buf),SoDoc);
If IOResult <> 0 Then
BaoLoi;
BlockWrite(g2,Buf,SoDoc,SoGhi);
If IOResult <> 0 Then
BaoLoi;
Until (SoDoc = 0) Or (SoGhi <> SoDoc);
Close(g2);
Close(f);
End;
{-------------------------------------}
BEGIN
MoTapTin;
TinhTrungDiem;
ChepNuaDau;
ChepNuaSau;
Writeln;
Write('Da thuc hien xong, bam <Enter>... ');
Readln;
END.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
Program Menu;
Uses Crt;
Type
St17 = String[17];
St7 = String[7];
HoSo = RECORD
Holot : St17;
Ten : St7;
ns : Integer;
Diem : Real
End;
Mang = Array[1..100] Of HoSo;
fhs = File Of HoSo;
Var
Filename : String[11];
f : fhs;
Tam : HoSo;
Ch : Char;
{----------------------------------}
Procedure Nhap(Var f : fhs);
Begin
Rewrite(f);
With Tam Do
Repeat
Write('-Ho lot (0 de ket thuc): ');
Readln(Holot);
If Holot <> '0' Then
Begin
Write('-Ten: ');
Readln(Ten);
Write('-Nam sinh: ');
Readln(Ns);
Write('-Diem: ');
Readln(Diem);
Write(f,tam);
End;
Until HoLot = '0';
Close(f);
End;
{----------------------------------}
Procedure SapXep(Var f : Fhs);
Var
i,j,Spt : Integer;
ds : Mang;
Begin
Reset(f);
Spt := 0;
While Not EOF(f) Do
Begin
Spt := Spt + 1;
Read(f,ds[spt]);
End;
For i := 1 To spt - 1 Do
For j := spt Downto i + 1 Do
If ds[j].Ten[1] < ds[j-1].Ten Then
Begin
Tam := ds[j];
ds[j] := ds[j-1];
ds[j-1] := Tam;
End;
Rewrite(f);
For i := 1 To spt Do
Write(f,ds[i]);
Close(f);
Writeln;
Write('Da sap xep xong, bam <Enter>... ');
Readln;
End;
{----------------------------------}
Procedure Xem(Var f : Fhs);
Begin
ClrScr;
Writeln(' HO VA TEN DIEM');
Reset(f);
While Not EOF(f) Do
Begin
Read(f,Tam);
With Tam Do
Writeln(Holot:17,' ',Ten:7,' ',Diem:6:1);
End;
Readln;
End;
{----------------------------------}
Procedure CapNhat(Var f : Fhs);
{--------------------}
Procedure Sua(Var f:Fhs);
Var
Holot1 : St17;
Ten1 : St7;
TimThay : Boolean;
Begin
Repeat
Write('-Holot: ');
Readln(Holot1);
Write('-Ten : ');
Readln(Ten1);
TimThay := False;
Reset(f);
While Not EOF(f) Do
With Tam Do
Begin
Read(f,Tam);
If (Holot = Holot1) And (Ten = Ten1) Then
Begin
Timthay := True;
Writeln(Holot,' ',Ten,' Diem : ',Diem : 0:1);
Repeat
Writeln('Co sua khong ? (c/k) ');
Ch := Readkey;
Until Ch in['c','C','k','K'];
If Upcase(Ch) = 'C' Then
Begin
Write('-Ho lot: ');
Readln(Holot);
Write('-Ten : ');
Readln(Ten);
Write('-Nam sinh : ',ns);
Write('-Diem : ');
Readln(Diem);
Seek(f,filepos(f)-1);
Write(f,Tam);
End;
End;
End;
If Not TimThay Then
Writeln('Khong tim thay');
Repeat
Writeln('Tim nu khong ? (c/k) ');
Ch := Readkey;
Until Ch in['c','C','k','K'];
Until Upcase(Ch) = 'K'
End;
{--------------------}
Procedure Them(Var f: Fhs);
Begin
Reset(f);
Seek(f,Filesize(f));
With Tam Do
Repeat
Write('-Ho lot: ');
Readln(Holot);
Write('-Ten : ');
Readln(Ten);
Write('-Nam sinh : ',ns);
Write('-Diem : ');
Readln(Diem);
Write(f,Tam);
Repeat
Writeln('Them nua khong ? (c/k) ');
Ch := Readkey;
Until Ch in['c','C','k','K'];
Until Upcase(Ch) = 'K';
End;
{-------------------}
Procedure Xoa(Var f : Fhs);
Var
ds : Mang;
Holot1 : St17;
Ten1 : St7;
i,spt,vitri : Integer;
TimThay : Boolean;
Begin
Reset(f);
spt := 0;
While Not EOF(f) Do
Begin
Read(f,Tam);
spt := spt + 1;
ds[spt] := Tam;
End;
Repeat
Write('-Ho lot : ');
Readln(holot1);
Write('-Ten : ');
Readln(Ten1);
TimThay := False;
i := 0;
Repeat
i := i + 1;
If (ds[i].Holot = Holot1) And (ds[i].Ten = Ten1) Then
Begin
TimThay := True;
vitri := i;
End;
Until TimThay Or (i > spt);
If TimThay Then
Begin
With ds[vitri] Do
Writeln(Holot,' ',Ten,' Diem: ',Diem:0:1);
Repeat
Writeln('Co xoa khong ? (c/k) ');
Ch := Readkey;
Until Ch in['c','C','k','K'];
If Upcase(Ch) = 'C' Then
Begin
spt := spt - 1;
For i := vitri To spt Do
ds[i] := ds[i+1];
End;
End
Else
Writeln('Khong tim thay');
Repeat
Writeln('Tim nua khong ? (c/k) ');
Ch := Readkey;
Until Ch in['c','C','k','K'];
Until Upcase(Ch) = 'K';
Rewrite(f);
For i := 1 To spt Do
Write(f,ds[i]);
Close(f);
End;
{-----Chuong trinh chiinh cua cap nhat-------}
Begin
Repeat
Repeat
ClrScr;
Writeln(' MENU CAP NHAT ');
Writeln('1-Sua');
Writeln('2-Them');
Writeln('3-Xoa');
Writeln('4-Thoat');
Ch := Readkey;
Until Ch in['1'..'4'];
Case Ch Of
'1' : Sua(f);
'2' : Them(f);
'3' : Xoa(f);
End;
Until Ch = '4'
End;
{************ CHUONG TRINH CHINH ***********}
BEGIN
ClrScr;
Write('-Ten tap tin : ');
Readln(Filename);
Assign(f,Filename);
Repeat
Repeat
ClrScr;
Writeln(' MENU CHINH');
Writeln(' 1-Nhap');
Writeln(' 2-Sap xep');
Writeln(' 3-Xem');
Writeln(' 4-Cap nhat');
Writeln(' 5-Ket thuc');
Writeln;
Ch := Readkey;
Until ch in['1'..'5'];
Case Ch Of
'1' : Nhap(f);
'2' : SapXep(f);
'3' : Xem(f);
'4' : CapNhat(f);
End;
Until Ch = '5'
END.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
Program D0_Dai_Cua_Dong;
Var
f : Text;
Filename : String[12];
St : String;
Max,Min: Integer;
Sodong,Tong : Integer;
Begin
Write('-Cho biet ten tap tin: ');
Readln(Filename);
Assign(f,Filename);
Reset(f);
Readln(f,St);
Max := length(St);
Min := Length(St);
Sodong := 1;
Tong := Length(St);
While Not EOF(f) Do
Begin
Readln(f,St);
If Max < Length(St) Then
Max := Length(St);
If Min > Length(St) Then
Min := Length(St);
Sodong := sodong + 1;
Tong := Tong + Length(St);
End;
Writeln('-Dong dai nhat : ',Max);
Writeln('-Dong ngan nhat : ',Min);
Writeln('-Trung binh : ',Tong / Sodong : 6:1);
Writeln;
Write('Bam <Enter>... ');
Readln
End.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
Program Diem_San_Pham;
Uses Crt;
Var
f : Text;
Nhom : Char;
d1,d2 : Real;
TongA1,TongA2 : Real;
TongB1,TongB2 : Real;
TongC1,TongC2 : Real;
SoA,SoB,SoC : Integer;
i : Integer;
Begin
Assign(f,'sanpham.txt');
Rewrite(f);
Writeln(f,'Nhom nguoi',' San pham 1 ',' San pham 2 ');
Writeln(f);
ClrScr;
Repeat
Write('Nhom nguoi ($ de thoat): ');
Readln(Nhom);
If Nhom <> '$' Then
Begin
Write('-Diem san pham 1 : ');
Readln(d1);
Write('-Diem san pham 2 : ');
Readln(d2);
Writeln(f,Upcase(Nhom):6,d1:16:1,d2:16:1);
End;
Until Nhom = '$';
Close(f);
ClrScr;
Reset(f);
Readln(f);
Readln(f);
TongA1 := 0;TongA2 := 0;SoA := 0;
TongB1 := 0;TongB2 := 0;SoB := 0;
TongC1 := 0;TongC2 := 0;SoC := 0;
While Not EOF(f) Do
Begin
For i := 1 To 6 Do {So vong lap bang vi tri cua nhom }
Read(f,Nhom);
Readln(f,d1,d2);
Case Nhom Of
'A' : Begin
TongA1 := TongA1 + d1;
TongA2 := TongA2 + d2;
SoA := SoA + 1;
End;
'B' : Begin
TongB1 := TongB1 + d1;
TongB2 := TongB2 + d2;
SoB := SoB + 1;
End;
'C' : Begin
TongC1 := TongC1 + d1;
TongC2 := TongC2 + d2;
SoC := SoC + 1;
End;
End;
End;
ClrScr;
Writeln('NHOM NGUOI',' TB San pham 1',' TB San pham 2');
Writeln;
If SoA <> 0 Then
Writeln('A':6,TongA1/SoA:16:1,TongA2/SoA:16:1);
If SoB <> 0 Then
Writeln('B':6,TongB1/SoB:16:1,TongB2/SoB:16:1);
If SoC <> 0 Then
Writeln('C':6,TongC1/SoC:16:1,TongC2/SoC:16:1);
Readln
End.Program DemChu;
Uses Crt;
Type
MangChu = Array[Char] Of Integer;
Var
f : Text;
Filename : String;
Line : String[25];
Chu : Char;
Letters,Lines,k : Integer;
Dem : MangChu;
Begin
ClrScr;
For Chu := Chr(0) To Chr(127) Do
Dem[chu] := 0;
Letters := 0;
Write('-Cho biet ten tap tin: ');
Readln(Filename);
Assign(f,Filename);
Reset(f);
While Not EOF(f) Do
Begin
Readln(f,Line);
For k := 1 To Length(line) Do
Begin
If Line[k] In ['a'..'z'] Then
Letters := Letters + 1;
Dem[Line[k]] := Dem[Line[k]] + 1;
End;
End;
Lines := 1;
Close(f);
Writeln('Tap tin: ',Filename,' co tat ca: ',Letters,' chu khong viet hoa');
Writeln;
Writeln('Phan phoi tan suat cua cac chu nhu sau:');
Writeln;
For Chu :='a' To 'z' Do
Begin
Write('-Chu: ',Chu,' = ');
Write((Dem[chu]/Letters * 100):6:2,' % ');
If (Lines Mod 4) = 0 Then
Writeln;
Lines := Lines + 1;
End;
Readln
End.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
Program Mo_Tap_Tin;
Label
NhapTenTapTin;
Var
F :Text;
Filename : String;
{--------------------------------------}
Procedure ThongBao(Str : String);
Begin
Write(Str + ' .Bam <Enter>');
Readln;
End;
{--------------------------------------}
BEGIN
NhapTenTapTin:
Writeln;
Write('-Cho biet ten tap tin van ban can mo: ');
Readln(Filename);
{$I-}
Assign(f,Filename);
Reset(f);
If IOResult = 0 Then
ThongBao('Da mo tap tin: '+ Filename+' ')
Else
Begin
Rewrite(f);
If IOResult = 0 Then
ThongBao('Da mo tap tin moi: '+Filename+' ')
Else
Begin
ThongBao('Khong the mo tap tin: '+Filename+' ');
Exit;
End;
End;
Close(f);
END.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
Program Tao_Tap_Tin_Van_Ban;
Var
f : Text;
Filename : String;
{---------------------------------}
Procedure Timvb(Var f: text; n : Word);
Var
i : Word;
Begin
Reset(f);
For i :=1 To n Do
Readln(f);
End;
{---------------------------------}
Procedure MoTapTin;
Begin
Write('-Cho biet ten tap tin van ban: ');
Readln(Filename);
{$I-}
Assign(f,Filename);
Rewrite(f);
If IOResult <> 0 Then
Begin
Writeln('Khong the mo tap tin moi: '+Filename+' ');
Halt;
End;
End;
{---------------------------------}
Procedure Nhap4dong;
Var
Tam : String;
i : Byte;
Begin
Writeln;
Writeln;
For i := 1 to 4 Do
Begin
Write('-Nhap dong thu: ',i:2,' : ');
Readln(Tam);
Writeln(f,Tam);
End;
End;
{---------------------------------}
Procedure Xuatdong2;
Var
Tam : String;
Begin
Timvb(f,2);
Readln(f,Tam);
Writeln('Dong thu 3 cua tap tin co noi dung la: ');
Writeln;
Writeln(' ',Tam);
End;
{---------------------------------}
BEGIN
MoTapTin;
Nhap4dong;
Writeln;
Xuatdong2;
Writeln;
Write(' Bam <Enter>... ');
Readln;
END.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
Program Xoa_Dong_Tap_Tin_Van_Ban;
Var
f : Text;
Filename : String;
{---------------------------------}
Procedure MoTapTin;
Var
Tam : String;
i : Byte;
Begin
Write('-Cho biet ten tap tin van ban: ');
Readln(Filename);
{$I-}
Assign(f,Filename);
Rewrite(f);
{$I+}
If IOResult <> 0 Then
Begin
Writeln('Khong the mo tap tin moi: '+Filename+' ');
Halt;
End;
For i := 1 to 4 Do
Begin
Write('-Nhap dong thu: ',i:2,' : ');
Readln(Tam);
Writeln(f,Tam);
End;
Close(f);
End;
{---------------------------------}
Procedure XemTapTin(Var f : Text);
Var
Tam : String;
Begin
Reset(f);
While Not EOF(f) Do
Begin
Readln(f,Tam);
Writeln(Tam);
End;
End;
{---------------------------------}
Procedure Xoadong(Var f : Text; n : Word);
Var
g : Text;
Tam : String;
i : Word;
Begin
Assign(g,Filename);
Reset(g);
Assign(f,'XOADONG.TXT');
Rewrite(f);
i := 0;
While Not EOF(g) Do
Begin
Readln(g,Tam);
If i <> n Then
Writeln(f,Tam);
Inc(i);
End;
Close(f);
End;
{---------------------------------}
BEGIN
MoTapTin;
Writeln;
Writeln(' Noi dung tap tin da tao');
Writeln;
XemTaptin(f);
Writeln;
Xoadong(f,2);
Writeln(' Noi dung con lai sau khi xoa dong 3');
Writeln;
XemTapTin(f);
Writeln;
Write(' Bam <Enter>... ');
Readln;
END.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
Program Xoa_chu_thich;
Var
Filename : String;
f,fn : Text;
Ch : Char;
Begin
Write('-Ten tap tin Pascal: ');
Readln(Filename);
Assign(f,Filename);
Assign(fn,'new.pas');
reset(f);
Rewrite(fn);
While not EOF(f) Do
Begin
Read(f,ch);
If Ch <> '{' Then
Write(fn,ch)
Else
Repeat
Read(f,ch);
Until (Ch = '}') Or EOF(f);
End;
Close(f);
Close(fn);
Writeln;
Write('Da thuc hien xong, bam <Enter>... ');
Readln;
End.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
Program Tim_Chuoi_Ky_Tu;
Var
Filename : String[12];
f : Text;
St : String;
Ch : Char;
Ok : Boolean;
i,solan:Integer;
Begin
Write('-Ten tap tin: ');
Readln(Filename);
Write('-Nhap chuoi ky tu: ');
Readln(St);
Assign(f,Filename);
Reset(f);
Solan := 0;
While NOt EOF(f) Do
Begin
Read(f,Ch);
If ch = St[1] Then
Begin
Ok := True;
i := 1;
While Not OK And ( i < length(St)) Do
Begin
Read(f,Ch);
If (Ch <> Chr(10)) And (Ch <> Chr(13)) Then
If Ch = St[1] Then
i := 1
Else
Begin
i := i + 1;
If (Ch <> St[i]) Then
Ok := False;
End;
End;
If Ok Then
Solan := Solan + 1;
End;
End;
Write('-Chuoi: ',St,' xuat hien : ',solan,' lan trong tap tin');
Readln;
Close(f);
End.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
Program Xu_ly_dong;
Var
f1,f2 : Text;
Filename : String[12];
lmax : Integer;
Tam,st,dong : String;
{--------------------------------------}
Procedure Catdong(Var st,dong:String;lmax :Integer);
Var
i : Integer;
Begin
i := lmax;
While st[i] <> ' ' Do
i:= i-1;
Dong := copy(st,1,i-1);
Delete(St,1,i);
End;
{--------------------------------------}
Procedure Lamday(Var dong: String;lmax : Integer);
Var
i,j : Integer;
Begin
i := lmax - length(dong);
While i <> 0 Do
Begin
j := Length(dong);
While (j > 1) And (i <> 0) Do
If (dong[j]=' ') And (dong[j-1] <> ' ') Then
Begin
Insert(' ',dong,j);
j :=j-1;
i := i-1;
End
Else
j := j-1;
End;
End;
{--------------------------------------}
BEGIN
Write('-Ten tap tin: ');
Readln(Filename);
Write('-Chieu dai cua dong: ');
Readln(lmax);
Assign(f1,filename);
Reset(f1);
Assign(f2,'new.txt');
Rewrite(f2);
St:=' ';
While NOt EOF(f1) Do
Begin
Readln(f1,tam);
St := St + Tam + ' ';
While length(St) >= lmax Do
Begin
Catdong(St,dong,lmax);
Lamday(dong,lmax);
Writeln(f2,dong);
End;
End;
Writeln(f2,St);
Writeln;
Writeln('Da thuc hien xong, bam <Enter>... ');
Readln;
reset(f2);
While Not EOF(f2) Do
Begin
Readln(f2,dong);
Writeln(dong);
End;
Writeln;
Write(' Xem xong bam <Enter>... ');
Readln;
Close(f1);
Close(f2);
END.
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)
(+==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==++==+==+==+)