Common conversions in Delphi

Author: lyboy99
E-mail: lyboy99@sina.com
URL: http://hnh.126.com
We provide you with several common conversion methods and their conversion functions.
Hope to help you

1. hex-> integer
2.2.dec to hex
3. ASCII to hex/math
4. Binary to decimal

========================================================== ======================================
1. hex-> integer
========================================================== ======================================
Method 1
--------------------------------------------------------------------------------

VaR
I: integer
S: string;
Begin
S: = '$' + thathexstring;
I: = strtoint ();
End;

--------------------------------------------------------------------------------

Method 2

--------------------------------------------------------------------------------

Const HEX: array ['A' .. 'F'] of integer = (10, 11, 12, 13, 14, 15 );
VaR STR: string;
Int,
I: integer;
Begin
Readln (STR );
INT: = 0;
For I: = 1 to length (STR) Do
If STR [I] <'A' then INT: = int * 16 + ord (STR [I])-48
Else INT: = int * 16 + hex [STR [I];
Writeln (INT );
Readln;
End.

========================================================== ==============
2. DEC to hex

--------------------------------------
Hexstring: = format ('% 0x', decvalue );
--------------------------------------

========================================================== ================
3. ASCII to hex/math
------------------------
Unit hexstr;

Interface
Uses string16, sysutils;

Type
Pbyte = ^ byte;

Procedure bytestohexstr (VAR hhexstr: string; pbytearray: pbyte; inputlength: Word );
Procedure hexstrtobytes (hhexstr: string; pbytearray: pointer );
Procedure hexbytestochar (VAR response: string; hexbytes: pchar; inputlength: Word );

Implementation
Procedure bytestohexstr (VAR hhexstr: string; pbytearray: pbyte; inputlength: Word );
Const
Hexchars: array [0 .. 15] of char = '0123456789abcdef ';
VaR
I, J: word;
Begin
Setlength (hhexstr, (inputlength * 2 ));
Fillchar (hhexstr, sizeof (hhexstr), #0 );
J: = 1;
For I: = 1 to inputlength do begin
Hhexstr [J]: = char (hexchars [pbytearray ^ SHR 4]); Inc (j );
Hhexstr [J]: = char (hexchars [pbytearray ^ and 15]); Inc (j );
INC (pbytearray );
End;
End;

Procedure hexbytestochar (VAR response: string; hexbytes: pchar; inputlength: Word );
VaR
I: word;
C: byte;
Begin
Setlength (response, inputlength );
Fillchar (response, sizeof (response), #0 );
For I: = 0 to (inputlength-1) Do begin
C: = byte (hexbytes [I]) and byte ($ F );
If C> 9 then
INC (C, $37)
Else
INC (C, $30 );
Response [I + 1]: = char (C );
End; {}
End;

Procedure hexstrtobytes (hhexstr: string; pbytearray: pointer );
{Pbytearray must point to enough memory to hold the output}
VaR
I, J: word;
Tempptr: pchar;
Twodigits: String [2];
Begin
Tempptr: = pbytearray;
J: = 1;
For I: = 1 to (length (hhexstr) Div 2) Do begin
Twodigits: = copy (hhexstr, J, 2); Inc (J, 2 );
Pbyte (tempptr) ^: = strtoint ('$' + twodigits); Inc (tempptr );
End; {}
End;

End.

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

Unit string16.
Interface
{$ Ifndef Win32}
Procedure setlength (var s: string; Len: integer );
Procedure setstring (var dst: string; SRC: pchar; Len: integer );
{$ Endif}
Implementation
{$ Ifndef Win32}
Procedure setlength (var s: string; Len: integer );
Begin
If Len> 255 then
S [0]: = CHR (1, 255)
Else
S [0]: = CHR (LEN)
End;

Procedure setstring (var dst: string; SRC: pchar; Len: integer );
Begin
If Len> 255 then
Move (SRC ^, DST [1], 255)
Else
Move (SRC ^, DST [1], Len );
Setlength (DST, Len );
End;
{$ Endif}
End.

========================================================== ======================================
4. Binary to decimal
-----------------------------------------------------------------

//////////////////////////////////////// ////////
// Convert 32 bit base2 to 32 bit base10 //
// Max number = 99 999 999, return-1 if more //
//////////////////////////////////////// ////////

Function base10 (base2: integer): integer; receiver;
ASM
CMP eax, 100000000 // check Upper Limit
JB @ 1 // OK
MoV eax,-1 // error flag
JMP @ exit // exit with-1
@ 1:
Push EBX // save registers
Push ESI
Xor esi, ESI // result = 0

MoV EBX, 10 // diveder base 10
MoV ECx, 8 // 8 nibbles (10 ^ 8-1)
@ 2:
MoV edX, 0 // clear Remainder
Div EBX // eax Div 10, EDX mod 10
Add ESI, EDX // result = Result + remainder [I]
Ror ESI, 4 // shift nibble
Loop @ 2 // loop for all 8 nibbles
MoV eax, ESI // function result
Pop ESI // restore registers
Pop EBX
@ Exit:
End;

--------------------------------------------------------------------------------

Method 2
[Oliver Townshend, oliver@zip.com.au]

--------------------------------------------------------------------------------

Function inttobin (value: longint; Size: integer): string;
VaR
I: integer;
Begin
Result: = '';
For I: = size downto 0 do begin
If value and (1 shl I) <> 0 then begin
Result: = Result + '1 ';
End else begin
Result: = Result + '0 ';
End;
End;
End;

Function bintoint (value: string): longint;
VaR
I, size: integer;
Begin
Result: = 0;
Size: = length (value );
For I: = size downto 0 do begin
If copy (value, I, 1) = '1' then begin
Result: = Result + (1 shl I );
End;
End;
End;