frmmain.frm

vb中如何进行网络编程的示例,包括:UDP聊天,TCP聊天,UDP,TCP flood攻击等 非常棒

      TabIndex        =   6
      Top             =   3420
      Width           =   1590
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Contact IP address"
      Height          =   195
      Left            =   4995
      TabIndex        =   4
      Top             =   3450
      Width           =   1350
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Contact NickName"
      Height          =   195
      Left            =   255
      TabIndex        =   3
      Top             =   3420
      Width           =   1530
   End
   Begin VB.Menu mnuOnline 
      Caption         =   "online"
      Visible         =   0   'False
      Begin VB.Menu mnuOffline 
         Caption         =   "Offline/Disconnect"
      End
      Begin VB.Menu mnuPriviacy 
         Caption         =   "Privacy (Invisible)"
      End
      Begin VB.Menu mnuDND 
         Caption         =   "DND (Do Not Disturb)"
      End
      Begin VB.Menu mnuOccupied 
         Caption         =   "Occupied (Urgent msgs)"
      End
      Begin VB.Menu mnuNA 
         Caption         =   "N/A (Extended away)"
      End
      Begin VB.Menu mnuAWAY 
         Caption         =   "Away"
      End
      Begin VB.Menu mnuChat 
         Caption         =   "Free For Chat"
      End
      Begin VB.Menu mnuAvailable 
         Caption         =   "Available / Connect"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ItemNumber As Long
Dim SelectedUIN As Long

Private Sub BtnSend_Click()
 On Error Resume Next
   
   Dim cSend As String
   Dim cFrom As String
   
   Dim cData As String
   
   ' Verify datas
   If Not IsNumeric(TextUIN.Text) Then
      MsgBox "The ICQ UIN not Numeric !"
         
      TextUIN.SetFocus
      Exit Sub
   End If
   
   'If CStr(Val(TextUIN.Text)) = "14996057" Then
   '   MsgBox "Please... Don't Test With my UIN"
         
   '   TextUIN.SetFocus
   '   Exit Sub
   'End If
         
   If Trim(TextMessage.Text) = "" Then
      MsgBox "Don't Allow Blank Messages"
         
      TextMessage.SetFocus
      Exit Sub
   End If

   ' Status
   LabelStatus.Caption = "Starting..."
   
   ' Close Socket
   SockPager.Close
      
   ' Change the " " for "+"
   cMail = ChangeSpaces(textPagerFrom.Text)
   cFrom = ChangeSpaces(FromName.Text)
   cSubject = ChangeSpaces(TextSubject.Text)
   cMessage = ChangeSpaces(TextMessage.Text)

   ' Fill the String
   cData = "from=" + cFrom + "&fromemail=" & cMail & "&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

   ' Send Message
   SockPager.Tag = cSend
   SockPager.Connect "wwp.mirabilis.com", 80
End Sub

Private Sub cmdAbout_Click()
frmAbout.Show

End Sub

Private Sub cmdRecent_Click()
PopupMenu mnuRecentFileZ

End Sub

Private Sub cmdURL_Click()
Rtn = SendURL(Val(txtURLUIN.Text), txtURL.Text)

End Sub

Private Sub Command1_Click()
Dim iUIN As Long
iUIN = Val(txtUIN.Text)

Rtn = SendMessage(iUIN, txtMessage.Text)

'Rtn = SendExternal(iUIN, "ICQ Control Center", txtMessage.Text, 1)

'NOTE : Send External is NOT as most people think
'people including myself at one point thought this
'was a method for sending external messages without
'ICQ Interaction, all send external actually does
'is to send an external chat request, if the person
'on the other side has not got this app configured
'as a legitamate external application then this is
'even more pointless.



End Sub

Private Sub Command2_Click()

If Me.Width = 7035 Then
Command2.Caption = "Normal mode <<-"
Me.Width = 10920
Me.Left = Screen.Width / 2 - Me.Width / 2

Else
Command2.Caption = "Advanced mode ->>"

Me.Width = 7035
Me.Left = Screen.Width / 2 - Me.Width / 2

End If


End Sub



Private Sub List2_DblClick()
'Call DisplayUserInfo(SelectedUIN)


End Sub

Private Sub SockPager_Connect()
   On Error Resume Next
   
   ' Status
   LabelStatus.Caption = "Sending..."
  
   SockPager.SendData SockPager.Tag
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)
   ' Status
   LabelStatus.Caption = "Error..."
   
   SockPager.Tag = ""
End Sub

