msnsession.pas

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

unit MsnSession;

interface

uses WSocket, Classes, MsnConsts, SysUtils, QDialogs,UMsnUtils,UMemberList;

Type
//  TMsnMember = class;
  //                           联机   忙碌        马上回来  离开  接听电话 就餐   隐身
//  TMsnMemberStatus = (usFLN, usNLN, usBSY, usIDL, usBRB, usAWY, usPHN,   usLUN, usHDN);
  {出错类型..}
  TErrorKind    = (fyMsnError, fySocketError);
  {更改组状态新增,修改,删除}
  TGroupChangeKind = (fyAdd, fyEdit, fyDel);
  {收到信息..}
  TReceiveMessage = Procedure (Sender: TObject; Member : TMsnMember; MessageText : WideString) of Object;
  {上线,下线..}
  TMsnMemberEvent = procedure (Sender: TObject; Member: TMsnMember) of Object;
  {ERROR EVENT..}
  TMsnErrorEvent = procedure (Sender: TObject; ErrorKind: TErrorKind;
      ErrorCode: Integer; ErrorMsg: WideString = '') of Object;

  TMsnSession = class(TComponent)
  private
    FUser: TMsnUser;
    FTrID: Integer;
    FMembers:TMsnMemberList; 

    FSocket: TWSocket;
    FOnDisConnect: TDisConnectEvent;
    FCookie: string;
    FSessionID: string;
    FMsnUserName: string;
    FOnReceiveMessage: TReceiveMessage;
    FConnected: Boolean;
    FSessionMembers: TMsnMemberList;
    FMember: TMsnMember;
    MemberList: TMsnMemberList;
    FSessionMail: string;
    FOnMemberBye: TMsnMemberEvent;
    FOnError: TMsnErrorEvent;
    procedure LogWrite(const Data: String);
    function GetSocksPort: string;
    function GetSocksServer: string;
    function GetSocksUserName: string;
    function GetUserPassWord: string;
    procedure SetSocksPort(const Value: string);
    procedure SetSocksServer(const Value: string);
    procedure SetSocksUserName(const Value: string);
    procedure SetUserPassWord(const Value: string);
  protected
    FTrialID: Integer;
    FLog: TStrings;

    {处理命令}
    procedure ProcessCommand(const ACommand: String);
    {断开连接}
    procedure SocketDisconnect(Sender: TObject; Error: Word);
    {Socket接收到数据}
    procedure SocketDataAvailable(Sender: TObject; Error: Word);
    {Socket连接}
    procedure SocketConnect(Sender: TObject; Error: Word);

  public
    procedure SocketWrite(AString: String);
    destructor Destroy;  override;
    constructor Create(AHost, APort, ACookie, ASessionID, AMsnUserName, SessionMail
        : String;AMember: TMsnMember; AMemberList : TMsnMemberList); reintroduce;
    //请求ID
    {连接}
    procedure Connect;
    {设置代理}
    procedure SetProxy(AServer, APort, AUserName, APassWord : String);
    {发送信息.}
    procedure SendMessage(AMessage: String);
    procedure Close;
    {连接成员}
    property Cookie: string read FCookie write FCookie;

    property SessionID: string read FSessionID write FSessionID;
    {日志}
    property Log: TStrings read FLog write FLog;
    {登陆的Msn用户名}
    property MsnUserName: string read FMsnUserName write FMsnUserName;
    {代理服务器地址}
    property Socks5Server: string read GetSocksServer write SetSocksServer;
    {代理服务器端口}
    property Socks5Port: string read GetSocksPort write SetSocksPort;
    {代理用户名}
    property Socks5UserName: string read GetSocksUserName write SetSocksUserName;
    {代理密码}
    property Socks5UserPassWord: string read GetUserPassWord write SetUserPassWord;
    {是否连接}
    property Connected: Boolean read FConnected write FConnected;
    {成员列表..}
    property SessionMembers: TMsnMemberList read FSessionMembers write
        FSessionMembers;
    {会话的成员}    
    property Member: TMsnMember read FMember write FMember;
    {会话的Mail}
    property SessionMail: string read FSessionMail write FSessionMail;
    {成员离天会话}
    property OnMemberBye: TMsnMemberEvent read FOnMemberBye write FOnMemberBye;
    {会话出错}
    property OnError: TMsnErrorEvent read FOnError write FOnError;

    property TrID: Integer read FTrID;
    property User: TMsnUser read FUser;

    procedure SetMemberList(ParamLst: TStringList);

  published
    {断开连接}
    property OnDisConnect: TDisConnectEvent read FOnDisConnect write FOnDisConnect;
    {接收数据}
    property OnReceiveMessage: TReceiveMessage read FOnReceiveMessage write
        FOnReceiveMessage;
  end;

  TMsnSessionList = class
  private
    FSessions: TList;
    function GetSession(Index: Integer): TMsnSession;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(AHost, APort, ACookie, ASessionID, MsnUserName, SessionMail : 
        String; AMember:TMsnMember; MemberList : TMsnMemberList): TMsnSession;
    procedure Delete(Idx: Integer);
    procedure Clear;
    function IndexOf(ASession: TMsnSession): Integer;
    function IndexOfSessionID(ASessionID: string): Integer;
    function GetMsnSessionByAlias(Alias: String): TMsnSession;
    function IndexOfEmail(AEmail: String): Integer;
    property Sessions[Index: Integer]: TMsnSession read GetSession; default;
    property Count: Integer read GetCount;
  end;


