[VB] VB6.0聊天室范例

这是大二时期的作业

是用VB6.0开发的一个聊天室的范例

 

VERSION 5.00 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" Begin VB.Form frmChat BorderStyle = 1 '單線固定 Caption = "雙人聊天室" ClientHeight = 4485 ClientLeft = 45 ClientTop = 330 ClientWidth = 5265 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4485 ScaleWidth = 5265 StartUpPosition = 3 '系統預設值 Begin VB.TextBox txtNick Height = 375 Left = 1080 TabIndex = 10 Text = "Guest" Top = 2880 Width = 2535 End Begin VB.CommandButton cmdClear Caption = "清除訊息" Height = 375 Left = 3840 TabIndex = 7 Top = 3960 Width = 1215 End Begin VB.CommandButton cmdCancel Caption = "取消" Height = 375 Left = 2520 TabIndex = 6 Top = 3960 Width = 1095 End Begin VB.CommandButton cmdConnect Caption = "連線" Height = 375 Left = 120 TabIndex = 5 Top = 3960 Width = 1095 End Begin VB.TextBox txtMsg Height = 375 Left = 120 TabIndex = 4 Top = 3360 Width = 3495 End Begin VB.CommandButton cmdListen Caption = "等待連線" Height = 375 Left = 1320 TabIndex = 3 Top = 3960 Width = 1095 End Begin VB.CommandButton cmdSend Caption = "送出訊息" Height = 375 Left = 3840 TabIndex = 2 Top = 3360 Width = 1215 End Begin MSWinsockLib.Winsock wsockChat Left = 0 Top = 3960 _ExtentX = 741 _ExtentY = 741 _Version = 393216 RemotePort = 2000 LocalPort = 2000 End Begin VB.ListBox lstShow DragMode = 1 '自動 Height = 2220 ItemData = "frmChat.frx":0000 Left = 120 List = "frmChat.frx":0002 TabIndex = 0 TabStop = 0 'False Top = 480 Width = 5055 End Begin VB.Label Label3 Caption = "暱稱：" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 255 Left = 120 TabIndex = 9 Top = 2880 Width = 855 End Begin VB.Label Label2 Height = 255 Left = 2520 TabIndex = 8 Top = 120 Width = 2055 End Begin VB.Label Label1 Caption = "訊息：" Height = 255 Left = 120 TabIndex = 1 Top = 120 Width = 855 End End Attribute VB_Name = "frmChat" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim strIP As String '宣告String儲存欲連結ip Private Sub cmdCancel_Click() '設定按鈕 cmdConnect.Enabled = True cmdListen.Enabled = True cmdCancel.Enabled = False End Sub Private Sub cmdClear_Click() txtMsg.Text = "" '清除Text txtMsg.SetFocus '讓游標回到Text End Sub Private Sub cmdConnect_Click() '設定按鈕 cmdConnect.Enabled = False cmdListen.Enabled = False cmdSend.Enabled = True cmdCancel.Enabled = True txtMsg.SetFocus '設定Client端socket lstShow.AddItem "連線中" strIP = InputBox("請輸入IP", "Connect") wsockChat.RemoteHost = strIP '設定遠端IP wsockChat.RemotePort = 690 '連結端Port wsockChat.Connect '連線 End Sub Private Sub cmdListen_Click() '設定按鈕是否可見 cmdConnect.Enabled = False cmdListen.Enabled = False cmdSend.Enabled = True cmdCancel.Enabled = True txtMsg.SetFocus lstShow.AddItem "等待對方連線中" '設定Server端socket wsockChat.LocalPort = 690 'LocalPort wsockChat.Bind If wsockChat.State <> skConnected Then wsockChat.Listen End If End Sub Private Sub cmdSend_Click() txtMsg.SetFocus wsockChat.SendData txtNick.Text + " ： " + txtMsg.Text '送出資料 lstShow.AddItem txtNick.Text + " ： " + txtMsg.Text txtMsg.Text = "" End Sub Private Sub Form_Activate() cmdSend.Enabled = False '送出訊息的按鈕為不可見 cmdCancel.Enabled = False '取消按鈕為不可見 Label2.Caption = "本機IP：" + wsockChat.LocalIP '秀出本機IP End Sub Private Sub Form_Load() wsockChat.Protocol = sckTCPProtocol 'TCP連線 '因為port相同才可連線 End Sub Private Sub Form_Unload(Cancel As Integer) '關閉socket wsockChat.SendData "對方已離線" If wsockChat <> skClossd Then wsockChat.Close End If End Sub Private Sub txtMsg_KeyPress(KeyAscii As Integer) If KetAscii = vbKeyReturn Then cmdSend_Click KetAscii = 0 End If End Sub Private Sub wsockChat_Connect() cmdCancel.Enabled = False lstShow.AddItem "已連線成功" End Sub Private Sub wsockChat_ConnectionRequest(ByVal requestID As Long) If wsockChat.State <> sckClosed Then wsockChat.Close cmdCancel.Enabled = False lstShow.AddItem "已建立連線" wsockChat.Accept requestID End Sub Private Sub wsockChat_DataArrival(ByVal bytesTotal As Long) Dim strData As String wsockChat.GetData strData lstShow.AddItem strData End Sub

 

下载执行档及代码