📄 umsnmsgr.pas
字号:
unit UMsnMsgr;
(* Msn Messenger Client Components *)
interface
uses
Windows, SysUtils, Classes, StrUtils, ScktComp, Wininet, Md5,
UMsnUtils, UStrResource, UMemberList, UMsnLogInfo,
UCTimeUtils, ExtCtrls,
UNsmClientSocket, UNsmClientSocketTypes, UNsmClientSocketConsts;
const
MSN_DEFAULTHOST = 'messenger.hotmail.com';
MSN_DEFAULTPORT = 1863;
MSN_VERSION8 = 'MSNP8';
MSN_VERSION9 = 'MSNP9';
// MSNP9偱偺僨僼僅儖僩PNG娫妘
DEFAULT_PING_INTERVAL = 50;
// MSNP8梡僒僀儞僀儞忣曬
INITIAL_PASSPORT_REDIRECT_SERVER = 'https://nexus.passport.com/rdr/pprdr.asp';
MSNP8_AUTH_REQUEST = 'Authorization: Passport1.4 OrgVerb=GET,OrgURL=%s,sign-in=%s,'
+ 'pwd=%s,lc=%s,id=%s,tw=%s,fs=%s,ct=%s,kpp=%s,kv=%s,ver=%s,tpf=%s';
// 僋儔僀傾儞僩婾憰
MSNMSGR_CHG_WINDOWS_MOBILE_DEV = 1;
MSNMSGR_CHG_UNKNOWN = 2;
MSNMSGR_CHG_SUPPORT_VIEW_INK = 4;
MSNMSGR_CHG_SUPPORT_CREATE_INK = 8;
MSNMSGR_CHG_SUPPORT_VIDEO = 16;
MSNMSGR_CHG_CLIENT_VERSION_6 = 32;
MSNMSGR_CHG_MSN_MOBILE = 64;
MSNMSGR_CHG_MSN_DIRECT = 128;
MSNMSGR_CHG_SUPPORT_MSNC1 = 268435456;
MSNMSGR_CHG_SUPPORT_MSNC2 = 536870912;
MSNMSGR_5_0_0540_CVR = '0x0409 winnt 5.1 i386 MSNMSGR 5.0.0540 MSMSGS';
MSNMSGR_5_0_0540_PID = 'PROD0038W!61ZTF9';
MSNMSGR_5_0_0540_CHL = 'VT6PX?UQTM4WM%YR';
MSNMSGR_6_0_0250_CVR = '0x0409 winnt 5.1 i386 MSNMSGR 6.0.0250 MSMSGS';
NSMMSGR_6_0_0250_PID = 'PROD0058#7IL2{QD';
NSMMSGR_6_0_0250_CHL = 'QHDCY@7R1TB6W?5B';
MSNMSGR_6_0_0268_CVR = '0x0409 winnt 5.1 i386 MSNMSGR 6.0.0268 MSMSGS';
MSNMSGR_6_0_0268_PID = 'PROD0061VRRZH@4F';
MSNMSGR_6_0_0268_CHL = 'JXQ6J@TUOGYV@N0M';
MSNMSGR_6_0_0602_CVR = '0x0409 winnt 5.1 i386 MSNMSGR 6.0.0602 MSMSGS';
MSNMSGR_6_0_0602_PID = 'PROD0061VRRZH@4F'; // invalid
MSNMSGR_6_0_0602_CHL = 'JXQ6J@TUOGYV@N0M'; // invalid
MSNMSGR_6_1_0128_CVR = '0x0409 winnt 5.1 i386 MSNMSGR 6.1.0128 MSMSGS';
MSNMSGR_6_1_0128_PID = 'PROD0061VRRZH@4F'; // invalid
MSNMSGR_6_1_0128_CHL = 'JXQ6J@TUOGYV@N0M'; // invalid
MSNMSGR_7_0_0777_CVR = '0x0409 winnt 5.1 i386 MSNMSGR 7.0.0777 MSMSGS';
MSNMSGR_7_0_0777_PID = 'PROD0101{0RM?UBW'; // not sure
MSNMSGR_7_0_0777_CHL = 'CFHUR$52U_{VIX5T'; // not sure
(*
MSNMSGR_CVR = MSNMSGR_6_0_0602_CVR;
MSNMSGR_PID = MSNMSGR_6_0_0602_PID;
MSNMSGR_CHL = MSNMSGR_6_0_0602_CHL;
*)
MSNMSGR_CVR = MSNMSGR_7_0_0777_CVR;
MSNMSGR_PID = MSNMSGR_7_0_0777_PID;
MSNMSGR_CHL = MSNMSGR_7_0_0777_CHL;
MSNMSGR_CHG =
MSNMSGR_CHG_CLIENT_VERSION_6 (* + MSNMSGR_CHG_SUPPORT_MSNC1 *);
ERR_SYNTAX_ERROR = 200;
ERR_INVALID_PARAMETER = 201;
ERR_INVALID_USER = 205;
ERR_FQDN_MISSING = 206;
ERR_ALREADY_LOGIN = 207;
ERR_INVALID_USERNAME = 208;
ERR_INVALID_FRIENDLY_NAME = 209;
ERR_LIST_FULL = 210;
ERR_ALREADY_THERE = 215;
ERR_NOT_ON_LIST = 216;
ERR_USER_NOT_ONLINE = 217;
ERR_ALREADY_IN_THE_MODE = 218;
ERR_ALREADY_IN_OPPOSITE_LIST = 219;
ERR_NOT_EXISTS_GROUP = 231;
ERR_SWITCHBOARD_FAILED = 280;
ERR_NOTIFY_XFR_FAILED = 281;
ERR_REQUIRED_FIELDS_MISSING = 300;
ERR_NOT_LOGGED_IN = 302;
ERR_INTERNAL_SERVER = 500;
ERR_DB_SERVER = 501;
ERR_FILE_OPERATION = 510;
ERR_MEMORY_ALLOC = 520;
ERR_WRONG_CHL_VALUE = 540;
ERR_SERVER_BUSY = 600;
ERR_SERVER_UNAVAILABLE = 601;
ERR_PEER_NS_DOWN = 602;
ERR_DB_CONNECT = 603;
ERR_SERVER_GOING_DOWN = 604;
ERR_CREATE_CONNECTION = 707;
ERR_UNKNOWN_CVR_PARAMETERS = 710;
ERR_BLOCKING_WRITE = 711;
ERR_SESSION_OVERLOAD = 712;
ERR_USER_TOO_ACTIVE = 713;
ERR_TOO_MANY_SESSIONS = 714;
ERR_NOT_EXPECTED = 715;
ERR_BAD_FRIEND_FILE = 717;
ERR_AUTHENTICATION_FAILED = 911;
ERR_NOT_ALLOWED_WHEN_OFFLINE = 913;
ERR_NOT_ACCEPTING_NEW_USERS = 920;
ERR_PASSPORT_NOT_VERIFIED = 924;
ERR_BAD_TICKET = 928;
MESSAGE_MAX_BYTES = 1664;
type
TSignInStage = (ssUnConnect, ssTryConnectServer, ssTrySignIn, ssSignIn);
TFileSesStage = (fsUnConnect, fsTryConnectServer, fsInBinSec);
TListKind = (lkFL, lkRL, lkAL, lkBL);
TErrorKind = (ekMsnError, ekSocketError);
TSignOutType = (otOTH, otSSD, otXFR, otUnKnown);
TBLP = (bpAL, bpBL);
TMsnListMemberEvent = procedure (Sender: TObject; ListKind: TListKind;
Member: TMsnMember) of Object;
TMsnListEvent = procedure (Sender: TObject; List: TListKind) of Object;
TMsnMemberEvent = procedure (Sender: TObject; Member: TMsnMemberBase) of Object;
TMsnGroupEvent= procedure (Sender: TObject; Group: TMsnGroup) of Object;
TMsnStatusChangeEvent = procedure (Sender: TObject; Member: TMsnMemberBase;
OldStatus: TMsnMemberStatus; InitList: Boolean) of Object;
TMsnSignOutEvent = procedure (Sender: TObject; SignOutType: TSignOutType) of Object;
TMsnLogEvent = procedure (LogInfo: TMsnLogInfo) of Object;
TMsnErrorEvent = procedure (Sender: TObject; ErrorKind: TErrorKind;
ErrorCode: Integer; ErrorMsg: WideString = '') of Object;
TMsnReceiveMessageEvent = procedure (Sender: TObject; Header: UTF8String;
FromAccount: String; FromName: WideString; Msg: UTF8String) of Object;
TMsnSwitchBoardEvent = procedure (Sender: TObject; TrID: Integer;
SBAddress, Cookie: String) of Object;
TMsnCalledEvent = procedure (Sender: TObject; SessionID, SBAddress, Cookie,
CallingUserAccount: String; CallingUserName: WideString) of Object;
TMsnUrlEvent = procedure (Sender: TObject; rru, passport: String; id: Integer) of Object;
TMsnNewMailEvent = procedure (Sender: TObject; Inbox: Boolean; FromName: WideString; FromAddr: String) of Object;
TMsnUnreadMailChangeEvent = procedure (Sender: TObject; Init: Boolean) of Object;
TMsnSysMsgEvent = procedure (Sender: TObject; Arg1: String) of Object;
// ---------------------------------------------------------------------------
TMsnConnection = class;
TMsnAuthThread = class(TTHread)
private
FOwner: TMsnConnection;
FChallenge: TStringList;
function SSLGet(Url, Content: String): String;
function ObtainLoginSrv: String;
function ObtainAuthStr(LoginSrv: String; var AuthStr: String): Boolean;
protected
procedure Execute; override;
public
constructor Create(Owner: TMsnConnection; Chal: String);
end;
// ---------------------------------------------------------------------------
TMsnConnection = class(TObject)
private
FNsmHandle: Cardinal;
FSocket: TNsmClientSocket;
FHost: String;
FPort: Integer;
FUser: TMsnUser;
FMembersCount: Integer;
FLstCount: Integer;
FMembers: TMsnMemberList;
FGroupsCount: Integer;
FLsgCount: Integer;
FGroups: TMSNGroupList;
FReverseMembers: TMsnMemberList;
FAllowMembers: TMsnMemberList;
FBlockMembers: TMsnMemberList;
FSignInStage: TSignInStage;
FGTC: Boolean;
FBLP: TBLP;
FTrID: Integer;
FInboxUnread: Integer;
FFoldersUnread: Integer;
FSignOutType: TSignOutType;
FIncompleteCommand: UTF8String;
FPingTimer: TTimer;
// 僷僗儚乕僪忣曬庢摼梡偺僗儗僢僪
FAuthThread: TMsnAuthThread;
// 僀儀儞僩僾儘僷僥傿偺曄悢
FOnMemberInit: TMsnListMemberEvent;
FOnMemberAddition: TMsnListMemberEvent;
FOnMemberDeletion: TMsnListMemberEvent;
FOnMemberListChange: TMsnListEvent;
FOnMemberStatusChange: TMsnStatusChangeEvent;
FOnMemberNameChange: TMsnMemberEvent;
FOnMemberGroupChange: TMsnMemberEvent;
FOnMemberOnline: TMsnMemberEvent;
FOnMemberOffline: TMsnMemberEvent;
FOnGroupAddition: TMsnGroupEvent;
FOnGroupDeletion: TMsnGroupEvent;
FOnGroupListChange: TNotifyEvent;
FOnGroupNameChange: TMsnGroupEvent;
FOnSignIn: TNotifyEvent;
FOnSignOut: TMsnSignOutEvent;
FOnMemberListUpdated: TMsnListEvent;
FOnLog: TMsnLogEvent;
FOnError: TMsnErrorEvent;
FOnSwitchBoard: TMsnSwitchBoardEvent;
FOnCalled: TMsnCalledEvent;
FOnReceiveMessage: TMsnReceiveMessageEvent;
FOnUrl: TMsnUrlEvent;
FOnNewMail: TMsnNewMailEvent;
FOnUnreadMailChange: TMsnUnreadMailChangeEvent;
FOnSystemMessage: TMsnSysMsgEvent;
// 撪晹偱巊偆庤懕偒側偳
procedure CreatePrivacyCommand(var ParamLst: TStringList; Cmd: String; BLP: TBLP);
procedure ProcessSignIn(ParamLst: TStringList);
procedure ProcessMemberList(ParamLst: TStringList);
procedure ProcessGroupList(ParamLst: TStringList);
procedure ProcessChangeStatus(ParamLst: TStringList);
procedure ProcessChangeName(ParamLst: TStringList);
procedure ProcessError(ParamLst: TStringList);
procedure ProcessPrivacySetting(ParamLst: TStringList);
procedure ProcessCHL(ParamLst: TStringList);
procedure ProcessQNG(ParamLst: TStringList);
procedure ProcessMessage(DataStr: UTF8String);
procedure ProcessSynCommand(ParamLst: TStringList);
procedure FinishSignInProcess;
procedure ChangeUserName(Account: String; NewName: WideString);
procedure SetPingInterval(Sec: Integer);
procedure PingTimerProc(Sender: TObject);
procedure CreateSocket;
procedure DestroySocket;
procedure SetGTC(Value: Boolean);
procedure SetBLP(Value: TBLP);
function ListKindToStr(List: TListKind): String;
// 僜働僢僩偺僀儀儞僩僴儞僪儔
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);
protected
// Events Trigger
procedure DoMemberInit(ListKind: TListKind; Member: TMsnMember);
procedure DoMemberAddition(ListKind: TListKind; Member: TMsnMember);
procedure DoMemberDeletion(ListKind: TListKind; Member: TMsnMember);
procedure DoMemberListChange(ListKind: TListKind);
procedure DoMemberStatusChange(Member: TMsnMemberBase; OldStatus: TMsnMemberStatus; InitList: Boolean);
procedure DoMemberNameChange(Member: TMsnMemberBase);
procedure DoMemberGroupChange(Member: TMsnMemberBase);
procedure DoMemberOnline(Member: TMsnMemberBase);
procedure DoMemberOffline(Member: TMsnMemberBase);
procedure DoGroupAddition(Group: TMsnGroup);
procedure DoGroupDeletion(Group: TMsnGroup);
procedure DoGroupListChange;
procedure DoGroupNameChange(Group: TMsnGroup);
procedure DoSignIn;
procedure DoSignOut(SignOutType: TSignOutType);
procedure DoMemberListUpdated(ListKind: TListKind);
procedure DoLog(Hdr: String; Msg: UTF8String);
procedure DoError(ErrorKind: TErrorKind; ErrorCode: Integer; ErrorMsg: WideString = '');
procedure DoSwitchBoard(TrID: Integer; SBAddress, Cookie: String);
procedure DoCalled(SessionID, SBAddress, Cookie, CallingUserAccount: String;
CallingUserName: WideString);
procedure DoReceiveMessage(Header: UTF8String; FromAccount: String;
FromName: WideString; Msg: UTF8String);
procedure DoUrl(rru, passport: String; id: Integer);
procedure DoNewMail(Inbox: Boolean; FromName: WideString; FromAddr: String);
procedure DoUnreadMailChange(Init: Boolean);
procedure DoSystemMessage(Arg1: String);
public
// 儊僜僢僪
constructor Create;
destructor Destroy; override;
procedure SendCommand(Str: UTF8String);
procedure SignIn(Account, Password: String; Name: WideString; Status: TMsnMemberStatus);
procedure SignOut;
function ChangeUserStatus(Status: TMsnMemberStatus): Integer;
function RenameMember(Account: String; NewName: WideString): Integer;
function AddMember(List: TListKind; Account: String; GroupId: Integer = -1): Integer;
function RemoveMember(List: TListKind; Account: String; GroupId: Integer = -1): Integer;
function AddGroup(Name: WideString): Integer;
function RemoveGroup(GroupId: Integer): Integer;
function RenameGroup(GroupId: Integer; NewName: WideString): Integer;
function SwitchBoardRequest: Integer;
function QueryUrl(Param: String): Integer;
procedure Ping;
procedure ErrorOnSignInProcess(ErrMsg: WideString);
procedure ApplyConfig;
// 幚峴帪僾儘僷僥
property NsmHandle: Cardinal read FNsmHandle write FNsmHandle;
property TrID: Integer read FTrID;
property User: TMsnUser read FUser;
property Members: TMsnMemberList read FMembers;
property ReverseMembers: TMsnMemberList read FReverseMembers;
property AllowMembers: TMsnMemberList read FAllowMembers;
property BlockMembers: TMsnMemberList read FBlockMembers;
property Groups: TMSNGroupList read FGroups;
property SignInStage: TSignInStage read FSignInStage;
property GTC: Boolean read FGTC write SetGTC;
property BLP: TBLP read FBLP write SetBLP;
property DSHost: String read FHost write FHost;
property DSPort: Integer read FPort write FPort;
property InboxUnread: Integer read FInboxUnread;
property FoldersUnread: Integer read FFoldersUnread;
property PingInterval: Integer write SetPingInterval;
property Socket: TNsmClientSocket read FSocket;
// 僀儀儞僩
property OnMemberInit: TMsnListMemberEvent read FOnMemberInit write FOnMemberInit;
property OnMemberAddition: TMsnListMemberEvent read FOnMemberAddition write FOnMemberAddition;
property OnMemberDeletion: TMsnListMemberEvent read FOnMemberDeletion write FOnMemberDeletion;
property OnMemberListChange: TMsnListEvent read FOnMemberListChange write FOnMemberListChange;
property OnMemberStatusChange: TMsnStatusChangeEvent read FOnMemberStatusChange write FOnMemberStatusChange;
property OnMemberNameChange: TMsnMemberEvent read FOnMemberNameChange write FOnMemberNameChange;
property OnMemberGroupChange: TMsnMemberEvent read FOnMemberGroupChange write FOnMemberGroupChange;
property OnMemberOnline: TMsnMemberEvent read FOnMemberOnline write FOnMemberOnline;
property OnMemberOffline: TMsnMemberEvent read FOnMemberOffline write FOnMemberOffline;
property OnGroupAddition: TMsnGroupEvent read FOnGroupAddition write FOnGroupAddition;
property OnGroupDeletion: TMsnGroupEvent read FOnGroupDeletion write FOnGroupDeletion;
property OnGroupListChange: TNotifyEvent read FOnGroupListChange write FOnGroupListChange;
property OnGroupNameChange: TMsnGroupEvent read FOnGroupNameChange write FOnGroupNameChange;
property OnSignIn: TNotifyEvent read FOnSignIn write FOnSignIn;
property OnSignOut: TMsnSignOutEvent read FOnSignOut write FOnSignOut;
property OnMemberListUpdated: TMsnListEvent read FOnMemberListUpdated write FOnMemberListUpdated;
property OnLog: TMsnLogEvent read FOnLog write FOnLog;
property OnError: TMsnErrorEvent read FOnError write FOnError;
property OnSwitchBoard: TMsnSwitchBoardEvent read FOnSwitchBoard write FOnSwitchBoard;
property OnCalled: TMsnCalledEvent read FOnCalled write FOnCalled;
property OnReceiveMessage: TMsnReceiveMessageEvent read FOnReceiveMessage write FOnReceiveMessage;
property OnUrl: TMsnUrlEvent read FOnUrl write FOnUrl;
property OnNewMail: TMsnNewMailEvent read FOnNewMail write FOnNewMail;
property OnUnreadMailChange: TMsnUnreadMailChangeEvent read FOnUnreadMailChange write FOnUnreadMailChange;
property OnSystemMessage: TMsnSysMsgEvent read FOnSystemMessage write FOnSystemMessage;
end;
// ---------------------------------------------------------------------------
TMsnSession = class(TObject)
private
// 僾儘僷僥傿僼傿乕儖僪
FNsmHandle: Cardinal;
FRequestID: Integer;
FSocket: TNsmClientSocket;
FHost: String;
FPort: Integer;
FUser: TMsnUser;
FMembers: TMsnMemberList;
FSignInStage: TSignInStage;
FConnected: Boolean;
FReservedMembers: TStringList;
FReservedMessages: TStringList;
FOnConnect: TNotifyEvent;
FOnDisconnect: TNotifyEvent;
FOnLog: TMsnLogEvent;
FOnError: TMsnErrorEvent;
FOnMemberListChange: TNotifyEvent;
FOnReceiveMessage: TMsnReceiveMessageEvent;
FOnReceiveNAK: TNotifyEvent;
FOnJoinMember: TMsnMemberEvent;
FOnByeMember: TMsnMemberEvent;
// FPingTimer: TTimer;
FTrID: Integer;
FCookie: String;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -