注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

BCB-DG's Blog

...

 
 
 

日志

 
 

EDcode  

2008-11-25 14:14:39|  分类: Delphi |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

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.

  评论这张
 
阅读(690)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017