07 提高的字符串的展开 帮忙看看那里错了
var p1,p2,p3,l:longint;
    str:string;
    a:array[1..10000]of longint;
procedure init;
begin
 readln(p1,p2,p3);
 readln(str);
end;
procedure shu1(s,t:longint);
var i,j,k:longint;
     s1,s2:string;
begin
 i:=ord(str[s])+1;j:=ord(str[t])-1;
 s1:=copy(str,1,s);s2:=copy(str,t,l-t+1);
 while i<=j do
 begin
  for k:=1 to p2 do  s1:=s1+chr(i);
  i:=i+1;
 end;
 str:=s1+s2;
end;
procedure shu2(s,t:longint);
var i,j,k:longint;
     s1,s2:string;
begin
 i:=ord(str[s])+1;j:=ord(str[t])-1;
 s1:=copy(str,1,s);s2:=copy(str,t,l-t+1);
 while i<=j do
 begin
  for k:=1 to p2 do  s1:=s1+chr(j);
  j:=j-1;
 end;
 str:=s1+s2;
end;
procedure jia1(s,t:longint);
var i,j,k:longint;
    s1,s2:string;
    f,ff:boolean;
begin
 f:=true;
 if (str[t]<='9')and(str[s]>='0')then begin shu1(s,t);exit;end;
 i:=ord(str[s])+1;j:=ord(str[t])-1;
 s1:=copy(str,1,s);s2:=copy(str,t,l-t+1);
 if str[s]<='Z' then ff:=true else ff:=false;
 while i<=j do
 begin
  if p1=1 then begin
                if ff then for k:=1 to p2 do s1:=s1+chr(i+32);
                if not ff then for k:=1 to p2 do s1:=s1+chr(i);
               end;
  if p1=2 then begin
                if ff then for k:=1 to p2 do s1:=s1+chr(i);
                if not ff then for k:=1 to p2 do s1:=s1+chr(i-32);
               end;
  if p1=3 then for k:=1 to p2 do s1:=s1+'*';
  i:=i+1;
 end;
 str:=s1+s2;
end;
procedure jia2( s,t:longint);
var i,j,k:longint;
    s1,s2:string;
    f,ff:boolean;
begin
 f:=true;
 if (str[t]<='9')and(str[s]>='0')then begin shu2(s,t);exit;end;
 i:=ord(str[s])+1;j:=ord(str[t])-1;
 s1:=copy(str,1,s);s2:=copy(str,t,l-t+1);
 if str[s]<='Z' then ff:=true else ff:=false;
 while i<=j do
 begin
  if p1=1 then begin
                if ff then for k:=1 to p2 do s1:=s1+chr(j+32);
                if not ff then for k:=1 to p2 do s1:=s1+chr(j);
               end;
  if p1=2 then begin
                if ff then for k:=1 to p2 do s1:=s1+chr(j);
                if not ff then for k:=1 to p2 do s1:=s1+chr(j-32);
               end;
  if p1=3 then for k:=1 to p2 do s1:=s1+'*';
  j:=j-1;
 end;
 str:=s1+s2;
end;
function pan(k:longint):boolean;
begin
 pan:=false;
 if (str[k]<>'-')or(str[k-1]>=str[k+1]) then exit;
 if ((str[k-1]>='A')and(str[k+1]<='Z'))or((str[k-1]>='a')and(str[k+1]<='z'))or((str[k-1]>='0')and(str[k+1]<='9')) then pan:=true;
end;
procedure zhan1;
var i:longint;
begin
 i:=1;
 while i<=l do
 begin
  if pan(i) then jia1(i-1,i+1);
  i:=i+1;
 end;
end;
procedure zhan2;
var i:longint;
begin
 i:=1;
 while i<=l do
 begin
  if pan(i) then jia2(i-1,i+1);
  i:=i+1;
 end;
end;
procedure main;
begin
 l:=length(str);
 if p3=1 then zhan1;
 if p3=2 then zhan2;
end;
procedure print;
begin
 writeln(str);
end;
begin
 init;
 main;
 print;
end.
挺麻烦 但也应该对吧
谢谢