精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● Delphi>>Object Pascal语言>>字符串操作转换的几个技巧

主题:字符串操作转换的几个技巧
发信人: 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] 
         ^^^^      ^^^ 

[关闭][返回]