implementation

uses MSNMessenger;

procedure TMsnSession.Connect;
begin
  FSocket.Connect;
end;

constructor TMsnSession.Create(AHost, APort, ACookie, ASessionID, AMsnUserName, 
    SessionMail : String;AMember: TMsnMember; AMemberList : TMsnMemberList);
begin
  inherited Create(Nil);
  FSocket := TWSocket.Create(Self);
  FSessionMembers := TMsnMemberList.Create;
  FSocket.Addr := AHost;
  FSocket.Proto := 'tcp';
  FSocket.Port := APort;
  FSocket.OnSessionConnected := SocketConnect;
  FSocket.OnSessionClosed    := SocketDisconnect;
  FSocket.OnDataAvailable    := SocketDataAvailable;
  Cookie := ACookie;
  SessionID := ASessionID;
  MsnUserName := AMsnUserName;
  MemberList := AMemberList;
  Member := AMember;
  FSessionMail := SessionMail;
end;

destructor TMsnSession.Destroy;
begin
  FSocket.Free;
  FSessionMembers.Free;
  inherited;
end;

function TMsnSession.GetSocksPort: string;
begin
  Result := FSocket.SocksPort ;
end;

function TMsnSession.GetSocksServer: string;
begin
  Result := FSocket.SocksServer;
end;

function TMsnSession.GetSocksUserName: string;
begin
  Result := FSocket.SocksUsercode ;
end;

function TMsnSession.GetUserPassWord: string;
begin
  Result := FSocket.SocksPassword;
end;

procedure TMsnSession.LogWrite(const Data: String);
begin
  if Assigned( FLog ) then FLog.Add(Data);
end;

procedure TMsnSession.ProcessCommand(const ACommand: String);
Var
  Cmd, Text, FromString, Mail : String;
  I : integer;
  AMember : TMsnMember;
