www.pudn.com > M2Server.rar > EDcode.pas
////////////////////////////////////////////////////////////////////////////////
// //
// 工程： M2Server //
// 版本: 1.0 //
// 公司： 乐都在线 //
// 网址： http://www.hh8.net //
// 日期： 2005-05-28 //
// //
////////////////////////////////////////////////////////////////////////////////
unit EDcode;
interface
uses
Windows, SysUtils, Classes, ClassDeclaration;
function fnDecode6BitBufA(pszSrc, pszDest: PChar; nDestLen: Integer): Integer;
function Decode6BitBuf(source: string; buf: PChar; BufLen: Integer): Integer;
function Encode6BitBuf(src, Dest: PChar; SrcLen, destlen: Integer): Integer;
function EncodeMessage(sMsg: TDEFAULTMESSAGE_RCD): string;
function DecodeMessage(Str: string): TDEFAULTMESSAGE_RCD;
function EncodeString(Str: string): string;
function DecodeString(Str: string): string;
function EncodeBuffer(buf: PChar; bufsize: Integer): string;
procedure DecodeBuffer(src: string; buf: PChar; bufsize: Integer);
function MakeDefaultMsg(wIdent: Word; nRecog: Integer; wParam, wTag, wSeries:
Word): TDEFAULTMESSAGE_RCD;
var
CSEncode: TRTLCriticalSection;
const
code = $3C;
implementation
var
EncBuf, TempBuf: PChar;
function fnDecode6BitBufA(pszSrc, pszDest: PChar; nDestLen: Integer): Integer;
var
I,
nLen,
nDestPos,
nBitPos,
nMadeBit: Integer;
chCode,
chTemp,
tmp: Byte;
Decode6BitMask: array[0..4] of Char;
begin
nLen := StrLen(pszSrc);
nDestPos := 0;
nBitPos := 2;
nMadeBit := 0;
Decode6BitMask[0] := Char($FC);
Decode6BitMask[1] := Char($F8);
Decode6BitMask[2] := Char($F0);
Decode6BitMask[3] := Char($E0);
Decode6BitMask[4] := Char($C0);
for I := 0 to nLen - 1 do //Iterate
begin
if pszSrc[I] >= Char($3C) then
begin
chTemp := Byte(Integer(pszSrc[I]) - $3C);
end
else
begin
nDestPos := 0;
Break;
end;
if nDestPos >= nDestLen then
begin
Break;
end;
if nMadeBit >= 2 then
begin
chCode := Byte(Char(Integer(tmp) or ((Integer(chTemp) and ($3F)) shr (6 -
nBitPos))));
pszDest[nDestPos] := Char(chCode);
Inc(nDestPos);
nMadeBit := 0;
if nBitPos < 6 then
begin
Inc(nBitPos);
Inc(nBitPos);
end
else
begin
nBitPos := 2;
Continue;
end;
end;
tmp := Byte((Integer(chTemp) shl nBitPos) and (Integer(Decode6BitMask[nBitPos
- 2])));
nMadeBit := nMadeBit + 8 - nBitPos;
end;
pszDest[nDestPos] := #0;
Result := nDestPos;
end;
function MakeDefaultMsg(wIdent: Word; nRecog: Integer; wParam, wTag, wSeries:
Word): TDEFAULTMESSAGE_RCD;
begin
Result.nRecog := nRecog;
Result.wIdent := wIdent;
Result.wParam := wParam;
Result.wTag := wTag;
Result.wSeries := wSeries;
end;
function Encode6BitBuf(src, Dest: PChar; SrcLen, destlen: Integer): Integer;
var
I, restcount, destpos: Integer;
made, Ch, rest: Byte;
begin
try
restcount := 0;
rest := 0;
destpos := 0;
for I := 0 to SrcLen - 1 do
begin
if destpos >= destlen then
Break;
Ch := Byte(src[I]);
made := Byte((rest or (Ch shr (2 + restcount))) and $3F);
rest := Byte(((Ch shl (8 - (2 + restcount))) shr 2) and $3F);
Inc(restcount, 2);
if restcount < 6 then
begin
Dest[destpos] := Char(made + code);
Inc(destpos);
end
else
begin
if destpos < destlen - 1 then
begin
Dest[destpos] := Char(made + code);
Dest[destpos + 1] := Char(rest + code);
Inc(destpos, 2);
end
else
begin
Dest[destpos] := Char(made + code);
Inc(destpos);
end;
restcount := 0;
rest := 0;
end;
end;
if restcount > 0 then
begin
Dest[destpos] := Char(rest + code);
Inc(destpos);
end;
Dest[destpos] := #0;
finally
Result := destpos;
end;
end;
function Decode6BitBuf(source: string; buf: PChar; BufLen: Integer): Integer;
const
Masks: array[2..6] of Byte = ($FC, $F8, $F0, $E0, $C0);
//($FE, $FC, $F8, $F0, $E0, $C0, $80, $00);
var
I, len, bitpos, madebit, bufpos: Integer;
Ch, tmp, _byte: Byte;
begin
try
len := Length(source);
bitpos := 2;
madebit := 0;
bufpos := 0;
tmp := 0;
for I := 1 to len do
begin
if Integer(source[I]) - code >= 0 then
Ch := Byte(source[I]) - code
else
begin
bufpos := 0;
Break;
end;
if bufpos >= BufLen then
Break;
if (madebit + 6) >= 8 then
begin
_byte := Byte(tmp or ((Ch and $3F) shr (6 - bitpos)));
buf[bufpos] := Char(_byte);
Inc(bufpos);
madebit := 0;
if bitpos < 6 then
Inc(bitpos, 2)
else
begin
bitpos := 2;
Continue;
end;
end;
tmp := Byte(Byte(Ch shl bitpos) and Masks[bitpos]); // #### ##--
Inc(madebit, 8 - bitpos);
end;
buf[bufpos] := #0;
finally
Result := bufpos;
end;
end;
function DecodeMessage(Str: string): TDEFAULTMESSAGE_RCD;
var
msg: TDEFAULTMESSAGE_RCD;
begin
try
EnterCriticalSection(CSEncode);
Decode6BitBuf(Str, EncBuf, 1024);
Move(EncBuf^, msg, SizeOf(TDEFAULTMESSAGE_RCD));
Result := msg;
finally
LeaveCriticalSection(CSEncode);
end;
end;
function DecodeString(Str: string): string;
begin
try
EnterCriticalSection(CSEncode);
Decode6BitBuf(Str, EncBuf, 65536);
Result := Strpas(EncBuf); //error, 1, 2, 3,...
finally
LeaveCriticalSection(CSEncode);
end;
end;
procedure DecodeBuffer(src: string; buf: PChar; bufsize: Integer);
begin
try
EnterCriticalSection(CSEncode);
Decode6BitBuf(src, EncBuf, 65536);
Move(EncBuf^, buf^, bufsize);
finally
LeaveCriticalSection(CSEncode);
end;
end;
function EncodeMessage(sMsg: TDEFAULTMESSAGE_RCD): string;
begin
try
EnterCriticalSection(CSEncode);
Move(sMsg, TempBuf^, SizeOf(TDEFAULTMESSAGE_RCD));
Encode6BitBuf(TempBuf, EncBuf, SizeOf(TDEFAULTMESSAGE_RCD), 1024);
Result := Strpas(EncBuf); //Error: 1, 2, 3, 4, 5, 6, 7, 8, 9
finally
LeaveCriticalSection(CSEncode);
end;
end;
function EncodeString(Str: string): string;
begin
try
EnterCriticalSection(CSEncode);
Encode6BitBuf(PChar(Str), EncBuf, Length(Str), 65536);
Result := Strpas(EncBuf);
finally
LeaveCriticalSection(CSEncode);
end;
end;
function EncodeBuffer(buf: PChar; bufsize: Integer): string;
begin
try
EnterCriticalSection(CSEncode);
if bufsize < 65536 then
begin
Move(buf^, TempBuf^, bufsize);
Encode6BitBuf(TempBuf, EncBuf, bufsize, 65536);
Result := Strpas(EncBuf);
end
else
Result := '';
finally
LeaveCriticalSection(CSEncode);
end;
end;
initialization
begin
GetMem(EncBuf, 10240 + 100); //65536 + 100);
GetMem(TempBuf, 10240); //2048);
InitializeCriticalSection(CSEncode);
end;
finalization
begin
//FreeMem (EncBuf, BUFFERSIZE + 100);
//FreeMem (TempBuf, 2048);
DeleteCriticalSection(CSEncode);
end;
end.