convert.pas

我自己写的Delphi下数据类型转换函数集

unit convert;

interface
uses
  Windows, SysUtils, Dialogs, WinSvc, Graphics, Classes;

function BinToByte(s : string) : byte;
function ByteToBin(wordnum : byte) : string;
function BinToWord(s : string) : word;
function WordToBin(wordnum : word) : string;
function DigToByte(s : string) : byte;
function ByteToDig(num : byte) : string;
function DigToWord(s : string) : word;
function WordToDig(num : word) : string;
function ByteToHex(num : byte) : string;
function HexToByte(str : ShortString) : byte;
function WordToHex(num : word) : string;
function HexToWord(str : ShortString): Word;
function BCDToByte(BCD:Byte):byte;
function ByteToBCD(Num:Byte):byte;
function BCDToWord(BCD:word):word;
function WordToBCD(Num:word):word;
function LongintToBin(Value: longint):string;
function BinToLongint(s : string): longint;
function LongintToHex(Value: longint): string;
function HexToLongint(str : ShortString): longint;
function IntToDig(Num: Longint): string;
function DigToInt(Str: string): Integer;
function ByteToDigEx(Num: byte): string;
function DigToByteEx(Str: string): byte;
function WordToDigEx(Num: word): string;
function DigToWordEx(Str: string): word;
function ByteBinToHex(ByteBin: string): string;
function WordBinToHex(WordBin: string): string;
function ByteHexToBin(ByteHex: string): string;
function WordHexToBin(WordHex: string): string;

implementation

{$WARNINGS OFF}

function CharOrd(inchar :char): byte;
begin
 if inchar in ['0'..'9'] then
    result := ord(inchar) - ord('0') else
 if Upcase(inchar) in ['A'..'F'] then
    result := ord(inchar) - ord('A') + 10 else
    result := 0;
end;

function HexChar(CharCode : char): boolean;
begin
 if (((byte(Upcase(CharCode)) >= $41) and
    (byte(Upcase(CharCode)) <= $46))) or
    (((byte(Upcase(CharCode)) >= $30) and
    (byte(Upcase(CharCode)) <= $39))) then
    result := True else result := False;
end;

function BinToByte(s : string) : byte;
var
w,i,j : byte;
begin
 w := 0;
 j := 1;
 for i := Length(s) downto 1 do begin
  w := w + (ord(s[i]) - 48) * j;
  j := j * 2;
 end;
 result := w
end;

function ByteToBin(wordnum : byte) : string;
const
CLength = 8;
var
i   : byte;
num : word;
wordstr : string[9];
begin
 num := 1;
 for i := CLength downto 1 do begin
  if (wordnum and num) <> 0 then wordstr[i] := '1' else wordstr[i]:= '0';
  num := num * 2;
 end;
 SetLength(wordstr,CLength);
 result := wordstr;
end;

function BinToWord(s: string): word;
var
w,i,j : word;
begin
 w := 0;
 j := 1;
 for i := Length(s) downto 1 do begin
  w := w + (ord(s[i]) - 48) * j;
  j := j * 2;
 end;
 result := w
end;

function WordToBin(wordnum : word): string;
const
CLength = 16;
var
i : byte;
num : word;
wordstr : string[17];
begin
 num := 1;
 for i := CLength downto 1 do begin
  if (wordnum and num) <> 0 then wordstr[i] := '1' else wordstr[i]:= '0';
  num := num * 2;
 end;
 SetLength(wordstr,CLength);
 result := wordstr;
end;

function DigToByte(s : string): byte;
var
b,i,j : byte;
begin
 b := 0;
 j := 1;
 for i := Length(s) downto 1 do begin
  b := b + (ord(s[i]) - 48) * j;
  j := j * 10;
 end;
 result := b
end;

function ByteToDig(num: byte): string;
Label ZHEND;
var
Dstr : ShortString;
i,ii,num1: byte;
NilHead : boolean;
begin
 if num = 0 then begin
  Dstr := '0';
  goto ZHEND;
 end;
 num1 := num; i := 100; ii := 1; NilHead := true;
 while i >= 1 do begin
  if (num1 div i) > 0 then NilHead := false;
   if NilHead = false then begin
    Dstr[ii] := char((num1 div i) + $30);
    num1 := num1 mod i;
    ii := ii + 1;
   end;
  i := i div 10;
 end;
 SetLength(Dstr,ii - 1);
 ZHEND:
 result := Dstr;
end;

function DigToWord(s : string) : word;
var
w,i,j : word;
begin
 w := 0;
 j := 1;
 for i := Length(s) downto 1 do begin
  w := w + (ord(s[i]) - 48) * j;
  j := j * 10;
 end;
 result := w
