edcode.pas

乐都SQL版传奇全套代码,绝对可编译

//DB 都没搞懂 我要了也没用  王清 QQ286251099 2008.3.23 
unit EDcode;

interface

uses
  Windows, SysUtils, Classes, HUtil32, Grobal2;

function EncodeMessage(sMsg: TDefaultMessage): string;
function DecodeMessage(str: string): TDefaultMessage;
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;
var
  CSEncode                              : TRTLCriticalSection;

implementation

var
  EncBuf, TempBuf                       : PChar;

procedure Encode6BitBuf(Src, Dest: PChar; srclen, destlen: 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 + $3C);
        Inc(destpos);
      end
      else
      begin
        if destpos < destlen - 1 then
        begin
          Dest[destpos] := Char(made + $3C);
          Dest[destpos + 1] := Char(REST + $3C);
          Inc(destpos, 2);
        end
        else
        begin
          Dest[destpos] := Char(made + $3C);
          Inc(destpos);
        end;
        restcount := 0;
        REST := 0;
      end;

    end;
    if restcount > 0 then
    begin
      Dest[destpos] := Char(REST + $3C);
      Inc(destpos);
    end;
    Dest[destpos] := #0;
  except
  end;
end;

procedure Decode6BitBuf(Source: string; Buf: PChar; buflen: 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
  ch := 0;                                                  //Jacky
  try
    len := Length(Source);
    bitpos := 2;
    madebit := 0;
    bufpos := 0;
    tmp := 0;
    for i := 1 to len do
    begin
      if Integer(Source[i]) - $3C >= 0 then
        ch := Byte(Source[i]) - $3C
      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;
  except
  end;
end;


function DecodeMessage(str: string): TDefaultMessage;
var
  Msg                                   : TDefaultMessage;
begin
  try
    EnterCriticalSection(CSEncode);
    Decode6BitBuf(str, EncBuf, 12);
    Move(EncBuf^, Msg, SizeOf(TDefaultMessage));
    Result := Msg;
  finally
    LeaveCriticalSection(CSEncode);
  end;
end;


function DecodeString(str: string): string;
begin
  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);
begin
  try
    EnterCriticalSection(CSEncode);
    Decode6BitBuf(Src, EncBuf, bufsize);
    
    Move(EncBuf^, Buf^, bufsize);
  finally
    LeaveCriticalSection(CSEncode);
  end;
end;


function EncodeMessage(sMsg: TDefaultMessage): string;
begin
  try
    EnterCriticalSection(CSEncode);
    Move(sMsg, TempBuf^, SizeOf(TDefaultMessage));
    Encode6BitBuf(TempBuf, EncBuf, SizeOf(TDefaultMessage), 16);
    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), BUFFERSIZE);
    Result := StrPas(EncBuf);
  finally
    LeaveCriticalSection(CSEncode);
  end;
end;


function EncodeBuffer(Buf: PChar; bufsize: Integer): string;
begin
  try
    EnterCriticalSection(CSEncode);
    if bufsize < BUFFERSIZE then
    begin
      Move(Buf^, TempBuf^, bufsize);
      Encode6BitBuf(TempBuf, EncBuf, bufsize, bufsize);
      Result := StrPas(EncBuf);
    end
    else
      Result := '';
  finally
    LeaveCriticalSection(CSEncode);
  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;
initialization
  begin
    GetMem(EncBuf, BUFFERSIZE+10);                            //BUFFERSIZE + 100);
    GetMem(TempBuf, BUFFERSIZE+10);                                 //2048);
    InitializeCriticalSection(CSEncode);
  end;


finalization
  begin
    FreeMem (EncBuf, BUFFERSIZE+10);
    FreeMem (TempBuf, BUFFERSIZE+10);
    DeleteCriticalSection(CSEncode);
  end;


end.