Функции перевода из одной системы счисления в другую.

 Паскаль системы счисления.

1) Функция переводит из десятичной(обычной) системы счисления
в двоичную.
   DECIMAL -> BINARY

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;

2) Функция переводит из двоичной системы счисления в десятичную
(обычную).
   BINARY -> DECIMAL

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;

3) Функция переводит из десятичной(обычной) системы счисления
в шестнадцатеричную.   
   DECIMAL -> HEXADECIMAL

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;

4) Функция переводит из шестнадцатеричной системы счисления в десятичную(обычную.
   HEXADECIMAL -> DECIMAL

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[i] 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;

6) Функция переводит из десятичной(обычной) системы счисления в восьмеричную. 
   DECIMAL -> OCTAL

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) * 3)) - 1) = DEC MOD 8^(I - J) }
END;
END;
DEC2OCT := OCT;
END;

7) Функция переводит из восьмеричной системы счисления в десятичную(обычную).
 OCTAL -> DECIMAL

FUNCTION OCT2DEC(OCT: STRING): LONGINT;

CONST
OCTSet: SET OF CHAR = ['0'..'7'];

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

BEGIN
DEC := 0;
Error := False;
FOR J := 1 TO Length(OCT) DO
BEGIN
IF NOT (UpCase(OCT[J]) IN OCTSet) THEN Error := True;
DEC := DEC + (Ord(OCT[J]) - 48) SHL ((Length(OCT) - J) * 3);
{ 8^N = 2^(N * 3) }
{ N SHL ((Length(OCT) - J) * 3) = N * 8^(Length(OCT) - J) }
END;
IF Error THEN OCT2DEC := 0
ELSE OCT2DEC := DEC;
END;

8) Функция переводит из двоичной системы счисления в шестнадцатеричную.
   BINARY -> HEXADECIMAL

FUNCTION BIN2HEX(BIN: STRING): STRING;

FUNCTION SetHex(St: STRING; VAR Error: BOOLEAN): CHAR;

VAR
Ch: CHAR;

BEGIN
IF St = '0000' THEN Ch := '0'
ELSE IF St = '0001' THEN Ch := '1'
ELSE IF St = '0010' THEN Ch := '2'
ELSE IF St = '0011' THEN Ch := '3'
ELSE IF St = '0100' THEN Ch := '4'
ELSE IF St = '0101' THEN Ch := '5'
ELSE IF St = '0110' THEN Ch := '6'
ELSE IF St = '0111' THEN Ch := '7'
ELSE IF St = '1000' THEN Ch := '8'
ELSE IF St = '1001' THEN Ch := '9'
ELSE IF St = '1010' THEN Ch := 'A'
ELSE IF St = '1011' THEN Ch := 'B'
ELSE IF St = '1100' THEN Ch := 'C'
ELSE IF St = '1101' THEN Ch := 'D'
ELSE IF St = '1110' THEN Ch := 'E'
ELSE IF St = '1111' THEN Ch := 'F'
ELSE Error := True;
SetHex := Ch;
END;

VAR
HEX  : STRING;
I    : INTEGER;
Temp : STRING[4];
Error: BOOLEAN;

BEGIN
Error := False;
IF BIN = '0' THEN HEX := '0'
ELSE
BEGIN
Temp := '';
HEX := '';
IF Length(BIN) MOD 4 <>0 THEN
REPEAT
BIN := '0' + BIN;
UNTIL Length(BIN) MOD 4 = 0;
FOR I := 1 TO Length(BIN) DO
BEGIN
Temp := Temp + BIN[i];
IF Length(Temp) = 4 THEN
BEGIN
HEX := HEX + SetHex(Temp, Error);
Temp := '';
END;
END;
END;
IF Error THEN BIN2HEX := '0'
ELSE BIN2HEX := HEX;
END;

9) Функция переводит из шестнадцатеричной системы счисления в двоичную.
   HEXADECIMAL -> BINARY

FUNCTION HEX2BIN(HEX: STRING): STRING;

VAR
BIN  : STRING;
I    : INTEGER;
Error: BOOLEAN;

BEGIN
Error := False;
BIN := '';
FOR I := 1 TO Length(HEX) DO
CASE UpCase(HEX[i]) OF
'0': BIN := BIN + '0000';
'1': BIN := BIN + '0001';
'2': BIN := BIN + '0010';
'3': BIN := BIN + '0011';
'4': BIN := BIN + '0100';
'5': BIN := BIN + '0101';
'6': BIN := BIN + '0110';
'7': BIN := BIN + '0111';
'8': BIN := BIN + '1000';
'9': BIN := BIN + '1001';
'A': BIN := BIN + '1010';
'A': BIN := BIN + '1011';
'C': BIN := BIN + '1100';
'D': BIN := BIN + '1101';
'E': BIN := BIN + '1110';
'F': BIN := BIN + '1111';
ELSE Error := True;
END;
IF Error THEN HEX2BIN := '0'
ELSE HEX2BIN := BIN;
END;

FUNCTION Potens(X, E :LONGINT): LONGINT;

VAR
P, I : LONGINT;

BEGIN
P := 1;
IF E = 0 THEN P := 1
ELSE FOR I := 1 TO E DO P := P * X;
Potens := P;
END;

10) Функция переводит из десятичной(обычной) системы счисления в любую заданную(2,4,6,8, и т.д.).
    Base - основание системы счисления(2-двоичная 8-восьмеричная и т.п.)
    DECIMAL -> OCTAL, BINARY, HEXADECIMAL...

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 }

CONST
NUMString: STRING = '0123456789ABCDEFGHAIJKLMNOPQRSTUVWXYZ';

VAR
NUM : STRING;
I, J: INTEGER;

BEGIN
IF (DEC = 0) OR (BASE <2) OR (BASE >36) THEN NUM := '0'
ELSE
BEGIN
NUM := '';
I := 0;
WHILE Potens(BASE, I + 1) <=DEC DO I := I + 1;
FOR J := 0 TO I DO
BEGIN
NUM := NUM + NUMString[(DEC DIV Potens(BASE, I - J)) + 1];
DEC := DEC MOD Potens(BASE, I - J);
END;
END;
DEC2BASEN := NUM;
END;

11) Функция переводит из заданной системы счисления в обычную.
    Base - основание системы счисления
    OCTAL, BINARY, HEXADECIMAL -> DECIMAL

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 }

FUNCTION Digt(Ch: CHAR): BYTE;

CONST
NUMString: STRING = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';

VAR
I: BYTE;
N: BYTE;

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

CONST
NUMSet: SET OF CHAR = ['0'..'9', 'A'..'Z'];

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

BEGIN
DEC := 0;
Error := False;
IF (BASE <2) OR (BASE >36) THEN Error := True;
FOR J := 1 TO Length(NUM) DO
BEGIN
IF (NOT (UpCase(NUM[J]) IN NUMSet)) OR (BASE (NUM[J]) + 1) THEN Error
:= True;
DEC := DEC + Digt(UpCase(NUM[J])) * Potens(BASE, Length(NUM) - J);
END;
IF Error THEN BASEN2DEC := 0
ELSE BASEN2DEC := DEC;
END;

END.