|
論壇說明 | 標記討論區已讀 |
歡迎您來到『史萊姆論壇』 ^___^ 您目前正以訪客的身份瀏覽本論壇,訪客所擁有的權限將受到限制,您可以瀏覽本論壇大部份的版區與文章,但您將無法參與任何討論或是使用私人訊息與其他會員交流。若您希望擁有完整的使用權限,請註冊成為我們的一份子,註冊的程序十分簡單、快速,而且最重要的是--註冊是完全免費的! 請點擊這裡:『註冊成為我們的一份子!』 |
|
主題工具 | 顯示模式 |
2005-06-27, 08:02 AM | #1 |
版區管理員
|
以VB實做一對一聊天室
本程式轉貼自Visual Basic遊戲設計實務 位元文化 編著
若單機作業可將IP設成127.0.0.1 Chat.frm內容 語法:
VERSION 5.00 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" Begin VB.Form frmChat BackColor = &H00C0C0C0& BorderStyle = 1 '單線固定 Caption = "一對一聊天室" ClientHeight = 4770 ClientLeft = 45 ClientTop = 330 ClientWidth = 7185 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4770 ScaleWidth = 7185 StartUpPosition = 3 '系統預設值 Begin VB.CommandButton cmdClear Caption = "清除" Height = 375 Left = 6240 TabIndex = 4 Top = 3600 Width = 735 End Begin VB.CommandButton cmdSend Caption = "送出" Height = 375 Left = 6240 TabIndex = 2 Top = 4080 Width = 735 End Begin VB.TextBox txtMsg BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 360 TabIndex = 1 Top = 4080 Width = 5655 End Begin VB.ListBox lstMsg BeginProperty Font Name = "新細明體" Size = 9.75 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 2985 Left = 360 TabIndex = 0 Top = 240 Width = 6495 End Begin MSWinsockLib.Winsock Winsock1 Left = 0 Top = 0 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin VB.Label lblName AutoSize = -1 'True BackColor = &H00C0C0C0& Caption = "Name" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 360 TabIndex = 3 Top = 3720 Width = 555 End End Attribute VB_Name = "frmChat" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Public sServerIP As String '對方主機的IP Public sName As String '使用者暱稱 '********** 按下清除鍵 ********** Private Sub cmdClear_Click() lstMsg.Clear End Sub '********** 送出訊息 ********** Private Sub cmdSend_Click() Dim sSend As String sSend = lblName.Caption & txtMsg.Text lstMsg.AddItem sSend If lstMsg.ListCount > 15 Then lstMsg.RemoveItem 0 Winsock1.SendData sSend txtMsg.Text = "" End Sub '********** 連結 ********** Public Sub subConnect() lblName.Caption = sName & ":" lstMsg.Clear '清除資訊 cmdSend.Enabled = False '設定送出鍵為無效 If bIfServer = True Then '當做伺服端 With Winsock1 .LocalPort = 2469 '自訂值,但值要在1024以上 .Bind .Listen End With lstMsg.AddItem "等待連結---" frmChat.Caption = frmChat.Caption & "---伺服端" Else '當做用戶端 With Winsock1 .RemoteHost = sServerIP .RemotePort = 2469 .Connect End With lstMsg.AddItem "正在連結---" frmChat.Caption = frmChat.Caption & "---用戶端" End If End Sub '********** 斷線離開 ********** Private Sub Form_Unload(Cancel As Integer) If Winsock1.State = sckConnected Then Winsock1.SendData sName & "離線了!" DoEvents End If End End Sub '********** 完成連結動作 ********** Private Sub Winsock1_Connect() cmdSend.Enabled = True Winsock1.SendData sName & "上線囉!" End Sub '********** 發生要求連結 ********** Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long) Winsock1.Close Winsock1.Accept requestID Winsock1.SendData "已和" & sName & "連上了!" cmdSend.Enabled = True End Sub '********** 當有資料送達時 ********** Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim b As Boolean Dim sMsgString As String Winsock1.GetData sMsgString, vbString, bytesTotal lstMsg.AddItem sMsgString If lstMsg.ListCount > 15 Then lstMsg.RemoveItem 0 End Sub '********** 按下 Enter 時 ********** Private Sub txtMsg_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then cmdSend_Click End Sub |
送花文章: 1530,
|
2005-06-27, 08:04 AM | #2 (permalink) |
版區管理員
|
ChatConnect.frm內容
語法:
VERSION 5.00 Begin VB.Form frmChatConnect BorderStyle = 1 '單線固定 Caption = "一對一 雙人聊天室" ClientHeight = 3225 ClientLeft = 45 ClientTop = 330 ClientWidth = 5355 LinkTopic = "Form2" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3225 ScaleWidth = 5355 StartUpPosition = 3 '系統預設值 Begin VB.TextBox txtIP BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 3000 TabIndex = 7 Text = "0.0.0.0" Top = 1560 Width = 1935 End Begin VB.CommandButton cmdExit Caption = "結束" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 3120 TabIndex = 6 Top = 2280 Width = 1215 End Begin VB.CommandButton cmdConnect Caption = "確定" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 495 Left = 1080 TabIndex = 5 Top = 2280 Width = 1215 End Begin VB.OptionButton optConnect Caption = "加入連結。" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 1 Left = 3120 TabIndex = 4 Top = 840 Width = 1575 End Begin VB.OptionButton optConnect Caption = "等待連結。" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Index = 0 Left = 3120 TabIndex = 3 Top = 480 Width = 1575 End Begin VB.Frame Frame1 Caption = "選擇連結方式" ForeColor = &H00FF0000& Height = 1095 Left = 2760 TabIndex = 2 Top = 240 Width = 2175 End Begin VB.TextBox txtName BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 960 TabIndex = 1 Top = 600 Width = 1335 End Begin VB.Label lblIPreport AutoSize = -1 'True Caption = "你的主機 IP為:" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000FF& Height = 240 Left = 240 TabIndex = 8 Top = 1680 Width = 1695 End Begin VB.Label Label1 AutoSize = -1 'True Caption = "暱稱:" BeginProperty Font Name = "新細明體" Size = 12 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 240 Left = 240 TabIndex = 0 Top = 720 Width = 720 End End Attribute VB_Name = "frmChatConnect" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Sub cmdConnect_Click() Load frmChat frmChat.Show frmChat.sName = txtName.Text If bIfServer = False Then frmChat.sServerIP = txtIP.Text frmChat.subConnect Me.Hide End Sub Private Sub cmdExit_Click() End End Sub Private Sub Form_Load() Me.Show bIfServer = True optConnect(0).Value = True optConnect(1).Value = False lblIPreport = "你的主機 IP 為:" & frmChat.Winsock1.LocalIP txtIP.Visible = False End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub optConnect_Click(Index As Integer) If Index = 0 Then bIfServer = True '要當伺服端 lblIPreport = "你的主機 IP 為:" & frmChat.Winsock1.LocalIP txtIP.Visible = False Else bIfServer = False '要當用戶端 lblIPreport = "請輸入欲連結的主機 IP :" txtIP.Visible = True End If End Sub 語法:
Attribute VB_Name = "Module1" Option Explicit Public bIfServer As Boolean Sub Main() Load frmChatConnect frmChatConnect.Show End Sub |
送花文章: 1530,
|