Delphi的几种类型转换 unit Support; interface type dword=longword; function WordToStr(Value: word): string; function DwordToStr(Value: dword): string; function StrToWord(Value: string): word; function StrToDword(Value: string): dword; procedure SetBit(var Str: string; BitNr: dword; Value: boolean); function GetBit(Str: string; BitNr: dword): boolean; function Pack(I: string):string; function UnPack(I: string): string; procedure FindBest(Main, Sub: string;var FoundLen, FoundPos: integer); implementation // DwordToStr() : Converts a DWORD to a 4 byte string function DwordToStr(Value: dword): string; var ResultPtr: PChar; begin SetLength(Result, 4); ResultPtr:=@Result[1]; asm MOV EAX, [ResultPtr] MOV EBX, Value MOV [EAX], EBX end; end; // StrToDWord() : Converts a 4 byte string to a DWORD function StrToDword(Value: string): dword; var ValuePtr: PChar; begin ValuePtr:=@Value[1]; asm MOV EAX, [ValuePtr] MOV EAX, [EAX] MOV Result, EAX end; end; // WordToStr() : Converts a WORD to a 2 byte string function WordToStr(Value: word): string; var ResultPtr: PChar; begin SetLength(Result, 2); ResultPtr:=@Result[1]; asm MOV EAX, [ResultPtr] MOV BX, Value MOV [EAX], BX end; end; // StrToWord() : Converts a 2 byte string to a WORD function StrToWord(Value: string): word; var ValuePtr: PChar; begin ValuePtr:=@Value[1]; asm MOV EAX, [ValuePtr] MOV AX, [EAX] MOV Result, AX end; end; function HexStrToStr(const S:string):string; //16进制字符串转换成字符串 var t:Integer; ts:string; M,Code:Integer; begin t:=1; Result:=''; while t<=Length(S) do begin //xlh 2006.10.21 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(const S:string):string; //字符串转换成16进制字符串 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; // SetBit() : Sets a single BIT in a string to true or false procedure SetBit(var Str: string; BitNr: dword; Value: boolean); var CharNr: dword; CharBit: byte; Original, Mask: byte; begin CharNr:=(BitNr DIV 8)+1; CharBit:=(BitNr MOD 8); Original:=byte(Str[CharNr]); Mask:=1 shl CharBit; if Value=true then Original:=(Original or Mask) else Original:=(Original and not Mask); Str[CharNr]:=char(Original); end; // GetBit() : Returns the state of a single bit in a string function GetBit(Str: string; BitNr: dword): boolean; var CharNr: dword; CharBit: byte; Original, Mask: byte; begin CharNr:=(BitNr DIV 8)+1; CharBit:=(BitNr MOD 8); Original:=byte(Str[CharNr]); Mask:=1 shl CharBit; if (Original and Mask)=Mask then Result:=true else Result:=false; end; // Pack() : Compresses a string to a hopefully smaller string function Pack(I: string):string; var Header: string; Tag,T1,T2: string; Buffer: string; History: string; FindStr: string; P: integer; FP,FL: integer; begin SetLength(Tag,(Length(I) DIV 8)+1); // Create TAG string Header:=DwordToStr(Length(I)); // Create Header string (length of original) // Pack the string P:=1; while P<=Length(I) do begin FindStr:=Copy(I,P,10); FindBest(History,FindStr,FL,FP); if FL>2 then begin // if match found in history and length>2 Buffer:=Buffer+WordToStr((FP SHL 3)+(FL-3)); History:=History+Copy(History,FP,FL); T1:=Copy(I,P,FL); T2:=Copy(History,FP,FL); SetBit(Tag,P-1,true); P:=P+(FL-1); end else begin // if no match found in history Buffer:=Buffer+I[P]; History:=History+I[P]; SetBit(Tag,P-1,false); end; if Length(History)>8100 then History:=Copy(History,1024,8100); INC(P); end; Result:=Header+Tag+Buffer; end; // UnPack() : DeCompresses a string compressed with Pack() function UnPack(I: string): string; var Tag,T: string; Buffer: string; TmpWrd: string; History: string; P, OL: integer; FP, FL: integer; begin // Split I in Tag and Buffer OL:=StrToDword(I); SetLength(Buffer, OL); SetLength(Tag,(OL DIV 8)+1); P:=5; Tag:=Copy(I,P,Length(Tag)); P:=P+Length(Tag); Buffer:=Copy(I,P,Length(Buffer)); Result:=''; // begin unpacking P:=1; while Length(Result)