msnmessenger.pas

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

    FSocksServer := Value;
    FSocket.SocksServer := Value;
  end;  
end;

function TMSNMessenger.GetSocksPort: string;
begin
  Result := FSocksPort ;
end;

procedure TMSNMessenger.SetSocksPort(const Value: string);
begin
  if Not FConnected then
  begin
    FSocksPort := Value;
    FSocket.SocksPort := Value;
  end;  
end;

function TMSNMessenger.GetSocksUserName: string;
begin
  Result := FSocksUserName ;
end;

procedure TMSNMessenger.SetSocksUserName(const Value: string);
begin
  if Not FConnected then
  begin
    FSocksUserName := Value;
    FSocket.SocksUsercode := Value;
  end;
end;

function TMSNMessenger.GetUserPassWord: string;
begin
  Result := FSocksUserPassWord ;
end;

procedure TMSNMessenger.SetUserPassWord(const Value: string);
begin
  if Not FConnected then
  begin
    FSocksUserPassWord := Value;
    FSocket.SocksPassword := Value;
  end;
end;

procedure TMSNMessenger.MemberByeSession(Sender: TObject;
  Member: TMsnMember);
Var
  SessionIndex : integer;
begin
  {收到下线将成员置空..}
  SessionIndex := sessions.IndexOf(TMsnSession(Sender));
  Sessions.Sessions[SessionIndex].Member := Nil;
end;

procedure TMSNMessenger.Close;
begin
  FGroups.Clear ;
  FMembers.Clear ;
  FSocket.Close;
end;

procedure TMSNMessenger.SessionDisConnect(Sender: TObject);
Var
  Session : TMsnSession;
begin
  Session := TMsnSession(Sender);
  Sessions.Delete(Sessions.IndexOf(Session));
end;

procedure TMSNMessenger.CloseSession(Alias: String);
Var
  Account : String;
  SessionIndex: Integer;
begin
  if Not FConnected then exit;
  Account := Members.FindMailByAlias(Alias) ;
  if Account = '' then exit; //成员不存在列表中。
  SessionIndex := Sessions.IndexOfEmail(Account);
  if SessionIndex <> -1 then
    Sessions.Sessions[SessionIndex].Close;
end;

