Go Back   Diễn đàn trường THPT Trần Phú - Đà Nẵng > Góc học tập - Học tập online - học trực tuyến > Các môn học THPT > Môn Tin học > Tin học lớp 11


Hướng dẫn chung về kỳ thi Đại học, Cao đẳng 2012

Hãy tìm kiếm trước khi bạn đặt câu hỏi trên diễn đàn nhé !
Hữu ích:         Phần mềm dạy và học | Kinh nghiệm học tập | Bài giảng trực tuyến
  Văn mẫu:               Văn mẫu lớp 10 | Văn mẫu lớp 11 | Văn mẫu lớp 12

Hãy sử dụng trình duyệt FireFox hoặc Google Chrome để lướt web nhanh và an toàn hơn .
> Download FireFox < - > Download Google Chrome <



Similar Threads
Ðề tài Người Gởi Chuyên mục Trả lời Bài mới gởi
Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 1 KuteoDnC Tin học lớp 11 2 28-11-2010 10:48 PM
V-Pascal 2.10 lập trình Pascal cho người Việt Mc.Neo Software & Crack 0 06-11-2010 05:50 PM
Sơ lược về Pascal Delta Tin học lớp 11 0 14-09-2010 11:07 PM
Pascal Study 1.0 - học pascal từ cơ bản đến nâng cao Assassin_C7 Phần mềm dạy và học 5 28-01-2010 04:48 PM
Mối liên hệ giữa tam giác pascal và 7 hằng đẳng thức ♥•»…ßi…ƒ€nT…«•██ Toán Học 2 17-01-2010 01:27 PM


Tags - Từ khóa tìm thêm:
bai tap pascal lop 11, bai tap tin hoc lop 12, bai tap tin hoc11, bài tập tin học 11, bài tập pascal kiểu tệp lớp 11, cac dang toan chung pascal, cac dang toan pascal, của, dạng, dạy và học pascal, học, hoc tot tin hoc phan pascal, pascal, pascal lớp 11 circle, phần, tập, thư viện các dạng bài tập pascal của tin học 11 - phần 4, tin hoc 11 vi du 2 bai 16, viện
Gởi Ðề Tài Mới  Trả lời
 
Ðiều Chỉnh Xếp Bài
  #1  
Old 28-11-2010, 10:50 PM
KuteoDnC's Avatar
  User Profile
KuteoDnCAdmin KuteoDnC is offline
Administrator
   Họ & Tên: Ku tèo
  • Đang học lớp : * Đã ra trường .
  • Niên khóa : 2002 - 2005
 
Tham gia: Oct 2009
Nơi Cư Ngụ: 127.0.0.1
Point: 2,317,746
Đã cảm ơn: 159 bài viết
Được cảm ơn 645 lần trong 184 bài
KuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to beholdKuteoDnC is a splendid one to behold

Trùm tham nhũng Trùm tham nhũng Trùm tham nhũng Trùm tham nhũng 
Total Awards: 8

Send a message via ICQ to KuteoDnC
Default Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 2

Thư Viện Các Dạng Bài Tập Pascal của Tin Học 11 - Phần 2


101/Nhập số liệu cho 1 tập tin số nguyên:
Code:
Program Tap_Tin_So_Nguyen;
Uses Crt;
Var
    f : File Of Integer;
   So : Integer;
   a : Array[1..10] Of Integer;
   Spt,i,j : Integer;
   Filename : String[11];
Begin
   ClrScr;
    Writeln('NHAP SO LIEU CHO TAP TIN SONGUYEN.DAT');
   Writeln('-------------------------------------');
   Writeln;
   Assign(f,'songuyen.dat');
   ReWrite(f);
   For i := 1 To 10 Do
       Begin
          Write('-So thu: ',i:2,' = ');
         Readln(So);
         Write(f,so);
      End;
   Close(f);
   Spt := 0;
   Reset(f);
   While NOT EOF(f) Do
       Begin
          Spt := Spt + 1;
         Read(f,so);
         a[Spt] := so;
      End;
   Close(f);
   For i := 1 To Spt -1 Do
       For j := Spt Downto i + 1 Do
          If a[j] < a[j-1] Then
             Begin
                So := a[j];
               a[j] := a[j-1];
               a[j-1] := So;
            End;
   Writeln;
   Writeln('Sau khi sap xep: ');
   For i := 1 To 10 Do
       Write(a[i]:6);
   Writeln;
   Write(' Bam <Enter>... ');
   Readln
End.
102/Ghép tập tin:
Code:
Program Ghep_Tap_Tin;
Uses Crt;
Var
    f1,f2,f3 : File Of Real;
   i : Integer;
   So : Real;
   Ch : Char;
Begin
    ClrScr;
    Writeln('NHAP SO LIEU CHO TAP1.DAT');
   Writeln('-------------------------');
   Writeln;
   Assign(f1,'TAP1.DAT');
   Rewrite(f1);
   i := 0;
   Repeat
       i := i + 1;
      Write('-So thu: ',i:2,' = ');
      Readln(So);
      Write(f1,so);
      Write('    Nhap nua ? (c/k) ');
      Readln(Ch);
   Until Upcase(Ch) ='K';
   Close(f1);
   ClrScr;
   Writeln('NHAP SO LIEU CHO TAP2.DAT');
   Writeln('-------------------------');
   Writeln;
   Assign(f2,'TAP2.DAT');
   Rewrite(f2);
   i := 0;
   Repeat
       i := i + 1;
      Write('-So thu: ',i:2,' = ');
      Readln(So);
      Write(f2,so);
      Write('    Nhap nua ? (c/k) ');
      Readln(Ch);
   Until Upcase(Ch) ='K';
   Close(f2);
   ClrScr;
   Writeln('GHEP TAP1 va TAP2 thanh TAP3');
   Writeln('----------------------------');
   Writeln;
   Assign(f3,'TAP3.DAT');
   Rewrite(f3);
   Reset(f1);
   Reset(f2);
   While NOT EOF(f1) Do
       Begin
          Read(f1,So);
         Write(f3,So);
      End;
   While NOT EOF(f2) Do
       Begin
          Read(f2,so);
         Write(f3,so);
      End;
   Reset(f3);
   While NOT EOF(f3) Do
       Begin
          Read(f3,So);
         Write(So :8:1);
      End;
   Close(f1);
   Close(f2);
   Close(f3);
   Writeln;
   Writeln;
   Write('    Da ghep xong, Bam <Enter>...');
   Readln;
End.
103/Sổ tay điện thoại:
Code:
Program So_tay_Dien_Tu;
Uses Crt;
Type
    DienThoai = RECORD
       HoTen : String[24];
      Tel   : LongInt;
      Add   : String;
      End;
Var
    f       : File Of DienThoai;
   Tam     : DienThoai;
   St      : String;
   TimThay : Boolean;
Begin
    ClrScr;
    Writeln('NHAP SO DIEN THOAI VA DIA CHI');
   Writeln('-----------------------------');
   Writeln;
   Assign(f,'Telephon.dat');
   Rewrite(f);
   With tam Do
       Repeat
          Write('-Ho ten, bam (0> de ket thuc: ');
         Readln(HoTen);
         If HoTen <> '0' Then
             Begin
                 Write('-So phone : ');
                Readln(Tel);
                Write('-Dia chi : ');
                Readln(Add);
                Write(f,tam);
            End;
      Until Hoten = '0';
      Close(f);
      ClrScr;
      Writeln('TIM SO DIEN THOAI VA DIA CHI');
      Writeln('----------------------------');
      Writeln;
      Write('-Ho ten nguoi muon tim: ');
      Readln(St);
      Reset(f);
      TimThay := False;
      While NOT EOF(f) Do
          Begin
             Read(f,Tam);
            With Tam Do
                If St = HoTen then
                   Begin
                      TimThay := True;
                     Writeln(HoTen);
                     Writeln('-So Telephone: ',Tel);
                     Writeln('-Dia chi     : ',Add);
                  End;
         End;
      If Not TimThay Then
          Writeln('Khong tim thay');
      Close(f);
      Writeln;
      Write('   Bam <Enter>... ');
      Readln
