用VB實現聊天討論室和點對點會話

在一個單位內部或通過廣域協議（如X.25）互聯的行業內部都有幾十或上萬臺計算機互聯，用Intr.net雖然可以建立聊天室，但實現點對點實時對話卻比較困難。本人用Winsock和VB自制了一套聊天室和對話系統，特拿來供同行們參考。

一·Winsock的主要屬性、事件和方法

Winsock是不可見控件，控件文件名是MSWINSCK.OCX，全稱為Mcirosoft winsock control，使用時要將此控件調入工具箱。

1·屬性：①Protocol=0 //使用TCP協議；

②RemoteHost //準備連接遠程機的IP地址

③RemotePort //連接遠程機的IP端口號 （1024—65535之間）

④LocalPort //本地機監聽IP端口號必須與呼叫機端口號相同

2·方法：①connect //申請連接遠程機

②listen //設置監聽

③aclearcase/" target="_blank" >ccept //建立實際連接

④senddata //發送數據

⑤getdata //接收數據

⑥close //關閉連接

3·事件：①connectionrequest //一方請求連接時另一方產生

②connect //一方機接受連接時另一方產生

③close //一方機關閉連接時另一方產生

④dataArrival //一方發送數據另一方產生

⑤error //請求連接失敗時產生

二·制作方法

⑴ 在一工程中添加兩個表單form1（模擬客戶端）、form2（模擬服務器端）。

form1中裝入控件：

控件名
主要屬性
用 途

VB.Form form1
caption=”雷萌聊天室”

controlbox=0 ‘False
模擬客戶機表單

VB.Textbox text1
multiline=-1 ‘True

scrollbars=3 ‘Bath
用于輸入發往聊天室的信息

VB.Textbox text2
locked=-1 ‘True

multiline=-1 ‘True

scrollbars=3 ‘Bath
顯示從聊天室發來的信息

VB.Combobox combo1
text=”10.84.234.11” ‘任定默認地址
放入常用的地址

VB.Commandbutton comm1
caption=”退出”
最小化form1

VB.Commandbutton comm2
caption=”連接”
請求與輸入的地址連接

VB.Commandbutton send
caption=”發送”
發送Text1中的內容

VB.Label label1
caption=“請在此輸入發表的信息”
Text1的框標

VB.Label label2
caption=“聊天室或對方的信息”
Text2的框標

VB.Label label3
caption=”等待連接”
顯示連接狀態信息

VB.Label label4
caption=”聊天室或對方地址”
用于指示Combo1

VB.Label label5
caption=”操作:選地址連接,連接成功看到聊天室內容后再輸信息發送”
操作說明

VB.Timer timer1
interval=6000; enabled=false
防止連接超時

MSWinsocklib.winsock a

用于數據傳輸






form2中裝入控件：

控件名
主要屬性
用 途

VB.Form form2
caption=”接收信息”

controlbox=0 ‘False
模擬客戶機表單

VB.Commandbutton command1
caption=”返回”
隱含Form2窗口

VB.Commandbutton command2
caption=”對話”
點對點會話時用此直接啟動Form1

VB.Textbox text1
locked=-1 ‘True

multiline=-1 ‘True

scrollbars=3 ‘Bath
存放聊天或對話內容

VB.Label label1
caption=”接收的信息”
Text1的框標

MSWinsocklib.Winsock a

用于監聽

MSWinsocklib.Winsock b

用于傳送聊天信息




⑵ 在Form1的各控件事件中加入如下代碼:

Dim flag As Boolean 注釋：連接狀態變量



Private Sub a_Connect()

flag = True

End Sub



Private Sub a_DataArrival(ByVal bytesTotal As Long)

Dim i As String

a.GetData i

Label3.Caption = "連接成功！"

Comm2.MousePointer = 0

Form1.MousePointer = 0

Timer1.Enabled = False

If i = Chr(0) Then

Text2.Text = "你是今天第一個進入本聊天室的客戶。" + Chr(13) + Chr(10)

Else

Text2.Text = Text2.Text + i

End If

Text2.SelStart = Len(Text2.Text)

Send.MousePointer = 0

Combo1.Enabled = False

Comm2.Caption = "斷開連接"

Text1.SetFocus

End Sub



Private Sub a_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)

flag = False

Timer1.Enabled = False

Comm2.MousePointer = 0

Form1.MousePointer = 0

MsgBox "網絡連接失敗 ！"

Label3.Caption = "等待連接"

