发信人: daji(妲姬)
整理人: teleme(2001-04-27 09:17:53), 站内信件
|
下面的代码是如何将10进制的数字转为 n 进制的数字。
unit BaseFunctions;
interface
uses
SysUtils;
function Dec_To_Base(nBase, nDec_Value, Lead_Zeros:integer; cOmit:string):string; // 10 进制 -> n 进制
function Base_To_Dec(nBase:integer;cBase_Value, cOmit:string):integer; // n 进制 -> 10 进制
implementation
function Dec_To_Base(nBase, nDec_Value, Lead_Zeros:integer; cOmit:string):string;
{Function : converts decimal integer to base n, max = Base36
Parameters : nBase = base number, ie. Hex is base 16
nDec_Value = decimal to be converted
Lead_Zeros = min number of digits if leading zeros required
cOmit = chars to omit from base (eg. I,O,U,etc)
Returns : number in base n as string}
var
Base_PChar : PChar;
Base_String : string;
To_Del, Modulus, DivNo : integer;
temp_string : string;
i, nLen, Len_Base : integer;
begin
{initialise..}
Base_String := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {max = Base36}
To_Del := 0;
Modulus := 0;
DivNo := nDec_Value;
result := '';
if (nBase > 36) then nBase := 36; {max = Base36}
cOmit := UpperCase(cOmit);
{build string to fit specified base}
if not(cOmit = '') then begin
{iterate thru' ommited letters}
nLen := Length(cOmit);
for i := 1 to nLen do begin
To_Del := Pos(cOmit[i], Base_String); {find position of letter}
if (To_Del > 0) then begin
{remove letter from base string}
Len_Base := Length(Base_String);
temp_string := Copy(Base_String, 0, To_Del - 1);
temp_string := temp_string + Copy(Base_String,To_Del + 1,Len_Base - To_Del);
Base_String := temp_string;
end; {if To_Del>0..}
end; {for i..}
end; {if not cOmit=''..}
{ensure string is required length for base}
SetLength(Base_String, nBase);
Base_PChar := PChar(Base_String);
{divide decimal by base & iterate until zero to convert it}
while DivNo > 0 do begin
Modulus := DivNo mod nBase; {remainder is next digit}
result := Base_PChar[Modulus] + result;
DivNo := DivNo div nBase;
end; {while..}
{fix zero value}
if (Length(result) = 0) then result := '0';
{add required leading zeros}
if (Length(result) < Lead_Zeros) then
for i := 1 to (Lead_Zeros - Length(result)) do result := '0' + result;
end; {function Dec_To_Base}
function Base_To_Dec(nBase:integer;cBase_Value, cOmit:string):integer;
{Function : converts base n integer to decimal, max = Base36
Parameters : nBase = base number, ie. Hex is base 16
cBase_Value = base n integer (as string) to be converted
cOmit = chars to omit from base (eg. I,O,U,etc)
Returns : number in decimal as string}
var
Base_PChar : PChar;
Base_String : string;
To_Del, Unit_Counter : integer;
temp_string : string;
i, nLen, Len_Base : integer;
begin
{initialise..}
Base_String := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; {max = Base36}
To_Del := 0;
Unit_Counter := nBase;
result := 0;
if (nBase > 36) then nBase := 36; {max = Base36}
cOmit := UpperCase(cOmit);
cBase_Value := UpperCase(cBase_Value); {ensure uppercase letters}
{build string to fit specified base}
if not(cOmit = '') then begin
{iterate thru' ommited letters}
nLen := Length(cOmit);
for i := 1 to nLen do begin
To_Del := Pos(cOmit[i], Base_String); {find position of letter}
if (To_Del > 0) then begin
{remove letter from base string}
Len_Base := Length(Base_String);
temp_string := Copy(Base_String, 0, To_Del - 1);
temp_string := temp_string + Copy(Base_String,To_Del + 1,Len_Base - To_Del);
Base_String := temp_string;
end; {if To_Del>0..}
end; {for i..}
end; {if not cOmit=''..}
{ensure string is required length for base}
SetLength(Base_String, nBase);
Base_PChar := PChar(Base_String);
{iterate thru digits of base n value, each digit is a multiple of base n}
nLen := Length(cBase_Value);
if (nLen = 0) then result := 0 {fix zero value}
else begin
for i := 1 to nLen do begin
if (i = 1) then unit_counter := 1 {1st digit = units}
else if (i > 1) then unit_counter := unit_counter * nBase; {multiples of base}
result := result
+ ((Pos(Copy(cBase_Value, (Length(cBase_Value)+1)-i, 1), Base_PChar) - 1)
* unit_counter);
end; {for i:=1..}
end; {else begin..}
end; {function Base_To_Dec}
end. {unit BaseFunctions}
//**********************************************
IntToHex 的补充
Delphi 提供了 IntToHex，但没有与其配套的 HexToInt。也没有在 sysutils 单元中提供
类似 IntToBin 和 BinToInt 一类的函数。我在前一段时间设计序列号输入的时候遇到这个
问题，居然叫我在今天找到了这几个函数的“第三方”实现，不敢独享，粘贴在此。
{ ======================================= }
{ Convert a HexString value to an Int64 }
{ Note : Last Char can be 'H' for Hex }
{ eg. '00123h' or '00123H' }
{ 0 will be returned if invalid HexString }
{ ======================================= }
function HexToInt(HexStr : string) : Int64;
var RetVar : Int64;
i : byte;
begin
HexStr := UpperCase(HexStr);
if HexStr[length(HexStr)] = 'H' then
Delete(HexStr,length(HexStr),1);
RetVar := 0;
for i := 1 to length(HexStr) do begin
RetVar := RetVar shl 4;
if HexStr[i] in ['0'..'9'] then
RetVar := RetVar + (byte(HexStr[i]) - 48)
else
if HexStr[i] in ['A'..'F'] then
RetVar := RetVar + (byte(HexStr[i]) - 55)
else begin
Retvar := 0;
break;
end;
end;
Result := RetVar;
end;
{ ============================================== }
{ Convert an Int64 value to a binary string }
{ NumBits can be 64,32,16,8 to indicate the }
{ return value is to be Int64,DWord,Word }
{ or Byte respectively (default = 64) }
{ NumBits normally are only required for }
{ negative input values }
{ ============================================== }
function IntToBin(IValue : Int64; NumBits : word = 64) : string;
var RetVar : string;
i,ILen : byte;
begin
RetVar := '';
case NumBits of
32 : IValue := dword(IValue);
16 : IValue := word(IValue);
8 : IValue := byte(IValue);
end;
while IValue <> 0 do begin
Retvar := char(48 + (IValue and 1)) + RetVar;
IValue := IValue shr 1;
end;
if RetVar = '' then Retvar := '0';
Result := RetVar;
end;
{ ============================================== }
{ Convert a bit binary string to an Int64 value }
{ Note : Last Char can be 'B' for Binary }
{ eg. '001011b' or '001011B' }
{ 0 will be returned if invalid BinaryString }
{ ============================================== }
function BinToInt(BinStr : string) : Int64;
var i : byte;
RetVar : Int64;
begin
BinStr := UpperCase(BinStr);
if BinStr[length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);
RetVar := 0;
for i := 1 to length(BinStr) do begin
if not (BinStr[i] in ['0','1']) then begin
RetVar := 0;
Break;
end;
RetVar := (RetVar shl 1) + (byte(BinStr[i]) and 1) ;
end;
Result := RetVar;
end;
//*****************************************
匹配带通配符的字符串
{ 这个函数取得两个字符串并进行比较。第一个字符串可以为任何字符串，但不能含有指定
的通配符(* 或 ?)。第二个字符串可以是你希望的任何形式。例如:
MatchStrings('David Stidolph','*St*') 返回真。}
function MatchStrings(source, pattern: String): Boolean;
var
pSource: Array [0..255] of Char;
pPattern: Array [0..255] of Char;
function MatchPattern(element, pattern: PChar): Boolean;
function IsPatternWild(pattern: PChar): Boolean;
var
t: Integer;
begin
Result := StrScan(pattern,'*') <> nil;
if not Result then Result := StrScan(pattern,'?') <> nil;
end;
begin
if 0 = StrComp(pattern,'*') then
Result := True
else if (element^ = Chr(0)) and (pattern^ <> Chr(0)) then
Result := False
else if element^ = Chr(0) then
Result := True
else begin
case pattern^ of
'*': if MatchPattern(element,@pattern[1]) then
Result := True
else
Result := MatchPattern(@element[1],pattern);
'?': Result := MatchPattern(@element[1],@pattern[1]);
else
if element^ = pattern^ then
Result := MatchPattern(@element[1],@pattern[1])
else
Result := False;
end;
end;
end;
begin
StrPCopy(pSource,source);
StrPCopy(pPattern,pattern);
Result := MatchPattern(pSource,pPattern);
end;
//********************************
操作二进制字符串的函数
{===============================================================}
{ BinHexTools }
{===============================================================}
{ VERSION : 1.0 }
{ COMPILER : Borland Delphi 3.0 }
{ AUTHOR : Hans Luyten }
{ DATE : 11 juni 1998 }
{===============================================================}
{ Utilities for working with binary strings }
{===============================================================}
{ FUNCTION : RESULTSTRING = HexToBin(HEXSTRING) }
{ PURPOSE : Convert a Hex number (string) to a Binary number }
{ (string) }
{===============================================================}
{ FUNCTION : RESULTINTEGER = HexCharToInt(HEXCHAR) }
{ PURPOSE : Convert a Hex character (0..9 & A..F or a..f) to }
{ an integer }
{===============================================================}
{ FUNCTION : RESULTSTRING = HexCharToBin(HEXCHAR) }
{ PURPOSE : Convert a Hex character (0..9 & A..F or a..f) to a}
{ binary string }
{===============================================================}
{ FUNCTION : RESULTINTEGER = Pow(BASE,POWER) }
{ PURPOSE : Simple power routine resulting in an integer }
{ (16bit) }
{===============================================================}
{ FUNCTION : RESULTINTEGER = BinStrToInt(BINSTRING) }
{ PURPOSE : this function converts a 16 bit binary string to }
{ an integer }
{===============================================================}
{ FUNCTION : RESULTSTRING = DecodeSMS7Bit (PDUSTRING) }
{ PURPOSE : this function decodes an 7-bit SMS (GSM 03.38) to }
{ ASCII }
{===============================================================}
{ FUNCTION : RESULTSTRING = ReverseStr (SOURCESTRING) }
{ PURPOSE : this function reverses a string }
{===============================================================}
unit BinHexTools;
interface
function HexToBin(HexNr : string): string;
function HexCharToInt(HexToken : char):Integer;
function HexCharToBin(HexToken : char): string;
function pow(base, power: integer): integer;
function BinStrToInt(BinStr : string) : integer;
function DecodeSMS7Bit(PDU : string):string;
function ReverseStr(SourceStr : string) : string;
implementation
uses sysutils, dialogs;
function HexCharToInt(HexToken : char):Integer;
begin
{if HexToken>#97 then HexToken:=Chr(Ord(HexToken)-32);
{ use lowercase aswell }
Result:=0;
if (HexToken>#47) and (HexToken<#58) then { chars 0....9 }
Result:=Ord(HexToken)-48
else if (HexToken>#64) and (HexToken<#71) then { chars A....F }
Result:=Ord(HexToken)-65 + 10;
end;
function HexCharToBin(HexToken : char): string;
var DivLeft : integer;
begin
DivLeft:=HexCharToInt(HexToken); { first HEX->BIN }
Result:='';
{ Use reverse dividing }
repeat { Trick; divide by 2 }
if odd(DivLeft) then { result = odd ? then bit = 1 }
Result:='1'+Result { result = even ? then bit = 0 }
else
Result:='0'+Result;
DivLeft:=DivLeft div 2; { keep dividing till 0 left and length = 4 }
until (DivLeft=0) and (length(Result)=4); { 1 token = nibble = 4 bits }
end;
function HexToBin(HexNr : string): string;
{ only stringsize is limit of binnr }
var Counter : integer;
begin
Result:='';
for Counter:=1 to length(HexNr) do
Result:=Result+HexCharToBin(HexNr[Counter]);
end;
function pow(base, power: integer): integer;
var counter : integer;
begin
Result:=1;
for counter:=1 to power do
Result:=Result*base;
end;
function BinStrToInt(BinStr : string) : integer;
var counter : integer;
begin
if length(BinStr)>16 then
raise ERangeError.Create(#13+BinStr+#13+
'is not within the valid range of a 16 bit binary.'+#13);
Result:=0;
for counter:=1 to length(BinStr) do
if BinStr[Counter]='1' then
Result:=Result+pow(2,length(BinStr)-counter);
end;
function DecodeSMS7Bit(PDU : string):string;
var OctetStr : string;
OctetBin : string;
Charbin : string;
PrevOctet: string;
Counter : integer;
Counter2 : integer;
begin
PrevOctet:='';
Result:='';
for Counter:=1 to length(PDU) do
begin
if length(PrevOctet)>=7 then { if 7 Bit overflow on previous }
begin
if BinStrToInt(PrevOctet)<>0 then
Result:=Result+Chr(BinStrToInt(PrevOctet))
else Result:=Result+' ';
PrevOctet:='';
end;
if Odd(Counter) then { only take two nibbles at a time }
begin
OctetStr:=Copy(PDU,Counter,2);
OctetBin:=HexToBin(OctetStr);
Charbin:='';
for Counter2:=1 to length(PrevOctet) do
Charbin:=Charbin+PrevOctet[Counter2];
for Counter2:=1 to 7-length(PrevOctet) do
Charbin:=OctetBin[8-Counter2+1]+Charbin;
if BinStrToInt(Charbin)<>0 then Result:=Result+Chr(BinStrToInt(CharBin))
else Result:=Result+' ';
PrevOctet:=Copy(OctetBin,1,length(PrevOctet)+1);
end;
end;
end;
function ReverseStr(SourceStr : string) : string;
var Counter : integer;
begin
Result:='';
for Counter:=1 to length(SourceStr) do
Result:=SourceStr[Counter]+Result;
end;
end.
----
^^ `_ ,
^^ | | | Hello, -(_)-
^^ )_) )_) )_) My Friends! , `
姬海涵 )___))___))___)\ ,
)____)____)_____)\\ __)\_
妲姬网苑 _____|____|____|____\\\__ (\_.-' a`-.
---------\ /--------(/~~````(/~^^`--------
^^^^^ ^^^^^^^^^^^^^^^^^^^^^ http://daji.xoasis.com
^^^^ ^^^^ ^^^ ^^ [email protected]
^^^^ ^^^
|
|