umsnmsgr.pas

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

    FSessionID: String;
    FIncompleteCommand: String;    
    procedure SendCommand(Str: Utf8String);
    procedure ErrorHandler(ParamLst: TStringList);

    procedure SetMemberList(ParamLst: TStringList);
    procedure DecodeReceivedMessage(DataStr: UTF8String;
                                    var Header: UTF8String; var FromAccount: String;
                                    var FromName: WideString; var Msg: UTF8String);
    function ContainsRegularMessage(Header: UTF8String): Boolean;

    procedure CreateSocket;
    procedure DestroySocket;
    
//    procedure SetPingInterval(Sec: Integer);
//    procedure PingTimerProc(Sender: TObject);
//    procedure Ping;
  protected
    procedure DoConnect;
    procedure DoDisconnect;
    procedure DoLog(Hdr: String; Msg: UTF8String);
    procedure DoError(ErrorKind: TErrorKind; ErrorCode: Integer; ErrorMsg: WideString = '');
    procedure DoMemberListChange;
    procedure DoReceiveMessage(Header: UTF8String; FromAccount: String;
                               FromName: WideString; Msg: UTF8String);
    procedure DoReceiveNAK;
    procedure DoJoinMember(Member: TMsnMember);
    procedure DoByeMember(Member: TMsnMember);
  public
    // 儊僜僢僪
    constructor Create;
    destructor Destroy; override;
    procedure Connect(AHost: String; APort: Integer; Account, Cookie,
      SessionID: String);
    procedure Disconnect;
    procedure SendMessage(Msg: WideString);
    procedure CallMember(Account: String);
    procedure CallReservedMembers;
    procedure SendReservedMessages;
    function SingleMember(Account: String): Boolean;
    procedure BeginTyping;

    // Socket Events
    procedure SocketConnect(Handle: HNsmClientSocket);
    procedure SocketRead(Handle: HNsmClientSocket);
    procedure SocketDisconnect(Handle: HNsmClientSocket);
    procedure SocketConnecting(Handle: HNsmClientSocket);
    procedure SocketError(Handle: HNsmClientSocket;
                          ErrorType: Integer; var ErrorCode: Integer);
    // 幚峴帪僾儘僷僥傿
    property NsmHandle: Cardinal read FNsmHandle write FNsmHandle;
    property RequestID: Integer read FRequestID write FRequestID;
    property TrID: Integer read FTrID;    
    property User: TMsnUser read FUser;
    property Members: TMsnMemberList read FMembers;
    property SignInStage: TSignInStage read FSignInStage;
    property Connected: Boolean read FConnected;
    property ReservedMembers: TStringList read FReservedMembers;
    property ReservedMessages: TStringList read FReservedMessages;
  published
    // 僀儀儞僩
    property OnConnect: TNotifyEvent read FOnConnect write FOnConnect;
    property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
    property OnLog: TMsnLogEvent read FOnLog write FOnLog;
    property OnError: TMsnErrorEvent read FOnError write FOnError;
    property OnReceiveMessage: TMsnReceiveMessageEvent read FOnReceiveMessage write FOnReceiveMessage;
    property OnReceiveNAK: TNotifyEvent read FOnReceiveNAK write FOnReceiveNAK;
    property OnJoinMember: TMsnMemberEvent read FOnJoinMember write FOnJoinMember;
    property OnByeMember: TMsnMemberEvent read FOnByeMember write FOnByeMember;
    property OnMemberListChange: TNotifyEvent
                read FOnMemberListChange write FOnMemberListChange;
  end;

  // ---------------------------------------------------------------------------
  // 僐僱僋僔儑儞儕僗僩
  TMsnConnectionList = class
  private
    FConnections: TList;
    function GetConnection(Index: Integer): TMsnConnection;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    function Add: TMsnConnection;
    procedure Delete(Idx: Integer);
    procedure Clear;
    function IndexOf(AConnection: TMsnConnection): Integer;
    function IndexOfNsmHandle(NsmHandle: Cardinal): Integer;
    function IndexOfUser(Account: String): Integer;

    property Connections[Index: Integer]: TMsnConnection read GetConnection; default;
    property Count: Integer read GetCount;
  end;

  // ---------------------------------------------------------------------------
  // 僙僢僔儑儞儕僗僩
  TMsnSessionList = class
  private
    FSessions: TList;
    function GetSession(Index: Integer): TMsnSession;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    function Add: TMsnSession;
    procedure Delete(Idx: Integer);
    procedure Clear;
    function IndexOf(ASession: TMsnSession): Integer;
    function IndexOfNsmHandle(NsmHandle: Cardinal): Integer;
    function IndexOfRequestID(RequestID: Integer): Integer;
    function IndexOfSingleMember(ASession: TMsnSession): Integer;

    property Sessions[Index: Integer]: TMsnSession read GetSession; default;
    property Count: Integer read GetCount;
  end;

function GetMsnErrorMessage(ECode: Integer): WideString;

implementation

uses
   UMsnPluginMain, UConfig;