Combo1.Enabled = True

Combo1.SetFocus

a.Close

Comm2.Caption = "連接"

End Sub



Private Sub Comm1_Click()

a.Close 注釋：關閉連接

Form1.WindowState = 1

End Sub



Private Sub Comm2_Click()

If Comm2.Caption = "斷開連接" Then

a.Close

Comm2.Caption = "連接"

Label3.Caption = "等待連接"

Combo1.Enabled = True

Timer1.Enabled = False

Comm2.MousePointer = 0

Form1.MousePointer = 0

Else

Text2.Text = ""

Label3.Caption = "正在連接.."

Comm2.MousePointer = 11

Form1.MousePointer = 11

Timer1.Enabled = True

flag = False

a.Protocol = sckTCPProtocol

a.RemoteHost = Combo1.Text

a.RemotePort = 3000

a.Connect

End If

End Sub



Private Sub Form_DblClick()

If MsgBox("關閉本聊天室! 確認嗎？", 36, "退出系統") = 6 Then

End

Else

Form1.WindowState = 1

End If

End Sub



Private Sub Form_Load()

If App.PrevInstance Then

MsgBox "本系統已經加載，請看任務攔！", 48, "提示"

End

End If

flag = False

Load Form2 ‘讀入form2進入監聽

End Sub



Private Sub Send_Click()

Dim S As String

On Error GoTo ffff ‘防止鏈路中斷

Send.MousePointer = 11

If Right(Text1.Text, 1) <> Chr(10) Then

S = Text1.Text + Chr(13) + Chr(10)

Else

S = Text1.Text

End If

If flag Then

a.SendData S

End If

Exit Sub

ffff:

MsgBox "連接中斷!", 48, "提示"

a.Close

Send.MousePointer = 0

Comm2.Caption = "連接"

Label3.Caption = "等待連接"

Combo1.Enabled = True

Comm2.MousePointer = 0

Form1.MousePointer = 0

Exit Sub

End Sub



Private Sub Timer1_Timer()

flag = False

Timer1.Enabled = False

Comm2.MousePointer = 0

Form1.MousePointer = 0

MsgBox "網絡連接失敗(超時) ！"

Label3.Caption = "等待連接"

Combo1.Enabled = True

Combo1.SetFocus

a.Close

Comm2.Caption = "連接"

End Sub



⑶ 在Form2的各控件事件中加入如下代碼:

Const maxn = 200 ‘最大同時連接本機的客戶數

Dim user(maxn) As Boolean



Private Sub Command1_Click()

Form2.Hide

End Sub



Private Sub Command2_Click()

Load Form1

Form1.Show

End Sub



Private Sub Form_Load()

Dim str1 As String

Form2.Caption = "雷萌通信軟件"

注釋：winsock控件 a 作為服務器程序監聽

a.LocalPort = 3000

a.Listen

End Sub



Private Sub a_ConnectionRequest(ByVal requestID As Long)

Dim i As Long

For i = 1 To maxn ‘當一客戶請求時給啟動一Winsock控件標志號

If Not user(i) Then

user(i) = True

Exit For

End If

Next i

If i > maxn Then

Exit Sub

End If

Load b(i) ‘當一客戶請求時啟動一Winsock控件

b(i).Accept requestID 注釋：實際建立連接

If Text1.Text = "" Then 注釋：發送數據

b(i).SendData Chr(0)

Else

b(i).SendData Text1.Text

End If

Form2.Show

End Sub



Private Sub s_Close(Index As Integer)

b(Index).Close 注釋：關閉連接

Unload b(Index) 注釋：卸載 一個WinSock 控件

user(Index) = False

End Sub

Private Sub b_DataArrival(Index As Integer, ByVal bytesTotal As Long)

Dim str As String

Dim i As Long

b(Index).GetData str

Text1.Text = Text1.Text + str

For i = 1 To maxn

If user(i) Then

b(i).SendData str

End If

Next i

End Sub

三·運行

本程序在VB6.0中編譯通過，運行后最小化到任務欄上，也可以用API的Shell_Notifyicon 函數做入右下角的指示器欄中常駐內存。你可以在網絡中用一個固定的機器地址作為聊天討論室，其他用戶都選該機地址連接進入該室聊天或討論。各用戶也可選各自熟悉的地址進行連接對話,雙擊form1空白處從內存中撤出系統。根據同樣的原理可以制作電子郵件系統。 

原文轉自：http://www.anti-gravitydesign.com