Переводить число из любой системы счисления в любую другую.

const
    NUMBERS: Set Of Char = ['0'..'9'];
function StrToWord(const s: String; var error: Boolean): Word;
var
    Result, code: Word;
begin
    Val(s, Result, code);
    error := (code <> 0);
    if (error)
    then
        Result := 0;
    StrToWord := Result;
end;
function WordToStr(const x: Word): String;
var
    Result: String;
begin
    Str(x, Result);
    WordToStr := Result;
end;
function Power(const a: Byte; const b: Byte): LongWord;
var
    Result: LongWord;
    i: Byte;
begin
    Result := 1;
    if (b > 0)
    then
        for i := 1 to b do
            Result := Result * a;
    Power := Result;
end;
function AnyToDec(s: String; const sep: Char; const q: Byte; var error: Boolean): LongWord;
var
    Result: LongWord;
    sCurrNumb: String;
    xCurrNumb: Word;
    currDigit: Byte;
begin
    currDigit := 0; Result := 0;
    s := sep + s; error := False;
    while ((Length(s) > 0) And (Not error)) do
    begin
        sCurrNumb := ''; 
        while (s[Length(s)] <> sep) do
        begin
            sCurrNumb := s[Length(s)] + sCurrNumb;
            Delete(s, Length(s), 1);
        end;
        Delete(s, Length(s), 1);
        xCurrNumb := StrToWord(sCurrNumb, error);
        error := (error Or (xCurrNumb >= q));
        if (Not error)
        then
            Inc(Result, Power(q, currDigit) * xCurrNumb);
        Inc(currDigit);
    end;
    AnyToDec := Result;
end;
function DecToAny(x: LongWord; const sep: Char; const q: Byte): String;
var
    Result: String;
begin
    Result := '';
    while (x > 0) do
    begin
        Result := sep + WordToStr(x mod q) + Result;
        x := x div q;
    end;
    Delete(Result, 1, 1);
    DecToAny := Result;
end;
var
    x: String;
    q1, q2: Byte; //целочисленное основание (2..255)
    separator: Char; //разделитель
    ans: LongWord;
    error: Boolean;
begin
    repeat
        Write('Введите разделитель разрядов числа: ');
        ReadLn(separator);
    until Not(separator in NUMBERS);
    repeat
        Write('Введите основание оригинального числа: ');
        ReadLn(q1);
    until (q1 > 1);
    Write('Введите число: '); ReadLn(x);
    ans := AnyToDec(x, separator, q1, error);
    if (Not error)
    then
    begin
        WriteLn(x, '_', q1, '=', ans, '_10');
        repeat
            Write('Введите основание второго числа: ');
            ReadLn(q2);
        until (q2 > 1);
        WriteLn(x, '_', q1, '=', DecToAny(ans, separator, q2), '_', q2);
    end;
end.