function SplitCommandStr(List: TStringList; const Str: UTF8String): UTF8String; forward;
procedure SplitParamStr(List: TStringList; const Str: UTF8String); forward;
function SS(List: TStringList; Idx: Integer): String; forward;
function Utf8ToAnsiEx(const S: Utf8String): String; forward;
function EncodeParam(const S: WideString): UTF8String; forward;
function DecodeParam(const S: UTF8String): WideString; forward;

// =============================================================================
//  僜働僢僩僀儀儞僩偺儔僢僷乕
// =============================================================================
procedure WrapConConnecting(Handle: HNsmClientSocket; Data: Cardinal); stdcall;
begin
   TMsnConnection(Data).SocketConnecting(Handle);
end;

procedure WrapConConnect(Handle: HNsmClientSocket; Data: Cardinal); stdcall;
begin
   TMsnConnection(Data).SocketConnect(Handle);
end;

procedure WrapConDisconnect(Handle: HNsmClientSocket; Data: Cardinal); stdcall;
begin
   TMsnConnection(Data).SocketDisconnect(Handle);
end;

procedure WrapConRead(Handle: HNsmClientSocket; Data: Cardinal); stdcall;
begin
   TMsnConnection(Data).SocketRead(Handle);
end;

procedure WrapConError(Handle: HNsmClientSocket; Data: Cardinal;
                       ErrorType: Integer; var ErrorCode: Integer); stdcall;
begin
   TMsnConnection(Data).SocketError(Handle, ErrorType, ErrorCode);
end;

procedure WrapSesConnecting(Handle: HNsmClientSocket; Data: Cardinal); stdcall;
begin
   TMsnSession(Data).SocketConnecting(Handle);
end;

procedure WrapSesConnect(Handle: HNsmClientSocket; Data: Cardinal); stdcall;
begin
   TMsnSession(Data).SocketConnect(Handle);
end;

procedure WrapSesDisconnect(Handle: HNsmClientSocket; Data: Cardinal); stdcall;
begin
   TMsnSession(Data).SocketDisconnect(Handle);
end;

procedure WrapSesRead(Handle: HNsmClientSocket; Data: Cardinal); stdcall;
begin
   TMsnSession(Data).SocketRead(Handle);
end;

procedure WrapSesError(Handle: HNsmClientSocket; Data: Cardinal;
                       ErrorType: Integer; var ErrorCode: Integer); stdcall;
begin
   TMsnSession(Data).SocketError(Handle, ErrorType, ErrorCode);
end;

// =============================================================================
//  SSL宱桼偱僷僗儚乕僪忣曬傪庢摼偡傞僗儗僢僪
// =============================================================================
constructor TMsnAuthThread.Create(Owner: TMsnConnection; Chal: String);
begin
   FOwner := Owner;
   FChallenge := TStringList.Create;
   Split(FChallenge, Chal, ',');
   inherited Create(False);
   FreeOnTerminate := True;
end;

procedure TMsnAuthThread.Execute;
var
   LoginSrv, AuthStr: String;
