unit EDcode;
interface
uses
Windows, SysUtils, Classes, HUtil32, Grobal2;
function EncodeMessage(sMsg: TDefaultMessage): string;
function EncodeString(str: string): string;
function EncodeBuffer(Buf: PChar; bufsize: Integer): string;
function DecodeMessage(str: string): TDefaultMessage;
function DecodeString(str: string): string;
procedure DecodeBuffer(Src: string; Buf: PChar; bufsize: Integer);
function MakeDefaultMsg(wIdent: Word; nRecog: Integer; wParam, wTag, wSeries:
Word): TDefaultMessage;
var
CSEncode : TRTLCriticalSection;
implementation
var
poslen : Integer;
const
code = $3C;
function MakeDefaultMsg(wIdent: Word; nRecog: Integer; wParam, wTag, wSeries:
Word): TDefaultMessage;
begin
Result.Recog := nRecog;
Result.Ident := wIdent;
Result.Param := wParam;
Result.Tag := wTag;
Result.Series := wSeries;
end;
function MirEncode(pIn: PChar; Size: Word; pOut: PChar): Word;
var
b1, bcal : Byte;
bflag1, bflag2 : Byte;
i, iPtr, oPtr : Word;
begin
b1 := 0;
bcal := 0;
bflag1 := 0;
bflag2 := 0;
i := 0;
iPtr := 0;
oPtr := 0;
while iPtr < Size do
begin
b1 := Ord(pIn[iPtr]) xor $EB;
Inc(iPtr);
if i < 2 then
begin
bcal := b1;
bcal := bcal shr 2;
bflag1 := bcal;
bcal := bcal and $3C;
b1 := b1 and 3;
bcal := bcal or b1;
bcal := bcal + $3B;
pOut[oPtr] := Chr(bcal);
Inc(oPtr);
bflag2 := (bflag1 and 3) or (bflag2 shl 2);
end
else
begin
bcal := b1;
bcal := bcal and $3F;
bcal := bcal + $3B;
pOut[oPtr] := Chr(bcal);
Inc(oPtr);
b1 := b1 shr 2;
b1 := b1 and $30;
b1 := b1 or bflag2;
b1 := b1 + $3B;
pOut[oPtr] := Chr(b1);
Inc(oPtr);
bflag2 := 0;
end;
Inc(i);
i := i mod 3;
end;
pOut[oPtr] := Chr(0);
if i <> 0 then
begin
pOut[oPtr] := Chr(bflag2 + $3B);
Inc(oPtr);
pOut[oPtr] := Chr(0);
end;
Result := oPtr;
end;
function MirDecode(pIn: string; pOut: PChar): Word;
var
b1, b2, b3 : Byte;
c1, c2, c3, c4 : Byte;
i, oPtr : Word;
X, Y : Word;
begin
i := 0;
oPtr := 0;
X := Length(pIn) div 4;
if Length(pIn) > 3 then
for i := 0 to X - 1 do
begin
c1 := Ord(pIn[i * 4 + 1]) - $3B;
c2 := Ord(pIn[i * 4 + 2]) - $3B;
c3 := Ord(pIn[i * 4 + 3]) - $3B;
c4 := Ord(pIn[i * 4 + 4]) - $3B;
b1 := (c1 and $FC) shl 2; //11111100->11110000
b2 := (c1 and 3); //00000011
b3 := c4 and $C; //00001100
pOut[oPtr] := Chr((b1 or b2 or b3) xor $EB);
Inc(oPtr);
b1 := (c2 and $FC) shl 2; //11111100->11110000
b2 := (c2 and 3); //00000011
b3 := (c4 and 3) shl 2; //00000011 ->00001100
pOut[oPtr] := Chr((b1 or b2 or b3) xor $EB);
Inc(oPtr);
b1 := (c4 and $30) shl 2; //00110000->11000000
pOut[oPtr] := Chr((c3 or b1) xor $EB);
Inc(oPtr);
end;
Y := Length(pIn) mod 4;
if Y = 2 then
begin
c1 := Ord(pIn[X * 4 + 1]) - $3B;
c2 := Ord(pIn[X * 4 + 2]) - $3B;
b1 := (c1 and $FC) shl 2; //11111100->11110000
b2 := (c1 and 3); //00000011
b3 := (c2 and 3) shl 2; //00000011->00001100
pOut[oPtr] := Chr((b1 or b2 or b3) xor $EB);
Inc(oPtr);
end;
if Y = 3 then
begin
c1 := Ord(pIn[X * 4 + 1]) - $3B;
c2 := Ord(pIn[X * 4 + 2]) - $3B;
c4 := Ord(pIn[X * 4 + 3]) - $3B;
b1 := (c1 and $FC) shl 2; //11111100->11110000
b2 := (c1 and 3); //00000011
b3 := c4 and $C; //00001100
pOut[oPtr] := Chr((b1 or b2 or b3) xor $EB);
Inc(oPtr);
b1 := (c2 and $FC) shl 2; //11111100->11110000
b2 := (c2 and 3); //00000011
b3 := (c4 and 3) shl 2; //00000011 ->00001100
pOut[oPtr] := Chr((b1 or b2 or b3) xor $EB);
Inc(oPtr);
end;
pOut[oPtr] := #0;
Result := oPtr;
end;
function EncodeMessage(sMsg: TDefaultMessage): string;
var
Msg : TDefaultMessage;
EncBuf : array[0..BUFFERSIZE - 1] of Char;
begin
try
EnterCriticalSection(CSEncode);
MirEncode(@sMsg, SizeOf(TDefaultMessage), @EncBuf);
Result := StrPas(EncBuf);
finally
LeaveCriticalSection(CSEncode);
end;
end;
function EncodeString(str: string): string;
var
Msg : TDefaultMessage;
EncBuf : array[0..BUFFERSIZE - 1] of Char;
Size : Integer;
begin
try
EnterCriticalSection(CSEncode);
Result := '';
Size := Length(str);
if Size < 7500 then
begin
MirEncode(PChar(str), Length(str), @EncBuf);
Result := StrPas(EncBuf);
end;
finally
LeaveCriticalSection(CSEncode);
end;
end;
function EncodeBuffer(Buf: PChar; bufsize: Integer): string;
var
Msg : TDefaultMessage;
EncBuf : array[0..BUFFERSIZE - 1] of Char;
S : Integer;
begin
try
EnterCriticalSection(CSEncode);
if bufsize < 7500 then
begin
MirEncode(Buf, bufsize, @EncBuf);
Result := StrPas(EncBuf);
end;
finally
LeaveCriticalSection(CSEncode);
end;
end;
function DecodeMessage(str: string): TDefaultMessage;
var
Msg : TDefaultMessage;
EncBuf : array[0..BUFFERSIZE - 1] of Char;
BufSize : Integer;
begin
try
EnterCriticalSection(CSEncode);
BufSize:=MirDecode(str, @EncBuf);
if BufSize>=12 then
Move(EncBuf, Msg, SizeOf(TDefaultMessage));
Result := Msg;
finally
LeaveCriticalSection(CSEncode);
end;
end;
function DecodeString(str: string): string;
var
Msg : TDefaultMessage;
EncBuf : array[0..BUFFERSIZE - 1] of Char;
Size : Integer;
begin
try
EnterCriticalSection(CSEncode);
Result := '';
Size := Length(str);
if Size < 7500 then
begin
MirDecode(str, @EncBuf);
Result := StrPas(EncBuf);
end;
finally
LeaveCriticalSection(CSEncode);
end;
end;
procedure DecodeBuffer(Src: string; Buf: PChar; bufsize: Integer);
var
Msg : TDefaultMessage;
EncBuf : array[0..BUFFERSIZE - 1] of Char;
S,size : Integer;
begin
try
EnterCriticalSection(CSEncode);
Size := Length(Src);
if Size < 7500 then
Begin
S := MirDecode(Src, @EncBuf);
if S > bufsize then
S := bufsize;
Move(EncBuf, Buf^, S);
End;
finally
LeaveCriticalSection(CSEncode);
end;
end;
initialization
InitializeCriticalSection(CSEncode);
finalization
DeleteCriticalSection(CSEncode);
end.
评论