Bài 1: Đổi ngày hệ thống

program set_and_get_date;

uses dos;

const dayofweek:array[0..6]of string[10]=('sunday','monday','tuesday','weday','thusday','friday','satuday');

var day,month,year:integer;error:boolean;

function getdate:string;

        var regs:registers;

            week,day,month,year:string[10];

        begin

             regs.AH:=$2A;

             MSDOS(regs);

             with Regs do

                  begin

                       week:=dayofweek[AL];

                       str(CX,year);

                       str(DH,month);

                       str(DL,day);

                  end;

             getdate:=week+'/'+day+'/'+month+'/'+year

             end;

             function setdate(day,month,year:integer):boolean;

             var regs:registers;

             begin

                  with regs do

                       begin

                            AH:=2;

                            CX:=year;

                            DH:=month;

                            DL:=day;

                       end;

                       MSDOS(regs);

                       setdate:=regs.Al=0;

                       end;

             begin

                  write(getdate);

                  repeat

                        write('ngay:');readln(day);

                        write('thang:');readln(month);

                        write('nam:');readln(year);

                        error:=not setdate(day,month,year);

                  until not error;

             end.

Bài 2:Tạo phím tắt

program readshiftstatus;

uses crt,dos;

var ins,caps,num,scroll,ctrl,alt,lshift,rshift:boolean;

procedure shiftstatus(var ins,caps,num,scroll,alt,ctrl,lshift,rshift:boolean);

var regs:registers;

begin

regs.ah:=2;

intr($16,regs);

ins:=(regs.al and $80)=$80;

caps:=(regs.al and $40)=$40;

num:=(regs.al and $20)=$20;

scroll:=(regs.al and $10)=$10;

alt:=(regs.al and $08)=$08;

ctrl:=(regs.al and $04)=$04;

lshift:=(regs.al and $02)=$02;

rshift:=(regs.al and $01)=$01;

end;

begin

clrscr;

writeln('an ctrl +shift phai de ket thuc');

repeat

shiftstatus(ins,caps,num,scroll,alt,ctrl,lshift,rshift);

gotoxy(4,1);

writeln('in status:',ins:10);

writeln('caps status:',caps:10);

writeln('num status:',num:10);

writeln('scroll status:',scroll:10);

writeln('alt status:',alt:10);

writeln('ctrl status:',lshift:10);

writeln('right status:',rshift:10);

until ctrl and rshift;

end.

Bài 3:Đổi font chữ

program newfont;

uses crt,dos;

var regs:registers;

clock:array[1..16] of byte;

procedure unitfont;

begin

     clock[1]:=0;

     clock[2]:=0;

     clock[3]:=$ff;

     clock[4]:=81;

     clock[5]:=81;

     clock[6]:=81;

     clock[7]:=$7e;

     clock[8]:=$3c;

     clock[9]:=18;

     clock[10]:=24;

     clock[11]:=42;

     clock[12]:=81;

     clock[13]:=81;

     clock[14]:=$ff;

     clock[15]:=$ff;

     clock[16]:=00;

end;

begin

     unitfont;

     regs.ax:=$1100;

     regs.bx:=$1100;

     regs.cx:=$1;

     regs.dx:=$58;

     regs.es:=seg(clock);

     regs.bp:=ofs(clock);

     intr($10,regs);

     end.