Đề thi tin học trẻ khối THCS năm 2011

B. PHẦN LẬP TRÌNH
ĐỀ BÀI:
Bài 1 (10 điểm): 
Sắp xếp trong xâu
Nhập một xâu s bao gồm số và kí tự, in ra xâu đã sắp xếp số theo thứ tự tăng dần còn vị trí các kí tự vẫn giữ nguyên?
Input
Output
abc6ghj7kkkkk1hhhh9
abc6ghj7kkkkk1hhhh9
Bài 2 (10 điểm): 
viết chương trình nhập vào một chuổi các ký tự chữ cái gồm nhiều từ mỗi từ là một tên của một học sinh và trên màn hình phải hiện ra đúng chữ đầu của tên là chữ hoa còn các chữ cái còn lại là chữ thường. Sau đó sắp xếp các tên trên theo thứ tự alphabet mỗi tên xuất một dòng
Dữ liệu vào: Các phím chữ cái thường từ ầ z và phím cách trống để phân biệt tên học sinh này với tên học sinh kia.
Kết quả ra: Màn hình sẽ hiển thị chữ đầu của mỗi tên học sinh là chữ hoa (người nhập không cần bấm giữ phím shift hoặc bật Caplock), sắp xếp các tên trên theo thứ tự alphabet mỗi tên xuất một dòng.
Gợi ý: Dùng hàm Readkey.
Ví dụ:
Input 
Output 
dung cuong an xuan dao
Dung Cuong An Xuan Dao
An
Cuong
Dao
Dung 
Xuan
program bai1;
uses crt;
var x,xs:string;
procedure docdl;
var v:text;
begin
 assign(v,'c:\input.txt'); reset(v);
 readln(v,x);
 close(v);
end;
procedure xau_so;
var i,j:word;c:char;
begin
 xs:='';
 for i:= 1 to length(x) do
 for c:= '0' to '9' do
 if x[i]=c then xs:=xs+c;
 for i:= 1 to length(xs)-1 do
 for j:= i+1 to length(xs) do
 if xs[i]>xs[j] then
 begin
 c:=xs[i];
 xs[i]:=xs[j];
 xs[j]:=c;
 end;
end;
procedure thay;
var i:word; c:char;
begin
 for i:= 1 to length(x) do
 for c:='0' to '9' do
 if x[i]=c then
 begin
 x[i]:=xs[1];
 delete(xs,1,1);
 end;
end;
procedure xuat;
var r:text;
begin
 assign(r,'c:\OUTPUT.TXT'); rewrite(r);
 writeln(r,x);
 close(r);
end;
begin
 clrscr;
 docdl;
 xau_so;
 thay;
 xuat;
end.
program bai 2;
uses crt;
var x:string; s:array[1..1000] of string;
 i,n,j:word; v,r:text;
begin
 clrscr;
 assign(v,'d:\vao.txt'); reset(v); readln(v,x);
 close(v);
 writeln(x);
 assign(r,'d:\ra.txt'); rewrite(r);
 n:=1;
 repeat
 i:= pos(' ',x);
 s[n]:= copy(x,1,i-1);
 delete(x,1,i);
 n:=n+1;
 until pos(' ',x) =0;
 n:=n+1; s[n]:=x;
 s[n-1]:=s[n]; n:=n-1;
 for i:= 1 to n do s[i][1]:= upcase(s[i][1]);
 for i:= 1 to n-1 do write(r,s[i],' '); writeln(r,s[n]);
 for i:= 1 to n-1 do
 for j:= i+1 to n do
 if s[i]>s[j] then
 begin
 x:=s[i];
 s[i]:=s[j];
 s[j]:=x;
 end;
 for i:= 1 to n do
 writeln(r,s[i]);
close(r);
end.