[原创]给ICQ发送信息的程序

文章作者：小珂[EST]
信息来源：邪恶八进制（www.EvilOctal.com）
文章版权：黑客基地 版权所有

这个程序将介绍在VB+Winsock网络编程中如何实现给指定的ICQ用户发送信息
用Winsock控件连接到指定的ICQ服务器，然后按照规定格式组成发送的信息，
最后使用Winsock控件发送信息。
first,按照惯例，创建窗体





其中Winsock控件的协议选择TCP协议。

单击“发送”按扭将开始发送的过程，代码如下：
（以下代码在winxp+vb6.0下通过）
Dim cMessage As String
Dim cSubject As String
Private Sub BtnSend_Click()
  On Error Resume Next '发生错误时跳转
  
  Dim cSend As String
  Dim cData As String
  If Not IsNumeric(TextUIN.Text) Then '验证号码是否为数字
    MsgBox "ICQ 号码不是数字!", "Error:"
    TextUIN.SetFocus
    Exit Sub
  End If
        
  If Trim(TextMessage.Text) = "" Then '判断内容是否为空
    MsgBox "请输入内容!", "Error:"
    TextMessage.SetFocus
    Exit Sub
  End If

  LabelStatus.Caption = "连接中……" '显示状态
  SockPager.Close '首先关闭Socket,然后开始连接
  cSubject = ChangeSpaces(TextSubject.Text)
  cMessage = ChangeSpaces(TextMessage.Text)
  cData = "from=anonymous&fromemail=mail@from.com&subject=" & cSubject & "&body=" & cMessage & "&to=" & Trim(TextUIN.Text) & "&Send=" & """" '组成信息的格式，信息的来源及内容
  cSend = "POST /scripts/WWPMsg.dll HTTP/1.0" & vbCrLf '发送方式
  cSend = cSend & "Referer: http://wwp.mirabilis.com" & vbCrLf
  cSend = cSend & "User-Agent: Mozilla/4.06 (Win95; I)" & vbCrLf '版本信息
  cSend = cSend & "Connection: Keep-Alive" & vbCrLf '连接方式
  cSend = cSend & "Host: wwp.mirabilis.com:80" & vbCrLf '服务器名称及其端口
  cSend = cSend & "Content-type: application/x-www-form-urlencoded" & vbCrLf '信息类型
  cSend = cSend & "Content-length: " & Len(cData) & vbCrLf '信息长度
  cSend = cSend & "Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*" & vbCrLf & vbCrLf
  cSend = cSend & cData & vbCrLf & vbCrLf & vbCrLf & vbCrLf
  ' 发送信息
  SockPager.Tag = cSend '保存发送信息
  SockPager.Connect "wwp.mirabilis.com", 80 '连接到指定服务器的端口
End Sub
Private Sub SockPager_Connect() '连接事件
  On Error Resume Next
  LabelStatus.Caption = "发送种..." '状态信息
  SockPager.SendData SockPager.Tag '发送信息
End Sub



其他部分的代码

Private Sub BtnExit_Click()
  End
End Sub
Private Sub Form_Load()
  On Error Resume Next

  '关闭
  SockPager.Close
End Sub

Private Sub Form_Unload(Cancel As Integer)
  On Error Resume Next

  '关闭
  SockPager.Close
  
  ' 退出
  End
End Sub
Private Sub SockPager_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
  ' 状况
  LabelStatus.Caption = "Error..."
  
  SockPager.Tag = ""
End Sub

Private Sub SockPager_SendComplete()
  ' 状况
  LabelStatus.Caption = "Complete!"
  
  SockPager.Tag = ""
End Sub

Private Function ChangeSpaces(cString As String) As String
  On Error Resume Next
  
  Dim cChar As String
  Dim cReturn As String
  
  Dim nLoop As Long
  
  
  cReturn = ""
  
  For nLoop = 1 To Len(cString)
     cChar = Mid(cString, nLoop, 1)
   
     If cChar = " " Then
       cChar = "+"
     End If
   
     cReturn = cReturn + cChar
  Next
  
  ChangeSpaces = cReturn
End Function
这下大功告成了，对了，上次在ICQ里骂我的那个家伙是谁来着？？
TTTT!!SHIT!!填上他的ICQ号码，然后·！#￥%……—(拜托老兄能饶人处
且饶人哦），不过这个东东拿来追MM确实不错~~（别说我没提醒你！~）
睡觉了，老惯例，觉得不爽就跟帖子：）