поменять местами цифры

program p1;
uses crt;
var a,i:integer;
c:array[1..10] of integer;
begin
repeat
clrscr;
readln(a);
until (a<=99999) and (a>=10000); (здесь проверка на то чтобы было введено именно 5-ти значное число)
 
writeln(a);
for I:=1 to 5 do begin
  c[i]:=a mod 10;
  if (a mod 2=0) then (проверка и вывод на четность)
  writeln(c[i]);
  a:=a div 10;
  end;
readln
end.

var n1,n2:integer;
begin
 n1:=12345;
 n2:=n1 div 10000 * 10000 + n1 div 10 mod 10 * 1000 +
  n1 div 100 mod 10 * 100 + n1 div 1000 mod 10 * 10 + n1 mod 10;
 write (n2);
 readln;
end.

Function GetNumCifr(A : Longint) : Byte;
Var l : Byte;
    k : LongInt;
Begin
  k:=A;l:=0;
  While k>0 do
  Begin
    Inc(l);
    k:=k div 10;
  End;
  GetNumCifr:=l;
End;
 
Function GetNumInPos(B : Longint;N : Byte) : Byte;
Var ll : Integer;
    kk : LongInt;
Begin
  kk:=B; ll:=1;
  While ll<N do
  Begin
    Inc(ll);
    kk:=kk div 10;
  End;
  GetNumInPos:=kk mod 10;
End;
 
Function SetNumInPos(C : Longint;N,SetNum : Byte) : Longint;
Var mm : Longint;
    vv : Byte;
Begin
  If N<=GetNumCifr(C) then
  Begin
    mm:=0;
    For vv:=GetNumCifr(C) downto 1 do
      If vv<>N then mm:=mm*10+GetNumInPos(C,vv)
      else mm:=mm*10+SetNum;
    SetNumInPos:=mm;
  End
  else SetNumInPos:=C;
End;
 
Var    i : Byte;
 Chislo,j : Longint;
Begin
  Readln(Chislo);
  For i:=1 to GetNumCifr(Chislo) div 2 do
  Begin
    If (not Odd(GetNumInPos(Chislo,i))) and (not Odd(GetNumInPos(Chislo,GetNumCifr(Chislo)-i+1))) then
    Begin
      j:=GetNumInPos(Chislo,i);
      Chislo:=SetNumInPos(Chislo,i,GetNumInPos(Chislo,GetNumCifr(Chislo)-i+1));
      Chislo:=SetNumInPos(Chislo,GetNumCifr(Chislo)-i+1,j);
    End;
  End;
  Writeln(Chislo);
End.