I'm use full search, but got WA on test 3. help me plz!
{$APPTYPE CONSOLE}
Var
    BeDa:integer;
    endDe:integer;
    Tren:Array[0..6]of byte;
    max,min:integer;
function Da(s:string; x:integer):integer;
var t:integer;
begin
if s='September' then t:=0;
if s='October' then t:=30;
if s='November' then t:=61;
if s='December' then t:= 91;
da:=t+x;
end;
Procedure Init;
var i,e:integer;
    s,s1:string;
begin
readln(s);
if s='Monday' then BeDa:=0;
if s='Tuesday' then BeDa:=1;
if s='Wednesday' then BeDa:=2;
if s='Thursday' then BeDa:=3;
if s='Friday' then BeDa:=4;
if s='Saturday' then BeDa:=5;
if s='Sunday' then BeDa:=6;

readln(s);
i:=pos(' ',s);
s1:=copy(s,i+1,length(s)-i);
delete(s,i,length(s)-i+1);
val(s1,i,e);
endde:=da(s,i);
readln(min,max);
end;
procedure Print;
var i:integer;
c:integer;
begin
for i:=0 to 6 do
 if Tren[i]=1 then inc(c);
writeln(c);
if Tren[0]=1 then writeln('Monday');
if Tren[1]=1 then writeln('Tuesday');
if Tren[2]=1 then writeln('Wednesday');
if Tren[3]=1 then writeln('Thursday');
if Tren[4]=1 then writeln('Friday');
if Tren[5]=1 then writeln('Saturday');
if Tren[6]=1 then writeln('Sunday');

end;

Procedure Solve;
var i,j,c,u:integer;
begin
for i:=1 to 127 do begin
 c:=0;
 u:=i;
 for j:=0 to 6 do begin
  Tren[j]:= u mod 2;
  u:=u div 2;
 end;

 for j:= 1 to endde-2 do
  if Tren[(j+Beda) mod 7]=1 then inc(c);
if (c<=max)and(c>=min) then begin
print; exit; end;
  end;
Writeln('Impossible');
end;
begin
init;
Solve;
end.