msnmessenger.pas

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

procedure TMSNMessenger.DoCalled(SessionID, SBAddress, Cookie,
  CallingUserAccount: String; CallingUserName: WideString);
begin

end;

procedure TMSNMessenger.Process_XFR_CMD(Trid:integer;stype,sbaddress,cookie:string);
Var
  TMP, AHost, APort, ACookie, ASessionID : String;
  AMember : TmsnMember;
begin
  AMember := Nil;
  if stype= NSString then
  begin
    FSocket.Close;
    AHost := Copy(SBAddress, 1, AnsiPos(':', SBAddress) - 1);
    APort := Copy(SBAddress, AnsiPos(':', SBAddress) + 1, Length(SBAddress));
    Fsocket.Addr:=AHost ;
    Fsocket.Port:=Aport ;
    Fsocket.Connect ;
    if SocksServer <> '' then
    begin
      FSocket.SocksServer := self.SocksServer;
      FSocket.SocksPort := Self.SocksPort;
      FSocket.SocksUsercode := Self.SocksUserName ;
      FSocket.SocksPassword := Self.SocksUserPassWord;
    end;  //proxy
    FSocket.Connect;
    FConnected := True;
    Exit;
  end  //if NS
  else if stype = SBString then
  begin
    ASessionID := '';
    AHost := Copy(SBAddress, 1, AnsiPos(':', SBAddress) - 1);
    APort := Copy(SBAddress, AnsiPos(':', SBAddress) + 1, Length(SBAddress));
    ACookie := Cookie ;
    ASessionID := Copy(ACookie, 0, Pos('.', ACookie)-1 );
    self.AddSession(AHost, APort, ACookie, ASessionID, User.Account , RequestMail, AMember, Members);
  end;
end;

procedure TMSNMessenger.AddSession(AHost, APort, ACookie, ASessionID,
    MsnUserName, SessionMail : String; AMember:TMsnMember; MemberList :
    TMsnMemberList);
Var
  MsnSession : TMsnSession;
begin
  MsnSession := Sessions.Add(AHost, APort, ACookie, ASessionID, MsnUserName , SessionMail, AMember, Members );
//  MsnSession.OnReceiveMessage:= Self.OnReceiveMessage;
  MsnSession.OnMemberBye := MemberByeSession ;
  MsnSession.OnError := Self.OnError ;
  MsnSession.OnDisConnect := SessionDisConnect;
  if Self.SocksServer <> '' then
    MsnSession.SetProxy(SocksServer , SocksPort , SocksUserName , SocksUserPassWord );
  if Assigned(Log) then   MsnSession.Log := Log;

  MsnSession.Connect;
end;

procedure TMSNMessenger.Process_RNG_CMD(ACmdStr: String);
Var
  TMP, AHost, APort, ACookie, ASessionID : String;
  AMember : TmsnMember;
  Mail : String;
  SessionIndex : integer;
begin
  AMember := Nil;
  ASessionID := WordAt(ACmdStr , 2);
  Mail := WordAt(ACmdStr, 6);
  {---删除存在的Session---}
  SessionIndex := Sessions.IndexOfSessionID(ASessionID);
  if SessionIndex <> -1 then Sessions.Delete(SessionIndex);
  SessionIndex := Sessions.IndexOfEmail(Mail);
  if SessionIndex <> -1 then Sessions.Delete(SessionIndex);
  TMP := WordAt(ACmdStr, 3);
  Delete(Tmp, pos(':', Tmp), Length(Tmp));
  AHost := Tmp;
  TMP := WordAt(ACmdStr, 3);
  Delete(Tmp, 1, pos(':', Tmp));
  APort := Tmp;
  ACookie := WordAt(ACmdStr , 5);
  if (AHost <> '') and (ACookie <> '') or (ASessionID <> '' ) then
  AMember := Members.FindMemberByMail(Mail);
  self.AddSession(AHost, APort, ACookie, ASessionID, user.Account , AMember.Account, AMember, Members);
end;

function TMSNMessenger.SendMessage(Account:String; MsgText: WideString):Boolean;
Var
  MemberMail : String;
  FSession : TMsnSession;
  SessionIndex: Integer;