end;

function WordToDig(num: word): string;
Label ZHEND;
var
Dstr : ShortString;
i,ii,num1: word;
NilHead : boolean;
begin
 if num = 0 then begin
  Dstr := '0';
  goto ZHEND;
 end;
 num1 := num; i := 10000; ii := 1; NilHead := true;
 while i >= 1 do begin
  if (num1 div i) > 0 then NilHead := false;
  if NilHead = false then begin
   Dstr[ii] := char((num1 div i) + $30);
   num1 := num1 mod i;
   ii := ii + 1;
  end;
  i := i div 10;
 end;
 SetLength(Dstr,ii - 1);
 ZHEND:
 result := Dstr;
end;

function ByteToHex(num: byte): string;
var
numhi,numlo : byte;
begin
 numlo := num   and  $0f;
 numhi := (num shr 4) and $0f;
 if numhi <= 9 then char(numhi) := chr(ord('1') + numhi - 1)
               else char(numhi) := chr(ord('A') + numhi - 10);
 if numlo <= 9 then char(numlo) := chr(ord('1') + numlo - 1)
               else char(numlo) := chr(ord('A') + numlo - 10);
 result := char(numhi) + char(numlo);
end;

function HexToByte(str: ShortString): byte;
var
strhi,strlo : char;
begin
 if Length(str) < 2 then begin
  strlo := str[1];
  strhi := '0';
 end else begin
  strhi := str[1];
  strlo := str[2];
 end;
 if strhi in ['0'..'9'] then
  byte(strhi) := ord(strhi) - ord('0') else
 if Upcase(strhi) in ['A'..'F'] then
  byte(strhi) := ord(strhi) - ord('A') + 10 else begin
  result := 0;
  exit;
 end;
 if strlo in ['0'..'9'] then
  byte(strlo) := ord(strlo) - ord('0') else
 if Upcase(strlo) in ['A'..'F'] then
  byte(strlo) := ord(strlo) - ord('A') + 10 else begin
  result := 0;
  exit;
 end;
 result := ((byte(strhi) shl 4) and $f0) or (byte(strlo) and $0f);
end;

function WordToHex(num: word): string;
var
nummsbhi,nummsblo,numlsbhi,numlsblo : byte;
begin
 numlsblo := num  and  $000f;
 numlsbhi := (num shr 4) and $000f;
 nummsblo := (num shr 8) and $000f;
 nummsbhi := (num shr 12) and $000f;
 if numlsblo <= 9 then
  char(numlsblo) := chr(ord('1') + numlsblo - 1)
  else
  char(numlsblo) := chr(ord('A') + numlsblo - 10);
 if numlsbhi <= 9 then
  char(numlsbhi) := chr(ord('1') + numlsbhi - 1)
  else
  char(numlsbhi) := chr(ord('A') + numlsbhi - 10);
 if nummsblo <= 9 then
  char(nummsblo) := chr(ord('1') + nummsblo - 1)
  else
  char(nummsblo) := chr(ord('A') + nummsblo - 10);
 if nummsbhi <= 9 then
  char(nummsbhi) := chr(ord('1') + nummsbhi - 1)
  else
  char(nummsbhi) := chr(ord('A') + nummsbhi - 10);
 result := char(nummsbhi) + char(nummsblo) +
           char(numlsbhi) + char(numlsblo);
end;

function HexToWord(str: ShortString): Word;
var
wordhi,wordlo     : word;
strmsbhi,strmsblo : char;
strlsbhi,strlsblo : char;
begin
 case Length(str) of
   0:  begin
        strlsblo := '0'; strlsbhi := '0';
        strmsblo := '0'; strmsbhi := '0';
       end;
   1 : begin
        strlsblo := str[1]; strlsbhi := '0';
        strmsblo := '0';       strmsbhi := '0';
       end;
   2 : begin
        strlsblo := str[2]; strlsbhi := str[1];
        strmsblo := '0';       strmsbhi := '0';
        end;
   3 : begin
        strlsblo := str[3]; strlsbhi := str[2];
        strmsblo := str[1]; strmsbhi := '0';
       end;
   4 : begin
        strlsblo := str[4]; strlsbhi := str[3];
        strmsblo := str[2]; strmsbhi := str[1];
       end;
   else
       begin
        strlsblo := str[4]; strlsbhi := str[3];
        strmsblo := str[2]; strmsbhi := str[1];
       end;
   end;
  strlsbhi := char(CharOrd(strlsbhi));
  strlsblo := char(CharOrd(strlsblo));
  strmsbhi := char(CharOrd(strmsbhi));
  strmsblo := char(CharOrd(strmsblo));
  wordhi   := ((byte(strmsbhi) shl 4) and $f0) or (byte(strmsblo) and $0f);
  wordlo   := ((byte(strlsbhi) shl 4) and $f0) or (byte(strlsblo) and $0f);
  result := ((wordhi shl 8) and $ff00) or (wordlo and $00ff);
