function GetSSOKey(key:PChar;challenge:PChar):PChar;stdcall external 'msnssocprty.dll' name '?GetSSOKey@@YGPADPAD0@Z';
var _MyMSN15Client : TMyMSN15Client; SSOXML : string;
implementation
//---------- //一些通用的函数 type CharSet = Set of char;
function UTF8ToAnsi(x: string): ansistring; var i: integer; b1, b2: byte; begin Result := x; i := 1; while i <= Length(Result) do begin if (ord(Result[i]) and $80) <> 0 then begin b1 := ord(Result[i]); b2 := ord(Result[i + 1]); if (b1 and $F0) <> $C0 then Result[i] := #128 else begin Result[i] := Chr((b1 shl 6) or (b2 and $3F)); Delete(Result, i + 1, 1); end; end; inc(i); end; end;
function AnsiToUtf8(x: ansistring): string; var i: integer; b1, b2: byte; begin Result := x; for i := Length(Result) downto 1 do if Result[i] >= #127 then begin b1 := $C0 or (ord(Result[i]) shr 6); b2 := $80 or (ord(Result[i]) and $3F); Result[i] := chr(b1); Insert(chr(b2), Result, i + 1); end; end;
Function ExtractWord(N:Integer;S:String;WordDelims:CharSet):String; Var I,J:Word; Count:Integer; SLen:Integer; Begin Count := 0; I := 1; Result := ''; SLen := Length(S); While I <= SLen Do Begin While (I <= SLen) And (S[I] In WordDelims) Do Inc(I); If I <= SLen Then Inc(Count); J := I; While (J <= SLen) And Not(S[J] In WordDelims) Do Inc(J); If Count = N Then Begin Result := Copy(S,I,J-I); Exit End; I := J; End; End;
function WordAt(const Text : string; Position : Integer) : string; begin Result := ExtractWord(Position, Text, [' ']); end;
//----------
procedure MSN15Init;stdcall; begin if _MyMSN15Client = nil then _MyMSN15Client := TMyMSN15Client.Create;
procedure TClientThread.Execute; var catalog,SK:String; //协议类别 TMP:String; //获取协议中的内容的临时 ReadLength,ORlen:integer; tmpBuf : array of Byte;
sp,sp1:string; http:IXMLHTTPRequest; XML:TNativeXML; XMLRoot,XMLFind,XMLFir,XMLFind2:TXMLNode; NodeList:TList; NeedCoInitialize : boolean; i:integer; begin while not Terminated do begin if Not IdTCP.Connected then begin Terminate; end; try Protocol := ''; Protocol := IdTCP.ReadLn; except Terminate; end;
catalog := UpperCase(Copy(Protocol,1,3)); if catalog ='' then continue;
if catalog = 'VER' then IdTCP.WriteLn('CVR '+_MyMSN15Client.GetAProtocolNum+' 0x0804 winnt 6.0 i386 MSNMSGR 8.1.0178 msmsgs '+_MyMSN15Client.FUsername);
if catalog = 'CVR' then IdTCP.WriteLn('USR '+_MyMSN15Client.GetAProtocolNum+' SSO I '+_MyMSN15Client.FUsername);
//XFR协议，服务器返回需要登录到NS XFR 3 NS 207.46.110.38:1863 U D if catalog = 'XFR' then begin TMP := WordAt(Protocol, 4); //207.46.110.38:1863 if IdTCP.Connected then IdTCP.Disconnect; _MyMSN15Client.StLogin(Copy(TMP,1,Pos(':',TMP)-1),StrToInt(Copy(TMP,Pos(':',TMP)+1,Length(TMP)))); end;
//USR trid TWN S auth_string //USR 6 SSO S MBI_KEY_OLD H6YRMGfYgZRiJeAs5dF9Vh1DOtgdI2bURt48g3MI6sqgSV7zgOB6kVeC2qun43C/ if catalog = 'USR' then begin TMP := UpperCase(WordAt(Protocol, 3));
NeedCoInitialize := Succeeded(CoInitialize(nil)); http:=CoXMLHTTPREQUEST.Create; XML := TNativeXML.Create; NodeList := TList.Create; try sp := StringReplace(SSOXML,'%USERNAME%',_MyMSN15Client.FUsername,[rfReplaceAll]); sp := StringReplace(sp,'%PASSWORD%',_MyMSN15Client.FPassword,[rfReplaceAll]); sp1:= ''; http.open('POST','https://login.live.com/RST.srf',false, EmptyParam, EmptyParam); http.SetRequestHeader('Content-Type','application/soap+xml'); http.SetRequestHeader('Content-Length', IntToStr(Length(SSOXML))); try http.send(sp); sp1 := http.responseText; if sp1<>'' then begin XML.ReadFromString(sp1); XMLRoot := XML.Root;
NodeList.Clear; XMLRoot.FindNodes('wst:RequestSecurityTokenResponse',NodeList); For i:=0 to NodeList.Count - 1 do begin XMLFir := TXMLNode(NodeList.Items[i]); XMLFind := XMLFir.FindNode('wsa:Address'); if XMLFind = nil then Continue; if LowerCase(XMLFind.ValueAsString) <> 'messengerclear.live.com' then Continue; XMLFind := XMLFir.FindNode('wsse:BinarySecurityToken'); XMLFind2 := XMLFir.FindNode('wst:BinarySecret'); if (XMLFind = nil) or (XMLFind2 = nil) then Continue; _MyMSN15Client.FBinarySecurityToken := XMLFind.ValueAsString; _MyMSN15CLient.FBinarySecret := XMLFind2.ValueAsString; Break; end; end; except end;
finally NodeList.Free; XML.Free; http := nil; if NeedCoInitialize then CoUninitialize; end; if (_MyMSN15Client.FBinarySecurityToken = '') or (_MyMSN15CLient.FBinarySecret = '') then begin _MyMSN15Client.FMsgCallBack('authfailed'); if _MyMSN15Client.FIdTCP.Connected then _MyMSN15Client.FIdTCP.Disconnect; Terminate; end; _MyMSN15Client.FMsgCallBack(PChar('toket='+_MyMSN15Client.FBinarySecurityToken)); _MyMSN15Client.FMsgCallBack(PChar('Nonce='+_MyMSN15Client.FNonce)); SK := GetSSOKey(PChar(_MyMSN15CLient.FBinarySecret),PChar(_MyMSN15Client.FNonce)); IdTCP.WriteLn('USR '+_MyMSN15Client.GetAProtocolNum+' SSO S '+_MyMSN15Client.FBinarySecurityToken + ' ' + SK);
end; end;
if catalog = 'GCF' then begin ReadLength := StrToInt(WordAt(Protocol, 3)); _MyMSN15Client.FGivenPolicy := IdTCP.ReadString(ReadLength); end;
end; end;
end.
----------
调用方法：
1、初始化
procedure ncb(netcode:integer); begin
end;
procedure msgcb(msg:pchar); begin if msg <> nil then frmMain.Memo1.Lines.Add('['+formatDateTime('yyyy-mm-dd hh:mm:ss',Now)+'] ' +msg) end;