begin
  FSession := Nil;
  Result := False;
  if Not FConnected then exit;
  if Length(MsgText) > MessageMaxLength then exit;
  MemberMail := Members.FindMailByAlias(Account);
  if MemberMail = '' then exit; //成员不存在列表中。
  SessionIndex := Sessions.IndexOfEmail(MemberMail);
  if SessionIndex <> -1 then
    FSession := Sessions.Sessions[SessionIndex];//查找到与此会话的ID
  if (FSession <> Nil) and (FSession.Connected) and (FSession.Member <> nil) then
  begin
    FSession.SendMessage(MsgText);
    Result := True;
  end 
  else
  begin
    if (FSession = Nil)and (FSession.Member = nil)and FSession.Connected then
    begin
      FSession.SocketWrite(COMMAND_CAL+ FormatID + MemberMail);
      FSession.SendMessage(MsgText);
      Result := True;
    end;
  end ;
end;

procedure TMSNMessenger.DoReceiveMessage(Header: UTF8String;
  FromAccount: String; FromName: WideString; Msg: UTF8String);
const
  DefaultMbox = 'ACTIVE';
  TrashMbox = 'trAsH';
  JunkMbox = 'HM_BuLkMail_';
  DeleteMbox0 = '.!!trAsH';
  DeleteMbox1 = '00000000-0000-0000-0000-000000000006';
var
  Lines: TStringList;
  ContentType: String;
  FromAddr, From, SrcFolder, DestFolder: String;
  MessageDelta: Integer;
  CPort: Integer;
  SysMsgType: Integer;
  SysMsgArg1: String;
