怎样把一个二进制的字符串转换成16进制的字符串呢?(30分)

  • 主题发起人 主题发起人 whory
  • 开始时间 开始时间
W

whory

Unregistered / Unconfirmed
GUEST, unregistred user!
比如说,
var a,b:string
a:='01000001';
//转换代码a->b;
最后b:='41';
注:二进制的'01000001'等于16进制的'41';
 
//找到一篇文章,不知道能不能帮上忙。没测试过。
HEX -> Integer

var
i : integer
s : string;
begin
s := '$' + ThatHexString;
i := StrToInt(a);
end;


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

Solution 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 < 'A' THEN Int := Int * 16 + ORD(str) - 48
ELSE Int := Int * 16 + HEX[str];
WRITELN(Int);
READLN;
END.

Dec To HEX


HexString := Format('%0x',DecValue);


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

ASCII to HEX / math
From: gregc@cryptocard.com (Greg Carter)

These work on byte array to strings, also look at the Ord and Chr functions in Delphi.

BytesToHexStr does this [0,1,1,0] of byte would be converted to string := '30313130'; HexStrToBytes goes the other way.


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

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) And BYTE($f);
if c > 9 then
Inc(c, $37)
else
Inc(c, $30);
Response[i + 1] := char(c);
end;{for}
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;{for}
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(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.


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


Convert binary to decimal

Can someone give me an idea of a simple way to convert binary (base2) to
decimal(base10).
Solution 1
[Anatoly Podgoretsky, kvk@estpak.ee]


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

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

function Base10(Base2:Integer) : Integer; assembler;
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
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;


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

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


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

Solution 3
[Demian Lessa, knowhow@compos.com.br]
Give this function any decimal value, specify a base (1..16) and it will return you a string containing the proper value, BaseX. You can use a similar method for Arabic/Roman conversion (see below).



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

function DecToBase( Decimal: LongInt; const Base: Byte): String;
const
Symbols: String[16] = '0123456789ABCDEF';
var
scratch: String;
remainder: Byte;
begin
scratch := '';
repeat
remainder := Decimal mod Base;
scratch := Symbols[remainder + 1] + scratch;
Decimal := Decimal div Base;
until ( Decimal = 0 );
Result := scratch;
end;

--------------------------------------------------------------------------------
Give this function any decimal value (1...3999), and it will return you a string containing the proper value in Roman notation.


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

function DecToRoman( Decimal: LongInt ): String;
const
Romans: Array[1..13] of String =
( 'I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M' );

Arabics: Array[1..13] of Integer =
( 1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);

var
i: Integer;
scratch: String;
begin
scratch := '';
for i := 13 downto 1 do
while ( Decimal >= Arabics ) do
begin
Decimal := Decimal - Arabics;
scratch := scratch + Romans;
end;
Result := scratch;
end;

Decimals to binary

From: cehjohnson@aol.com (CEHJohnson)
Yes, ironic that it's so difficult to find routines to convert from decimal to binary isn't it!

The following should work.(for negative numbers too)



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

function DecToBinStr(n: integer): string;

var
S: string;
i: integer;
Negative: boolean;

begin
if n < 0 then Negative := true;
n := Abs(n);
for i := 1 to SizeOf(n) * 8 do
begin
if n < 0 then S := S + '1' else S := S + '0';
n := n shl 1;
end;
Delete(S,1,Pos('1',S) - 1);//remove leading zeros
if Negative then S := '-' + S;
Result := S;
end;

 
function bintohex(value:string):string;
var i,size:integer;
m:integer;
begin
m:=0;
size:=length(value);
for i:=size downto 0 do
begin
if copy(value,i,1)='1' then begin
m:=m+(1 shl i);
end;
end;
result:=format('0x',m);//inttohex(m,2)//4)
end;
 
可是我要把此函数放到dll中,编译时认不到format这个函数喔?
 
help~~~~~~~~~~~~!
 
function IntToStrAsHex(var S: string; V: Cardinal): Boolean;
var
i: Integer;
begin
S := '';
repeat
i := V and $F;
V := V shr 4;
S := IntToHex(i, 1) + S;
until V = 0;
Result := True;
end;

function StrToIntAsBin(var V: Cardinal; S: string): Boolean;
var
i, j: Cardinal;
begin
Result := IsBinStr(S);
if not Result then Exit;

V := 0;
for i := 1 to Length(S) do
begin
j := Ord(S) - Ord('0');
V := (V shl 1) + j;
end;
Result := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
s,a:string;
V: Cardinal;
begin
a:='01000001';
if StrToIntAsBin(V, a) then
begin
IntToStrAsHex(S, V);
edit1.text:= S;
end;
end;
 
我自己写出来了,和各位的意见差不多,谢谢大家!
 

Similar threads

回复
0
查看
867
不得闲
S
回复
0
查看
1K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
916
SUNSTONE的Delphi笔记
S
S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
后退
顶部