edcode.pas

传世源码可编译的,功能齐全.是学习的好模版,会DELPHI的朋友们也可以自己修改,弄个自己的引擎.

    end else begin
      if nDestPos < nDestLen - 1 then begin
        pDest[nDestPos]:=Char(btMade + $3C);
        pDest[nDestPos + 1]:=Char(btRest + $3C);
        Inc (nDestPos,2);
      end else begin
        pDest[nDestPos]:=Char(btMade + $3C);
        Inc(nDestPos);
      end;
      nRestCount:=0;
      btRest:=0;
    end;
   end;
   if nRestCount > 0 then begin
     pDest[nDestPos]:=Char(btRest + $3C);
     Inc(nDestPos);
   end;
   pDest[nDestPos]:=#0;
end;

{
procedure Decode6BitBuf (sSource:PChar;pBuf:PChar;nSrcLen,nBufLen:Integer);
var
  Proc:procedure (sSource:PChar;pBuf:PChar;nSrcLen,nBufLen:Integer);
begin
  Proc:=Pointer(g_Config.Encode6BitBuf);
  if assigned(Proc) then
    Proc(sSource,pBuf,nSrcLen,nBufLen);
end;
}


     //function CSDecode(pIn: string; pOut: pChar; Size: word): word;
procedure Decode6BitBuf (sSource:PChar;pBuf:PChar;nSrcLen,nBufLen:Integer);
begin
CSDecode(strpas(sSource),pBuf,nSrclen);

end;

procedure Decode6BitBufbak (sSource:PChar;pBuf:PChar;nSrcLen,nBufLen:Integer);
const
  Masks: array[2..6] of byte = ($FC, $F8, $F0, $E0, $C0);
   //($FE, $FC, $F8, $F0, $E0, $C0, $80, $00);
var
  I,{nLen,}nBitPos,nMadeBit,nBufPos:Integer;
  btCh,btTmp,btByte:Byte;
begin
//  nLen:= Length (sSource);
  nBitPos:= 2;
  nMadeBit:= 0;
  nBufPos:= 0;
  btTmp:= 0;
  for I:= 0 to nSrcLen - 1 do begin
    if Integer(sSource[I]) - $3C >= 0 then
      btCh := Byte(sSource[I]) - $3C
    else begin
      nBufPos := 0;
      break;
    end;
    if nBufPos >= nBufLen then break;
    if (nMadeBit + 6) >= 8 then begin
      btByte := Byte(btTmp or ((btCh and $3F) shr (6- nBitPos)));
{$IF ENDECODEMODE = NEWMODE}
      btByte:=btByte xor (HiByte(LoWord(n4CEEF8)) +  LoByte(LoWord(n4CEEF8)));
      btByte:=btByte xor LoByte(LoWord(n4CEEF4));
      btByte:=DecodeBitMasks[btByte] xor LoByte(w4CEF00);
{$IFEND}
      pBuf[nBufPos] := Char(btByte);
      Inc(nBufPos);
      nMadeBit := 0;
      if nBitPos < 6 then Inc (nBitPos, 2)
      else begin
        nBitPos := 2;
        continue;
      end;
    end;
    btTmp:= Byte (Byte(btCh shl nBitPos) and Masks[nBitPos]);   // #### ##--
    Inc(nMadeBit, 8 - nBitPos);
  end;
  pBuf[nBufPos] := #0;

{
  nLen:= Length (sSource);
  nBitPos:= 2;
  nMadeBit:= 0;
  nBufPos:= 0;
  btTmp:= 0;
  for I:= 1 to nLen do begin
    if Integer(sSource[I]) - $3C >= 0 then
      btCh := Byte(sSource[I]) - $3C
    else begin
      nBufPos := 0;
      break;
    end;
    if nBufPos >= nBufLen then break;
    if (nMadeBit + 6) >= 8 then begin
      btByte := Byte(btTmp or ((btCh and $3F) shr (6- nBitPos)));
      pBuf[nBufPos] := Char(btByte);
      Inc(nBufPos);
      nMadeBit := 0;
      if nBitPos < 6 then Inc (nBitPos, 2)
      else begin
        nBitPos := 2;
        continue;
      end;
    end;
    btTmp:= Byte (Byte(btCh shl nBitPos) and Masks[nBitPos]);   // #### ##--
    Inc(nMadeBit, 8 - nBitPos);
  end;
  pBuf[nBufPos] := #0;
  }
