umsnmsgr.pas

msn控件 可验证 可接受信息 可发送信息 msn8协议 win32

// BLP 愝掕
procedure TMsnConnection.SetBLP(Value: TBLP);
begin
   Inc(FTrID);
   case Value of
      bpAL:
         SendCommand(Format('BLP %d AL'#13#10, [FTrID]));
      bpBL:
         SendCommand(Format('BLP %d BL'#13#10, [FTrID]));
   end;
end;

// 僜働僢僩僆僽僕僃僋僩傪嶌惉
procedure TMsnConnection.CreateSocket;
var
   SockInitInfo: TNsmClientSocketInitInfo;
begin
   if not Assigned(FSocket) then
   begin
      with SockInitInfo do
      begin
         cbSize := SizeOf(TNsmClientSocketInitInfo);
         lpOnLookup      := nil;
         lpOnConnecting  := WrapConConnecting;
         lpOnConnect     := WrapConConnect;
         lpOnDisconnect  := WrapConDisconnect;
         lpOnRead        := WrapConRead;
         lpOnWrite       := nil;
         lpOnError       := WrapConError;
         Data := Cardinal(Self);
      end;
      FSocket := TNsmClientSocket.Create(PluginMain.InitInfo, SockInitInfo);
   end;
end;

// 僜働僢僩僆僽僕僃僋僩傪攋婞
procedure TMsnConnection.DestroySocket;
begin
   If Assigned(FSocket) then
      FreeAndNil(FSocket);
end;

// 僜働僢僩愙懕拞僀儀儞僩僴儞僪儔
procedure TMsnConnection.SocketConnecting(Handle: HNsmClientSocket);
var
   HostName: String;
begin
   if FSocket.Host <> '' then
      HostName := FSocket.Host
   else
      HostName := FSocket.Address;
   // 僒乕僶偵愙懕拞
   FSignInStage := ssTryConnectServer;
   DoLog('-', Format('Connecting => %s:%d', [HostName, FSocket.Port]));
end;

// 僜働僢僩愙懕姰椆僀儀儞僩僴儞僪儔
procedure TMsnConnection.SocketConnect(Handle: HNsmClientSocket);
var
   MsnVer: String;
begin
   // 僒僀儞僀儞張棟奐巒
   FSignOutType := otUnKnown;
   FSignInStage := ssTrySignIn;
   FTrID := 0;
   MsnVer := MSN_VERSION9 + ' ' + MSN_VERSION8;
   SendCommand(Format('VER %d %s CVR0'#13#10, [FTrID, MsnVer]));
end;

// 僜働僢僩愗抐僀儀儞僩
procedure TMsnConnection.SocketDisconnect(Handle: HNsmClientSocket);
begin
   // 枹愙懕忬懺
   FSignInStage := ssUnConnect;
   DoLog('-', 'Disconnect');
   // 儊儞僶儕僗僩傪徚嫀
   FMembers.Clear;
   FReverseMembers.Clear;
   FAllowMembers.Clear;
   FBlockMembers.Clear;
   FGroups.Clear;
   // 僒僀儞傾僂僩僀儀儞僩
   DoSignOut(FSignOutType);
end;

// 僜働僢僩僄儔乕僀儀儞僩僴儞僪儔
procedure TMsnConnection.SocketError(Handle: HNsmClientSocket;
                                     ErrorType: Integer; var ErrorCode: Integer);
begin
   // Socket 僄儔乕
   DoLog('-', Format('Socket Error #%d',[ErrorCode]));
   // 僄儔乕僀儀儞僩
   DoError(ekSocketError, ErrorCode);

   ErrorCode := 0;
   FSocket.Close;
   if FSignInStage <> ssUnConnect then
   begin
      FSignInStage := ssUnConnect;
      FSignOutType := otUnKnown;
      // 僒僀儞傾僂僩僀儀儞僩
      DoSignOut(FSignOutType);
   end;
end;

// 僜働僢僩庴怣僀儀儞僩僴儞僪儔
procedure TMsnConnection.SocketRead(Handle: HNsmClientSocket);
var
   DataStr: Utf8String;
   CommandLst: TStringList;
   ParamLst: TStringList;
begin
   CommandLst := TStringList.Create;
   ParamLst := TStringList.Create;
   try
      DataStr := FSocket.ReceiveText;
      DataStr := FIncompleteCommand + DataStr;

      FIncompleteCommand := SplitCommandStr(CommandLst, DataStr);
      while CommandLst.Count > 0 do
      begin
         DoLog('S', CommandLst[0]);
         SplitParamStr(ParamLst, CommandLst[0]);

         // 僄儔乕
         if StrToIntDef(SS(ParamLst, 0), -1) <> -1 then
            ProcessError(ParamLst)
               // 僒乕僶偐傜愗抐偝傟偨
         else if (SS(ParamLst, 0) = 'OUT') and (SS(ParamLst, 1) = 'OTH') then
            FSignOutType := otOTH
         else if (SS(ParamLst, 0) = 'OUT') and (SS(ParamLst, 1) = 'SSD') then
            FSignOutType := otSSD
               // 儊儞僶偺忬懺偑曄壔
         else if (SS(ParamLst, 0) = 'CHG') or (SS(ParamLst, 0) = 'NLN') or
                    (SS(ParamLst, 0) = 'FLN') or (SS(ParamLst, 0) = 'ILN') then
            ProcessChangeStatus(ParamLst)
               // 儊儞僶偺柤慜偑曄峏偝傟偨
         else if (SS(ParamLst, 0) = 'REA') then
            ProcessChangeName(ParamLst)
               // 儊僢僙乕僕傪庴怣偟偨
         else if SS(ParamLst, 0) = 'MSG' then
            ProcessMessage(CommandLst[0])
               // 夛榖偵彽懸偝傟偨
         else if (SS(ParamLst, 0) = 'RNG') then
            DoCalled(ParamLst[1], ParamLst[2], ParamLst[4],
                     ParamLst[5], DecodeParam(ParamLst[6]))
               // SwitchBoard Server
         else if (SS(ParamLst, 0) = 'XFR') and (SS(ParamLst, 2) = 'SB') then
            DoSwitchBoard(StrToInt(ParamLst[1]), ParamLst[3], ParamLst[5])
               // 儊儞僶偲僌儖乕僾偺悢傪庢摼
         else if (SS(ParamLst, 0) = 'SYN') then
            ProcessSynCommand(ParamLst)
               // 儊儞僶儕僗僩傪曄峏
         else if (SS(ParamLst, 0) = 'LST') or
                    (SS(ParamLst, 0) = 'ADD') or (SS(ParamLst, 0) = 'REM') then
            ProcessMemberList(ParamLst)
               // 僌儖乕僾儕僗僩傪曄峏
         else if ((SS(ParamLst, 0) = 'LSG') and (SS(ParamLst, 4) <> '0')) or
                    (SS(ParamLst, 0) = 'ADG') or (SS(ParamLst, 0) = 'REG') or
                    (SS(ParamLst, 0) = 'RMG') then
            ProcessGroupList(ParamLst)
               // 僾儔僀僶僔乕愝掕偺曄峏
         else if (SS(ParamLst, 0) = 'GTC') or (SS(ParamLst, 0) = 'BLP') then
            ProcessPrivacySetting(ParamLst)
               // 儘僌僀儞忬懺偺僠僃僢僋丠
         else if (SS(ParamLst, 0) = 'CHL') then
            ProcessCHL(ParamLst)
               // PNG僐儅儞僪傊偺曉帠(MSNP9+)
         else if (SS(ParamLst, 0) = 'QNG') then
            ProcessQNG(ParamLst)
               // URL
         else if (SS(ParamLst, 0) = 'URL') then
            DoUrl(ParamLst[2], ParamLst[3], StrToIntDef(SS(ParamLst, 4), 2))
         else if FSignInStage <> ssSignIn then
            ProcessSignIn(ParamLst);
         
         CommandLst.Delete(0);
      end;
   finally
      ParamLst.Free;
      CommandLst.Free;
   end;
end;

// TMsnAuthThread 偐傜偺僄儔乕捠抦愱梡両
procedure TMsnConnection.ErrorOnSignInProcess(ErrMsg: WideString);
begin
   If FSignInStage = ssTrySignIn then
   begin
      DoError(ekMsnError, -1, ErrMsg);
      FSocket.Close;
   end;
end;

// 僒僀儞僀儞僔乕働儞僗
procedure TMsnConnection.ProcessSignIn(ParamLst: TStringList);
var
   MsgID: Integer;
   P: Integer;
begin
   // 暿偺 NS 偵嵞愙懕
   if (ParamLst.Count > 3) and (ParamLst[0] = 'XFR') then
   begin
      FSignOutType := otXFR;
      FSocket.Close;
      DestroySocket;
      CreateSocket;
      P := AnsiPos(':', ParamLst[3]);
      FSocket.Address := LeftStr(ParamLst[3], P - 1);
      FSocket.Port := StrToIntDef(Copy(ParamLst[3], P + 1, Length(ParamLst[3]) - P), FPort);
      FSocket.Host := '';
      FSocket.Open;
      Exit;
   end;
   
   MsgID := StrToIntDef(SS(ParamLst, 1), -1);
   if MsgID = 0 then
   begin
      // 僋儔僀傾儞僩僶乕僕儑儞捠抦
      Inc(FTrID);
      SendCommand(Format('CVR %d %s %s'#13#10,[FTrID,MSNMSGR_CVR,FUser.Account]));
   end
   else if MsgID = 1 then
   begin
      // 儐乕僓擣徹梫媮
      Inc(FTrID);
      SendCommand(Format('USR %d TWN I %s'#13#10, [FTrID, FUser.Account]));
   end
   else if MsgID = 2 then
   begin
      Inc(FTrID);
      FAuthThread := TMsnAuthThread.Create(Self, ParamLst[4]);
   end
   else if MsgID = 3 then // 僒僀儞僀儞僔乕働儞僗僐儞僾儕乕僩
   begin
      if (ParamLst[0] = 'USR') and (ParamLst[2] = 'OK') then
      begin
         // 柤慜偺弶婜壔
         FUser.Name := DecodeParam(ParamLst[4]);
         
         // 嵟怴忣曬庢摼梫媮
         Inc(FTrID);
         SendCommand(Format('SYN %d 0'#13#10, [FTrID]));
         
         // 僒僀儞僀儞僀儀儞僩
         DoSignIn;
      end else
      begin
         // 僒僀儞僀儞幐攕偭傐偄
         FSocket.Close;
      end;
   end;
end;

// 僒僀儞僀儞廔椆張棟
procedure TMsnConnection.FinishSignInProcess;
begin
   // 僒僀儞僀儞廔椆
   FSignInStage := ssSignIn;
   // 弶婜忬懺曄峏
   Inc(FTrID);
   SendCommand(Format('CHG %d %s %d'#13#10,
                      [FTrID, MemberStatusToStr(FUser.Status), MSNMSGR_CHG]));

   // Ping僞僀儅乕偺弶婜壔(initial = 50sec)
   // MSNP9
   SetPingInterval(DEFAULT_PING_INTERVAL)
end;

procedure TMsnConnection.ChangeUserName(Account: String; NewName: WideString);
var
   Member: TMsnMemberBase;
begin
   if Account = FUser.Account then
      FUser.Name := NewName;
   // 慡偰偺儕僗僩偱柤慜傪曄峏
   Member := FMembers.Find(Account);
   if Member <> nil then
      Member.Name := NewName;
   Member := FReverseMembers.Find(Account);
   if Member <> nil then
      Member.Name := NewName;
   Member := FBlockMembers.Find(Account);
   if Member <> nil then
      Member.Name := NewName;
   Member := FAllowMembers.Find(Account);
   if Member <> nil then
      Member.Name := NewName;
   // 儊儞僶柤曄峏僀儀儞僩敪峴
   Member := FMembers.Find(Account);
   if not Assigned(Member) and AnsiSameStr(FUser.Account, Account) then
      Member := FUser;
   if Assigned(Member) then
      DoMemberNameChange(Member);
end;
    
// 儊儞僶偺柤慜傪曄峏
procedure TMsnConnection.ProcessChangeName(ParamLst: TStringList);
begin
  if ParamLst[0] = 'REA' then
     ChangeUserName(DecodeParam(ParamLst[3]), DecodeParam(ParamLst[4]));
end;

// 儊儞僶偺忬懺傪曄峏
procedure TMsnConnection.ProcessChangeStatus(ParamLst: TStringList);
var
  Member: TMsnMemberBase;
  OldStatus: TMsnMemberStatus;
  OldName: WideString;
  InitList: Boolean;
  MsnObj: String;
begin
  Member := nil;
  OldStatus := usFLN;
  InitList := False;
  
  // 儐乕僓偺忬懺傪曄峏
  if ParamLst[0] = 'CHG' then
  begin
    OldStatus := FUser.Status;
    FUser.Status := StrToMemberStatus(ParamLst[2]);
    Member := TMsnMember(FUser);
  end
  // 儊儞僶偑僆儞儔僀儞
  else if ParamLst[0] = 'NLN' then
  begin
    Member := FMembers.Find(ParamLst[2]);
    if Member <> nil then
    begin
      OldName := Member.Name;
      OldStatus := Member.Status;
      Member.Status := StrToMemberStatus(ParamLst[1]);
      Member.Name := DecodeParam(ParamLst[3]);
      
      // 傾僶僞乕
      if ParamLst.Count > 6 Then
      begin
         MsnObj := UrlDecode(ParamLst[6]);
         MsnObj := Copy(MsnObj, 2, Length(MsnObj)-3); // Trim "<" and "/>"
         if Member.MsnObj <> MsnObj then
            Member.MsnObj := MsnObj;
      end;
      
      // 搊榐柤傪曄峏
      if Member.Name <> OldName then
         RenameMember(Member.Account, Member.Name);
      
      // 僆儞儔僀儞僀儀儞僩
      if OldStatus = usFLN then
        DoMemberOnline(Member);
    end;
  end
  //丂儊儞僶偑僆僼儔僀儞
  else if ParamLst[0] = 'FLN' then
  begin
    Member := FMembers.Find(ParamLst[1]);
    if Member <> nil then
    begin
      OldStatus := Member.Status;
      Member.Status := usFLN;
      
      // 僆僼儔僀儞僀儀儞僩
      if OldStatus <> usFLN then
        DoMemberOffline(Member);
    end;
  end
  //丂儊儞僶偺忬懺偑曄峏
  else if ParamLst[0] = 'ILN' then
  begin
    InitList := True;
    Member := FMembers.Find(ParamLst[3]);
    if Member <> nil then
    begin
      OldStatus := Member.Status;
      Member.Status := StrToMemberStatus(ParamLst[2]);
      Member.Name := DecodeParam(ParamLst[4]);
      
      // 傾僶僞乕
      if ParamLst.Count > 7 Then
      begin
         MsnObj := UrlDecode(ParamLst[7]);
         MsnObj := Copy(MsnObj, 2, Length(MsnObj)-3); // Trim "<" and "/>"