{*******************************************************}
{ }
{ 进制转换 }
{ }
{ cxg 2008-08-23 08:52:16 }
{ }
{*******************************************************}
unit uStrUnit;
interface
uses
SysUtils, StrUtils, Windows, Classes, WinSock, Forms, Controls, Dialogs;
const
cHexBinStrings: array[0..15] of string = //十六进制和二进制对照表
(
'0000', '0001', '0010', '0011',
'0100', '0101', '0110', '0111',
'1000', '1001', '1010', '1011',
'1100', '1101', '1110', '1111'
);
function BinToHex(mBin:string):string; //二进制转十六进制
function HexToBin(mHex:string):string; //十六进制转二进制
function StrToHexStr(S:string):string; //字符串转换成16进制字符串
function HexStrToStr(const S:string):string; //16进制字符串转换成字符串
function HexToDec(AHexString: String): Integer; //16 进制转换为 10 进制
function DecToHex(Value:Integer;Digit:Integer=2):string; //10进制转换为16进制
Function binToDec(Value :string) : integer; //二进制字符转十进制
Function DecTobin(Value :Integer) : string; //十进制转化二进制
function SplitString(Source, Deli: string ): TStringList;//分割字符串
Function GetLocateIp(InternetIp:Boolean=False):String; //取本机IP地址
function GetCS(AStr: string;AIndex: Integer): string; //生成效验和
procedure EnumCOM(Ports: TStrings); //列举COM口
implementation
function DecToHex(Value:Integer;Digit:Integer=2):string;
begin
Result:=IntToHex(value,Digit);
end;
Function binToDec(Value :string) : integer;
var
str : String;
Int : Integer;
i : integer;
BEGIN
Str := UpperCase(Value);
Int := 0;
FOR i := 1 TO Length(str) DO
Int := Int * 2+ ORD(str[i]) - 48;
Result := Int;
end;
Function DecTobin(Value :Integer) : string;//十进制转化二进制
Var
ST:String;
N:Integer;
function mod_num(n1,n2:integer):integer;//取余数
begin
result:=n1-n1 div n2*n2
end;
function reverse(s:String):String; //取反串
var
i,num:Integer;
st:String;
begin
num:=Length(s);
st:='';
For i:=num DownTo 1 do
Begin
st:=st+s[i];
End;
Result:=st;
end;
Begin
ST:='';
n:=value;
While n>=2 Do
Begin
st:=st+IntToStr(mod_num(n,2));
n:=n div 2;
End;
st:=st+IntToStr(n);
Result:=reverse(st);
End;
Function GetLocateIp(InternetIp:Boolean=False):String;
type
TaPInAddr = Array[0..10] of PInAddr;
PaPInAddr = ^TaPInAddr;
var
phe: PHostEnt;
pptr: PaPInAddr;
Buffer: Array[0..63] of Char;
I: Integer;
GInitData: TWSAData;
IP: String;
begin
Screen.Cursor := crHourGlass;
try
WSAStartup($101, GInitData);
IP:='0.0.0.0';
GetHostName(Buffer, SizeOf(Buffer));
phe := GetHostByName(buffer);
if phe = nil then
begin
ShowMessage(IP);
Result:=IP;
Exit;
end;
pPtr := PaPInAddr(phe^.h_addr_list);
if InternetIp then
begin
I := 0;
while pPtr^[I] <> nil do
begin
IP := inet_ntoa(pptr^[I]^);
Inc(I);
end;
end
else
IP:=StrPas(inet_ntoa(pptr^[0]^));
WSACleanup;
Result:=IP; //如果上网则为上网ip否则是网卡ip
finally
Screen.Cursor := crDefault;
end;
end;
function SplitString(Source, //源字符串
Deli: string //分割符
): TStringList; //返回字符串列表
var
EndOfCurrentString: byte;
StringList:TStringList;
begin
StringList:=TStringList.Create;
while Pos(Deli, Source)>0 do
begin
EndOfCurrentString := Pos(Deli, Source);
StringList.add(Copy(Source, 1, EndOfCurrentString - 1));
Source := Copy(Source, EndOfCurrentString + length(Deli), length(Source) - EndOfCurrentString);
end;
Result := StringList;
StringList.Add(source);
end;
function HexToDec(AHexString: String): Integer;
begin
Result :=StrToInt('$' + AHexString);
end;
function HexStrToStr(const S:string):string;
var
t:Integer;
ts:string;
M,Code:Integer;
begin
t:=1;
Result:='';
while t<=Length(S) do
begin
while (t<=Length(S)) and (not (S[t] in ['0'..'9','A'..'F','a'..'f'])) do
inc(t);
if (t+1>Length(S))or(not (S[t+1] in ['0'..'9','A'..'F','a'..'f'])) then
ts:='$'+S[t]
else
ts:='$'+S[t]+S[t+1];
Val(ts,M,Code);
if Code=0 then
Result:=Result+Chr(M);
inc(t,2);
end;
end;
function StrToHexStr(S:string):string;
var
I:Integer;
begin
for I:=1 to Length(S) do
begin
if I=1 then
Result:=IntToHex(Ord(S[1]),2)
else Result:=Result+' '+IntToHex(Ord(S[I]),2);
end;
end;
procedure EnumCOM(Ports: TStrings);
var
KeyHandle: HKEY;
ErrCode, Index: Integer;
ValueName, Data: string;
ValueLen, DataLen, ValueType: DWORD;
TmpPorts: TStringList;
begin
ErrCode := RegOpenKeyEx(
HKEY_LOCAL_MACHINE,
'HARDWARE/DEVICEMAP/SERIALCOMM',
0,
KEY_READ,
KeyHandle);
if ErrCode <> ERROR_SUCCESS then
Exit;
TmpPorts := TStringList.Create;
try
Index := 0;
repeat
ValueLen := 256;
DataLen := 256;
SetLength(ValueName, ValueLen);
SetLength(Data, DataLen);
ErrCode := RegEnumValue(
KeyHandle,
Index,
PChar(ValueName),
Cardinal(ValueLen),
nil,
@ValueType,
PByte(PChar(Data)),
@DataLen);
if ErrCode = ERROR_SUCCESS then
begin
SetLength(Data, DataLen);
TmpPorts.Add(Data);
Inc(Index);
end
else
if ErrCode <> ERROR_NO_MORE_ITEMS then
exit;
until (ErrCode <> ERROR_SUCCESS) ;
TmpPorts.Sort;
Ports.Assign(TmpPorts);
finally
RegCloseKey(KeyHandle);
TmpPorts.Free;
end;
end;
function GetCS(AStr: string;
AIndex: Integer): string; //从第几个字符开始计算
var
newstr1,he,oldstr:string;
tj:boolean;
i:integer;
begin
i:=1;
he:='';
tj:=true;
oldstr:=copy(AStr,AIndex,length(AStr)-AIndex+1);
while tj=true do
begin
newstr1:=copy(oldstr,i,2);
oldstr:=copy(oldstr,i+2,length(oldstr)-2);
if he='' then
begin
he:=inttohex(strtointdef('$'+newstr1,16)+ strtointdef('$'+'00',16),2);
he:=rightstr(he,2);
end else
begin
he:=inttohex(strtointdef('$'+newstr1,16)+ strtointdef('$'+he,16),2);
he:=rightstr(he,2);
end;
if length(oldstr) =0 then tj:=false;
end;
Result:= AStr+he;
end;
function BinToHex( //二进制转换成十六进制
mBin: string //二进制字符
): string; //返回十六进制字符
var
I, L: Integer;
S: string;
begin
Result := '';
if mBin = '' then Exit;
mBin := '000' + mBin;
L := Length(mBin);
while L >= 4 do
begin
S := Copy(mBin, L - 3, MaxInt);
Delete(mBin, L - 3, MaxInt);
for I := Low(cHexBinStrings) to High(cHexBinStrings) do
if S = cHexBinStrings[I] then
begin
Result := IntToHex(I, 0) + Result;
Break;
end;
L := Length(mBin);
end;
end; { BinToHex }
function HexToBin( //十六进制转换成二进制
mHex: string //十六进制字符串
): string; //返回二进制字符串
var
I: Integer;
begin
Result := '';
for I := 1 to Length(mHex) do
Result := Result + cHexBinStrings[StrToIntDef('$' + mHex[I], 0)];
end; { HexToBin }
end.