动力通讯工作组

动力通信工作组致力于网络通信的开发工作,进行tcpip网络编程,采用unix平台socket系列函数, windows平台 vc++6.0 MFC ,采用ASyncSocket对象。目前有telnet,irc,msn, SocketProxy 等产品程序。

  IT博客 :: 首页 :: 新随笔 :: 联系 :: 聚合  :: 管理 ::
  14 随笔 :: 14 文章 :: 111 评论 :: 0 Trackbacks

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

 

 

posted on 2005-08-03 10:12 动力通讯工作组 阅读(722) 评论(0)  编辑 收藏 引用
只有注册用户登录后才能发表评论。