Private Sub SockPager_SendComplete()
   ' Status
   LabelStatus.Caption = "www pager sent..."
      
   SockPager.Tag = ""
End Sub

Private Function ChangeSpaces(cString As String) As String
   On Error Resume Next
  
   ' Variaveis
   Dim cChar As String
   Dim cReturn As String
  
   Dim nLoop As Long
  
   ' Faz a Troca
   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


Private Sub cmdExit_Click()
Unload Me

End Sub

Private Sub cmdStatus_Click()
PopupMenu mnuOnline

End Sub

Private Sub Form_Load()
'(C)


  Me.Width = 7035
  Me.Left = Screen.Width / 2 - Me.Width / 2
  Me.Top = Screen.Height / 2 - Me.Height / 2
  

  sName = "Visual Basic"
  sPassword = "aaaaaaaa"
  sLicense = "E94AD7C14D1DBAE8"
   
  Rtn = SetLicenseKey(sName, sPassword, sLicense)
  Rtn = GetVersion(iCQversion)
  

  Call GetUserList
  Call SendNotify
  
  iCQowner = GetOwnerUin
  iCQownerNick = GetOwnerNickName
  
  txtOwnerNickname.Text = GetOwnerNickName
  txtOwnerUIN.Text = iCQowner
  txtOwnerIP.Text = GetOwnerIP
    

  textPagerFrom.Text = GetOwnerEmail
  
  
  
  Me.Caption = iCQowner & " - [ ICQ Control Center ]"
  
  
  
 X = GetOwnerStatus
   
 If X = BICQAPI_USER_STATE_ONLINE Then cmdStatus.Caption = "Status - ONLINE"
 If X = BICQAPI_USER_STATE_CHAT Then cmdStatus.Caption = "Status - Free For Chat"
 If X = BICQAPI_USER_STATE_AWAY Then cmdStatus.Caption = "Status - Away"
 If X = BICQAPI_USER_STATE_NA Then cmdStatus.Caption = "Status - N/A [Extended Away]"
 If X = BICQAPI_USER_STATE_OCCUPIED Then cmdStatus.Caption = "Status - Occupied [Urgent MSGS]"
 If X = BICQAPI_USER_STATE_DND Then cmdStatus.Caption = "Status - DND [Do Not Disturb]"
 If X = BICQAPI_USER_STATE_INVISIBLE Then cmdStatus.Caption = "Status - Privacy [Invisible]"
 If X = BICQAPI_USER_STATE_OFFLINE Then cmdStatus.Caption = "Status - OFFLINE"

 
 
 
 
End Sub

Private Sub Form_Unload(Cancel As Integer)
Rtn = UnRegisterNotify

End Sub

Private Sub List1_Click()
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
List2.Selected(i) = True
List3.Selected(i) = True

End If
Next i

End Sub

Private Sub List2_Click()
For i = 0 To List2.ListCount - 1
If List2.Selected(i) = True Then
txtUIN.Text = List2.List(i)
TextUIN.Text = List2.List(i)
txtURLUIN.Text = List2.List(i)
SelectedUIN = List2.List(i)

List1.Selected(i) = True
List3.Selected(i) = True
End If
Next i


End Sub

Private Sub List3_Click()
For i = 0 To List3.ListCount - 1
If List3.Selected(i) = True Then
List2.Selected(i) = True
List3.Selected(i) = True
End If
Next i

End Sub

Private Sub mnuAvailable_Click()
X = SetOwnerState(BICQAPI_USER_STATE_ONLINE)


End Sub

Private Sub mnuAWAY_Click()
X = SetOwnerState(BICQAPI_USER_STATE_AWAY)

End Sub

Private Sub mnuChat_Click()
X = SetOwnerState(BICQAPI_USER_STATE_CHAT)

End Sub

Private Sub mnuDND_Click()
X = SetOwnerState(BICQAPI_USER_STATE_DND)

End Sub

Private Sub mnuNA_Click()
X = SetOwnerState(BICQAPI_USER_STATE_NA)

End Sub

Private Sub mnuOccupied_Click()
X = SetOwnerState(BICQAPI_USER_STATE_OCCUPIED)

End Sub

Private Sub mnuOffline_Click()
X = SetOwnerState(BICQAPI_USER_STATE_OFFLINE)

End Sub

Private Sub mnuOnline_Click()
X = SetOwnerState(BICQAPI_USER_STATE_ONLINE)

End Sub

Private Sub mnuPriviacy_Click()
X = SetOwnerState(BICQAPI_USER_STATE_INVISIBLE)

End Sub