end;

function BCDToByte(BCD: Byte): byte;
begin
 result := ((BCD shr 4) * 10) + (BCD and $0f);
end;

function ByteToBCD(Num: Byte): byte;
var BCDNumHi,BCDNumLo : byte;
begin
 BCDNumHi := Num div 10;
 BCDNumLo := Num mod 10;
 result := (BCDNumHi shl 4) or BCDNumLo;
end;

function BCDToWord(BCD: word): word;
var
BCDNumHi,BCDNumLo : byte;
begin
 asm
  push ax
  mov  ax,BCD
  mov  BCDNumHi,ah
  mov  BCDNumLo,al
  pop  ax
 end;
 BCDNumHi := BCDToByte(BCDNumHi);
 BCDNumLo := BCDToByte(BCDNumLo);
 result := (BCDNumHi * 100) + BCDNumLo;
end;

function WordToBCD(Num: word): word;
var BCDNumHi,BCDNumLo : word;
begin
 BCDNumHi := Num div 100;
 BCDNumLo := Num mod 100;
 BCDNumHi := ByteToBCD(BCDNumHi);
 BCDNumLo := ByteToBCD(BCDNumLo);
 result := (BCDNumHi shl 8) or BCDNumLo;
end;

function BinToLongint(s : string): longint;
var
i    : word;
w,j  : longint;
begin
 w := 0;
 j := 1;
 for i := length(s) downto 1 do begin
  w := w + (ord(s[i]) - 48) * j;
  j := j * 2;
 end;
 result := w
end;

function LongintToBin(Value: longint): string;
type
TLV = record
       case byte of
        0:(W0: word; W1: word);
        1:(LNum: longint);
      end;
var
LV : TLV;
begin
 LV.LNum := Value;
 result := WordToBin(LV.W1);
 result := result + WordToBin(LV.W0);
end;

function LongintToHex(Value: longint): string;
type
TLV = record
       case byte of
        0:(W0: word; W1: word);
        1:(LNum: longint);
      end;
var
LV : TLV;
begin
 LV.LNum := Value;
 result := WordToHex(LV.W1);
 result := result + WordToHex(LV.W0);
end;

