动力通讯工作组

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

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

Option Explicit
Dim tmpData
Dim tmpData1
Dim tmpData2
Dim tmpData3
Dim strMSGrcvd ' message received
 
Dim imtrialid ' trial id of the message
Dim blnconnected As Boolean ' check if connected to m server
Private Sub cmdSend_Click()
If cmdClose.Tag = "hotmail" Then
        Dim strbldmsg As String
        Dim strmessage As String
        strbldmsg = "MIME-Version: 1.0" & vbCrLf & "Content-Type: text/plain; charset=UTF-8" & vbCrLf & "X-MMS-IM-Format: FN=MS%20Shell%20Dlg; EF=; CO=0; CS=0; PF=0" & vbCrLf & vbCrLf & rtbIMsend.Text  ' build the message string
        strmessage = "MSG " & imtrialid & " N " & Len(strbldmsg) & vbCrLf & strbldmsg  ' send message to buddy
        imtrialid = imtrialid + 1
        wnsckMSNim.SendData strmessage
        rtbIMchat.Text = rtbIMchat.Text & vbCrLf & txtIMto.Text & " : " & rtbIMsend.Text  ' add message to the chat window
        rtbIMsend.Text = ""
        rtbIMchat.SelStart = Len(rtbIMchat)
End If
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

 

Private Sub Form_load()
If blnconnected = False Then
                If cmdClose.Tag = "hotmail" Then
                        cmdIgnore.Visible = False
                        cmdSend.Enabled = False
                End If
        blnconnected = True
End If
imtrialid = 1
End Sub

 

Private Sub wnsckMSNim_Close()
Unload Me
End Sub

Private Sub wnsckMSNim_Connect()

StatusBar1.Panels(1).Text = "INITIALIZING CONTACT" ' start connecting to im server
If cmdClose.Tag = "hotmail" Then
                If cmdIgnore.Tag = "called" Then  ' check if user started im conversation or buddy
                        wnsckMSNim.SendData "USR " & imtrialid & " " & frmMSN.txtUsername.Text & " " & txtCKIid.Text & vbCrLf
                        imtrialid = imtrialid + 1
                        Exit Sub
                End If
        wnsckMSNim.SendData "ANS " & imtrialid & " " & frmMSN.txtUsername.Text & " " & txtCKIid.Text & " " & txtSid.Text & vbCrLf ' reply to a im chat request
        imtrialid = imtrialid + 1
End If
End Sub

Private Sub wnsckMSNim_DataArrival(ByVal bytesTotal As Long)
Dim blnTYp ' check if message is user typing a message
If cmdClose.Tag = "hotmail" Then
        Dim strIMData As String
        wnsckMSNim.GetData strIMData
                If InStr(strIMData, "JOI") Then  ' check if buddy has joined im chat
                        cmdSend.Enabled = True
                        StatusBar1.Panels(1).Text = " Contacted "
                End If
                If InStr(strIMData, "USR") Then
                        wnsckMSNim.SendData "CAL " & imtrialid & " " & cmdSend.Tag & vbCrLf  ' call the buddy to an im chat room
                        imtrialid = imtrialid + 1
                        cmdIgnore.Tag = ""
                End If
        Debug.Print "im " & strIMData
                If InStr(strIMData, "MSG") Then ' check if buddy sent a message
                        tmpData = InStr(strIMData, "text/plain")
                    If InStr(strIMData, "text/x-msmsgsinvite") Then
                    'file transfer
                   
                    End If
                   
                   
                        If tmpData = 0 Then StatusBar1.Panels(1).Text = txtIMfrom.Text & " is typing a message"
                If tmpData > 0 Then
                        StatusBar1.Panels(1).Text = ""
                                Do While InStr(strIMData, vbCrLf & vbCrLf)
                                        tmpData1 = InStr(strIMData, vbCrLf & vbCrLf)
                                        strMSGrcvd = Right(strIMData, Len(strIMData) - tmpData1 - 3)
                                                If InStr(strMSGrcvd, "MSG") Then
                                                                If InStr(strMSGrcvd, "MIME-") Then
                                                                        tmpData1 = InStr(strMSGrcvd, vbCrLf & vbCrLf)
                                                                        strMSGrcvd = Right(strMSGrcvd, Len(strMSGrcvd) - tmpData1 - 3)
                                                                 End If
                                                End If
                                                If InStr(strMSGrcvd, "TypingUser") Then
                                                        tmpData3 = InStr(strMSGrcvd, "MSG")
                                                        strMSGrcvd = Left(strMSGrcvd, tmpData3 - 1)
                                                                If strMSGrcvd <> vbCrLf And strMSGrcvd <> "" Then
                                                                        tmpData2 = InStr(strMSGrcvd, "MIME-")
                                                                        If tmpData2 = 0 Then rtbIMchat.Text = rtbIMchat.Text & vbCrLf & txtIMfrom.Text & " : " & strMSGrcvd  ' add message sent by the buddy to chat window
                                                                        rtbIMchat.SelStart = Len(rtbIMchat.Text)
                                                                        blnTYp = True
                                                                End If
                                                End If
                                        strIMData = Right(strIMData, Len(strIMData) - tmpData1 - 1)
                                                If blnTYp = False Then
                                                        If strMSGrcvd <> vbCrLf And strMSGrcvd <> "" Then
                                                        tmpData2 = InStr(strMSGrcvd, "MIME-")
                                                        If tmpData2 = 0 Then rtbIMchat.Text = rtbIMchat.Text & vbCrLf & txtIMfrom.Text & " : " & strMSGrcvd
                                                                rtbIMchat.SelStart = Len(rtbIMchat.Text)
                                                                blnTYp = True
                                                        End If
                                                End If
                                Loop
                End If
        End If
End If
End Sub

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