begin
  Lines := TStringList.Create;
  SplitMimeHeader(Lines, Header + #13#10 +  String(UTF8Decode(Msg)));

  ContentType := Lines.Values['Content-Type'];
  if AnsiContainsStr(ContentType, 'text/x-msmsgsprofile') then
  begin
    with user.PassportInfo do
    begin
      LoginTime := StrToIntDef(Lines.Values['LoginTime'], 0);
      EmailEnabled := (StrToIntDef(Lines.Values['EmailEnabled'], 0) = 1);
      MemberIdHigh := StrToIntDef(Lines.Values['MemberIdHigh'], 0);
      MemberIdLow := StrToIntDef(Lines.Values['MemberIdLow'], 0);
      lang_preference := StrToIntDef(Lines.Values['lang_preference'], 0);
      preferredEmail := Lines.Values['preferredEmail'];
      country := Lines.Values['country'];
      PostalCode := Lines.Values['PostalCode'];
      Gender := Lines.Values['Gender'];
      Kid := StrToIntDef(Lines.Values['Kid'], 0);
      Age := StrToIntDef(Lines.Values['Age'], 0);
      sid := StrToIntDef(Lines.Values['sid'], 0);
      kv := StrToIntDef(Lines.Values['kv'], 0);
      MSPAuth := Lines.Values['MSPAuth'];
      ClientIP := Lines.Values['ClientIP'];
      CPort := StrToIntDef(Lines.Values['ClientPort'], 0);
      ClientPort := ((CPort and $00ff) shl 8) + ((CPort and $ff00) shr 8);
      sl := DateTimeToFileDate(Now);
      If LoginTime = 0 then
         LoginTime := DateTimeToCTime(Now);
    end;
  end
  else if AnsiContainsStr(ContentType, 'text/x-msmsgsinitialemailnotification') then
  begin
     FInboxUnread := StrToIntDef(Lines.Values['Inbox-Unread'], FInboxUnread);
     FFoldersUnread := StrToIntDef(Lines.Values['Folders-Unread'], FFoldersUnread);
     FreeAndNil(Lines);
//     DoUnreadMailChange(Config.NotifyUnreadMailWhenSignin);
  end
  else if AnsiContainsStr(ContentType, 'text/x-msmsgsemailnotification') then
  begin
     If Lines.Values['From'] <> '' then
        From := Trim(Jis2Sjis(MIMEDecode(DecodeParam(Lines.Values['From']))))
     else
        From := '';
     FromAddr := Lines.Values['From-Addr'];
     DestFolder := Lines.Values['Dest-Folder'];
     FreeAndNil(Lines);

     if (DestFolder = DefaultMbox) then
     begin
        Inc(FInboxUnread);
        DoNewMail(True, From, FromAddr);
     end
     else if (DestFolder <> TrashMbox) and (DestFolder <> JunkMbox) then
     begin
        Inc(FFoldersUnread);
//        If Config.CountFolders then
           DoNewMail(False, From, FromAddr);
     end;
     DoUnreadMailChange(False);
  end
  else if AnsiContainsStr(ContentType, 'text/x-msmsgsactivemailnotification') then
  begin
     SrcFolder := Lines.Values['Src-Folder'];
     DestFolder := Lines.Values['Dest-Folder'];
     MessageDelta := StrToIntDef(Lines.Values['Message-Delta'], 0);
     FreeAndNil(Lines);

     if (SrcFolder = DefaultMbox) then
     begin
        if (DestFolder = SrcFolder)
           or (DestFolder = TrashMbox)
           or (DestFolder = JunkMbox) then
        begin
           Dec(FInboxUnread, MessageDelta);
        end
        else
        begin
           Dec(FinboxUnread, MessageDelta);
           Inc(FFoldersUnread, MessageDelta);
        end;
        if FInboxUnread < 0 then FInboxUnread := 0;
     end
     else if (SrcFolder = TrashMbox) or (SrcFolder = JunkMbox) then
     begin
        if (DestFolder = DefaultMbox) then
           Inc(FInboxUnread, MessageDelta)
        else if (DestFolder <> TrashMbox)
                and (DestFolder <> JunkMbox)
                and (DestFolder <> DeleteMbox0)
                and (DestFolder <> DeleteMbox1)
        then
        begin
           Inc(FFoldersUnread, MessageDelta);
        end;
     end
     else
     begin
        if (DestFolder = SrcFolder)
           or (DestFolder = TrashMbox)
           or (DestFolder = JunkMbox) then
        begin
           Dec(FFoldersUnread, MessageDelta);
        end
        else
        begin
           Inc(FinboxUnread, MessageDelta);
           Dec(FFoldersUnread, MessageDelta);
        end;
     end;
     DoUnreadMailChange(False);
  end
  else if AnsiContainsStr(ContentType, 'application/x-msmsgssystemmessage') then
  begin
     SysMsgType := StrToIntDef(Lines.Values['Type'], -1);
     SysMsgArg1 := Lines.Values['Arg1'];
     case SysMsgType of
        1:
           DoSystemMessage(SysMsgArg1);
     end;
  end
  else if Assigned(FOnReceiveMessage) then
     FOnReceiveMessage(Self, Header, FromAccount, FromName, Msg);
  If Assigned(Lines) then  FreeAndNil(Lines);
end;

procedure TMSNMessenger.DoUrl(rru, passport: String; id: Integer);
begin
  if Assigned(FOnUrl) then
    FOnUrl(Self, rru, passport, id);
end;

procedure TMSNMessenger.ProcessGroupList(ParamLst: TStringList);
var
   I: Integer;
   Group: TMsnGroup;
begin
   if ParamLst[0] = 'LSG' then  ////组列表
   begin
      Group := FGroups.Add;
      with Group do
      begin
         Id := StrToIntDef(ParamLst[1], 0);
         Name := DecodeParam(ParamLst[2]);
      end;
      if (FSignInStage <> ssSignIn) and (FMembersCount = FLstCount) then
           FinishSignInProcess;
{      if (Group.Name <> 'Individuals') then //默认为SCIndividuals
      begin
         AddGroup(Name);
         DoGroupListChange;
      end;
}
   end
   else if ParamLst[0] = 'ADG' then
   begin
      Group := FGroups.Add;
      with Group do
      begin
         Id := StrtoIntDef(ParamLst[4], 0);
         Name := DecodeParam(ParamLst[3]);
      end;
      AddGroup(Name);
      DoGroupListChange;
   end
   else if ParamLst[0] = 'REG' then
   begin
      I := FGroups.IndexOf(StrtoIntDef(ParamLst[3], -1));
      if I <> -1 then
      begin
         FGroups[I].Name := DecodeParam(ParamLst[4]);
         RenameGroup(i,FGroups[I].Name);
      end;
   end
   else if ParamLst[0] = 'RMG' then
   begin
      I := FGroups.IndexOf(StrToIntDef(ParamLst[3], -1));
      if I <> -1 then
      begin
         DelGroup(I) ;
         FGroups.Delete(I);
         DoGroupListChange;
      end;
   end;
end;

procedure TMSNMessenger.ProcessMemberList(ParamLst: TStringList);
var
   I: Integer;
   nLk: Integer;
   Idx: Integer;
   List: TMsnMemberList;
   ListKind: TListKind;
   Member: TMsnMember;
begin
   if (ParamLst[0] = 'LST') then
   begin
      Inc(FLstCount);
      nLk := StrToIntDef(SS(ParamLst,3),0);
      if (nLK and (1 shl I)) <> 0 then
      begin
        case I of
            0: begin ListKind := lkFL; List := FMembers;        end;
            1: begin ListKind := lkAL; List := FAllowMembers;   end;
            2: begin ListKind := lkBL; List := FBlockMembers;   end;
            3: begin ListKind := lkRL; List := FReverseMembers; end;
         else
             begin ListKind := lkFL; List := FMembers; end;
         end;
         Member := List.Add;
         Member.Status := usFLN;
         Member.Account := ParamLst[1];
         Member.Name := DecodeParam(ParamLst[2]);
         if (FSignInStage <> ssSignIn) and (FMembersCount = FLstCount) then
           FinishSignInProcess;
         if ListKind = lkFL then Member.Groups.Add(StrToIntDef(SS(ParamLst,4),0));
         if Member.Groups.Count = 0 then Member.Groups.Add(0);
            DoMemberInit(ListKind, Member);
      end;
   end
{   else
   begin
      if ParamLst[2] = 'FL' then
      begin
         ListKind := lkFL;
         List := FMembers;
      end
      else if ParamLst[2] = 'RL' then
      begin
         ListKind := lkRL;
         List := FReverseMembers;
      end
      else if ParamLst[2] = 'AL' then
      begin
         ListKind := lkAL;
         List := FAllowMembers;
      end
      else if ParamLst[2] = 'BL' then
      begin
         ListKind := lkBL;
         List := FBlockMembers;
      end else
         Exit;
      if (ParamLst[0] = 'ADD') then
      begin
         Member := List.Find(ParamLst[4]);
         if Member = nil then
         begin
            Member := List.Add;
            with Member do
            begin
               Status := usFLN;
               Account := ParamLst[4];
               Name := DecodeParam(ParamLst[5]);
               if SS(ParamLst, 6) <> '' then
                  Member.Groups.Add(StrToIntDef(SS(ParamLst, 6), 0));
               if Member.Groups.Count = 0 then Member.Groups.Add(0);
               DoMemberAddition(ListKind, Member);
            end;
         end else
         begin
            if SS(ParamLst, 6) <> '' then
               Member.Groups.Add(StrToIntDef(SS(ParamLst, 6), 0));
            DoMemberGroupChange(Member);
         end;
      end
      else if (ParamLst[0] = 'REM') then
      begin
         Idx := List.IndexOf(ParamLst[4]);
         if Idx <> -1 then
         begin
            if SS(ParamLst, 5) = '' then
            begin
               DoMemberDeletion(ListKind, List[Idx]);
               List.Delete(Idx);
            end else
            begin
               List[Idx].Groups.Remove(StrToIntDef(ParamLst[5], -1));
               if List[Idx].Groups.Count = 0 then
               begin
                  DoMemberDeletion(ListKind, List[Idx]);
                  List.Delete(Idx);
               end else
                  DoMemberGroupChange(List[Idx]);
            end;
         end;
      end;
   end;
}
end;


procedure TMSNMessenger.ProcessPrivacySetting(ParamLst: TStringList);
var
  Cmd: TStringList;
  OBLP: TBLP;
begin
  if (ParamLst[0] = 'GTC') then
  begin
    if ParamLst[1] = 'A' then
      FGTC := True
    else if ParamLst[1] = 'N' then
      FGTC := False;
  end else
  if (ParamLst[0] = 'BLP') then
  begin
    OBLP := FBLP;
    if (ParamLst[1] = 'AL') or (SS(ParamLst, 3) = 'AL') then
    begin
      FBLP := bpAL;
      OBLP := bpBL;
    end
    else if (ParamLst[1] = 'BL') or (SS(ParamLst, 3) = 'BL') then
    begin
      FBLP := bpBL;
      OBLP := bpAL;
    end;
    Cmd := TStringList.Create;
    CreatePrivacyCommand(Cmd, 'ADD', FBLP);
    ProcessMemberList(Cmd);
    Cmd.Clear;
    CreatePrivacyCommand(Cmd, 'REM', OBLP);
    ProcessMemberList(Cmd);
    Cmd.Free;
  end;
end;

procedure TMSNMessenger.CreatePrivacyCommand(var ParamLst: TStringList;
  Cmd: String; BLP: TBLP);
begin