End.
104/Che dấu tập tin:
Code:
Program CheDau_TapTin;
Uses Dos,Crt;
Var
    f : File; {hoac f : Text }
   Filename : String;
   Ch : Char;
Begin
    Repeat
        ClrScr;
       TextColor(14);
       TextBackGround(2);
       GotoXY(23,4);
        Writeln('DAT THUOC TINH CHE DAU TAP TIN');
       GotoXY(23,5);
        Writeln('------------------------------');
       Writeln;
       TextColor(12);
       GotoXY(11,6);
       Writeln('*Khong hien thi duoc ten tap tin khi dung lenh DIR cua DOS*');
       GotoXY(15,8);
       TextColor(1);
       TextBackGround(14);
       Write('-Cho biet ten tap tin: ');
      Readln(Filename);
      TextColor(4+Blink);
      TextBackGround(14);
      GotoXY(25,24);
      Writeln('DANG THUC HIEN, XIN CHO DOI...');
      Assign(f,Filename);
      SetFAttr(f,Hidden);
      TextColor(4);
      TextBackGround(15);
      GotoXY(15,10);
      Case DosError Of
          0 : Writeln('Da hoan thanh tot dep');
         2 : Writeln('Khong tim thay tap tin nay');
         3 : Writeln('Khong tim thay duong dan')
      Else
          Writeln('Tap tin duoc bao ve, khong sua duoc');
      End;
      GotoXY(19,24);
      TextColor(14);
      TextBackGround(4);
      Writeln('Bam phim bat ky de tiep tuc, <Esc> de thoat ');
      Ch := Readkey;
      TextColor(White);
       TextBackGround(Black);
       ClrScr;
   Until Ch = #27;
End.
105/Cập nhật dữ liệu:
Code:
Program Cap_Nhat_Du_Lieu;
Uses Crt;
Type
    HoSo = RECORD
       Holot : String[17];
      Ten   : String[7];
      Tuoi  : 18..60;
      ChucVu: String[20];
      BacLuong : 300000..900000;
      End;
Var
    f : File Of HoSo;
   Nv : HoSo;
   ans : Char;
Begin
    ClrScr;
    Writeln('CAP NHAT DU LIEU VAO TAP TIN LUONG.DAT');
   Writeln('----------------------------------');
   Writeln;
   Assign(f,'LUONG.DAT');
   Reset(f);
   Seek(f,Filesize(f));
   Repeat
       With Nv Do
          Begin
             Write('-Ho lot: ');
            Readln(Holot);
            Write('-Ten   : ');
            Readln(Ten);
            Write('-Tuoi  : ');
            {$R+}
            Readln(tuoi);
            Write('-Chuc vu : ');
            Readln(ChucVu);
            Write('-Bac luong: ');
            Readln(BacLuong);
            Write(f,Nv);
         End;
      ans := Readkey;
   Until ans = #27;
   Close(f);
End.
106/Đọc tập tin:
Code:
Program Doc_Tap_tin;
Var
    f : Text;
   Filename : String;
   Ch : Char;
Begin
    Writeln('DOC TAP TIN VAN BAN');
   Writeln('-------------------');
   Writeln;
   Write('-Cho biet ten tap tin: ');
   Readln(Filename);
   Assign(f,filename);
   Reset(f);
   While Not EOF(f) Do
       Begin
          Read(f,Ch);
         Write(Ch);
      End;
   Close(f);
   Writeln;
   Write('Bam <Enter>... ');
   Readln
End.
107/Đọc chậm tập tin theo từng chử:
Code:
Program Doc_Tung_Chu;
Uses Crt;
Var
    Filename : String;
   f : Text;
   Line : String[251];
   k : Integer;
Begin
    ClrScr;
   Writeln('DOC CHAM TAP TIN THEO TUNG CHU');
   Writeln('------------------------------');
   Writeln;
   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
                Write(line[k]);
               Delay(150);
            End;
         Writeln;
      End;
   Close(f);
End.
108/Đọc ghi tập tin:
Code:
Program Doc_Ghi_Tap_Tin;
Var
    f1,f2 : Text;
   Filename : String;
   i : Integer;
   St : String;
Begin
    Writeln('DANH SO DONG TAP TIN');
   Writeln('--------------------');
   Writeln;
   Write('-Cho biet ten tap tin: ');
   Readln(Filename);
   Assign(f1,filename);
   Reset(f1);
   Assign(f2,'Newfile.txt');
   Rewrite(f2);
   i := 0;
   While Not EOF(f1) Do
       Begin
          i := i + 1;
         Readln(f1,st);
         Writeln(f2,i,' ',St);
      End;
   Close(f1);
   Close(f2);
   Writeln;
   Writeln('Da danh so dong va ghi vao tap tin NEWFILE.TXT');
   Writeln;
   Write('     Bam <Enter> de xem tap tin NEWFILE.TXT ');
   Readln;
   Assign(f2,'Newfile.txt');
   Reset(f2);
   While Not EOF(f2) Do
       Begin
          Readln(f2,st);
         Writeln(St);
      End;
   Close(f2);
   Writeln;
   Write('Xem xong, ban <Enter> ');
   Readln
End.
109/Tạo tập tin âm thanh Lambada:
Code:
Program Lambada;
Uses Crt;
Var
    f : Text;
   Note,dur : Word;
   Buf : Array[1..10240] Of Byte;
{---------------------------------}
    Procedure Play(Caodo,Truongdo : Word);
   Begin
       Sound(Caodo);
      Delay(Truongdo);
      NoSound;
   End;
{---------------------------------}
BEGIN
    ClrScr;
   TextColor(Yellow);
    Writeln('TAO TAP TIN AM THANH');
   TextColor(Red);
   Writeln('--------------------');
   Writeln;
   TextColor(Green);
   Writeln('Bam phim bat ky de tat am thanh');
   Repeat
        Assign(f,'lambada.not');
       SetTextBuf(f,buf);
       Reset(f);
       While (Not EOF(f)) And (Not KeyPressed) Do
            Begin
              Readln(f,Note,dur);
             Play(Note,Dur);
            End;
   Until KeyPressed;
   Close(f);
   NoSound;
END.
110/Karaoke:
Code:
Program Karaoke;
Uses Crt;
Const
    Lento = 10;
Type
    ConTro = ^Nhac;
   Nhac = RECORD
       Note,Dura : Word;
      Next      : ConTro;
      End;
