Xâu kí tự

một số dạng về xâu ký tự trong pascal

uses crt;
var stgoc,tg,chu,kthuc,batdau:string;
    i,dem,k,j,max,h:integer; B,C,E:array[1..50] of string;
    D:array[1..100] of integer;

procedure nhap_xau(var stgoc:string);  {chuong trinh con nhap xau ki tu goc}
          begin
               write(`moi ban nhap xau ki tu: `); readln(stgoc);
               tg:=stgoc; {gan xau trung gian vao xau goc
                        tu bay gio ta lam viec voi xau trung gian
                        neu sau nay can den xau goc ta van con xau goc}
               writeln;
          end;
 
 
procedure chuan_hoa_xau(var tg:string); {chuong trinh chuan hoa xau ki tu}
          begin
               tg:=` `+tg;
               for i:=1 to length(tg) do tg[i]:=upcase(tg[i]);  {doi cac ki tu thanh chu hoa}
               for i:=1 to length(tg) do
                   if ord(tg[i])in[65..90] then
                      tg[i]:=chr(ord(tg[i])+32); {doi cac ki tu tu A den Z sang chu thuong}
               for i:=1 to length(tg) do         {xoa cac dau cach thua giua cac tu}
                   if (tg[i]=` `) and (tg[i+1]<>` `) then
                      tg[i+1]:=upcase(tg[i+1]);
               while tg[1]=` ` do delete(tg,1,1); {xoa cac dau cach thua o dau chuoi ki tu}
               while tg[length(tg)]=` ` do delete(tg,length(tg),1);
               for i:=1 to length(tg) do           {xoa cac dau cach thua o dau chuoi ki tu}
                   while (tg[i]=` `) and (tg[i+1]=` `) do delete(tg,i,1);
          end;
 
 
procedure tim_chu(tg:string);        {chuong trinh con tim chu trong xau}
          var i:integer;  chu:string;
          begin
               write(`nhap chu ban muon kiem tra: `); readln(chu);
               for i:=1 to length(tg) do
               begin
                   if pos(chu,tg)=1 then
                      begin
                           delete(tg,1,length(chu));
                           dem:=dem+1;
                           i:=1;
                      end
                   else if pos(chu,tg)>1 then
                      begin
                           dem:=dem+1;
                           delete(tg,1,length(chu)+pos(chu,tg));
                           i:=1;
                      end;
               end;
               writeln(`trong xau"`,tg,`" co `,dem,` chu "`,chu,`"`);
          writeln;
          end;
 
 
procedure kiem_tra_tu(tg:string);
          var chu:string;
          begin
               chuan_hoa_xau(tg);
               write(`ban muon tim tu nao? `); readln(chu);
               dem:=0;
               chu:=` `+chu+` `;
               tg:=` `+tg+` `;
               while pos(chu,tg)<>0 do
                     begin
                          dem:=dem+1;
                          delete(tg,1,length(chu)+pos(chu,tg)-1);
                     end;
               if dem=0 then writeln(`tu "`,chu,`" khong co trong xau`)
               else writeln(`trong xau co `,dem,` tu "`,chu,`"`);
               writeln;
          end;
 
 
procedure dem_tu(st:string);  {chuong trinh con dem so lan xuat hien cua tu trong xau}
          var a:array[1..50] of string;
          begin
               tg:=st;
               chuan_hoa_xau(tg);
               tg:=tg+` `; dem:=0; k:=1;
               for i:=1 to length(st) do
                   if (tg[i]<>` `) and (tg[i+1]=` `) then
                      begin
                           dem:=dem+1;
                           a[dem]:=copy(tg,k,i-k+1);
                           k:=i+2;
                      end;