edcode.pas

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

  //  bflag1 := 0;
  bflag2 := 0;
  i := 0;
  iPtr := 0;
  oPtr := 0;
  while iPtr < Size do begin
    b1 := ord(pIn[iPtr]) xor $BB;
    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 + $2B;
      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 + $2B;
      pOut[oPtr] := chr(bcal);
      inc(oPtr);
      b1 := b1 shr 2;
      b1 := b1 and $30;
      b1 := b1 or bflag2;
      b1 := b1 + $2B;
      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 + $2B);
    inc(oPtr);
    pOut[oPtr] := chr(0);
  end;
  result := oPtr;
end;

procedure Encode6BitBuf (pSrc,pDest:PChar;nSrcLen,nDestLen: integer);
begin
   CSEncode(pSrc, pDest,nSrcLen );
end;

procedure Encode6BitBufbak (pSrc,pDest:PChar;nSrcLen,nDestLen: integer);
var
  I          :Integer;
  nRestCount :Integer;
  nDestPos   :Integer;
  btMade     :Byte;
  btCh       :Byte;
  btRest     :Byte;
begin
  nRestCount:=0;
  btRest:= 0;
  nDestPos:= 0;
  for i:= 0 to nSrcLen - 1 do begin
    if nDestPos >= nDestLen then break;
    btCh:=Byte(pSrc[i]);
{$IF ENDECODEMODE = NEWMODE}
    btCh:=(EncodeBitMasks[btCh] xor n4CEEFC) xor n4CEEF4;
    btCh:=btCh xor (HiByte(LoWord(n4CEEF8)) + LoByte(LoWord(n4CEEF8)));
{$IFEND}
    btMade:=Byte((btRest or (btCh shr (2+ nRestCount))) and $3F);
    btRest:=Byte(((btCh shl (8 - (2+ nRestCount))) shr 2) and $3F);
    Inc (nRestCount,2);

    if nRestCount < 6 then begin
      pDest[nDestPos]:=Char(btMade + $3C);
      Inc(nDestPos);
    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);
begin
  CSDecode(strpas(sSource),pBuf,nSrclen);
end;

procedure myDecode6BitBuf (sSource:PChar;pBuf:PChar;nSrcLen,nBufLen:Integer);
begin
  myDecode(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);
var
  I,nBitPos,nMadeBit,nBufPos:Integer;
  btCh,btTmp,btByte:Byte;
begin
  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;
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;
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);
end;

 function DecodeStringmir (str: string): string;
var
  EncBuf:array[0..BUFFERSIZE - 1] of Char;
begin
  Decode6BitBufbak (PChar(str), @EncBuf,Length(str), SizeOf(EncBuf));
  Result := StrPas (EncBuf);
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);
end;

procedure myDecodeBuffer (src: string; buf: PChar; bufsize: integer);
var
  EncBuf:array[0..10000 - 1] of Char;
begin
  myDecode6BitBuf (PChar(src), @EncBuf,Length(src), SizeOf(EncBuf));
  Move (EncBuf, buf^, bufsize);
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);
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);
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));
    Result := StrPas (EncBuf);
  end else Result := '';
end;

function myEncodeString (str: string): string;
var
  EncBuf:array[0..BUFFERSIZE - 1] of Char;
begin
  myEncode(PChar(str), @EncBuf,Length(str));
  Result:=StrPas(EncBuf);
end;

function myDecodeString (str: string): string;
var
  EncBuf:array[0..BUFFERSIZE - 1] of Char;
begin
  myDecode(str,@EncBuf,Length(str));
  Result := StrPas (EncBuf);
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;

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.