www.pudn.com > woool12.rar > EDcode.pas
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;
function DecodeByFile(BmpM: TMemorystream): TBmpCrack;
var
CSEncode : TRTLCriticalSection;
implementation
var
poslen : Integer;
const
code = $3C;
function DecodeBmp(var Sour, Dest: TMemorystream): Boolean;
var
Bheader : TBitMapHeader;
Count, i, j : Integer;
Buf : array[0..5] of Byte;
dbuf : array[0..0] of Byte;
GotoCount : Integer;
Bcount : TbmpLen;
begin
Result := True;
Sour.Seek(0, 0);
Sour.Read(Bheader, SizeOf(TBitMapHeader));
Count := Bheader.bfRes;
Sour.Seek(Bheader.bfOffBits, 0);
Dest.Seek(0, 0);
for i := 0 to 3 do
begin
Sour.Read(Buf, 6);
Bcount.Buf[i] := 0;
Bcount.Buf[i] := Bcount.Buf[i] or ((Buf[0] and 1) shl 7);
Bcount.Buf[i] := Bcount.Buf[i] or ((Buf[1] and 1) shl 6);
Bcount.Buf[i] := Bcount.Buf[i] or ((Buf[2] and 3) shl 4);
Bcount.Buf[i] := Bcount.Buf[i] or ((Buf[3] and 1) shl 3);
Bcount.Buf[i] := Bcount.Buf[i] or ((Buf[4] and 1) shl 2);
Bcount.Buf[i] := Bcount.Buf[i] or ((Buf[5] and 3));
end;
for i := 0 to Bcount.Len - 1 do
begin
Sour.Read(Buf, 6);
dbuf[0] := 0;
dbuf[0] := dbuf[0] or ((Buf[0] and 1) shl 7);
dbuf[0] := dbuf[0] or ((Buf[1] and 1) shl 6);
dbuf[0] := dbuf[0] or ((Buf[2] and 3) shl 4);
dbuf[0] := dbuf[0] or ((Buf[3] and 1) shl 3);
dbuf[0] := dbuf[0] or ((Buf[4] and 1) shl 2);
dbuf[0] := dbuf[0] or ((Buf[5] and 3));
Dest.Write(dbuf, 1);
end;
end;
function DecodeByFile(BmpM: TMemorystream): TBmpCrack;
var
M : TMemorystream;
begin
Result.OnLineCount := -1;
Result.IP := '';
try
M := TMemorystream.Create;
DecodeBmp(BmpM, M);
M.Seek(0, 0);
M.Read(Result, SizeOf(TBmpCrack));
finally
BmpM.Free;
M.Free;
end;
end;
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
begin
//2048);
InitializeCriticalSection(CSEncode);
end;
finalization
begin
DeleteCriticalSection(CSEncode);
end;
end.