function HexToLongint(str : ShortString): longint;
type
str_abs = array[0..8] of char;
var
strabs : str_abs absolute str;
Mstrmsbhi,Mstrmsblo : char;
Mstrlsbhi,Mstrlsblo : char;
Lstrmsbhi,Lstrmsblo : char;
Lstrlsbhi,Lstrlsblo : char;
MWordHi,MWordLo : word;
LWordHi,LWordLo : word;
LLongHi,LLongLo : longint;
begin
 case byte(strabs[0]) of
   0:  begin
        Lstrlsblo := '0'; Lstrlsbhi := '0';
        Lstrmsblo := '0'; Lstrmsbhi := '0';
        Mstrlsblo := '0'; Mstrlsbhi := '0';
        Mstrmsblo := '0'; Mstrmsbhi := '0';
       end;
   1 : begin
        Lstrlsblo := strabs[1]; Lstrlsbhi := '0';
        Lstrmsblo := '0';       Lstrmsbhi := '0';
        Mstrlsblo := '0';       Mstrlsbhi := '0';
        Mstrmsblo := '0';       Mstrmsbhi := '0';
       end;
   2 : begin
        Lstrlsblo := strabs[2]; Lstrlsbhi := strabs[1];
        Lstrmsblo := '0';       Lstrmsbhi := '0';
        Mstrlsblo := '0';       Mstrlsbhi := '0';
        Mstrmsblo := '0';       Mstrmsbhi := '0';
        end;
   3 : begin
        Lstrlsblo := strabs[3]; Lstrlsbhi := strabs[2];
        Lstrmsblo := strabs[1]; Lstrmsbhi := '0';
        Mstrlsblo := '0';       Mstrlsbhi := '0';
        Mstrmsblo := '0';       Mstrmsbhi := '0';
       end;
   4 : begin
        Lstrlsblo := strabs[4]; Lstrlsbhi := strabs[3];
        Lstrmsblo := strabs[2]; Lstrmsbhi := strabs[1];
        Mstrlsblo := '0';       Mstrlsbhi := '0';
        Mstrmsblo := '0';       Mstrmsbhi := '0';
       end;
   5 : begin
        Lstrlsblo := strabs[5]; Lstrlsbhi := strabs[4];
        Lstrmsblo := strabs[3]; Lstrmsbhi := strabs[2];
        Mstrlsblo := strabs[1]; Mstrlsbhi := '0';
        Mstrmsblo := '0';       Mstrmsbhi := '0';
       end;
   6 : begin
        Lstrlsblo := strabs[6]; Lstrlsbhi := strabs[5];
        Lstrmsblo := strabs[4]; Lstrmsbhi := strabs[3];
        Mstrlsblo := strabs[2]; Mstrlsbhi := strabs[1];
        Mstrmsblo := '0';       Mstrmsbhi := '0';
        end;
   7 : begin
        Lstrlsblo := strabs[7]; Lstrlsbhi := strabs[6];
        Lstrmsblo := strabs[5]; Lstrmsbhi := strabs[4];
        Mstrlsblo := strabs[3]; Mstrlsbhi := strabs[2];
        Mstrmsblo := strabs[1]; Mstrmsbhi := '0';
       end;
   8 : begin
        Lstrlsblo := strabs[8]; Lstrlsbhi := strabs[7];
        Lstrmsblo := strabs[6]; Lstrmsbhi := strabs[5];
        Mstrlsblo := strabs[4]; Mstrlsbhi := strabs[3];
        Mstrmsblo := strabs[2]; Mstrmsbhi := strabs[1];
       end;
   else
       begin
        Lstrlsblo := strabs[8]; Lstrlsbhi := strabs[7];
        Lstrmsblo := strabs[6]; Lstrmsbhi := strabs[5];
        Mstrlsblo := strabs[4]; Mstrlsbhi := strabs[3];
        Mstrmsblo := strabs[2]; Mstrmsbhi := strabs[1];
       end;
   end;
  Mstrmsbhi := char(CharOrd(Mstrmsbhi));
  Mstrmsblo := char(CharOrd(Mstrmsblo));
  Mstrlsbhi := char(CharOrd(Mstrlsbhi));
  Mstrlsblo := char(CharOrd(Mstrlsblo));
  Lstrmsbhi := char(CharOrd(Lstrmsbhi));
  Lstrmsblo := char(CharOrd(Lstrmsblo));
  Lstrlsbhi := char(CharOrd(Lstrlsbhi));
  Lstrlsblo := char(CharOrd(Lstrlsblo));
  MWordHi   := ((byte(Mstrmsbhi) shl 4) and $f0) or (byte(Mstrmsblo) and $0f);
  MWordLo   := ((byte(Mstrlsbhi) shl 4) and $f0) or (byte(Mstrlsblo) and $0f);
  LWordHi   := ((byte(Lstrmsbhi) shl 4) and $f0) or (byte(Lstrmsblo) and $0f);
  LWordLo   := ((byte(Lstrlsbhi) shl 4) and $f0) or (byte(Lstrlsblo) and $0f);
  LLongHi   := ((MWordHi shl 8) and $ff00) or (MWordLo and $00ff);
  LLongLo   := ((LWordHi shl 8) and $ff00) or (LWordLo and $00ff);
  result    := ((LLongHi shl 16) and $ffff0000) or (LLongLo and $0000ffff);
end;

function IntToDig(Num: Longint): string;
var
NumStr: string[12];
begin
 Str(Num,NumStr);
 result := NumStr;
end;

function DigToInt(Str: string): Integer;
var
di : integer;
ei : integer;
begin
 Val(Str,di,ei);
 if ei = 0 then result := di else result := 0;
end;

function ByteToDigEx(Num: byte): string;
var
 NumStr: string[12];
begin
 Str(Num,NumStr);
 result := NumStr;
end;

function DigToByteEx(Str: string): byte;
var
di : byte;
ei : integer;
begin
 Val(Str,di,ei);
 if ei = 0 then result := di else result := 0;
end;

function WordToDigEx(Num: word): string;
var
 NumStr: string[12];
begin
 Str(Num,NumStr);
 result := NumStr;
end;

function DigToWordEx(Str: string): word;
var
di : word;
ei : integer;
begin
 Val(Str,di,ei);
 if ei = 0 then result := di else result := 0;
end;

function ByteBinToHex(ByteBin: string): string;
begin
 result := ByteToHex(BinToByte(ByteBin));
end;

function WordBinToHex(WordBin: string): string;
begin
 result := WordToHex(BinToWord(WordBin));
end;

function ByteHexToBin(ByteHex: string): string;
begin
 result := ByteToBin(HexToByte(ByteHex));
end;

function WordHexToBin(WordHex: string): string;
begin
 result := WordToBin(HexToWord(WordHex));
end;


end.