function TMSNMessenger.AddGroup(Const AGroupName: WideString): Integer;
begin
   Inc(FTrID);
   SendCommand(Format('ADG %d %s 0'#13#10, [FTrID, EncodeParam(Name)]));
   Result := FTrID;
end;

function TMSNMessenger.ChangeGroup(Const AGroupID: Integer; AGroupName:
    WideString): Integer ;
begin
   Inc(FTrID);
   SendCommand(Format('REG %d %d %s 0'#13#10, [FTrID, AGroupId, EncodeParam(AGroupName)]));
   Result := FTrID;
end;

function TMSNMessenger.DelGroup(Const AGroupID: Integer): Integer;
begin
   Inc(FTrID);
   SendCommand(Format('RMG %d %d'#13#10, [FTrID, AGroupId]));
   Result := FTrID;
end;

function TMSNMessenger.AddMember(List: TListKind; Account: String;
                                  GroupId: Integer = -1): Integer;
var
  Name: UTF8String;
begin
{   if Account = RS_DUMMY_ALL_USER_ACCOUNT then
   begin
      if (List = lkAL) and (FBLP <> bpAL) then
         BLP := bpAL
      else if (List = lkBL) and (FBLP <> bpBL) then
         BLP := bpBL;
      Result := 1;
      Exit;
  end;
}
  if FMembers.Contains(Account) then
       Name := EncodeParam(FMembers.Find(Account).Name)
   else
      Name := Account;

   Inc(FTrID);
   if GroupId <> -1 then
      SendCommand(Format('ADD %d %s %s %s %d'#13#10,
                         [FTrID, ListKindToStr(List), Account, Name, GroupId]))
   else if List = lkFL then
      SendCommand(Format('ADD %d %s %s %s 0'#13#10,
                         [FTrID, ListKindToStr(List), Account, Name]))
   else
      SendCommand(Format('ADD %d %s %s %s'#13#10,
                         [FTrID, ListKindToStr(List), Account, Name]));
   Result := FTrID;
end;

procedure TMSNMessenger.GetPassportInfo(acmdStr : String);
  procedure SplitMimeHeader(List: TStrings; const MimeHeader: String);
  var
    I: Integer;
    Temp: TStringList;
  begin
    Temp := TStringList.Create;
    Temp.Text := MimeHeader;
    List.Clear;
    for I := 0 to Temp.Count - 1 do
      List.Add(StringReplace(Temp[I], ': ', '=', []));
    Temp.Free;
  end;
var
  Lines: TStringList;
  ContentType: String;
  CPort: Integer;
begin
  Lines := TStringList.Create;
  SplitMimeHeader(Lines, String(UTF8Decode(acmdStr)));
  ContentType := Lines.Values['Content-Type'];
  if AnsiContainsStr(ContentType, 'text/x-msmsgsprofile') then
  begin
    with PassInfo 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);
    end;
  end;
end;

procedure TMSNMessenger.ProcessMail(acmdStr : String);
var
  TmpLst: TStringList;
  TmpFileName: String;
  TimeDif: Integer;
  creds: String;
  PassportInfo: TMsnPassportInfo;
begin
  PassportInfo := PassInfo;
  TimeDif := DateTimeToCTime(Now) - PassportInfo.LoginTime;
  creds := Format('%s%d%s', [PassportInfo.mspauth,
                             TimeDif,
                             Self.FUser.Password]);
//  creds := LowerCase(MD5(creds)); //bylcx
  TmpLst := TStringList.Create;
  try
		TmpLst.Add('<html>');
		TmpLst.Add('<head>');
		TmpLst.Add('<noscript>');
		TmpLst.Add('<meta http-equiv=Refresh content="0; url=http://www.hotmail.com">');
		TmpLst.Add('</noscript>');
		TmpLst.Add('</head>');
		TmpLst.Add('');
		TmpLst.Add('<body onload="document.pform.submit(); ">');
		TmpLst.Add(Format('<form name="pform" action="%s" method="POST">', [WordAt(acmdStr, 4)]));
		TmpLst.Add('<input type="hidden" name="mode" value="ttl">');
		TmpLst.Add(Format('<input type="hidden" name="login" value="%s">', [Fuser.Password]));
		TmpLst.Add(Format('<input type="hidden" name="username" value="%s">', [Fuser.Account]));
		TmpLst.Add(Format('<input type="hidden" name="sid" value="%d">', [PassportInfo.sid]));
		TmpLst.Add(Format('<input type="hidden" name="kv" value="%d">', [PassportInfo.kv]));
		TmpLst.Add(Format('<input type="hidden" name="id" value="%s">', [WordAt(acmdStr, 5)]));
		TmpLst.Add(Format('<input type="hidden" name="sl" value="%d">', [TimeDif]));
		TmpLst.Add(Format('<input type="hidden" name="rru" value="%s">', [WordAt(acmdStr, 3)]));
		TmpLst.Add(Format('<input type="hidden" name="auth" value="%s">', [PassportInfo.mspauth]));
		TmpLst.Add(Format('<input type="hidden" name="creds" value="%s">', [creds]));
		TmpLst.Add('<input type="hidden" name="svc" value="mail">');
		TmpLst.Add('<input type="hidden" name="js" value="yes">');
		TmpLst.Add('</form></body>');
		TmpLst.Add('</html>');

    TmpFileName := TEMP_HTMLNAME;
    TmpLst.SaveToFile(TmpFileName);
    ShellExecute(0, nil, PChar(TmpFileName), nil, nil, SW_SHOW)
  finally
    TmpLst.Free;
  end;
end;

procedure TMSNMessenger.SendCommand(Str: UTF8String);
begin
LogWrite('send:  ' + str);
  FSocket.Sendstr(Str);
end;

procedure TMSNMessenger.FinishSignInProcess;
begin
   Fconnected:=true ;
   FSignInStage := ssSignIn;
   Inc(FTrID);
//   SendCommand(Format('CHG %d %s %d'#13#10,[FTrID,'NLN',268435456]));
   SendCommand(Format('CHG %d %s %d'#13#10,[FTrID, MemberStatusToStr(FUser.Status),MSNMSGR_CHG]));
   SetPingInterval(DEFAULT_PING_INTERVAL);
end;                                                          //268435492
                                                              //268435456
procedure TMSNMessenger.ProcessSignIn(ParamLst: TStringList);
var
   MsgID: Integer;
   P: Integer;
begin
   if (ParamLst.Count > 3) and (ParamLst[0] = 'XFR') then
   begin
      FSignOutType := otXFR;
      P := AnsiPos(':', ParamLst[3]);
      FSocket.Close ;
      FSocket.Addr := LeftStr(ParamLst[3], P - 1);
      FSocket.Port := Copy(ParamLst[3], P + 1, Length(ParamLst[3]) - P);
      FSocket.Connect;
      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]));
      end else
      begin
         logwrite('exception:'+ParamLst.Text);
         FSocket.Close;
      end;
   end;
end;

procedure TMSNMessenger.ChangeUserName(Account: String; NewName: WideString);
var
   Member: TMsnMemberBase;
begin
   if Account = FUser.Account then User.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 TMSNMessenger.ProcessChangeName(ParamLst: TStringList);
begin
  if ParamLst[0] = 'REA' then
     ChangeUserName(DecodeParam(ParamLst[3]), DecodeParam(ParamLst[4]));
end;

procedure TMSNMessenger.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
        if Assigned(FOnMemberOnline) then FOnMemberOnline(Self, TMsnMember(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 if Assigned(FOnMemberOffline) then FOnMemberOffline(Self, TMsnMember(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 "/>"
         if Member.MsnObj <> MsnObj then
            Member.MsnObj := MsnObj;
      end;
      if (Member.Status <> usFLN) and (Member.Name <> OldName) then
         RenameMember(Member.Account, Member.Name);
    end;
  end;
//  if Member <> nil then
//    FOnMemberStatusChange(Tmsnmember(Member), OldStatus, InitList);
end;

procedure TMSNMessenger.ProcessCHL(ParamLst: TStringList);
var
  ChlStr: String;
  sTemp: String;
begin
  Inc(FTrID);
  ChlStr := Trim(ParamLst[2]) + MSNMSGR_CHL;
  sTemp := LowerCase(MD5Print(MD5String(ChlStr)));
  SendCommand(Format('QRY %d %s 32'#13#10, [FTrID, MSNMSGR_PID]));
  SendCommand(sTemp);
end;

procedure TMSNMessenger.ProcessMessage(DataStr: UTF8String);
var
  Command, Header: UTF8String;
  FromAccount: String;
  FromName: WideString;
  Msg: UTF8String;
  ParamLst: TStringList;
  P: Integer;
begin
  P := Pos(#13#10, DataStr);
  if P > 0 then
    Command := Copy(DataStr, 1, P - 1)
  else
    Command := DataStr;
  ParamLst := TStringList.Create;
  try
    SplitParamStr(ParamLst, Command);
    FromAccount := String(UTF8Decode(ParamLst[1]));
    FromName := DecodeParam(ParamLst[2]);
    Delete(DataStr, 1, Length(Command) + 2);
    P := Pos(#13#10#13#10, DataStr);
    if P > 0 then
    begin
      Header := Copy(DataStr, 1, P - 1);
      Msg := Copy(DataStr, P + 4, Length(DataStr));
    end else
    begin
      Header := DataStr;
      Msg := '';
    end;
    DoReceiveMessage(Header, FromAccount, FromName, Msg);
  finally
    ParamLst.Free;
  end;
end;

procedure TMSNMessenger.ProcessQNG(ParamLst: TStringList);
var
   Sec: Integer;
begin
   Sec := StrToIntDef(SS(ParamLst,1),-1);
   If Sec > 1 then
      SetPingInterval(Sec - 1);
end;

procedure TMSNMessenger.ProcessSynCommand(ParamLst: TStringList);
var
   MsgID: Integer;
   IniState: TMsnMemberStatus;
begin
   MsgID := StrToIntDef(SS(ParamLst, 1), -1);
   If MsgID = 4 then
   begin
      FMemberCount := StrToInt(ParamLst[3]);
      FGroupCount  := StrToInt(ParamLst[4]);
      FLstCount := 0;
      FLsgCount := 0;
   end;
end;