udpchat.frm

用VC++编写的源码

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form2 
   Caption         =   "UDP Chat Program"
   ClientHeight    =   4860
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6585
   Icon            =   "UDPChat.frx":0000
   LinkTopic       =   "Form2"
   MDIChild        =   -1  'True
   ScaleHeight     =   4860
   ScaleWidth      =   6585
   WindowState     =   2  'Maximized
   Begin VB.TextBox txtSend 
      Enabled         =   0   'False
      Height          =   375
      Left            =   0
      TabIndex        =   6
      Top             =   1560
      Width           =   5655
   End
   Begin VB.TextBox txtNick 
      Height          =   285
      Left            =   1080
      TabIndex        =   3
      Top             =   840
      Width           =   2775
   End
   Begin VB.TextBox txtRemoteP 
      Height          =   285
      Left            =   1080
      TabIndex        =   2
      Top             =   600
      Width           =   2775
   End
   Begin VB.CommandButton cmdDisc 
      Caption         =   "Disconnect"
      Enabled         =   0   'False
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4080
      TabIndex        =   5
      Top             =   600
      Width           =   1815
   End
   Begin VB.TextBox txtMain 
      Enabled         =   0   'False
      Height          =   2895
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   9
      Top             =   1920
      Width           =   5655
   End
   Begin MSWinsockLib.Winsock sckSend 
      Left            =   6000
      Top             =   600
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      Protocol        =   1
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "Send"
      Height          =   255
      Left            =   5760
      TabIndex        =   7
      Top             =   1560
      Width           =   615
   End
   Begin VB.CommandButton cmdC 
      Caption         =   "Connect"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4080
      TabIndex        =   4
      Top             =   120
      Width           =   1815
   End
   Begin VB.TextBox txtLocalP 
      Height          =   285
      Left            =   1080
      TabIndex        =   1
      Top             =   360
      Width           =   2775
   End
   Begin VB.TextBox txtHost 
      Height          =   285
      Left            =   1080
      TabIndex        =   0
      Top             =   120
      Width           =   2775
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "Nick Name"
      Height          =   195
      Left            =   120
      TabIndex        =   12
      Top             =   870
      Width           =   795
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "Remote Port"
      Height          =   195
      Left            =   120
      TabIndex        =   11
      Top             =   615
      Width           =   885
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Local Port"
      Height          =   195
      Left            =   120
      TabIndex        =   10
      Top             =   375
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Host"
      Height          =   210
      Left            =   120
      TabIndex        =   8
      Top             =   120
      Width           =   330
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim buffer() As Byte
Dim lBytes As Long
Private Sub cmdC_Click()
On Error GoTo Win_Error
    If Len(txtNick) < 1 Then 'make sure there is a nickname entered
        MsgBox "You must enter a nickname first!"
        txtNick.SetFocus 'put the cursor in the nickname textbox
        Exit Sub
    End If
    
    If Len(txtHost) < 1 Or Len(txtLocalP) < 1 Or Len(txtRemoteP) < 1 Then
        MsgBox "Please make sure a Host, a Local Port, and a Remote Port have been entered!"
        Exit Sub
    End If
    If Len(txtHost) < 1 Or Len(txtLocalP) < 1 Or Len(txtRemoteP) < 1 Then
        MsgBox "Please make sure a Host, a Local Port, and a Remote Port have been entered!"
        Exit Sub
    End If
    txtMain.Text = txtMain.Text & "Connecting..." & vbCrLf
    sckSend.RemoteHost = txtHost 'set the host
    sckSend.LocalPort = txtLocalP.Text 'set the local port
    sckSend.RemotePort = txtRemoteP.Text 'set the remote port
    sckSend.Connect  'Connect

    If sckSend.State = sckError Then
        MsgBox "An error has occured connecting"
        End

    ElseIf sckSend.State = 1 Then
        txtMain.Text = txtMain.Text & "Connected to IP: " & sckSend.RemoteHost & vbCrLf & vbCrLf
        'txtMain.Text = txtMain.Text & "Waiting for Network Computer to connect" & vbCrLf
        sckSend.SendData "Network Computer also connected" & vbCrLf
        MDIForm1.Icon = LoadPicture(App.Path & "\face01.ico")
        MDIForm1.IconTray1.Icon = MDIForm1.Icon
        MDIForm1.IconTray1.Update
    End If
    txtMain.Enabled = True
    txtSend.Enabled = True
    txtLocalP.Enabled = False
    txtRemoteP.Enabled = False
    cmdSend.Enabled = True 'Enable the send button
    txtNick.Enabled = False 'Make it so you can't change your nickname
    txtSend.SetFocus 'you have been connected. put the cursor in the send textbox
    cmdC.Enabled = False
    cmdDisc.Enabled = True
