Here goes, right out the oven. 
' Compiler: PB 8.04 (Can be tweaked to work also with PBCC)

' Compiler: PB 8.04 (Can be tweaked to work also with PBCC)
Code:
#COMPILE EXE #DIM ALL #INCLUDE "WIN32API.INC" ' This took me lots and lots of time, not because it was hard, ' But because of my lack of knowledge about COM. ' ' Thanx goes to, Paul Franks and David Roberts, MACRO CreateObject(id) = NEW DISPATCH IN id ' ==== Ask the nexus server to wich server should i connect=============== FUNCTION WriteNEXUS() AS STRING LOCAL v1 AS VARIANT, v2 AS VARIANT DIM objXMLHTTP AS DISPATCH 'SET objXMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") '<--- This one is better supported in TrustedWebHost SET objXMLHTTP = CreateObject("Msxml2.xmlhttp.4.0") v1 ="GET " v2 = "https://nexus.passport.com:443/rdr/pprdr.asp" OBJECT CALL objXMLHTTP.open(v1, v2) v1 = "" OBJECT CALL objXMLHTTP.send(v1) OBJECT GET objXMLHTTP.getAllResponseHeaders TO v1 FUNCTION = VARIANT$(v1) SET objXMLHTTP = NOTHING END FUNCTION '============================================================================ '==Send The Autentication Code to the server================================= FUNCTION WriteLOGIN1(LoginURL AS STRING, AuthPolicy AS STRING, EmailAddress AS STRING, Password AS STRING) AS STRING LOCAL v1 AS VARIANT, v2 AS VARIANT DIM objXMLHTTP AS DISPATCH 'SET objXMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") '<--- This one is better supported in TrustedWebHost SET objXMLHTTP = CreateObject("Msxml2.xmlhttp.4.0") v1 ="GET" LoginURL = LCASE$(LoginURL) REPLACE ".com/" WITH ".com:443/" IN LoginURL REPLACE ".net/" WITH ".net:443/" IN LoginURL v2 = "https://" & LoginURL OBJECT CALL objXMLHTTP.open(v1, v2) v1 = "Authorization" v2 = "Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & EmailAddress & ",pwd=" & Password & "," & _ AuthPolicy OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2) v1 = "User-Agent" v2 = "MSMSGS" OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2) v1 = "Host" v2 = PARSE$(LoginUrl, ANY ":/", 1) OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2) v1 = "Connection" v2 = "Keep-Alive" OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2) v1 = "Cache-Control" v2 = "no-cache" OBJECT CALL objXMLHTTP.setRequestHeader(v1, v2) v1 = "" OBJECT CALL objXMLHTTP.send(v1) OBJECT GET objXMLHTTP.getAllResponseHeaders TO v1 FUNCTION = VARIANT$(v1) SET objXMLHTTP = NOTHING END FUNCTION '===================================================================================== '==Send a message to the MSN server and wait for an answer============================ FUNCTION WriteMsnPort(FF AS LONG, TCPLine AS STRING, AsIs AS LONG, SleepTime AS LONG) AS STRING STATIC CurTran AS LONG LOCAL Index AS LONG LOCAL Buffer AS STRING LOCAL Answer AS STRING ERRCLEAR IF INSTR(TCPLine, "%TRN") THEN INCR CurTran REPLACE "%TRN" WITH FORMAT$(CurTran) IN TCPLine END IF IF INSTR(TCPLine, "%TR2") THEN INCR CurTran REPLACE "%TR2" WITH FORMAT$(CurTran) IN TCPLine END IF IF ISTRUE(VARPTR(AsIs)) THEN IF AsIs THEN TCP SEND #FF, TCPLine & $CRLF ELSE GOTO ByParts END IF ELSE ByParts: TcpLine = TcpLine & $CRLF FOR Index = 1 TO PARSECOUNT(Tcpline, $CRLF) IF ISTRUE(LEN(PARSE$(TCPLine, $CRLF, Index))) THEN TCP PRINT #FF, (TRIM$(PARSE$(TCPLine, $CRLF, Index)) & " ") END IF NEXT Index END IF KeepReading: Buffer = SPACE$(2048) TCP RECV #FF, 2048, Buffer Answer = (Answer & Buffer) IF ISFALSE(EOF(FF)) THEN SLEEP SleepTime GOTO KeepReading END IF ReceiveDone: FUNCTION = Answer END FUNCTION '===================================================================================== FUNCTION GetMoreText(FF AS LONG) AS STRING LOCAL Buffer AS STRING LOCAL Answer AS STRING KeepReading: TCP LINE #FF, Buffer Answer = Answer & Buffer & $CRLF IF ISFALSE(EOF(FF)) THEN GOTO KeepReading FUNCTION = TRIM$(Answer, ANY $CRLF) END FUNCTION '===================================================================================== '==Replace character codes with apropriate character (Needs to be added more chars)=== FUNCTION FixFormatting(MyString AS STRING) AS STRING LOCAL targetstring AS STRING TargetString = MyString REPLACE "%20" WITH " " IN TargetString FUNCTION = TargetString END FUNCTION '===================================================================================== '==Easy-To-Call Function to retrieve the contact list================================= FUNCTION RetrieveContactList(EmailAddress AS STRING, Password AS STRING, List() AS STRING) AS LONG LOCAL Hserver1 AS LONG LOCAL HServer2 AS LONG LOCAL FF1 AS LONG LOCAL FF2 AS LONG LOCAL NextServer AS STRING LOCAL Result AS STRING LOCAL XML AS STRING LOCAL AuthPolicy AS STRING LOCAL Policy AS STRING LOCAL Pos1 AS LONG LOCAL Pos2 AS LONG LOCAL Index AS LONG LOCAL Index1 AS LONG LOCAL Index2 AS LONG LOCAL Index3 AS LONG IF ISFALSE(LEN(Password)) THEN MSGBOX "Please edit the code to include your account and password.",,"Please enter required data." EXIT FUNCTION END IF CLOSE FF1 = FREEFILE ERRCLEAR TCP OPEN PORT 1863 AT "207.46.96.153" AS #FF1 ' First Part, ask the main server wich server should we connect to. Result = WriteMsnPort(FF1, "VER %TRN MSNP8 CVR0", 0, 100) Result = WriteMsnPort(FF1, "CVR %TRN 0x0409 win 4.10 i386 MSNMSGR 6.2.0137 MSMSGS " & EmailAddress, 0, 100) NextServer = WriteMsnPort(FF1, "USR %TRN TWN I " & EmailAddress, 0, 100) TCP CLOSE #FF1 NextServer = PARSE$(NextServer, " ", 4) ' Part 2, Ask the second server wich server has our information, and as for an autentication code. ERRCLEAR FF1 = FREEFILE TCP OPEN PORT VAL(PARSE$(NextServer, ":", 2)) AT PARSE$(NextServer, ":", 1) AS #FF1 Result = WriteMsnPort(FF1, "VER %TRN MSNP8 CVR0", 0, 100) Result = WriteMsnPort(FF1, "CVR %TRN 0x0409 win 4.10 i386 MSNMSGR 6.2.0137 MSMSGS " & EmailAddress, 0, 100) AuthPolicy = WriteMsnPort(FF1, "USR %TRN TWN I " & EmailAddress, 0, 100) AuthPolicy = PARSE$(AuthPolicy, " ", 5) ' Now that we have the autentication code, lets atenticate our log in. Result = WriteNEXUS() LOCAL TextLine AS STRING LOCAL TextMember AS STRING FOR Index1 = 1 TO PARSECOUNT(Result, $CRLF) TextLine = PARSE$(Result, $CRLF, Index1) IF UCASE$(TRIM$(PARSE$(TextLine, ":", 1))) = UCASE$("PassportURLs") THEN TextLine = TRIM$(PARSE$(TextLine, " ", 2)) FOR Index2 = 1 TO PARSECOUNT(Result, ",") TextMember = TRIM$(PARSE$(TextLine, ",", Index2)) IF UCASE$(TRIM$(PARSE$(TextMember, "=", 1))) = UCASE$("DALogin") THEN TextMember = TRIM$(PARSE$(TextMember, "=", 2)) GOTO GotServer END IF NEXT Index2 END IF NEXT Index1 GotServer: ' The Nexus server replies with another autentication code, wich we now send to the first server. Result = WriteLOGIN1(TextMember, AuthPolicy, EmailAddress, Password) ' We check if we succeeded or failed. IF INSTR(UCASE$(Result), UCASE$("status=failed")) THEN FUNCTION = 0 : TCP CLOSE #FF1 : EXIT FUNCTION IF ISFALSE(INSTR(UCASE$(Result), UCASE$("='t="))) THEN FUNCTION = 0 : TCP CLOSE #FF1 : EXIT FUNCTION ' We succeded, now the last part is to send the last autentication code to the first server. FOR Index1 = 1 TO PARSECOUNT(Result, $CRLF) TextLine = PARSE$(Result, $CRLF, Index1) IF UCASE$(TRIM$(PARSE$(TextLine, ":", 1))) = UCASE$("Authentication-Info") THEN Pos1 = (INSTR(TextLine, "='t=") + 1) TextLine = RIGHT$(TextLine, LEN(TextLine)-Pos1) TextLine = TRIM$(PARSE$(TextLine, "'", 1)) GOTO GotAuth END IF NEXT Index1 GotAuth: 'We send the autentication code!! Result = WriteMsnPort(FF1, "USR %TRN TWN S " & TextLine, 0, 200) ' We ask for the contact list... Result = WriteMsnPort(FF1, "SYN %TRN 0", 0, 200) ' We wait a bit so more info comes. SLEEP 2000 ' And we pick our list of contacts! Result = GetMoreText(FF1) ' Finally we parse it into a tidy array LOCAL Contact AS LONG LOCAL ThisContact AS STRING Contact = 1 FOR Index = 1 TO PARSECOUNT(Result, $CRLF) ThisContact = TRIM$(PARSE$(Result, $CRLF, Index)) IF UCASE$(PARSE$(ThisContact, " ", 1)) = "LST" THEN List(Contact) = PARSE$(ThisContact, " ", 2) '& FixFormatting(TRIM$(PARSE$(ThisContact, " ", 3))) ' Un REM This if you also want the nicknames. INCR Contact REDIM PRESERVE List(1 TO Contact) END IF NEXT Index IF Contact > 1 THEN REDIM PRESERVE List(1 TO (Contact-1)) FUNCTION = 1 TCP CLOSE #FF1 TCP CLOSE #FF2 END FUNCTION '================================================================= FUNCTION PBMAIN () AS LONG LOCAL Result AS LONG LOCAL EmailAddress AS STRING LOCAL Password AS STRING DIM List(1 TO 1) AS LOCAL STRING EmailAddress = "[email protected]" Password = "" '<- Your Password Here. Result = RetrieveContactList(EmailAddress, Password, List()) IF Result THEN LOCAL Index AS LONG LOCAL COntacts AS STRING FOR Index = LBOUND(List()) TO UBOUND(List()) Contacts = Contacts & List(Index) & $CRLF NEXT Index MSGBOX Contacts,,"SUCCESS!!" ELSE MSGBOX "The function failed due to unknown error." & $CRLF & _ "Verify the address and Password, also remember" & $CRLF & _ "that server some times rejects requests.",,"FAILURE!!" END IF END FUNCTION