end;





function DecodeMessage (str: string): TDefaultMessage;
var
  EncBuf:array[0..BUFFERSIZE - 1] of Char;
  Msg: TDefaultMessage;
begin
  Decode6BitBuf (PChar(str), @EncBuf,Length(str),SizeOf(EncBuf));
  Move (EncBuf, msg, sizeof(TDefaultMessage));
  Result := msg;
   {
   try
      EnterCriticalSection (CSencode);
      Decode6BitBuf (str, EncBuf, 1024);
      Move (EncBuf^, msg, sizeof(TDefaultMessage));
      Result := msg;
   finally
   	LeaveCriticalSection (CSencode);
   end;
   }
end;


function DecodeString (str: string): string;
var
  EncBuf:array[0..BUFFERSIZE - 1] of Char;
begin
  Decode6BitBuf (PChar(str), @EncBuf,Length(str), SizeOf(EncBuf));
  Result := StrPas (EncBuf);
{
  try
    EnterCriticalSection (CSencode);
    Decode6BitBuf (str, EncBuf, BUFFERSIZE);
    Result := StrPas (EncBuf); //error, 1, 2, 3,...
  finally
    LeaveCriticalSection (CSencode);
  end;
}
end;

function myDecodeString (str: string): string;
var
  EncBuf:array[0..BUFFERSIZE - 1] of Char;
begin
 // Decode6BitBuf (PChar(str), @EncBuf,Length(str), SizeOf(EncBuf));
  myDecode(str,@EncBuf,Length(str));
  Result := StrPas (EncBuf);
{
  try
    EnterCriticalSection (CSencode);
    Decode6BitBuf (str, EncBuf, BUFFERSIZE);
    Result := StrPas (EncBuf); //error, 1, 2, 3,...
  finally
    LeaveCriticalSection (CSencode);
  end;
}
end;


procedure DecodeBuffer (src: string; buf: PChar; bufsize: integer);
var
  EncBuf:array[0..BUFFERSIZE - 1] of Char;
begin
      Decode6BitBuf (PChar(src), @EncBuf,Length(src), SizeOf(EncBuf));
      Move (EncBuf, buf^, bufsize);
   {
   try
      EnterCriticalSection (CSencode);
      Decode6BitBuf (src, EncBuf, BUFFERSIZE);
      Move (EncBuf^, buf^, bufsize);
   finally
   	LeaveCriticalSection (CSencode);
   end;
   }
end;


function  EncodeMessage (smsg: TDefaultMessage): string;
var
  EncBuf,TempBuf:array[0..BUFFERSIZE - 1] of Char;
begin
  Move (smsg, TempBuf, sizeof(TDefaultMessage));
  Encode6BitBuf(@TempBuf, @EncBuf, sizeof(TDefaultMessage), SizeOf(EncBuf));
  Result:=StrPas(EncBuf);
  {
  EnterCriticalSection(CSencode);
  try
    Move (smsg, TempBuf^, sizeof(TDefaultMessage));
    Encode6BitBuf(TempBuf, EncBuf, sizeof(TDefaultMessage), 1024);
    Result:=StrPas(EncBuf);  //Error: 1, 2, 3, 4, 5, 6, 7, 8, 9
  finally
    LeaveCriticalSection(CSencode);
  end;
  }
end;


function EncodeString (str: string): string;
var
  EncBuf:array[0..BUFFERSIZE - 1] of Char;
begin
  Encode6BitBuf(PChar(str), @EncBuf, Length(str), SizeOf(EncBuf));
  Result:=StrPas(EncBuf);
  {
  EnterCriticalSection(CSencode);
  try
    Encode6BitBuf(PChar(str), EncBuf, Length(str), BUFFERSIZE);
    Result:=StrPas(EncBuf);
  finally
    LeaveCriticalSection(CSencode);
  end;
  }
end;


function myEncodeString (str: string): string;
var
  EncBuf:array[0..BUFFERSIZE - 1] of Char;
