为delphi补充函数!

下面的代码是如何将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.