Option Explicit
Dim numIM As Long 'MAX No of IM allowed open
Dim svrMSN ' MSN server ip address
Dim strLstName 'User nick on MSN
Dim strUsrAdd ' User id being added to array of users online
Dim strIMsvrip ' Ip address of IM server to connect to
Dim strCKID ' the CKI id needed to log into the chat IM server
Dim strSid 'ID required to log into chat server
Dim intImNum 'No if IM windows open
Dim strLstNames ' Buddy names
Dim strLstEMid 'Email id of buddies
Dim msgid As Long ' Message no for ineternal refernce
Dim trialid As Long ' Message /Trial id of the message/command being sent
Dim strCKIauth ' CKI authorisation id
Dim intidlst
Dim term As Boolean
Dim strUsrid ' User ID
Dim strImfrnd ' ID of buddy
Dim frmIM(50) As New frmMSNim ' array of IM forms
Dim mpt As Boolean
Dim arrImexists(30) ' array to check if im window already exists
Dim usrnum ' current user id
Dim blnfrmIMexists(50) As Boolean ' to check if the windowexists
Private Sub cmdLogin_Click()
wnsckMSN.Close
wnsckMSN.Connect ' connect to the server
msgid = 0
End Sub
Private Sub Form_load()
trialid = 1
End Sub
Private Sub tvwMSNlist_DblClick()
wnsckMSN.SendData "XFR " & trialid & " SB" & vbCrLf 'send a request to the server to start an im chat conversation
trialid = trialid + 1
For numIM = 1 To 50
If frmIM(numIM).Tag = "" Then
Load frmIM(numIM)
frmIM(numIM).txtIMfrom.Text = tvwMSNlist.SelectedItem.Text '
frmIM(numIM).txtIMto.Text = strUsrid ' setup the im window
frmIM(numIM).cmdClose.Tag = "hotmail" 'with required details
frmIM(numIM).cmdIgnore.Tag = "called" ' and display the im window
frmIM(numIM).cmdSend.Tag = tvwMSNlist.SelectedItem.Key '
frmIM(numIM).Tag = tvwMSNlist.SelectedItem.Text '
frmIM(numIM).Visible = True
Exit Sub
End If
Next numIM
End Sub
Private Sub wnsckMSN_Close()
If mpt = False Then
' MsgBox "You have been Logged out ,Login Again"
mpt = True
tvwMSNlist.Nodes.Clear
txtPassword.Text = ""
End If
End Sub
Private Sub wnsckMSN_Connect()
' start the actual process of logging into the messenger server
wnsckMSN.SendData "VER " & trialid & " MSNP7 MSNP6 MSNP5 MSNP4 CVRO" & vbCrLf ' check versions
trialid = trialid + 1
msgid = 0
mpt = False
End Sub
Private Sub wnsckMSN_DataArrival(ByVal bytesTotal As Long)
'On Error Resume Next
Dim strdata As String
Dim tmpData ' temporary data to be used
Dim tmpData1 ' " " " " "
Dim tmpData2 ' " " " " "
Dim tmpData3 ' " " " " "
Dim tmpData4 ' " " " " "
Dim tmpData5 ' " " " " "
Dim tmpData6 ' " " " " "
Dim tmpnum
If msgid = 0 Then
wnsckMSN.GetData strdata
Debug.Print strdata
tmpData = InStr(strdata, "XFR") ' check if we have to connect to a different switch board server
If tmpData > 0 Then
tmpData1 = InStrRev(strdata, ":")
tmpData2 = Left(strdata, tmpData1 - 1)
End If
wnsckMSN.SendData "INF " & trialid & vbCrLf ' start the loggin in process
Debug.Print "INF " & trialid & vbCrLf
trialid = trialid + 1
msgid = msgid + 1
Exit Sub
End If
If msgid = 1 Then
wnsckMSN.GetData strdata
Debug.Print strdata
tmpData = InStr(strdata, "XFR") ' check if we have to connect to a different switch board server
If tmpData > 0 Then
tmpData1 = InStrRev(strdata, ":")
tmpData2 = Left(strdata, tmpData1 - 1)
End If
wnsckMSN.SendData "USR " & trialid & " MD5 I " & txtUsername.Text & vbCrLf ' ask the server if authentication algorithm is MD%
Debug.Print "USR " & trialid & " MD5 I " & txtUsername.Text & vbCrLf
trialid = trialid + 1
msgid = msgid + 1
Exit Sub
End If
If msgid = 2 Then
msgid = msgid + 1
wnsckMSN.GetData strdata
Debug.Print strdata
tmpData = InStr(strdata, "XFR") ' check if we have to connect to a different switch board server
If tmpData > 0 Then
tmpData1 = InStr(strdata, ":")
tmpData2 = Left(strdata, tmpData1 - 1)
tmpData3 = InStrRev(tmpData2, " ")
svrMSN = Right(tmpData2, Len(tmpData2) - tmpData3)
msgid = 0
wnsckMSN.Close
wnsckMSN.Connect svrMSN, 1863 ' connect to the changed switch board server
Exit Sub
End If
tmpData = InStrRev(strdata, "S")
tmpData1 = Right(strdata, Len(strdata) - tmpData)
tmpData1 = Left(tmpData1, Len(tmpData1) - 2)
tmpData1 = Right(tmpData1, Len(tmpData1) - 1)
wnsckMSN.SendData "USR " & trialid & " MD5 S " & MD5String(tmpData1 & txtPassword.Text) & vbCrLf ' send the password encrypted string
Debug.Print "USR " & trialid & " MD5 S " & MD5String(tmpData1 & txtPassword.Text) & vbCrLf
trialid = trialid + 1
Exit Sub
End If
If msgid = 3 Then
wnsckMSN.GetData strdata
Debug.Print strdata
tmpData = InStrRev(strdata, " 1")
strdata = Left(strdata, tmpData - 1)
strLstName = Left(strdata, tmpData - 1)
tmpData1 = InStrRev(strdata, " ")
strUsrid = Right(strLstName, Len(strLstName) - tmpData1)
tmpData2 = InStr(strUsrid, "%20")
Do While tmpData2 > 0
tmpData = Left(strUsrid, tmpData2 - 1)
tmpData1 = Right(strUsrid, Len(strUsrid) - tmpData2 - 2)
strUsrid = tmpData & " " & tmpData1
tmpData2 = InStr(strUsrid, "%20")
Loop
wnsckMSN.SendData "CHG " & trialid & " NLN" & vbCrLf ' change the user status to online
Debug.Print "CHG " & trialid & " NLN" & vbCrLf
trialid = trialid + 1
msgid = msgid + 1
Exit Sub
End If
If msgid = 4 Then
wnsckMSN.GetData strdata
Debug.Print strdata
msgid = msgid + 1
Exit Sub
End If
If msgid = 5 Then ' this part to check whether any of the buddies in the list are currently online
usrnum = 0
wnsckMSN.GetData strdata
Debug.Print "data at " & strdata
tmpData = InStr(strdata, "NLN")
tmpData1 = Right(strdata, Len(strdata) - tmpData)
tmpData = InStr(tmpData1, "NLN")
tmpData1 = Right(tmpData1, Len(tmpData1) - tmpData)
Do While tmpData > 0
tmpData1 = Right(tmpData4, Len(tmpData4) - tmpData)
tmpData2 = InStr(tmpData1, vbCrLf)
tmpData3 = Left(tmpData1, tmpData2 - 1)
tmpData4 = Right(tmpData1, Len(tmpData1) - tmpData2)
tmpData5 = InStrRev(tmpData3, " ")
strUsrAdd = Right(tmpData3, Len(tmpData3) - tmpData5)
tmpData2 = InStr(strUsrAdd, "%20")
Do While tmpData2 > 0
tmpData1 = Right(strUsrAdd, Len(strUsrAdd) - tmpData2 - 2)
strUsrAdd = tmpData & " " & tmpData1
tmpData2 = InStr(strUsrAdd, "%20")
DoEvents
Loop
arrImexists(usrnum) = strUsrAdd
usrnum = usrnum + 1
tmpData = InStr(tmpData4, "NLN")
DoEvents
Loop
wnsckMSN.SendData "LST " & trialid & " RL" & vbCrLf 'command sent to retrieve the buddy list
intidlst = trialid
trialid = trialid + 1
msgid = msgid + 1
Exit Sub
End If
If msgid = 6 Then
wnsckMSN.GetData strdata
Debug.Print "frm here " & strdata
If InStr(strdata, "NLN") Then ' check if the data is for any user arrival message
tmpData4 = InStrRev(strdata, " ")
strLstName = Right(strdata, Len(strdata) - tmpData4)
strLstName = Left(strLstName, Len(strLstName) - 2)
tmpData2 = InStr(strLstName, "%20")
Do While tmpData2 > 0
tmpData = Left(strLstName, tmpData2 - 1)
tmpData1 = Right(strLstName, Len(strLstName) - tmpData2 - 2)
strLstName = tmpData & " " & tmpData1
tmpData2 = InStr(strLstName, "%20")
Loop
tmpData = tvwMSNlist.Nodes.Count
For tmpData1 = 1 To tmpData
tmpData5 = tvwMSNlist.Nodes.Item(tmpData1).Text
If tmpData5 = strLstName Then
tvwMSNlist.Nodes.Item(tmpData1).Bold = True
End If
Next tmpData1
End If
If (InStr(strdata, "CHL ")) Then
Dim rt
Dim et, pt As String
rt = InStrRev(strdata, "0 ")
et = Right(strdata, Len(strdata) - rt - 1)
et = Left(et, Len(et) - 2)
Dim xt As String
xt = "Q1P7W2E4J9R8U3S5"
pt = et & xt
Debug.Print " pt " & pt
Dim mat As String
mat = MD5String(pt)
Debug.Print mat
wnsckMSN.SendData "QRY " & trialid & " msmsgs@msnmsgr.com 32" & vbCrLf & mat
Debug.Print "QRY " & trialid & " msmsgs@msnmsgr.com 32" & vbCrLf & mat
trialid = trialid + 1
Debug.Print strdata
End If
If InStr(strdata, "FLN") Then ' check if the data is for any user going online message
tmpData4 = InStrRev(strdata, " ")
strLstName = Right(strdata, Len(strdata) - tmpData4)
strLstName = Left(strLstName, Len(strLstName) - 2)
tmpData2 = InStr(strLstName, "%20")
Do While tmpData2 > 0
tmpData = Left(strLstName, tmpData2 - 1)
tmpData1 = Right(strLstName, Len(strLstName) - tmpData2 - 2)
strLstName = tmpData & " " & tmpData1
tmpData2 = InStr(strLstName, "%20")
Loop
tmpData = tvwMSNlist.Nodes.Count
For tmpData1 = 1 To tmpData
tmpData5 = tvwMSNlist.Nodes.Item(tmpData1).Key
If tmpData5 = strLstName Then
tvwMSNlist.Nodes.Item(tmpData1).Bold = False
End If
Next tmpData1
End If
If InStr(strdata, "RNG") Then ' check if the a buddy wants to start an im conversation with the user
tmpData = InStr(strdata, "CKI")
tmpData1 = InStr(strdata, ":")
strIMsvrip = Left(strdata, tmpData1 - 1)
tmpData3 = InStrRev(strIMsvrip, " ")
strIMsvrip = Right(strIMsvrip, Len(strIMsvrip) - tmpData3)
strCKID = Right(strdata, Len(strdata) - tmpData - 3)
tmpData4 = InStr(strCKID, " ")
strCKID = Left(strCKID, tmpData4 - 1)
tmpData5 = InStrRev(strdata, " ")
strImfrnd = Right(strdata, Len(strdata) - tmpData5)
strImfrnd = Left(strImfrnd, Len(strImfrnd) - 2)
tmpData2 = InStr(strImfrnd, "%20")
Do While tmpData2 > 0
tmpData = Left(strImfrnd, tmpData2 - 1)
tmpData1 = Right(strImfrnd, Len(strImfrnd) - tmpData2 - 2)
strImfrnd = tmpData & " " & tmpData1
tmpData2 = InStr(strImfrnd, "%20")
Loop
tmpData1 = Right(strdata, Len(strdata) - 4)
tmpData2 = InStr(tmpData1, " ")
strSid = Left(tmpData1, tmpData2 - 1)
For numIM = 0 To 50
If frmIM(numIM).Tag = strImfrnd Then
blnfrmIMexists(tmpnum) = True
intImNum = tmpnum
GoTo proc1
End If
Next numIM
For numIM = 0 To 50
If frmIM(numIM).Tag = "" Then
blnfrmIMexists(numIM) = False
intImNum = numIM
GoTo proc1
End If
Next numIM
proc1:
If blnfrmIMexists(intImNum) = False Then
Load frmIM(intImNum)
frmIM(intImNum).Tag = strImfrnd
frmIM(intImNum).cmdClose.Tag = "hotmail"
blnfrmIMexists(intImNum) = True
End If
frmIM(intImNum).txtCKIid.Text = strCKID
frmIM(intImNum).txtSid.Text = strSid
'frmIM(intImNum).cmdIgnore.Tag = "called"
frmIM(intImNum).cmdClose.Tag = "hotmail"
frmIM(intImNum).wnsckMSNim.Close
frmIM(intImNum).wnsckMSNim.Connect strIMsvrip, 1863
frmIM(intImNum).Show
frmIM(intImNum).txtIMfrom.Text = strImfrnd
frmIM(intImNum).txtIMto.Text = strUsrid
Exit Sub
End If
If InStr(strdata, "MSG") Then ' check if it's a message from a buddy
tmpData6 = InStr(strdata, "TypingUser")
If tmpData6 = 0 Then
tmpData = InStrRev(strdata, " ")
tmpData1 = Left(strdata, tmpData - 1)
tmpData2 = InStrRev(tmpData1, " ")
tmpData3 = Right(tmpData1, Len(tmpData1) - tmpData2)
tmpData4 = Left(tmpData1, tmpData2 - 1)
For numIM = 0 To 50
If frmIM(numIM).Tag = tmpData3 Then
If frmIM(numIM).Visible = False Then
frmIM(numIM).Visible = True
End If
If frmIM(numIM).Visible = True Then
tmpData5 = InStrRev(strdata, vbCrLf)
tmpData4 = Right(strdata, Len(strdata) - tmpData5 - 1)
frmIM(numIM).Visible = True
frmIM(numIM).rtbIMchat.Text = frmIM(numIM).rtbIMchat.Text & vbCrLf & tmpData4
Exit Sub
End If
End If
Next numIM
End If
End If
If InStr(strdata, "LST " & intidlst) Then ' check if it's a list of all buddies in user's friends list
tmpData6 = InStr(strdata, vbCrLf)
Do While tmpData6 > 0
tmpData4 = Left(strdata, tmpData6 - 2)
tmpData5 = InStrRev(tmpData4, " ")
strLstNames = Right(tmpData4, Len(tmpData4) - tmpData5)
strLstEMid = Left(tmpData4, tmpData5 - 1)
tmpData3 = InStrRev(strLstEMid, " ")
strLstEMid = Right(strLstEMid, Len(strLstEMid) - tmpData3)
tmpData2 = InStr(strLstNames, "%20")
Do While tmpData2 > 0
tmpData = Left(strLstNames, tmpData2 - 1)
tmpData1 = Right(strLstNames, Len(strLstNames) - tmpData2 - 2)
strLstNames = tmpData & " " & tmpData1
tmpData2 = InStr(strLstNames, "%20")
Loop
tvwMSNlist.Nodes.Add , , strLstEMid, strLstNames
tmpData4 = Right(strdata, Len(strdata) - tmpData6)
strdata = tmpData4
tmpData6 = InStr(strdata, vbCrLf)
DoEvents
Loop
For tmpData6 = 0 To usrnum
tmpData = tvwMSNlist.Nodes.Count
For tmpData1 = 1 To tmpData
tmpData5 = tvwMSNlist.Nodes.Item(tmpData1).Text
If tmpData5 = arrImexists(tmpData6) Then
tvwMSNlist.Nodes.Item(tmpData1).Bold = True
End If
Next tmpData1
Next tmpData6
tvwMSNlist.Nodes.Item(2).Expanded = True
ElseIf InStr(strdata, "XFR") Then ' check if user request to start an im conversation with a buddy
tmpData1 = InStr(strdata, ":")
strIMsvrip = Left(strdata, tmpData1 - 1)
tmpData4 = InStrRev(strIMsvrip, " ")
strIMsvrip = Right(strIMsvrip, Len(strIMsvrip) - tmpData4)
tmpData3 = InStrRev(strdata, " ")
tmpData2 = Right(strdata, Len(strdata) - tmpData3)
tmpData2 = Left(tmpData2, Len(tmpData2) - 2)
strCKIauth = tmpData2
For numIM = 0 To 50
If frmIM(numIM).Tag = tvwMSNlist.SelectedItem.Text Then
blnfrmIMexists(numIM) = True
intImNum = numIM
GoTo proc2
End If
Next numIM
proc2:
If blnfrmIMexists(intImNum) = True Then
frmIM(numIM).Visible = True
frmIM(numIM).wnsckMSNim.Close
frmIM(numIM).wnsckMSNim.Connect strIMsvrip, 1863
frmIM(numIM).txtCKIid.Text = strCKIauth
blnfrmIMexists(numIM) = False
End If
End If
End If
End Sub