Exit Sub

Win_Error:
txtMain.Text = ""
MsgBox "There was an error connecting" & vbCrLf & "Please Read the README document to see what may be the cause"
Unload Me
End Sub

Private Sub cmdDisc_Click()
Unload Me
'If sckSend.State = sckConnected Then
''    sckSend.SendData "Connection Closed"
'    sckSend.Close
'    Unload Me
'End If
End Sub

Private Sub cmdSend_Click()
    On Error Resume Next
    MDIForm1.Icon = LoadPicture(App.Path & "\face01.ico")
    MDIForm1.IconTray1.Icon = MDIForm1.Icon
    sckSend.SendData txtNick.Text & ": " & txtSend.Text & Chr$(13) & Chr$(10) 'Send whatever is wrtten in txtSend to the other person's chatroom.
    txtSend.SetFocus
    txtMain.Text = txtMain.Text & txtNick.Text & ": " & txtSend.Text & Chr$(13) & Chr$(10) 'Put it in your chatroom
    txtMain.SelStart = Len(txtMain) 'scroll that chatroom down
    txtSend.Text = "" 'clear the send textbox
End Sub


Private Sub Form_Load()
    ChDir App.Path
    sckSend.Protocol = sckUDPProtocol 'set protocol. For this Type of chat, we are using UDP
    cmdSend.Enabled = False
End Sub

Private Sub Form_Resize()
'On Error Resume Next
txtSend.Width = MDIForm1.ActiveForm.ScaleWidth - 1000
txtMain.Width = MDIForm1.ActiveForm.ScaleWidth
txtMain.Height = MDIForm1.ActiveForm.ScaleHeight - 1900
cmdSend.Left = MDIForm1.ActiveForm.ScaleWidth - 900
End Sub

Private Sub Form_Unload(Cancel As Integer)
If sckSend.State = sckOpen Then
    sckSend.SendData "Connection Closed"
    sckSend.Close
    Unload Me
Else
    Unload Me
End If
End Sub

Private Sub icontray1_LeftDblClick()
MDIForm1.Visible = True
MDIForm1.Icon = LoadPicture(App.Path & "\face01.ico")
MDIForm1.IconTray1.Icon = MDIForm1.Icon
MDIForm1.IconTray1.Update
End Sub

Private Sub icontray1_RightClick()
PopupMenu MDIForm1.mnuOptions
End Sub

Private Sub sckSend_DataArrival(ByVal bytesTotal As Long)
    'We have received data!
    Dim TheData As String
    On Error GoTo ClearChat
    MDIForm1.Icon = LoadPicture(App.Path & "\exclem.ico")
    MDIForm1.IconTray1.Icon = MDIForm1.Icon
    MDIForm1.IconTray1.Update
    PlaySound App.Path & "\message.wav"
    sckSend.GetData TheData, vbString 'extract the data
    txtMain.Text = txtMain.Text & TheData 'add the data to our chatroom
    txtMain.SelStart = Len(txtMain) 'scroll that chatroom down
    Exit Sub
ClearChat:
    MsgBox "Chat room ran out of memory and must be cleared!"
    txtMain.Text = ""

End Sub

Private Sub sckSend_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)
    If Number = 10048 Then
    MsgBox "An Error occurred in winsock!"
    End
    End If
End Sub

Private Sub txtSend_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
    MDIForm1.Icon = LoadPicture(App.Path & "\face01.ico")
    MDIForm1.IconTray1.Icon = MDIForm1.Icon
    MDIForm1.IconTray1.Update
    sckSend.SendData txtNick.Text & ": " & txtSend.Text & Chr$(13) & Chr$(10) 'Send whatever is wrtten in txtSend to the other person's chatroom.
    txtMain.Text = txtMain.Text & txtNick.Text & ": " & txtSend.Text & Chr$(13) & Chr$(10) 'Put it in your chatroom
    txtMain.SelStart = Len(txtMain) 'scroll that chatroom down
    txtSend.Text = "" 'clear the send textbox
End If

End Sub

Private Sub Text1_Change()

End Sub

Private Sub txtSend_KeyPress(KeyAscii As Integer)
    MDIForm1.Icon = LoadPicture(App.Path & "\face01.ico")
    MDIForm1.IconTray1.Icon = MDIForm1.Icon
    MDIForm1.IconTray1.Update
End Sub

Private Sub txtSend_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    MDIForm1.Icon = LoadPicture(App.Path & "\face01.ico")
    MDIForm1.IconTray1.Icon = MDIForm1.Icon
    MDIForm1.IconTray1.Update
End Sub