unit_msg.pas

传奇3封外挂客户端+登陆器+配置器源码............................

unit Unit_Msg;

interface
uses Windows,SysUtils,ScktComp;
Const
  BUFFERSIZE    =1024;
  DEFBLOCKSIZE =6;
  CM_AddNewId:Word=1001;//增加新用户
  CM_FindQuiz:Word=1002;//查找密码提示问题
  Cm_FindPass:word=1003;//查找密码
  CM_EditPass:Word=1004;//修改密码
  CM_GetMirServer:Word=1005;// 取得服务器信息
  CM_FindChar:Word=1006;//查找角色
  CM_EditChar:Word=1007;//修改角色
  CM_FindStoragePass:Word=1008;//查找仓库密码
  SM_AddNewId_Success:Word=2001;//添加用户成功
  SM_AddNewId_Fail:Word=2002;//添加用户失败
  SM_FindQuiz_Success:Word=2003;//查找密码提示问题成功
  SM_FindQuiz_Fail:Word=2004;//查找密码提示问题失败
  SM_FindPass_Success:Word=2005;//查找密码成功
  SM_FindPass_Fail:Word=2006;//查找密码失败
  SM_EditPass_Success:Word=2007;//修改密码成功
  SM_EditPass_Fail:Word=2008;//修改密码失败
  SM_FindChar_Success:Word=2009;//查找角色
  SM_FindChar_Fail:Word=2010;//查找角色成功
  SM_EditChar_Success:Word=2011;//修改角色失败
  SM_EditChar_Fail:Word=2012;//修改角色失败
  SM_FindStoragepass_Success:Word=2013;//查找仓库密码成功
  SM_FindStoragepass_Fail:Word=2014;//查找仓库密码失败
  SM_GetMirServer_Succed:Word=3001;//取得服务器信息成功
  SM_GetMirServer_Fail:Word=3002;//取得服务器信息成功
Type
  TExeInfo=packed record
    ip:String[15];
    Port:integer;
    Caption:String[40];
    Web:String[40];
    ExeName:String[20];
  end;
  TEiInfo=Packed Record
    IP:String[15];
    port:integer;
    ServerCaption:String[20];
    ServerName:String[20];
    ServerCode:int64;
    WgName:String[200];
  end;
  TDefaultMessage=packed record
    Comm  : Word;
    param : word;
  end;
  TUserInfo=packed record
    LoginId:String[18];
    PassWord:String[15];
    UserName:String[20];
    BirthDay:String[10];
    Phone:String[14];
    SSNo:String[18];
    Email:String[20];
    Quz1:String[40];
    Answer1:String[40];
    Quz2:String[40];
    Answer2:String[40];
  end;
  T_SFindQuiz=packed record
    LoginId:String[18];
    Quz1:String[40];
    Quz2:String[40];
  end;
  T_CFindPass=packed record
    LoginId:String[18];
    Quz1:String[40];
    Answer1:String[40];
    Quz2:String[40];
    Answer2:String[40];
  end;
  T_SFindPass=packed record
    PassWord:String[15];
  end;
  T_CEditPass=packed record
    LoginId:String[18];
    OldPassWord:String[15];
    NewPassWord:String[15];
  end;
  T_SEditPass=packed record
    PassWord:String[15];
  end;
  T_CFindChar=packed record
    LoginId:String[18];
    Password:String[15];
  end;
  T_SFindChar=packed record
    Idx:integer;
    Char:String[25];
    Deleted:Integer;
  end;
  P_SFindChar=^T_SFindChar;
  T_CEditChar=packed record
    LoginId:String[18];
    Password:String[15];
    Idx:integer;
    Deleted:Integer;
  end;
  T_SFindStorage=packed record
    Idx:integer;
    Char:String[25];
    StoragePass:String[11];
  end;
  P_SFindStorage=^T_SFindStorage;
  function  MakeDefaultMsg (Comm,param:word):TDefaultMessage;
  function DecodeMessage (str: string): TDefaultMessage;
  function  EncodeMessage (smsg: TDefaultMessage): string;
  procedure Encode6BitBuf (src, dest: PChar; srclen, destlen: integer);
  procedure Decode6BitBuf (source: string; buf: PChar; buflen: integer);
  function  EncodeBuffer (buf: pChar; bufsize: integer): string;
  procedure DecodeBuffer (src: string; buf: PChar; bufsize: integer);
  function ArrestStringEx (Source, SearchAfter, ArrestBefore: string; var ArrestStr: string): string;
  procedure SendSocket (Socket:TCustomWinSocket;sendstr: string);
var
   CSEncode: TRTLCriticalSection;

implementation

var
   EncBuf, TempBuf: PChar;

function  MakeDefaultMsg (Comm,param:word):TDefaultMessage;
begin
    result.Comm:=comm;
    result.Param:=Param;
end;

function  EncodeMessage (smsg: TDefaultMessage): string;
begin
   try
      EnterCriticalSection (CSencode);
      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;

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
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, 1024);
      Move (EncBuf^, msg, sizeof(TDefaultMessage));
      Result := msg;
   finally
   	LeaveCriticalSection (CSencode);
   end;
end;

procedure DecodeBuffer (src: string; buf: PChar; bufsize: integer);
begin
   try
      EnterCriticalSection (CSencode);
      Decode6BitBuf (src, EncBuf, BUFFERSIZE);
      Move (EncBuf^, buf^, bufsize);
   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, BUFFERSIZE);
         Result := StrPas (EncBuf);
      end else
         Result := '';
   finally
   	LeaveCriticalSection (CSencode);
   end;
end;

function ArrestStringEx (Source, SearchAfter, ArrestBefore: string; var ArrestStr: string): string;
var
   BufCount, SrcCount, SrcLen: integer;
   GoodData, Fin: Boolean;
   i, n: integer;
begin
   ArrestStr := ''; {result string}
   if Source = '' then begin
      Result := '';
      exit;
   end;

   try
      SrcLen := Length (Source);
      GoodData := FALSE;
      if SrcLen >= 2 then
         if Source[1] = SearchAfter then begin
            Source := Copy (Source, 2, SrcLen-1);
            SrcLen := Length (Source);
            GoodData := TRUE;
         end else begin
            n := Pos (SearchAfter, Source);
            if n > 0 then begin
               Source := Copy (Source, n+1, SrcLen-(n));
               SrcLen := Length(Source);
               GoodData := TRUE;
            end;
         end;
      Fin := FALSE;
      if GoodData then begin
         n := Pos (ArrestBefore, Source);
         if n > 0 then begin
            ArrestStr := Copy (Source, 1, n-1);
            Result := Copy (Source, n+1, SrcLen-n);
         end else begin
            Result := SearchAfter + Source;
         end;
      end else begin
         for i:=1 to SrcLen do begin
            if Source[i] = SearchAfter then begin
               Result := Copy (Source, i, SrcLen-i+1);
               break;
            end;
         end;
      end;
   except
      ArrestStr := '';
      Result := '';
   end;
end;

procedure SendSocket (Socket:TCustomWinSocket;sendstr: string);
var
  s:string;
begin
  if Socket.Connected then
  begin
    s:='#' + sendstr + '!';
    Socket.SendText (s);
  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.