begin
   LoginSrv := ObtainLoginSrv;
   If LoginSrv <> '' then
   begin
      If ObtainAuthStr(LoginSrv, AuthStr) then
         FOwner.SendCommand(Format('USR %d TWN S %s'#13#10, [FOwner.TrID, AuthStr]))
      else
         FOwner.ErrorOnSignInProcess(AuthStr); // 擣徹幐攕
   end
   else
   begin
      FOwner.ErrorOnSignInProcess(
         GetLocalStr(RS_SECTION_ERR, 'RS_ERR_ON_REQUESTING_TICKET'));
   end;
   FChallenge.Free;
end;

function TMsnAuthThread.ObtainLoginSrv: String;
var
   HeadLst, ParamLst: TStringList;
begin
   Result := '';
   HeadLst := TStringList.Create;
   try
      SplitMimeHeader(HeadLst, SSLGet(INITIAL_PASSPORT_REDIRECT_SERVER, ''));
      If HeadLst.Values['PassportURLs'] <> '' then
      begin
         ParamLst := TStringList.Create;
         try
            Split(ParamLst, HeadLst.Values['PassportURLs'], ',');
            If ParamLst.Values['DALogin'] <> '' then
               Result := 'https://' + ParamLst.Values['DALogin'];
         finally
            ParamLst.Free;
         end;
      end;
   finally
      HeadLst.Free;
   end;
end;

function TMsnAuthThread.ObtainAuthStr(LoginSrv: String; var AuthStr: String): Boolean;
var
   HeadLst, ParamLst, ClientInfo: TStringList;
   Auth, S: String;
begin
   Result := False;
   HeadLst := TStringList.Create;
   try
      Auth := Format(MSNP8_AUTH_REQUEST,
                     [FChallenge.Values['ru'],
                      UrlEncode(FOwner.User.Account),
                      UrlEncode(FOwner.User.Password),
                      FChallenge.Values['lc'],
                      FChallenge.Values['id'],
                      FChallenge.Values['tw'],
                      FChallenge.Values['fs'],
                      FChallenge.Values['ct'],
                      FChallenge.Values['kpp'],
                      FChallenge.Values['kv'],
                      FChallenge.Values['ver'],
                      FChallenge.Values['tpf']]);
      SplitMimeHeader(HeadLst, SSLGet(LoginSrv, Auth));
      If HeadLst.Values['Location'] <> '' then
         Result := ObtainAuthStr(HeadLst.Values['Location'], AuthStr)
      else If HeadLst.Values['Authentication-Info'] <> '' then
      begin
         ParamLst := TStringList.Create;
         ClientInfo := TStringList.Create;
         try
            Split(ParamLst, HeadLst.Values['Authentication-Info'], ' ');
            If (ParamLst[0] = 'Passport1.4') and (ParamLst[1] <> '') then
            begin
               Split(ClientInfo, ParamLst[1], ',');
               If ClientInfo.Values['da-status'] = 'success' then
               begin
                  S := ClientInfo.Values['from-PP'];
                  AuthStr := Copy(S,2,Length(S)-2);
                  Result := True;
               end;
            end;
         finally
            ParamLst.Free;
            ClientInfo.Free;
         end;
      end
      else If HeadLst.Values['WWW-Authenticate'] <> '' then
      begin
         ParamLst := TStringList.Create;
         ClientInfo := TStringList.Create;
         try
            Split(ParamLst, HeadLst.Values['WWW-Authenticate'], ' ');
            If (ParamLst[0] = 'Passport1.4') and (ParamLst[1] <> '') then
            begin
               Split(ClientInfo, ParamLst[1], ',');
               If ClientInfo.Values['da-status'] = 'failed' then
               begin
                  AuthStr := UrlDecode(ClientInfo.Values['cbtxt']);
                  Result := False;
               end;
            end;
         finally
            ParamLst.Free;
            ClientInfo.Free;
         end;
      end;
   finally
      HeadLst.Free;
   end;
end;
            
function TMsnAuthThread.SSLGet(Url, Content: String): String;
var
   NetHandle,UrlHandle: HINTERNET;
   Buffer: Array[0..4095] of Char; // 揔摉乧
   dwCode, dwSzBuff, dwTemp: DWORD;
   Proto: String;
   proxyType: Integer;
begin
   If Config.UseInetOptOnSignIn then
   begin
      NetHandle := InternetOpen('MSMSGS', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
   end
   else
   begin
      proxyType := FOwner.Socket.GetInfoInt(NMSOCK_INFO_PROXYTYPE);
      If proxyType = NMSOCK_PROXY_NONE then
         NetHandle := InternetOpen('MSMSGS', INTERNET_OPEN_TYPE_DIRECT, nil, nil, 0)
      else
      begin
         case proxyType of
            NMSOCK_PROXY_HTTP:   Proto := 'http';
            NMSOCK_PROXY_SOCKS4: Proto := 'socks';
            NMSOCK_PROXY_SOCKS5: Proto := 'socks';
         end;
         NetHandle := InternetOpen('MSMSGS', INTERNET_OPEN_TYPE_PROXY,
                                   PChar(Format('https=%s://%s:%d',
                                                [Proto,Config.ProxyHost,Config.ProxyPort])),
                                   PChar('<local>'), 0);
      end;
   end;
   UrlHandle := InternetOpenUrl(NetHandle, PChar(Url), PChar(Content), DWORD(-1),
                                INTERNET_FLAG_IGNORE_CERT_CN_INVALID
                                + INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
                                + INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP
                                + INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS
                                + INTERNET_FLAG_KEEP_CONNECTION
                                + INTERNET_FLAG_NO_AUTO_REDIRECT
                                + INTERNET_FLAG_NO_CACHE_WRITE
                                + INTERNET_FLAG_NO_COOKIES
                                + INTERNET_FLAG_NO_UI
                                + INTERNET_FLAG_PRAGMA_NOCACHE
                                + INTERNET_FLAG_RELOAD
                                + INTERNET_FLAG_SECURE, 0);
   dwSzBuff := SizeOf(dwCode);
   dwTemp := 0;
   HttpQueryInfo(UrlHandle, HTTP_QUERY_STATUS_CODE + HTTP_QUERY_FLAG_NUMBER,
                 @dwCode, dwSzBuff, dwTemp);
   case dwCode of
      HTTP_STATUS_REDIRECT:
         begin
            FillChar(Buffer, SizeOf(Buffer), 0);
            dwSzBuff := SizeOf(Buffer);
            dwTemp := 0;
            HttpQueryInfo(UrlHandle, HTTP_QUERY_LOCATION,
                          @Buffer, dwSzBuff, dwTemp);
            Result := SSLGet(String(Buffer), Content);
         end;
      HTTP_STATUS_OK:
         begin
            FillChar(Buffer, SizeOf(Buffer), 0);
            dwSzBuff := SizeOf(Buffer);
            dwTemp := 0;
            HttpQueryInfo(UrlHandle, HTTP_QUERY_RAW_HEADERS_CRLF,
                          @Buffer, dwSzBuff, dwTemp);
            Result := Buffer;
         end;
   end;
   InternetCloseHandle(UrlHandle);
   InternetCloseHandle(NetHandle);
end;