Перевод между системами счисления

unit convunit;
{ convunit unit 1.1 }
{ copyright (c) 1997 hЖkon stordahl }

{ e-mail : stordahl@usa.net }
{ homepage: http://stordahl.home.ml.org/ }

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

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;

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;

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;

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;

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;

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 < digt(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.