begin
//  Encode6BitBuf(PChar(str), @EncBuf, Length(str), SizeOf(EncBuf));
//  Encode6BitBuf (pSrc,pDest:PChar;nSrcLen,nDestLen: integer);
  myEncode(PChar(str), @EncBuf,Length(str));
  Result:=StrPas(EncBuf);
  {
  EnterCriticalSection(CSencode);
  try
    Encode6BitBuf(PChar(str), EncBuf, Length(str), BUFFERSIZE);
    Result:=StrPas(EncBuf);
  finally
    LeaveCriticalSection(CSencode);
  end;
  }
end;


function myMulEncodeString (str: string;n:integer): string;
var i:integer;
    s:string;
begin
   s:=str;
  for  i:=0 to n do
    s:=myencodestring(s);
  result:=s;
end;

function myMuldecodeString (str: string;n:integer): string;
var i:integer;
    s:string;
begin
   s:=str;
  for  i:=0 to n do
    s:=mydecodestring(s);
  result:=s;
end;



function EncodeA1(p1:pchar;p2:pchar;bytecount:integer):integer;     //xjs
var optr,iptr,i,j:integer;
    b1,b2,b3:byte;
begin
optr:=0;
iptr:=0;
i:=(bytecount) mod 3;
j:=bytecount -i-1;
if bytecount >=3 then
repeat
b1:=byte(p1[iptr]) xor $eb ;
iptr:=iptr+1;
b2:=byte(p1[iptr]) xor $eb;
iptr:=iptr+1;
b3:=byte(p1[iptr]) xor $eb;
iptr:=iptr+1;
p2[optr]:=chr(((b1 and  $03) or ((b1 and $f0) shr 2)) + $3b); //第一个
optr:=optr+1;
p2[optr]:=chr((b2 and $03) or ((b2 and $f0) shr 2) + $3b);   //第二个
optr:=optr+1;
p2[optr]:=chr((b3 and $3f) + $3b);      //第三个
optr:=optr+1;
p2[optr]:=chr((b1 and $0c) or ((b2 and $0c) shr 2) or ((b3 and $c0) shr 2) + $3b);
                                       //第四个
optr:=optr+1;
until iptr> j  ;
i:=bytecount mod 3;
if (i=1)  then
begin
b1:=byte(p1[iptr]) xor $eb;
iptr:=iptr+1;
p2[optr]:=chr((b1 and $03)or((b1 and $f0) shr 2) + $3b);
optr:=optr+1;
p2[optr]:=chr(((b1 and $0c) shr 2) + $3b);
optr:=optr+1;
end
else if(i=2) then
begin
b1:=byte(p1[iptr]) xor $eb;
iptr:=iptr+1;
b2:=byte(p1[iptr]) xor $eb;
iptr:=iptr+1;
p2[optr]:=chr((b1 and $03)or ((b1 and $f0) shr 2) + $3b);
optr:=optr+1;
p2[optr]:=chr((b2 and $03)or ((b2 and $f0) shr 2) + $3b);
optr:=optr+1;
p2[optr]:=chr((b1 and $0c) or ((b2 and $0c) shr 2) + $3b);
optr:=optr+1;
end;
p2[optr]:=#0;
EncodeA1:=optr;
end;


function  EncodeBuffer (buf: pChar; bufsize: integer): string;
var
  EncBuf,TempBuf:array[0..BUFFERSIZE - 1] of Char;
begin
  if bufsize < BUFFERSIZE then begin
    Move (buf^, TempBuf, bufsize);
    Encode6BitBuf (@TempBuf, @EncBuf, bufsize, SizeOf(EncBuf));
 //   EncodeA1(@TempBuf,@encbuf,bufsize);
    Result := StrPas (EncBuf);
  end else Result := '';
  {
  EnterCriticalSection (CSencode);
  try
    if bufsize < BUFFERSIZE then begin
      Move (buf^, TempBuf^, bufsize);
      Encode6BitBuf (TempBuf, EncBuf, bufsize, BUFFERSIZE);
      Result := StrPas (EncBuf);
    end else Result := '';
  finally
    LeaveCriticalSection (CSencode);
  end;
  }
end;

initialization
begin
//  GetMem (EncBuf, 10240 + 100); //BUFFERSIZE + 100);
//  GetMem (TempBuf, 10240); //2048);
//  InitializeCriticalSection (CSEncode);
end;


finalization
begin
//  FreeMem (EncBuf, BUFFERSIZE + 100);
//  FreeMem (TempBuf, 2048);
//  DeleteCriticalSection (CSEncode);
end;
end.