Category : Utilities for DOS and Windows Machines
Archive   : FDFORM18.ZIP
Filename : BASECONV.PAS

 
Output of file : BASECONV.PAS contained in archive : FDFORM18.ZIP
{BASE Convert Unit for Turbo-Pascal 5.5}
{Copyright (c) 1989 Christoph H. Hochst„tter}


{$A+,B-,D+,F-,I-,L+,R-,S-,V-}
UNIT baseconv;

INTERFACE

TYPE basestr = String[32];

VAR BaseError: Byte;

FUNCTION base(x:LongInt;b:Byte):basestr; {Convert x to base b}
FUNCTION basef(x:LongInt;b,f:Byte):basestr; {Convert x to base b length f}
FUNCTION hex(x:LongInt):basestr; {Convert x to base 16}
FUNCTION hexf(x:LongInt;f:Byte):basestr; {Convert x to base 16 length f}
FUNCTION dez(x:basestr;s:Byte):LongInt; {Convert x from Base s to decimal}
FUNCTION dezh(x:basestr):LongInt; {Convert hexadecimal x to decimal}

IMPLEMENTATION

VAR o: basestr;
CONST h: String[36] = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
VAR i: Byte;
CONST n: String[31] = '0000000000000000000000000000000';

FUNCTION base;

PROCEDURE base1(x: LongInt);
BEGIN
IF x>Pred(b) THEN base1(x DIV b);
o:=o+h[Succ(x MOD b)];
END;

BEGIN {base}
IF b>36 THEN BEGIN
BaseError:=1;
Exit;
END ELSE
BaseError:=0;
IF x<0 THEN
o:='-'
ELSE
o[0]:=Chr(0);
base1(Abs(x));
base:=o;
END;

FUNCTION hex;
BEGIN
hex:=base(x,16);
END;


FUNCTION basef;
BEGIN
o:=base(x,b);
IF BaseError <> 0 THEN Exit;
IF Ord(o[0])>f THEN
BaseError:=2
ELSE BEGIN
n[0]:=Chr(f-Ord(o[0]));
IF x<0 THEN i:=2 ELSE i:=1;
Insert(n,o,i);
END;
basef:=o;
END;

FUNCTION hexf;
BEGIN
hexf:=basef(x,16,f);
END;

FUNCTION dez;
VAR a: Byte;
b,c: LongInt;
BEGIN
BaseError:=0;
c:=1;
b:=0;
FOR i:=Length(x) DOWNTO 1 DO
IF BaseError=0 THEN BEGIN
a:=Pred(pos(Upcase(x[i]),h));
IF (a=255) OR (a>=s) THEN BaseError:=1;
b:=b+c*a;
c:=s*c;
END;
dez:=b;
END;

FUNCTION dezh;
BEGIN
dezh:=dez(x,16);
END;

END.


  3 Responses to “Category : Utilities for DOS and Windows Machines
Archive   : FDFORM18.ZIP
Filename : BASECONV.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/