Системы счисления

Из Любой в Любую1 - через 10-тичную - сначала подстановкой по степеням - в 10-тичную, затем делением на Любую1

вот такой юнит нашел на паскале

UNIT CONVUNIT;

INTERFACE

FUNCTION DEC2BIN(DEC: LONGINT): STRING;
FUNCTION BIN2DEC(BIN: STRING): LONGINT;
FUNCTION DEC2HEX(DEC: LONGINT): STRING;
FUNCTION HEX2DEC(HEX: STRING): LONGINT;
FUNCTION DEC2OCT(DEC: LONGINT): STRING;
FUNCTION OCT2DEC(OCT: STRING): LONGINT;
FUNCTION BIN2HEX(BIN: STRING): STRING;
FUNCTION HEX2BIN(HEX: STRING): STRING;
FUNCTION DEC2BASEN(BASE: INTEGER; DEC: LONGINT): STRING;
{ This function converts numbers from decimal (Base 10 notation) to
different systems of notation. Valid systems are from Base 2 notation
to Base 36 notation }
FUNCTION BASEN2DEC(BASE: INTEGER; NUM: STRING): LONGINT;
{ This function converts numbers from different systems of notation
to decimal (Base 10 notation). Valid systems are from Base 2 notation
to Base 36 notation }

IMPLEMENTATION

FUNCTION DEC2BIN(DEC: LONGINT): STRING;

VAR
BIN : STRING;
I, J: LONGINT;

BEGIN
IF DEC = 0 THEN BIN := '0'
ELSE
BEGIN
BIN := '';
I := 0;
WHILE (1 SHL (I + 1)) <=DEC DO I := I + 1;
{ (1 SHL (I + 1)) = 2^(I + 1) }
FOR J := 0 TO I DO
BEGIN
IF (DEC SHR (I - J)) = 1 THEN BIN := BIN + '1'
{ (DEC SHR (I - J)) = DEC DIV 2^(I - J) }
ELSE BIN := BIN + '0';
DEC := DEC AND ((1 SHL (I - J)) - 1);
{ DEC AND ((1 SHL (I - J)) - 1) = DEC MOD 2^(I - J) }
END;
END;
DEC2BIN := BIN;
END;

FUNCTION BIN2DEC(BIN: STRING): LONGINT;

VAR
J : LONGINT;
Error: BOOLEAN;
DEC : LONGINT;

BEGIN
DEC := 0;
Error := False;
FOR J := 1 TO Length(BIN) DO
BEGIN
IF (BIN[J] <>'0') AND (BIN[J] <>'1') THEN Error := True;
IF BIN[J] = '1' THEN DEC := DEC + (1 SHL (Length(BIN) - J));
{ (1 SHL (Length(BIN) - J)) = 2^(Length(BIN)- J) }
END;
IF Error THEN BIN2DEC := 0
ELSE BIN2DEC := DEC;
END;

FUNCTION DEC2HEX(DEC: LONGINT): STRING;

CONST
HEXDigts: STRING[16] = '0123456789ABCDEF';

VAR
HEX : STRING;
I, J: LONGINT;

BEGIN
IF DEC = 0 THEN HEX := '0'
ELSE
BEGIN
HEX := '';
I := 0;
WHILE (1 SHL ((I + 1) * 4)) <=DEC DO I := I + 1;
{ 16^N = 2^(N * 4) }
{ (1 SHL ((I + 1) * 4)) = 16^(I + 1) }
FOR J := 0 TO I DO
BEGIN
HEX := HEX + HEXDigts[(DEC SHR ((I - J) * 4)) + 1];
{ (DEC SHR ((I - J) * 4)) = DEC DIV 16^(I - J) }
DEC := DEC AND ((1 SHL ((I - J) * 4)) - 1);
{ DEC AND ((1 SHL ((I - J) * 4)) - 1) = DEC MOD 16^(I - J) }
END;
END;
DEC2HEX := HEX;
END;

FUNCTION HEX2DEC(HEX: STRING): LONGINT;

FUNCTION Digt(Ch: CHAR): BYTE;

CONST
HEXDigts: STRING[16] = '0123456789ABCDEF';

VAR
I: BYTE;
N: BYTE;

BEGIN
N := 0;
FOR I := 1 TO Length(HEXDigts) DO
IF Ch = HEXDigts THEN N := I - 1;
Digt := N;
END;

CONST
HEXSet: SET OF CHAR = ['0'..'9', 'A'..'F'];

VAR
J : LONGINT;
Error: BOOLEAN;
DEC : LONGINT;

BEGIN
DEC := 0;
Error := False;
FOR J := 1 TO Length(HEX) DO
BEGIN
IF NOT (UpCase(HEX[J]) IN HEXSet) THEN Error := True;
DEC := DEC + Digt(UpCase(HEX[J])) SHL ((Length(HEX) - J) * 4);
{ 16^N = 2^(N * 4) }
{ N SHL ((Length(HEX) - J) * 4) = N * 16^(Length(HEX) - J) }
END;
IF Error THEN HEX2DEC := 0
ELSE HEX2DEC := DEC;
END;

FUNCTION DEC2OCT(DEC: LONGINT): STRING;

CONST
OCTDigts: STRING[8] = '01234567';

VAR
OCT : STRING;
I, J: LONGINT;

BEGIN
IF DEC = 0 THEN OCT := '0'
ELSE
BEGIN
OCT := '';
I := 0;
WHILE (1 SHL ((I + 1) * 3)) <=DEC DO I := I + 1;
{ 8^N = 2^(N * 3) }
{ (1 SHL (I + 1)) = 8^(I + 1) }
FOR J := 0 TO I DO
BEGIN
OCT := OCT + OCTDigts[(DEC SHR ((I - J) * 3)) + 1];
{ (DEC SHR ((I - J) * 3)) = DEC DIV 8^(I - J) }
DEC := DEC AND ((1 SHL ((I - J) * 3)) - 1);
{ DEC AND ((1 SHL ((I - J)