Var
    f : Text;
   P,First, Last,HeapTop : ConTro;
{------------------------------------}
    Procedure AssignList(Filename : String);
   Begin
       Assign(f,Filename);
      {$I-}
      Reset(f);
      {$I+}
      If IOResult <> 0 Then
          Halt(1);
      First := Nil;
      Mark(HeapTop);
      While NOt EOF(f) Do
          Begin
             New(p);
            Readln(f,p^.Note,p^.Dura);
            If First = Nil Then
                First := p
            Else
                Last^.Next := p;
            Last := p;
            Last^.Next := Nil;
         End;
      Close(f);
   End;
{------------------------------------}
   Procedure Music;
   Begin
       p := First;
      While (p <> Nil) And Not (KeyPressed And (Readkey = #27)) Do
          Begin
             Sound(p^.Note);
            Delay(Lento*p^.Dura);
            p := p^.Next;
            If p = Nil Then
                p := First;
         End;
   End;
{------------------------------------}
BEGIN
    ClrScr;
   Writeln('    CHUONG TRINH NHAC EM DIU');
   Writeln('Truong do cham 10 lan so voi BT15_10');
   Writeln('     Bam <Esc> de ket thuc');
   Writeln('-------------------------------------');
    AssignList('Lambada.Not');
   Music;
   NoSound;
END.
111/Ghi điểm vào tập tin:
Code:
Program Nhap_Diem;
Type
    HocBa = RECORD
       HoTen : String[24];
      Van,Toan,Ly,Hoa,Tb: Real;
      End;
   FileHB = File Of HocBa;
Var
    f : FileHB;
   HS : HocBa;
   q : Boolean;
Begin
    Writeln('CHUONG TRINH GHI DIEM VAO TAP TIN');
   Writeln('--------------------------------------');
   Writeln;
   Assign(f,'DIEM.DAT');
   ReWrite(f);
   q := True;
   While q Do
       With HS Do
          Begin
             Write('-Ho ten hoc sinh,(<Enter> de ket thuc): ');
            Readln(HoTen);
            If HoTen = '' Then
                    Q := False
                Else
                    Begin
                   Write('-Diem Van : ');
                  Readln(Van);
                  Write('-Diem Toan: ');
                  Readln(Toan);
                  Write('-Diem Ly  : ');
                  Readln(Ly);
                  Write('-Diem Hoa : ');
                  Readln(Hoa);
                  Tb := ((Van*2)+(Toan*2)+Ly+Hoa)/6;
                  Write(f,HS);
                    End;
         End;
End.
112/Ghi thêm điểm vào tập tin:
Code:
Program Nhap_Them_Diem;
Type
    HocBa = RECORD
       HoTen : String[24];
      Van,Toan,Ly,Hoa,Tb: Real;
      End;
   FileHB = File Of HocBa;
Var
    f : FileHB;
   HS : HocBa;
   q : Boolean;
Begin
    Writeln('CHUONG TRINH GHI THEM DIEM VAO TAP TIN');
   Writeln('--------------------------------------');
   Writeln;
   Assign(f,'DIEM.DAT');
   Reset(f);
   Seek(f,filesize(f));
   q := True;
   While q Do
       With HS Do
          Begin
             Write('-Ho ten hoc sinh,(<Enter> de ket thuc): ');
            Readln(HoTen);
            If HoTen = '' Then
                    Q := False
                Else
                    Begin
                   Write('-Diem Van : ');
                  Readln(Van);
                  Write('-Diem Toan: ');
                  Readln(Toan);
                  Write('-Diem Ly  : ');
                  Readln(Ly);
                  Write('-Diem Hoa : ');
                  Readln(Hoa);
                  Tb := ((Van*2)+(Toan*2)+Ly+Hoa)/6;
                  Write(f,HS);
                    End;
         End;
End.
113/Tìm điểm theo họ tên:
Code:
Program Timp_Diem;
Type
    HocBa = RECORD
       HoTen : String[24];
      Van,Toan,Ly,Hoa,Tb: Real;
      End;
   FileHB = File Of HocBa;
Var
    f : FileHB;
   Hs : HocBa;
   St : String;
   TimThay : Boolean;
Begin
    Writeln('CHUONG TRINH TIM DIEM THEO HO TEN');
   Writeln('---------------------------------');
   Writeln;
   Write('-Ho ten hoc sinh muon tim: ');
   Readln(St);
   Assign(f,'DIEM.DAT');
   Reset(f);
   Timthay := False;
   While Not EOF(f) Do
       Begin
           Read(f,Hs);
               With Hs Do
                  If St = HoTen Then
                      Begin
                         TimThay := True;
                        Writeln(HoTen);
                           Writeln('-Diem Van : ',Van:5:2);
                        Writeln('-Diem Toan: ',Toan:5:2);
                        Writeln('-Diem Ly  : ',Ly:5:2);
                        Writeln('-Diem Hoa : ',Hoa:5:2);
                        Writeln('-Diem trung binh := ',Tb:5:2);
                        End
      End;
   If Not Timthay Then
       Writeln('Trong danh sach khong co hoc sinh: ',St);
   Close(f);
   Writeln;
   Write('   Bam <Enter>... ');
   Readln;
End.
114/Hồ sơ:
Code:
Program Ho_So;
Uses Crt;
Type
    LyLich = RECORD
       HoTen : String[24];
      NamSinh : Integer;
      ChucVu : String[20];
      BacLuong : Real;
      End;
Var
    f : File Of LyLich;
   q : Boolean;
   Nv : LyLich;
   Stt : Integer;
   Ch : Char;
Begin
    ClrScr;
   Assign(f,'HOSO.DAT');
   Rewrite(f);
   q := True;
   While q Do
       With Nv Do
           Begin
              Write('-Ho ten CBCNV (<Enter> de ngung): ');
             Readln(HoTen);
            If HoTen = '' Then
                q := False
            Else
                Begin
                   Write('-Nam sinh: ');
                  Readln(NamSinh);
                  Write('-Chuc vu: ');
                  Readln(Chucvu);
                  Write('-Bac luong: ');
                  Readln(BacLuong);
                  Write(f,Nv);
               End;
          End;
      Repeat
          GotoXY(28,24);
         Write('Co can sua khong? (c/k) ');
         Readln(Ch);
         If UpCase(Ch) = 'C' Then
             Begin
                Write('-Thay doi so thu tu : ');
               Readln(Stt);
               If Stt >= 1 Then
                   Begin
                      Seek(f,Stt-1);
                     With Nv Do
                         Begin
                            Write('-Ho ten CBCNV : ');
                           Readln(HoTen);
                            Write('-Nam sinh: ');
                              Readln(NamSinh);
                              Write('-Chuc vu: ');
                              Readln(Chucvu);
                              Write('-Bac luong: ');
                              Readln(BacLuong);
                              Write(f,Nv);
                        End;
                  End;
            End;
      Until UpCase(Ch) = 'K';
   Close(f)
End.
115/Trộn tập tin:
Code:
Program Tron_Tap_tin;
Uses Crt;
Var
    f1,f2,f3 : File Of Integer;
   So1,So2 : Integer;
   i : Integer;
   Ch : Char;
   ok1,ok2 : Boolean;
{--------------------------------}
    Function Layso1(Var So1 : Integer): Boolean;
   Begin
       If Not EOF(f1) Then
          Begin
             Read(f1,So1);
            LaySo1 := True;
         End
      Else
          layso1 := False;
   End;
{--------------------------------}
   Function Layso2(Var So2 : Integer): Boolean;
   Begin
       If Not EOF(f2) Then
          Begin
             Read(f2,So2);
            LaySo2 := True;
         End
      Else
          layso2 := False;
   End;
{--------------------------------}
BEGIN
    Assign(f1,'so1.dat');
   Rewrite(f1);
   ClrScr;
   Writeln('NHAP TAP TIN SO1');
   Writeln('----------------');
   Writeln;
   i := 0;
   Repeat
       i := i + 1;
      Write('-So thu: ',i:2,' = ');
      Readln(So1);
      Write(f1,so1);
      Write('-Nhap nua ? (c/k) ');
      Readln(Ch);
   Until Upcase(Ch) = 'K';
   Close(f1);
   Assign(f2,'so2.dat');
   Rewrite(f2);
   ClrScr;
   Writeln('NHAP TAP TIN SO2');
   Writeln('----------------');
   Writeln;
   i := 0;
   Repeat
       i := i + 1;
      Write('-So thu: ',i:2,' = ');
      Readln(So2);
      Write(f2,so2);
      Write('-Nhap nua ? (c/k) ');
      Readln(Ch);
   Until Upcase(Ch) = 'K';
   Close(f2);
   Assign(f3,'so3.dat');
   Rewrite(f3);
   Reset(f1);
   Reset(f2);
   ok1 := Layso1(So1);
   ok2 := Layso2(so2);
   While ok1 Or ok2 Do
       Begin
          If ok1 And ok2 Then {co ca 2 tap tin}
             Begin
                If So1 < So2 Then
                   Begin
                      Write(f3,so1);
                     ok1 := layso1(so1);
                  End
               Else
                   Begin
                      Write(f3,so2);
                     ok2 := Layso2(so2);
                  End;
            End
         Else
             If ok1 Then   {chi con tap tin so1.dat}
                Begin
                   Write(f3,so1);
                  ok1 := layso1(so1);
               End
            Else
                If ok2 Then   {chi con tap tin so2.dat}
                   Begin
                      Write(f3,so2);
                     ok2 := Layso2(so2);
                  End;
      End;
   Writeln;
   Reset(f3);
   While not EOF(f3) Do
       Begin
          Read(f3,i);
         Write(i:6);
      End;
   Close(f1);
   Close(f2);
   Close(f3);
   Writeln;
   Write('Da tron xong, bam <Enter>... ');
   Readln
END.
116/Đội tuyển:
Code:
Program Doi_Tuyen;
Uses Crt;
Type
    HocSinh = RECORD
       HoTen : String[24];
      Lop : String[4];
      Dtb : Real;
      End;
   Fhs = File Of HocSinh;
Var
    f : Fhs;
   Ch : Char;
{----------------------------------}
    Procedure Nhap(Var f : Fhs);
   Var
       Tam : HocSinh;
   Begin
       Rewrite(f);
      Repeat
          Write('-Nhap ho ten (0 de thoat): ');
            Readln(Tam.Hoten);
            If Tam.HoTen <> '0' Then
                Begin
                Write('-Lop: ');
               Readln(Tam.Lop);
               Write('-Diem trung binh: ');
               Readln(Tam.Dtb);
               Write(f,Tam);
                End;
      Until tam.HoTen ='0';
   Close(f);
   End;
{----------------------------------}
   Procedure Lapds(Var f:Fhs);
   Var
       Tam    : Hocsinh;
      a      : Array[1..1000] Of HocSinh;
      TenLop : Array[1..100] Of String[4];
      alop   : Array[1..200] Of HocSinh;
      Sohs12,Solop12,Sohslop : Integer;
      Stt    : Integer;
      i,j,k  : Integer;
      Coroi  : Boolean;
   Begin
       Reset(f);
      Sohs12 := 0;
      Solop12 := 0;
      While Not EOF(f) Do
          Begin
             Read(f,tam);
            If (Tam.Lop[1]='1') And (Tam.Lop[2]='2') Then
                Begin
                   Sohs12 := Sohs12 + 1;
                  a[Sohs12] := Tam;
                  Coroi := False;
                  For i := 1 To Solop12 Do
                      If Tenlop[i] = Tam.Lop Then
                         Coroi := True;
                  If Not coroi Then
                      Begin
                         Solop12 :=Solop12+1;
                        TenLop[Solop12] := Tam.Lop;
                     End;
               End;
         End;
      Writeln('|','STT','|','HO VA TEN':24,'|','  LOP  ','|','  HANG  ','|');
      Stt := 1;
      For i := 1 to Solop12 Do
          Begin
             Sohslop := 0;
            For j := 1 To Sohs12 Do
                If a[j].Lop = Tenlop[i] Then
                   Begin
                      Sohslop := Sohslop + 1;
                     alop[sohslop]:=a[j];
                  End;
            For k := 1 To Sohslop - 1 Do
                For j := sohslop DownTo k + 1 Do
                   If alop[j].Dtb > alop[j-1].Dtb Then
                      Begin
                         Tam := alop[j];
                        alop[j] := alop[j-1];
                        alop[j-1] := Tam;
                     End;
                  If Sohslop >=3 Then
                      For k := 1 To 3 Do
                         Begin
                            With alop[k] Do
                           Writeln('|',stt:3,' |',HoTen:24,' | ',
                                            Lop:5,' | ',k : 3,' |');
                           Stt := Stt + 1;
                        End
                  Else
                      For k := 1 To Sohslop Do
                         Begin
                            With alop[k] Do
                               Writeln('|',stt:3,' |',HoTen:24,' | ',
                                            Lop:5,' | ',k : 3,' |');
                              Stt := Stt + 1;
                        End;
         End;
      Close(f);
   End;

{----------------------------------}
BEGIN
    Assign(f,'doituyen.dat');
   Repeat
       Repeat
          Writeln('1-Nhap du lieu');
         Writeln('2-Danh sach doi du tuyen');
         Writeln('3-Ket thuc');
         Ch := Readkey;
      Until ch in ['1'..'3'];
      Case Ch Of
          '1' : Nhap(f);
         '2' : Lapds(f);
      End;
   Until Ch = '3';
END.
117/Tạo tập tin có kiểu:
Code:
Program Tao_Tap_Tin_Co_Kieu;
Type
    HocSinh = RECORD
       Ten : String[7];
      Diem : 0..10;
      End;
Var
    f : File Of Hocsinh;
{-------------------------------}
    Procedure TaoTapTin;
   Var
       Tam : HocSinh;
      Filename : String;
   Begin
       Write('-Cho biet ten tap tin: ');
      Readln(Filename);
      Assign(f,Filename);
      {$I-}
      Rewrite(f);

      {$I+}
      If IOResult <> 0 Then
          Begin
             Writeln('Khong mo duoc tap tin: ',Filename);
            Halt;
         End;
      Repeat
          Write('Ten (bam <Enter> de cham dut) : ');
         Readln(Tam.Ten);
            If Tam.Ten <> '' Then
             Begin
                Write('-Diem : ');
               Readln(Tam.Diem);
               Write(f,Tam);
            End;
      Until Tam.Ten = '';
      Close(f);
   End;
{-------------------------------}
   Procedure XemLaiBanGhi;
   Var
       RecNo : Word;
      Tam : HocSinh;
   Begin
       Write('-Xem lai ban ghi thu may: ');
      Readln(RecNo);
      Reset(f);
      Seek(f,RecNo-1);
      Read(f,Tam);
      Writeln('-Ten  : ',Tam.Ten);
      Writeln('-Diem : ',Tam.Diem);
   End;
{-------------------------------}
BEGIN
    TaoTapTin;
   Writeln;
   XemLaiBanGhi;
   Writeln;
   Write('    Bam <Enter>... ');
   Readln;
END.
118/Tạo danh sách:
Code:
Program Tao_Danh_Sach;
Type
    HocSinh = RECORD
       Ten : String[7];
      Diem : 0..10;
      End;

   T_pList = ^T_List;
   T_List = RECORD
       d : HocSinh;
      Next : T_pList;
      End;
Var
    f : File Of Hocsinh;
   First : Pointer;
   Curr, News : T_pList;
{-------------------------------}
    Procedure MoTapTin;
   Var
      Filename : String;
   Begin
       Write('-Cho biet ten tap tin: ');
      Readln(Filename);
      Assign(f,Filename);
      {$I-}
      Reset(f);

      {$I+}
      If IOResult <> 0 Then
          Begin
             Writeln('Khong mo duoc tap tin: ',Filename);
            Halt;
         End;
   End;
{-------------------------------}
    Procedure DocVaoList;
   Begin
       First := Nil;
      While NOt EOF(f) Do
          Begin
             New(News);
            News^.Next := Nil;
            Read(f,News^.d);
            If First = Nil Then
                First := News
            Else
                Curr^.Next := News;
            Curr := News;
         End;
      Close(f);
   End;
{-------------------------------}
   Procedure Xem;
   Begin
       Curr :=First;
      While Curr <> Nil Do
          Begin
             Writeln('-Ten: ',Curr^.D.Ten : 6, #32:10,
                '-Diem : ',Curr^.D.Diem);
            Curr := Curr^.Next;
         End;
   End;
{-------------------------------}
BEGIN
    MoTapTin;
   Writeln;
   DocVaoList;
   Writeln;
   Xem;
   Writeln;
   Write('    Bam <Enter>... ');
   Readln;
END.
119/Dự đoán bóng đá:
Code:
Program Du_Doan_Bong_Da;
Type
    Doi = RECORD
       Diem,hlv,tm,hv,ct,sb : Real;
      Ten : String[24];
      Hang : Integer;
      End;
   Filedb = file Of Doi;
   Mang = Array[1..40] Of Doi;
Var
    f : Filedb;
   i,j,n : Integer;
   a : Mang;
   t : Doi;
   q : Boolean;
Begin
    i := 1;
   q := True;
   While q Do
       With a[i] Do
          Begin
             Write('-Ten doi (bam <Enter> de ngung): ');
            Readln(Ten);
            If Ten = '' Then
                q := False
            Else
                Begin
                   Repeat
                      Write('=Diem huan luyen vien: ');
                     Readln(hlv);
                  Until hlv <=30;
                  Repeat
                      Write('=Diem thu mon: ');
                     Readln(tm);
                  Until tm <= 15;
                  Repeat
                      Write('=Diem hau ve: ');
                     Readln(hv);
                  Until hv <= 30;
                  Repeat
                      Write('=Diem cac cau thu khac: ');
                     Readln(ct);
                  Until ct <= 50;
                  Repeat
                      Write('=Diem thuan loi san bai: ');
                     Readln(sb);
                  Until sb <= 20;
                  Diem := hlv + hv + tm + ct + sb;
                  i := i + 1;
               End;
         End;
      n := i - 1;
      For i := 1 To N - 1 Do
          For j := 1 To N - i Do
             If a[j].Diem < a[j+1].Diem then
                Begin
                   t :=a[j];
                  a[j] := a[j+1];
                  a[j+1] := t;
               End;
      Assign(f,'diemdb.dat');
      Rewrite(f);
      For i := 1 to N Do
          Begin
             If (i > 1) And (a[i].Diem = a[i-1].Diem) Then
                a[i].Hang := a[i-1].Hang
            Else
                a[i].Hang := i;
            Write(f,a[i]);
         End;
      Close(f);
End.
120/Cắt tập tin:
Code:
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.
121/Tạo menu:
Code:
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.
122/Độ dài của dòng:
Code:
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.
123/Điểm Sản phẩm:
Code:
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.
124/Đếm chử:
Code:
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.
125/Tạo tập tin văn bản:
Code:
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.
126/Xóa dòng tập tin văn bản:
Code:
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.
127/Xóa chú thích:
Code:
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.
128/Tìm chuỗi kí tự:
Code:
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.
129/Xử lí dòng:
Code:
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.
130/Chạy chử:
Code:
Program Chay_Chu;
Uses Crt;
Var
    St : String;
   n,i,j : Integer;
Begin
    ClrScr;
   Write('Nhap mot chuoi ky tu: ');
   Readln(St);
   ClrScr;
   n := 40-(Length(St) Div 2);
   For j := 1 To Length(St) Do
       For i := 80 DownTo n+j Do
          Begin
             GotoXY(i,12);
            Write(St[j]);
            ClrEoL;
            Sound(400+j*200);
            Delay(30);
            Nosound;
         End;
   Readln;
End.
131/Đường thẳng:
Code:
Program Duong_Thang;
Uses Graph;
Var
    Gd,Gm,k : Integer;
Begin
    Gd :=Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt(1);
   SetBkColor(Blue);
   k := -300;
   Repeat
       SetColor(14);
       MoveTo(160,100);
      LineRel(k,100);
      LineRel(k,-100);
      MoveTo(160,100);
      LineRel(k,-100);
      LineRel(k,100);
      k := k+15;
   Until k = 0;
   Repeat
       Line(k,0,k,200);
      k := k-15;
   Until k = 0;
   Line(0,100,320,100);
   Readln;
   CloseGraph;
End.
132/Chùm đường thẳng đồng quy:
Code:
Program Chum_duong_thang_dong_quy;
Uses Crt,Graph;
Var
    Palette : PaletteType;
   Gd,Gm,k,i : Integer;
   Color : Word;
   Tri : String[4];
Begin
    Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   Str(GetColor: 2,Tri);
   OutTextXY(10,10,Tri);
   With Palette Do
       Begin
          Size := 4;
         Colors[0] := White;
         Colors[1] := Red;
         Colors[2] := Blue;
         Colors[3] := Magenta;
         SetAllPalette(Palette);
      End;
   SetBkColor(LightBlue);
   Randomize;
   k := 1;
   Repeat
       Color := Succ(GetColor);
      If Color > Palette.Size Then
          Color := 2;
      SetColor(Color);
      i := k Mod 4;
      SetLineStyle(i,0,3);
      LineTo(Random(GetMaxX),Random(GetMaxY));
      Delay(100);
      k := k+1;
   Until k =15;
   SetColor(1);
   OutTextXY(10,100,'Chao mung nam 2000');
   Delay(2000);
   CloseGraph;
End.
133/Đa giác:
Code:
Program Da_Giac;
Uses Graph;
Const M : Array[0..5] Of PointType = ((x:0;y:10),(x:53;y:29),
          (x:112;y:134),(x:65;y:100),(x:34;y:100),(x:0;y:10));
Var
    Gd,Gm : Integer;
Begin
    Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   DrawPoly(7,M);
   Readln;
   CloseGraph;
End.
134/Vòng Olympic:
Code:
Program Vong_Olympic;
Uses Graph;
Var
    Gd,Gm:Integer;
   MaxX,MaxY:Integer;
   R : Integer;
   Y1,Y2 : Integer;
   X1,X2,X3,X4,X5 : Integer;
   Kc : Integer;
Begin
    Write('-Ban kinh = ');
   Readln(R);
   Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOK Then
       Halt(1);
   MaxX := GetMaxX;
   MaxY := GetMaxY;
   Y1 := (MaxY - 3*R) Div 2 + R;
   Y2 := Y1 + R;
   Kc := R Div 5;
   X1 := (MaxX - 6*R -2*Kc) Div 2 + R;
   X2 := X1 + Kc + 2*R;
   X3 := X2 + Kc + 2*R;
   X4 := X1 + R + (Kc Div 2);
   X5 := X2 + R + (Kc Div 2);
   SetColor(14);
   Circle(X1,Y1,R);
   Circle(X2,Y1,R);
   Circle(X3,Y1,R);
   Circle(X4,Y2,R);
   Circle(X5,Y2,R);
   Readln;
   CloseGraph;
End.
135/Hình quạt:
Code:
Program Hinh_Quat;
Uses Graph;
Var
    Gd,Gm : Integer;
   CenterX,CenterY,Radius : Word;
Begin
    Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt(1);
   SetGraphMode(0);
   SetBkColor(Blue);
   CenterX := GetMaxX Div 2;
   CenterY := GetMaxY Div 2;
   Radius := CenterY - 10;
   SetFillStyle(2,2);
   Pieslice(CenterX,CenterY,0,120,Radius);
   SetFillStyle(3,1);
   Pieslice(CenterX,CenterY,120,245,Radius);
   SetFillStyle(4,3);
   Pieslice(CenterX,CenterY,245,360,Radius);
   Readln;
   CloseGraph;
End.
136/Biểu đồ cột:
Code:
Program Bieu_Do_Cot;
Uses Graph;
Const h = 60;
Var
    Gd,Gm : Integer;
   Socot : Integer;
   a : Array[1..100] Of Integer;
   Max : Integer;
   i : Integer;
   Mx,My : Integer;
   Xstep,Ystep : Integer;
   x : Integer;
Begin
    Write('-Tong so cot: ');
   Readln(Socot);
   For i := 1 To Socot Do
       Begin
          Write('    +Cot thu : ',i:2,' = ');
         Readln(a[i]);
      End;
   Max := a[1];
   For i := 2 To Socot Do
   If a[i] > Max Then
       Max := a[i];
   Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt(1);
   Mx := GetMaxX;
   My := GetMaxY;
   Rectangle(0,0,Mx,My);
   Line(h,h,h,My-h);
   Line(h,My-h,MX-h,My-h);
   Xstep := Round((Mx-3*h)/Socot);
   Ystep := Round((My-2*h)/Max);
   x := h;
   For i := 1 To Socot Do
       Begin
          SetFillStyle(i,i);
         Bar(x,(My-h)-a[i]*Ystep,x+Xstep,My-h);
         Rectangle(x,(My-h)-a[i]*Ystep,x+Xstep,My-h);
         x := x + Xstep;
      End;
   Readln;
   CloseGraph;
End.
137/Biểu đồ PIE:
Code:
Program Bieu_Do_PIE;
Uses Graph;
Var
    Gd,Gm : Integer;
   Somuc : Integer;
   a : Array[1..100] Of Real;
   Tong,Goc : Real;
   r,i : Integer;
Begin
    Write('-Tong so muc: ');
   Readln(Somuc);
   Tong := 0;
   For i := 1 To Somuc Do
       Begin
          Write('    +Muc thu : ',i:2,' = ');
         Readln(a[i]);
         Tong := Tong + a[i];
      End;
   For i := 1 To Somuc Do
       a[i]:=(a[i]/Tong)*360;
   Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt(1);
   R := GetMaxY Div 3;
   Rectangle(0,0,GetMaxX,GetMaxY);
   Goc := 0;
   For i := 1 To Somuc Do
       Begin
          SetFillStyle(i,i);
         PieSlice(GetMaxX Div 2, GetMaxY Div 2,Round(Goc),Round(Goc+a[i]),R);
         Goc := Goc + a[i];
      End;
   Readln;
   CloseGraph;
End.
138/Đồ thị:
Code:
Program Do_Thi;
Uses Graph;
Var
    Gd,Gm,j,mx,my : Integer;
   i,x,y : Real;
   Xasp,Yasp,CenterX,CenterY : Word;
   Pattern : Word;
   Palette : PaletteType;
{----------------------------------}
    Function Adjasp(Value: Integer) : Integer;
   Begin
       Adjasp := (LongInt(Value)*Xasp) Div Yasp;
   End;
{----------------------------------}
BEGIN
    Gd := Detect;
   InitGraph(Gd,Gm,'C:\BP\BGI');
   If GraphResult <> GrOk Then
       Halt;
   SetGraphMode(0);
   SetBkColor(Blue);
   GetPalette(Palette);
   SetAllPalette(Palette);
   GetAspectRatio(Xasp,Yasp);
   CenterX := GetMaxX Div 2;
   CenterY := GetMaxY Div 2;
   SetTextJustify(CenterText,CenterText);
   SetColor(2);
   Line(0,CenterY,GetMaxX-25,CenterY);
   Line(CenterX,20,CenterX,GetMaxY);
   OutTextXY(CenterX-10,CenterY+5,'0');
   OutTextXY(GetMaxX-16,CenterY,'>X ');
   SetTextStyle(DefaultFont,VertDir,0);
   OutTextXY(CenterX,18,'>');
   SetTextStyle(DefaultFont,HorizDir,0);
   OutTextXY(CenterX,8,'Y');
   i := 0;
   SetColor(2);
   While i <= GetMaxX Do
       Begin
          x :=(i-160)/20;
         mx := Round(i);
         y := (sin(x))*(Sin(x))*(Sin(x));
         my := CenterY - Adjasp(Round(y*20));
         If abs(my) < 200 Then
             PutPixel(mx,my,14);
         i := i+(2/7);
      End;
   Rectangle(CenterX+10,CenterY+10,GetMaxX-10,GetMaxY-15);
   SetViewPort(CenterX+9,CenterY+9,GetMaxX-9,GetMaxY-16,ClipOn);
   SetTextStyle(2,0,4);
   OutTextXY(48,12,'He truc toa do');
   SetTextStyle(1,0,3);
   OutTextXY(60,40,'DESCARTES');
   Readln;
   CloseGraph;
END.
139/Cá chép miệng:
Code:
Program Ca_Chep_Mieng;
Uses Crt,Graph;
Var
    Gd,Gm : Integer;
   Active,Visual,Temp:Word;
   Xcenter,YCenter,Radius,StAngle,EndAngle : Integer;
{--------------------------------}
    Procedure Initialize;
   Begin
       Gd := Detect;
      InitGraph(Gd,Gm,'C:\BP\BGI');
      SetColor(Red);
      SetFillStyle(SolidFill,Blue);
      Xcenter := GetMaxX Div 2;
      YCenter := GetMaxY Div 2;
      StAngle := 15;
      Radius := GetMaxY Div 8;
      Active := 0;
      Visual := 1;
   End;
{--------------------------------}
    Procedure Veca;
   Begin
       if StAngle = 15 Then  {ve bung ca}
          Begin
             StAngle := 30;
            EndAngle := 330;
         End
      Else
          Begin
             StAngle := 15;
            EndAngle := 345;
         End;
      PieSlice(Xcenter,YCenter,StAngle,EndAngle,Radius);
          {ve mat ca}
      Circle(Xcenter+Radius Div 2,YCenter - Radius Div 2,4);
          {ve duoi ca}
      Line(Xcenter-Radius,Ycenter,Xcenter-2*Radius,Ycenter-Radius);
      Line(Xcenter-Radius,Ycenter,Xcenter-2*Radius,Ycenter+Radius);
   End;
{--------------------------------}
BEGIN
    Initialize;
   While Not KeyPressed Do
       Begin
          SetActivePage(Active);
         SetvisualPage(Visual);
         Veca;
         Temp := Active;
         Active := Visual;
         Visual := Temp;
      End;
END.
140/Âm thanh:
Code:
Program Am_thanh;
Uses Crt;
CONST
    Notdon=8*58;
   Notdoi=Notdon Div 2;
TYPE
    Notnhac=(c,cf,d,df,e,f,ff,g,gf,a,af,b);
Var
    Kyam:Notnhac;
   (*----------------------*)
   PROCEDURE Bannhac(Kyam:Notnhac;Caodo,Truongdo:Integer);
   Var
       Tanso:Real;
      i:Integer;
   Begin
       Tanso:=32.625;
      For i:=1 To Caodo Do
          Tanso:=Tanso * 2;
      For i:=1 To Ord(Kyam) Do
          Tanso:=Tanso * 1.05946;
      If Truongdo <> 0 Then
          Begin
             Sound(Round(Tanso));
            Delay(Truongdo);
            NoSound
         End
      Else
          Sound(Round(Tanso))
   End;
   (*----------------------*)
BEGIN
    Bannhac(c,4,Notdon);
   Bannhac(f,4,Notdon);
   Bannhac(g,4,Notdon);
   Bannhac(a,4,Notdon);
   Bannhac(a,4,Notdon);
END.
141/3 cạnh của tam giác:
Code:
Program Tam_giac;
Var
    a,b,c:Integer;
   tamgiac,deu,can:Boolean;
Begin
    Writeln('BA CANH CUA TAM GIAC ?');
   Writeln('----------------------');
   Write('-Nhap so thu nhat= ');
   Readln(a);
   Write('-Nhap so thu hai = ');
   Readln(b);
   Write('-Nhap so thu ba  = ');
   Readln(c);
   tamgiac:=False;
   deu:=False;
   can:=False;
   If (a+b>c) And (b+c>a) And (c+a>b) Then
       Begin
          tamgiac:=True;
         If (a=b) And (b=c) Then
             deu:=True;
         If (a=b) Or (b=c) Or (c=a) Then
             can:=True;
      End;
    Writeln;
   Writeln(' 3 so vua nhap la:');
   Writeln('+Tam giac: ',tamgiac);
   Writeln('+Tam giac deu: ',deu);
   Writeln('+Tam giac can: ',can);
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc');
   Readln
End.
142/Bài toán cổ điển:
Code:
Program Tram_trau;
Var
    dung,nam,gia,co,trau:Integer;
Begin
    Writeln('BAI TOAN CO DIEN');
   Writeln('Tram trau tram co');
   Writeln('Trau dung an 5');
   Writeln('Trau nam an 3');
   Writeln('Ba trau gia an 1');
   Writeln('----------------');
   Writeln('           Bai toan nay co cac loi giai sau');
   For dung:=0 To 20 Do
       For nam:=0 To 33-dung Do
          For gia:=0 To (100-(dung+nam)) Do
             Begin
                co:=5*dung+3*nam+(gia Div 3);
               trau:=dung+nam+gia;
               If (gia Mod 3 =0) And (trau=100) And ( co=100) Then
                   Writeln('-Trau dung ',dung,' con, -Trau nam ',nam,' con, -Trau gia ',gia,' con');
            End;
   Writeln;
   Writeln('   Bam phim <Enter> de ket thuc');
   Readln
End.
143/Các hàm lượng giác:
Code:
Program Cac_ham_luong_giac;
CONST
    g='|';
   ke='--------------------------------------------------';
   Ten='               CAC HAM LUONG GIAC';
   Tde='|DO | RADIAN |   SIN  | COSIN  |  TANG  | COTANG |';
Var
    Doo:1..89;
   Rad,s,c,t,ct:Real;
Begin
    Repeat
       Write('-Nhap do (tu 1 den 89, so 0 de ngung): ');
      Readln(Doo);
      If Doo= 0 Then
          Exit;
        Writeln(Ten);
       Writeln(ke);
       Writeln(Tde);
       Writeln(ke);
       Rad:=Doo*Pi/180;
      s:=Sin(rad);
      c:=Cos(Rad);
      t:=s/c;
      ct:=c/s;
       Writeln(g,Doo:2,#248,g,Rad:8:6,g,s:8:6,g,
                            c:8:6,g,t:8:5,g,ct:8:5,g);
      Writeln(ke);
      Writeln;
   Until Doo=0;
End.
144/Bài toán gà, chó:
Code:
Program ga_cho;
Var
   x,y,n:Integer;
Begin
      n:=1;
   Writeln('* CAC LOI GIAI BAI TOAN CO DIEN GA,CHO');
   Writeln('----------------------------------');
   For x:=1 To 36 Do
      For y:=1 To (36-x) Do
         If ((x*2)+(y*4) =100) then {and ((x+y) =36) Then}
            Begin
                 Writeln('      * Loi giai thu : ',n:3);
              Write('- Ga  = ',x:2,' con = ',(x*2):2,' chan   ');
              Write('- Cho = ',y:2,' con = ',(y*4):2,' chan ');
              If x+y<36 Then
                    Writeln('Ga+Cho= ',x+y:2,' con,khong dung')
              Else If x+y=36 Then
                     Writeln('Ga+Cho= ',x+y:2,' con,loi giai dung');
                  n:=n+1;
             End;
       Writeln('      * Tong cong co: ',(n-1):3,' loi giai');
       Writeln;
       Writeln('   Bam phim <Enter> de ket thuc');
       Readln
   End.
145/Các nguyên âm, phụ âm trong 1 chuỗi:
Code:
Program Nguyen_am_Phu_am;
TYPE
    Kytu=Set of Char;
Var
    a,b,Nguyen,Phu:Kytu;
   Chuoi:String;
   i:Integer;
   Ch:Char;
Begin
    Writeln('CAC NGUYEN AM, PHU AM TRONG MOT CHUOI');
   Writeln('-------------------------------------');
   Write('-Nhap mot chuoi ky tu: ');
   Readln(Chuoi);
   a:=['a','e','i','o','u','A','E','I','O','U'];
   b:=['a'..'z','A'..'Z'] - a;
   Nguyen:=[];
   Phu:=[];
   For I:=1 To Length(Chuoi) Do
       Begin
          If Chuoi[i] In a Then
             Nguyen:=Nguyen + [Chuoi[i]];
         If Chuoi[i] In b Then
             Phu:=Phu +[Chuoi[i]];
      End;
   Writeln;
   Writeln('*Chuoi nay co cac nguyen am sau day:');
   Write('     ');
   For Ch:='A' To 'z' Do
       If Ch In Nguyen Then
          Write(Upcase(ch),', ');
   Writeln;
   Writeln('*Chuoi nay co cac phu am sau day:');
   Write('     ');
   For Ch:='A' To 'z' Do
       If Ch In Phu Then
          Write(Upcase(Ch),', ');
   Writeln;
   Writeln;
   Write('    Bam phim <Enter> de ket thuc ');
   Readln
End.
146/Các phép toán trong tập hợp:
Code:
Program Cac_phep_Toan;
TYPE
    KyTu=Set of Char;
Var
    a,b,Cong,Nhan,tru1,tru2:KyTu;
   p:Array[1..100] Of Char;
   m,n,i:Byte;
Begin
    Writeln('CAC PHEP TOAN TRONG TAP HOP');
   Writeln('---------------------------');
   a:=[];
   b:=[];
   Write('-So phan tu cua tap hop A= ');
   Readln(m);
   For i:=1 To M Do
       Begin
          Write('  -Phan tu A[',i,']= ');
         Readln(p[i]);
         a:=a + [p[i]];
      End;
   Write('-So phan tu cua tap hop B= ');
   Readln(n);
   For i:=1 To N Do
       Begin
          Write('  -Phan tu B[',i,']= ');
         Readln(p[i]);
         b:=b + [p[i]];
      End;
   Nhan:=a * b;
   Writeln('A * B gom cac phan tu: ');
   For i:=0 To 255 Do
       If Char(i) In Nhan Then
          Write(Char(i),#32);
   Writeln;
   Cong:=a + b;
   Writeln('A + B gom cac phan tu: ');
   For i:=0 To 255 Do
       If Char(i) In Cong Then
          Write(Char(i),#32);
   Writeln;
    Tru1:=a - b;
   Writeln('A - B gom cac phan tu: ');
   For i:=0 To 255 Do
       If Char(i) In Tru1 Then
          Write(Char(i),#32);
   Writeln;
    Tru2:=b - a;
   Writeln('B - A gom cac phan tu: ');
   For i:=0 To 255 Do
       If Char(i) In Tru2 Then
          Write(Char(i),#32);
   Writeln;
   If A <= B Then
       Writeln('-Tap hop A nho hon tap hop B');
    If B <= A Then
       Writeln('-Tap hop B nho hon tap hop A');
   Writeln;
   Write('   Bam phim <Enter> de ket thuc ');
   Readln
End.
147/Các phép toán:
Code:
Program Cac_phep_toan;
Var
    a,b,c,d,e,x,y,g,h,i:Integer;
Begin
    Writeln('CAC PHEP TOAN');
   Writeln('-------------');
   Writeln;
   a:=124;
   b:=12;
   Writeln(a:3,' DIV ',b:2,' = ',a DIV b);
   Writeln(a:3,' MOD ',b:2,' = ',a MOD b);
   c:=12;
   d:=22;
   Writeln(c:2,' AND ',d:2,' = ',c AND d);
   Writeln(c:2,' OR ',d:2,' = ',c OR d);
   Writeln(c:2,' XOR ',d:2,' = ',c XOR d);
   x:=2;
   g:=x Shl 7;
   Writeln('g = ',x:2,' Shl 7 = ',g);
   x:=256;
   h:=x Shr 7;
   Writeln('h = ',x:2,' Shr 7 = ',h);
   i:=g+h;
   Writeln('i = g + h = ',i);
   Writeln('Lo(i) = ',Lo(i));
   Writeln('Hi(i) = ',Hi(i));
   Writeln('Swap(i) = ',Swap(i));
   Writeln;
   Writeln('    Bam phim <Enter> de ket thuc');
   Readln
End.
148/Các số nguyên tố:
Code:
Program So_nguyen_to;
Var
    NguyenTo,Sang:Set of 1..100;
   so:1..100;
   i:Integer;
Begin
    Writeln('             CAC SO NGUYEN TO TU 1 DEN 100');
   Writeln('             -----------------------------');
   Writeln;
   NguyenTo:=[];
   Sang:=[2..100];
   So:=2;
   Repeat
       While Not (So In Sang) Do
          So:=So+1;
      NguyenTo:=NguyenTo + [So];
      Write(So,' ');
      I:=So;
      While I <= 100 Do
          Begin
             Sang:=Sang -[I];
            I:=I + So;
         End;
   Until Sang=[];
   Writeln;
   Writeln;
   Write('             Bam phim <Enter> de ket thuc ');
   Readln
End.
149/Cho biết ngày hôm nay sẽ tính được ngày mai:
Code:
Program Ngay_mai_la_ngay_may;
Var
    Nam:1900..2000;
   Thang:1..12;
   Ngay:1..31;
Begin
    Writeln('CHO BIET NGAY HOM NAY SE TINH DUOC NGAY MAI');
   Writeln('-------------------------------------------');
   Repeat
       Write('-Cho biet ngay ( so 0 de ngung): ');
      Readln(Ngay);
      If Ngay = 0 Then
          Exit;
      Write('-Cho biet thang: ');
      Readln(Thang);
      Write('-Cho biet nam: ');
      Readln(Nam);
      Case Thang Of
          1,3,5,7,8,10,12 : If Ngay < 31 Then
                                     Ngay:=Ngay+1
                                 Else
                              If Thang = 12 Then
                                  Begin
                                     Nam:=Nam+1;
                                    Thang:=1;
                                 End
                               Else
                                 Begin
                                     Thang:=Thang+1;
                                    Ngay:=1;
                                 End;
         4,6,9,11    :  If Ngay < 30 Then
                             Ngay:=Ngay+1
                         Else
                         Begin
                            Thang:=Thang+1;
                           Ngay:=1;
                        End;
         2: If (Ngay < 28) Or ((Ngay=28) And (Nam Mod 4 = 0)) then
                 Ngay:=Ngay+1
             Else
                Begin
                   Thang:=Thang+1;
                  Ngay:=1;
               End;
      End;
   Writeln;
   Writeln('+Ngay mai la ngay: ',Ngay:2,' / ',Thang:2,' / ',Nam:4);
   Writeln;
   Until Ngay=0;
End.
150/Chọn loại giải trí thích hợp:
Code:
Program Giai_Tri;
Var
    t:Byte;
Begin
    Writeln('CHON LOAI GIAI TRI THICH HOP');
   Writeln('----------------------------');
   Write('-Cho biet nhiet do ngay hom nay: ');
   Readln(t);
   If t < 20 Then
       Writeln('Troi lanh, ban nen o nha coi TV');
   If ((t > 20) And (t < 25)) Then
       Writeln('Troi mat me, ban nen di cam trai');
   If ((t > 25) And (t < 30)) Then
       Writeln('Troi hoi nong, ban nen di tam bien Vung Tau');
   If t > 30 Then
       Writeln('Troi nong, ban nen di nghi mat o Da Lat');
    Writeln;
   Writeln('   Bam phim <Enter> de ket thuc');
   Readln
End.


***Hãy cùng chia sẻ với bạn bè bằng cách ***
Copy nội dung dưới đây gửi đến nick yahoo bạn bè!
Tài sản của KuteoDnC
Trả Lời Với Trích Dẫn
Gởi Ðề Tài Mới  Trả lời

Ðiều Chỉnh
Xếp Bài

Quyền Sử Dụng
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Mở
Smilies đang Mở
[IMG] đang Mở
HTML đang Tắt


Xin thông báo, bây giờ là 06:15 PM

Tổng lượng truy cập diễn đàn Tranphudn.Com
Powered by vBulletin
Copyright ©2000-2013, Jelsoft Enterprises Ltd
Website hiển thị tốt nhất ở trình duyệt Chrome hoặc FireFox và chế độ toàn màn hình
Khi tham gia diễn đàn tức là bạn đã đồng ý với Nội quy diễn đàn
BQT Không chịu trách nhiệm về nội dung bài viết mà các thành viên đăng tải lên diễn đàn
Địa chỉ trường: 11 Lê Thánh Tôn - TP.Đà Nẵng
Điện thoại: 0511.3822851

tran phu | de thi dh 2011 | de thi dai hoc 2011 | de thi dai hoc 2011 | Thu vien giao an dien tu| giao an dien tu| Giao an lop 10| Giao an lop 11| Giao an lop 12| Kinh nghiem hoc tap| van mau lop 9| Van mau lop 10| Van mau lop 11| Van mau lop 12| THPT Trần Phú Đà Nẵng | Thế hệ trẻ Yêu Hóa Học | doc truyen conan | meo choi lmht| soan bai | do go doc | top keywords, bua | |