郁闷,不能读文件就不能算个数....一直RUNNING不出来了!!

program transf;

var k,ans,i:integer;

a,b:array[1..6] of string;

as,bs:string;

function find(t,s:string):integer;

var lt,ls:integer;

next:array[0..100] of integer;

procedure getnext;

var j,k:integer;

begin

j:=1; k:=0;

while j<lt do

if (k=0) or (t[k]=t[j]) then begin

inc(k);

inc(j);

next[j]:=k;

end

else k:=next[k];

end;

function kmp:integer;

var i,j:integer;

begin

i:=1; j:=1;

while (i<=ls) and (j<=lt) do

if (j=0) or (s[i]=t[j]) then begin

inc(j);

inc(i);

end

else j:=next[j];

if j>lt then exit(i-lt);

exit(0);

end;

begin

lt:=length(t);

ls:=length(s);

fillchar(next,sizeof(next),0);

getnext;

exit(kmp);

end;

procedure trans(t,t1:string;var s:string);

var p:integer;

begin

p:=find(t,s);

if p=0 then exit;

delete(s,p,length(t));

insert(t1,s,p);

end;

procedure dfs(s:string; dep:integer);

var s1:string;

i:integer;

begin

if s=bs then begin if dep<ans then ans:=dep; exit; end;

if dep>10 then exit;

s1:=s;

for i:=1 to k do

begin

trans(a[i],b[i],s);

if s<>s1 then begin dfs(s,dep+1); s:=s1; end;

end;

end;

procedure change(var temp1,temp2:string);

var k:integer;

len:integer;

begin

len:=length(temp1);

k:=pos(' ',temp1);

temp2:=copy(temp1,k+1,len-k);

delete(temp1,k,len-k+1);

end;

BEGIN

for i:=1 to 6 do a[i]:='';

readln(as);change(as,bs);

for i:=1 to 6 do begin readln(a[i]); change(a[i],b[i]);

if a[i]='' then break; end;

k:=i-1;-------就是这句....改成3能过3个点....-----

ans:=20;

dfs(as,0);

if (ans=20) and (as<>bs) then begin writeln('NO ANSWER!'); halt; end;

writeln(ans);

END.