begin
  Text := ACommand;
  Cmd := WordAt(ACommand, 1);
  AMember := Nil;
  if (Cmd = COMMAND_USR) and (WordAt(ACommand, 3) = OKString) then
  begin
    SocketWrite(COMMAND_CAL+ FormatID + FSessionMail);
    exit;
  end
  else if (Cmd = COMMAND_JOI) then //加入会话..
  begin
    Mail := WordAt(ACommand, 2);
    AMember := MemberList.FindMemberByMail(Mail);
    if AMember <> nil then Member := AMember;
    exit;
  end
  else if (Cmd = COMMAND_BYE) then //退出会话..
  begin
    if Assigned(FOnMemberBye) then FOnMemberBye(self, Member);
    exit;
  end
  else if (Cmd = IntToStr(ERROR_217)) then//对方不在线
  begin
    Self.Close;
    if Assigned(FOnError) then
      FOnError(self, fyMsnError, ERROR_217, ERROR_217Str);
    exit;
  end
  else if (Cmd = IntToStr(ERROR_216)) then
  begin
    self.Close;
    if Assigned(FOnError) then
      FOnError(self, fyMsnError, ERROR_216, ERROR_216Str);
    exit;
  end;
  if Pos(ReceiveMessage, ACommand) = 0 then exit;
  if Cmd = COMMAND_MSG then
  begin
    FromString := WordAt(ACommand, 2);  //发送的Email;
    Member := MemberList.FindMemberByMail(FromString);
    //for I := 0 to 3 do
     // CmdText.Delete(0);
     i:= Pos(#13#10#13#10,ACommand);
     Text := Copy(ACommand, i+4, Length(ACommand)-i);
    if Text <> '' then
      if (Assigned(FOnReceiveMessage)) and (Member <> nil) then
        FOnReceiveMessage(self, Member, Text);
  end;//if COMMAND_MSG
end;

procedure TMsnSession.SetSocksPort(const Value: string);
begin
  FSocket.SocksPort:= Value;
end;

procedure TMsnSession.SetSocksServer(const Value: string);
begin
  FSocket.SocksServer := Value;
end;

procedure TMsnSession.SetSocksUserName(const Value: string);
begin
  FSocket.SocksUsercode := Value;
end;

procedure TMsnSession.SetUserPassWord(const Value: string);
begin
  FSocket.SocksPassword := Value;
end;

procedure TMsnSession.SocketConnect(Sender: TObject; Error: Word);
begin
  FConnected := True;
  FTrialID := 0;
  if Member <> nil then//被请求的...
    SocketWrite(COMMAND_ANS + FormatID + Format(SEND_ANS_COMMAND, [MsnUserName, Cookie, SessionID]))
  else
    SocketWrite(COMMAND_USR + FormatID + MsnUserName +' '+ Cookie);
end;

procedure TMsnSession.SocketDataAvailable(Sender: TObject; Error: Word);
var
  Tmp: String;
begin
  Tmp := FSocket.ReceiveStr;
  LogWrite('Session RECV : ' + Tmp);
  ProcessCommand(DecodeParam(Tmp))
end;

procedure TMsnSession.SocketDisconnect(Sender: TObject; Error: Word);
begin
  FConnected := False;
  LogWrite(SocketDiscon);
  if Assigned(FOnDisConnect) then
    FOnDisConnect(self);   
end;

procedure TMsnSession.SocketWrite(AString: String);
begin
  if Pos(FormatID2, AString) > 0 then
  begin
    FSocket.SendStr(Format(AString, [FTrialID]) + SRequestHead4);
    LogWrite('Session SENT : ' + Format(AString, [FTrialID]));
    Inc(FTrialID);
  end else
  begin
    FSocket.SendStr(AString + SRequestHead4);
    LogWrite('Session SENT : ' + AString);
  end;
end;

procedure TMsnSession.SetProxy(AServer, APort, AUserName, APassWord : String);
begin
  if AServer <> '' then
  begin
    Socks5Server := AServer;
    Socks5Port := APort;
    Socks5UserName := AUserName;
    Socks5UserPassWord := APassWord;
  end;
end;

procedure TMsnSession.SendMessage(AMessage: String);
var
  Utf8Msg: UTF8String;
begin
  Utf8Msg := Format(SendMessageText, ['%E5%AE%8B%E4%BD%93']) + EncodeParam(AMessage);
  SocketWrite(COMMAND_MSG + FormatID +format(MGSFormat, [Length(Utf8Msg)+2]));
  SocketWrite(Utf8Msg);
end;

procedure TMsnSession.Close;
begin
  FSocket.Close;
end;


{ TMsnSessionList }

function TMsnSessionList.Add(AHost, APort, ACookie, ASessionID, MsnUserName, 
    SessionMail : String; AMember:TMsnMember; MemberList : TMsnMemberList):
    TMsnSession;
begin
  Result := TMsnSession.Create(AHost, APort, ACookie, ASessionID, MsnUserName, SessionMail, AMember, MemberList);
  FSessions.Add(Result);
end;

procedure TMsnSessionList.Clear;
begin
  while FSessions.Count > 0 do
    Delete(0);
end;

constructor TMsnSessionList.Create;
begin
  FSessions := TList.Create;
end;

procedure TMsnSessionList.Delete(Idx: Integer);
begin
  TMsnSession(FSessions[Idx]).Free;
  FSessions.Delete(Idx);
end;

destructor TMsnSessionList.Destroy;
var
  i : integer;
begin
  for i := 0 to FSessions.Count -1 do
    TMsnSession(FSessions.Items[i]).Free;
//  Clear;
  FSessions.Free;
  inherited;
end;

function TMsnSessionList.GetCount: Integer;
begin
  Result := FSessions.Count;
end;

function TMsnSessionList.GetSession(Index: Integer): TMsnSession;
begin
  Result := TMsnSession(FSessions[Index]);
end;

function TMsnSessionList.IndexOf(ASession: TMsnSession): Integer;
var
  I: integer;
begin
  Result := -1;
  for I := 0 to FSessions.Count - 1 do
  begin
    if TMsnSession(FSessions[I]) = ASession then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function TMsnSessionList.IndexOfSessionID(ASessionID: string): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to FSessions.Count - 1 do
  begin
    if TMsnSession(FSessions[I]).SessionID = ASessionID then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function TMsnSessionList.GetMsnSessionByAlias(Alias: String): TMsnSession;
Var
  I: integer;
begin
  Result := Nil;
  For I:= 0 to FSessions.Count-1 do
  begin
    if TMsnSession(FSessions[I]).Member = Nil then Continue
    else
    if TMsnSession(FSessions[I]).Member.Account  = Alias then
    begin
      Result := Sessions[I];
      exit;
    end;   //if
  end;     //else
end;

function TMsnSessionList.IndexOfEmail(AEmail: String): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := 0 to FSessions.Count - 1 do
  begin
    if TMsnSession(FSessions[I]).SessionMail = AEmail then
    begin
      Result := I;
      Break;
    end;
  end;
end;


procedure TMsnSession.SetMemberList(ParamLst: TStringList);
var
  Member: TMsnMember;
  MemberCheck: TMsnMember;
  I: Integer;
begin
  if (ParamLst[0] = 'IRO') then
  begin
    Member := FMembers.Add;
    with Member do
    begin
      Account := ParamLst[4];
      Name := DecodeParam(ParamLst[5]);
    end;
//    DoJoinMember(Member);
  end
  else if (ParamLst[0] = 'JOI') then
  begin
    MemberCheck := FMembers.Find(ParamLst[1]);
    if MemberCheck = nil then
    begin
       Member := FMembers.Add;
       Member.Account := ParamLst[1];
       Member.Name := DecodeParam(ParamLst[2]);
//       DoJoinMember(Member);
    end;
  end
  else if (ParamLst[0] = 'BYE') then
  begin
    I := FMembers.IndexOf(ParamLst[1]);
    if I <> -1 then
    begin
 //     DoByeMember(FMembers[I]);
 //     FMembers.Delete(I);
    end;
  end;
//  if (FMembers.Count > 0) and (FSignInStage = ssSignIn) then
//    SendReservedMessages;
//  DoMemberListChange;
end;

end.