★★★★★★vb网络聊天程序源码★★★★★★★★★
要完整的!输入自己ip和对方ip可以聊天!
如果有以下功能,还可以获得20分:
可以离线发送
可以自己获得自己IP
快点来吧!
§№☆★○●◎◇◆□■△▲※→←↑↓〓＃＆＠＼＾＿￣―♂♀
要完整的!输入自己ip和对方ip可以聊天!
如果有以下功能,还可以获得20分:
可以离线发送
可以自己获得自己IP
快点来吧!
§№☆★○●◎◇◆□■△▲※→←↑↓〓＃＆＠＼＾＿￣―♂♀
利用VB设计聊天室
作者：何书臣
Internet 上 的 聊 天 室 一 向 是 一 个 吸 引 人 的 地 方， 但 多 用C 语 言 设 计， 我 用VB 设 计 了 一 个 聊 天 室， 取 名 为“ 升 达 自 由 论 坛”， 实 际 使 用 证 明 效 果 良 好。
---- Internet 上 的 通 讯 协 议 是TCP/IP，Internet 上 数 据 传 输 协 议 主 要 有TCP 和UDP，TCP 是 有 连 接 协 议， 它 要 求 计 算 机 进 行 对 话 时 必 须 先 建 立 连 接， 保 证 数 据 传 送 安 全 到 达 目 的 地。 UDP 是 无 连 接 协 议， 它 只 是 将 信 息 送 到 网 络 上， 并 不 检 查 数 据 是 否 到 达 了 目 的 地。 要 进 行 实 时 会 话， 则 应 该 采 用TCP 协 议。 本 程 序 采 用 的 协 议 就 是TCP 协 议。 ---- 程 序 分 服 务 和 客 户 程 序 两 部 分。 客 户 程 序 启 动 后 首 先 与 服 务 器 连 接， 连 接 成 功 后， 随 意 输 入 一 个 名 字 即 可 进 入 聊 天 室； 服 务 程 序 则 负 责 维 护 与 每 一 个 客 户 的 连 接 和 数 据 交 换， 并 且 记 录 下 所 有 聊 天 内 容， 及 人 员 名 单。 由 于 在 会 话 过 程 中 大 家 起 的 都 是 假 名 字， 不 可 避 免 地 要 有 的 人 讲 一 些 不 健 康 内 容， 为 了 保 持 秩 序， 服 务 器 程 序 实 现 了IP 地 址 跟 踪 功 能。 管 理 人 员 可 以 很 容 易 地 查 找 出 每 一 个 匿 名 的 计 算 机 名， 并 对 之 进 行 警 告 或 其 它 处 理（ 下 面 会 进 一 步 介 绍）。 可 保 证 会 话 内 容 的 健 康。 如 果 服 务 器 程 序 关 闭， 则 所 有 客 户 程 序 自 动 关 闭。 VB5 的Winsock 控 件---- VB5 企 业 版 提 供 了Winsock 控 件， 要 实 现 两 台 计 算 机 的 对 话， 可 以 通 过Winsock 控 件 进 行。 而 不 需 了 解 更 多 的 数 据 传 输 细 节, 本 程 序 就 是 通 过Winsock 进 行 的。
---- Winsock 有 多 种 属 性、 方 法 和 事 件， 本 文 只 列 举 出 要 使 用 的 属 性、 方 法 和 事 件。 ---- ... ... ---- 一 个Winsock 控 件 可 以 建 立 与 一 个 计 算 机 的 联 接， 服 务 器 程 序 中 首 先 设 置 一 个Winsock 控 件， 将 其 索 引 值 设 为 ０， 以 便 在 运 行 时 动 态 增 减 元 素， 这 样 可 以 与 多 个 计 算 机 进 行 对 话。 程 序 介 绍---- 服 务 程 序 部 分 ---- 服 务 器 程 序 启 动 时， 先 设 置 自 己 的 本 地 端 口， 因 为 有 些 端 口 有 其 固 定 的 作 用， 如80 是WWW 端 口， 故 尽 可 能 选 择 不 可 能 使 用 的 端 口， 这 里 我 选 择 了1600。 将 连 接 状 态 设 置 为 假， 然 后 开 始 进 行 侦 听。 当 侦 听 到 有 计 算 机 要 求 与 服 务 器 进 行 对 话， 就 接 受， 并 记 录 下 客 户 机 的 地 址、 端 口、 客 户 起 的 匿 名， 将 连 接 状 态 设 置 为 真， 将 上 述 内 容 存 入 一 个 用 户 自 定 义 的 数 组 中， 进 行 动 态 维 护。 用 户 自 定 义 数 据 类 型 如 下： Private Type ActiveUser
ClientIP As String 记录客户的IP地址
ClientName As String 记录客户的匿名
ClientPort As Integer 记录当前会话的端口
ClientConnected As Boolean
客户连接状态，True表示已连接，False表示没有连接
End Type
---- 做 完 这 些 工 作 后， 服 务 器 再 调 入 一 个 新 控 件， 进 行 新 的 侦 听， 如 此 反 复 不 断。 如 果 有 客 户 退 出 ， 则 关 闭 相 应 的 连 接。 注 意 不 能 在 客 户 端 关 闭 连 接， 否 则 会 产 生 错 误， 只 能 由 服 务 器 关 闭 连 接。 服 务 器 程 序 主 要 对 象 设 置 .
.
.
---- 利 用 上 述 对 象 可 以 实 现 服 务 器 的 各 种 功 能， 当 然， 还 可 以 再 加 入 新 控 件， 以 使 界 面 更 美 观。 ---- 服 务 程 序 中 三 个 关 键 程 序 段 如 下： ---- １ ． 处 理 连 接 请 求 ---- sckServer_ConnectionRequest 过 程 处 理 连 接 请 求, 当 远 程 计 算 机 要 求 连 接 时, 服 务 器 首 先 检 查 用 户 自 定 义 数 组 中 是 否 有 空 闲 位 置( 因 为 在 谈 话 中 途, 肯 定 会 有 人 退 出, 所 以 会 产 生 空 闲 位 置), 如 果 有 则 选 择 空 闲 位 置 给 予 要 求 连 接 的 客 户, 否 则 将 数 组 维 数 加 一, 将 之 给 予 请 求 连 接 的 远 程 节 点。 错 误 处 理 主 要 是 忽 略 两 个 或 两 个 以 上 的 客 户 同 时 要 求 连 接 时 产 生 的 地 址 冲 突 现 象。 ---- ... ... ---- ２ ． 处 理 处 于 连 接 状 态 的 用 户 发 送 来 的 信 息 ---- sckServer_DataArrival 过 程 处 理 客 户 端 传 来 的 数 据。 当 有 数 据 发 送 过 来 后， 服 务 器 首 先 接 收 数 据， 调 用 自 定 义 过 程HandleOtherMessage 检 查 是 谈 话 内 容 还 是 其 它 信 息， 如 果 是 其 它 信 息， 则 在HandleOtherMessage 中 进 行 处 理， 否 则 在 本 过 程 中 进 行 处 理。 ---- 因 为Winsock 控 件 将 数 据 首 先 送 至 缓 冲 区， 待 缓 冲 区 满 才 发 送 信 息， 这 显 然 不 能 保 证 适 时 对 话， 用Doevents 语 句 可 确 保Windows 将 数 据 及 时 送 出。 其 中 的 错 误 处 理 程 序 处 理 当 远 程 计 算 机 非 正 常 关 闭 程 序 时 产 生 的 错 误， 因 为 此 时 服 务 器 并 不 知 道 它 已 关 闭， 仍 然 向 它 发 送 信 息， 这 样 就 会 产 生 错 误， 导 致 服 务 程 序 关 闭， 中 断 整 个 谈 话。 处 理 方 法 只 是 简 单 地 关 闭 掉 该 连 接 即 可。 ---- ... ... ---- 3. 关 闭 客 户 连 接 ---- sckServer_Close 过 程 关 闭 与 客 户 的 连 接， 删 除 控 件， 收 回 系 统 资 源， 将 该 位 置 的 连 接 状 态 设 置 为 假， 以 便 有 用 户 请 求 连 接 时 继 续 使 用。 它 一 般 由HandleOtherMessage 过 程 调 用 ---- ... ... ---- 如 何 保 证 聊 天 内 容 的 健 康 是 一 个 很 重 要 的 方 面， 在Internet 上， 我 们 对 谈 话 内 容 不 健 康 者， 只 有 将 之 开 除 出 聊 天 室。 但 在 局 域 网 上 则 可 以 查 出 是 谁 谈 话 不 文 明（ 局 域 网 环 境 为Windows NT4.0 服 务 器，Windows 95 工 作 站）。 方 法 如 下： 在95 工 作 站 上 将 网 络 中 的TCP/IP 协 议 中 的IP 地 址 选 项 设 为 动 态 获 得IP 地 址， 在NT 服 务 器 上 用DHCP 管 理 工 具 为 每 一 个 客 户 机 进 行IP 地 址 动 态 分 配。 聊 天 服 务 程 序 记 录 下 来 了 每 一 个 客 户 的IP 地 址， 我 们 就 可 以 通 过DHCP 管 理 工 具 很 容 易 地 查 出 某IP 地 址 对 应 的 计 算 机 名， 并 进 行 处 理。 客 户 程 序 部 分---- 客 户 程 序 启 动 时 首 先 设 置 服 务 器 的 地 址 及 端 口， 这 里 我 直 接 使 用 了“192.168.0.2”， 这 是 我 的 服 务 器 地 址， 可 以 在Form_load 过 程 中 设 置 你 自 己 的 服 务 器 地 址， 也 可 在 程 序 开 始 时 让 用 户 输 入 服 务 器 地 址 以 增 加 灵 活 性。 时 钟 控 件 用 以 与 远 程 节 点 进 行 自 动 连 接。
---- ... ... ---- 客 户 程 序 主 要 对 象 设 置 ---- ... ... ---- “” 显 示 所 有 正 在 聊 天 室 中 的 用 户 名 ---- 显 示 当 前 的 状 态（ 用 户 名，IP 地 址 及 是 否 密 谈） ---- 与 服 务 器 程 序 一 样， 这 里 列 出 的 并 非 全 部 的 控 件， 但 是 已 经 足 以 完 成 工 作。 ---- 客 户 程 序 中 的 自 定 义 类MyMessage 用 来 记 录 自 己 的 信 息， ---- ... ... ---- 类 中 的 变 量cmdExitClick 用 来 记 录 用 户 是 否 按 了 退 出 按 钮， 如 果 是 按 了 退 出 按 钮 则 为 真。 当 用 户 选 择 了 系 统 的 窗 体 关 闭 菜 单 而 没 有 按 退 出 按 钮 时 将 会 产 生 错 误， 因 此 用 它 来 记 录 是 如 何 退 出 的， 如 果 选 择 了 系 统 的 窗 体 关 闭 菜 单， 则 执 行 一 次cmdExit_Click() 过 程， 以 确 保 无 误。 ---- 客 户 退 出 时， 不 是 简 单 地 关 闭 自 己 的Winsock 控 件， 而 是 发 送 一 个 字 符 串（ 我 采 用 了 一 个 大 家 在 聊 天 时 很 难 用 到 的 字 符 串“=_RE”） 给 服 务 器， 表 明 自 己 要 退 出， 由 服 务 器 端 关 闭 连 接， 进 而 关 闭 自 身。
由于UDP 协议不需要显式的连接，就需要在两个Winsock控件中间发送数据，关键需要完成以下的三步：
1．将RemoteHost属性设置为另一台计算机的名称。
2．将RemotePort属性设置为第二个控件的LocalPort属性。
3．调用Bind方法，指定使用的LocalPort。
因为两台计算机的地位可以看成“对等的”，这种应用程序也被称为点对点的应用程序。
下面将创建一个聊天应用程序，两个人可以通过它进行实时的交谈。请按照以下步骤制作：
1．创建一个新的 Standard EXE 工程。将缺省的窗体的名称修改为frmPeerA，将窗体的标题修改为“Peer A”。
2．在窗体中放入一个 Winsock 控件，并将其命名为 udpPeerA。在“属性”页上，单击“协议”并将协议修改为 UDPProtocol。
3．在窗体中添加两个 TextBox 控件。将第一个命名为 txtSend，第二个命名为 txtOutput。
4．为窗体添加如下的代码。
Private Sub Form_Load()
′控件的名字为udpPeerA
With udpPeerA
′重点:必须将 RemoteHost 的值修改为对方计算机的名字。
RemoteHost= ″PeerB″
RemotePort = 1001 ′连接的端口号。
Bind 1002 ′绑定到本地的端口。
End With
frmPeerB.Show′显示第二个窗体。
End Sub
Private Sub txtSend_Change()
′在键入文本时，立即将其发送出去。
udpPeerA.SendData txtSend.Text
End Sub
Private Sub udpPeerA_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
udpPeerA.GetData strData
txtOutput.Text = strData
End Sub
要创建第二个 UDP 伙伴，请按照以下步骤执行：
1．在工程中添加一个标准窗体，将窗体的名字修改为 frmPeerB，将窗体的标题修改为“Peer B”。
2．在窗体中放入一个 Winsock 控件，并将其命名为 udpPeerB。
3．在“属性”页上，单击“协议”并将协议修改为“UDPProtocol”。
4．在窗体上添加两个 TextBox 控件。将第一个命名为 txtSend，第二个命名为 txtOutput。
5．在窗体中添加如下代码
Private Sub Form_Load()
′控件的名字为 udpPeerB。
With udpPeerB
′重点:必须将RemoteHost的值改为对方计算机的名字。
RemoteHost= ″PeerA″
RemotePort = 1002 ′要连接的端口。
Bind 1001 ′绑定到本地的端口上。
End With
End Sub
Private Sub txtSend_Change()
′在键入后立即发送文本。
udpPeerB.SendData txtSend.Text
End Sub
Private Sub udpPeerB_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
udpPeerB.GetData strData
txtOutput.Text = strData
End Sub
运行工程，然后在两个窗体的txtSend TextBox中分别键入一些文本。键入的文字将出现在另一个窗体的 txtOutput TextBox中。
（广东 刘亮）
Const SOCKET_ERROR = 0
Private Type WSAdata
wVersion As Integer
wHighVersion As Integer
szDescription(0 To 255) As Byte
szSystemStatus(0 To 128) As Byte
iMaxSockets As Integer
iMaxUdpDg As Integer
lpVendorInfo As Long
End Type
Private Type Hostent
h_name As Long
h_aliases As Long
h_addrtype As Integer
h_length As Integer
h_addr_list As Long
End Type
Private Type IP_OPTION_INFORMATION
TTL As Byte
Tos As Byte
Flags As Byte
OptionsSize As Long
OptionsData As String * 128
End Type
Private Type IP_ECHO_REPLY
Address(0 To 3) As Byte
Status As Long
RoundTripTime As Long
DataSize As Integer
Reserved As Integer
data As Long
Options As IP_OPTION_INFORMATION
End Type
Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long, ByVal RequestData As String, ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As LongPrivate Sub Command1_Click()
Dim HostName As String
HostName = Text1.Text
Dim hFile&, AddrList&, Address&, rIP$
Dim lpWSAdata As WSAdata, hHostent As Hostent, OptInfo As IP_OPTION_INFORMATION, EchoReply As IP_ECHO_REPLY
Call WSAStartup(&H101, lpWSAdata)
If GetHostByName(HostName + String(64 - Len(HostName), 0)) <> SOCKET_ERROR Then
CopyMemory hHostent.h_name, ByVal GetHostByName(HostName & String(64 - Len(HostName), 0)), Len(hHostent)
CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
CopyMemory Address, ByVal AddrList, 4
End If
hFile = IcmpCreateFile()
If hFile = 0 Then MsgBox "检测失败", vbCritical, "错误": Exit Sub
OptInfo.TTL = 255
If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then
rIP = CStr(EchoReply.Address(0)) & "." & CStr(EchoReply.Address(1)) & "." & CStr(EchoReply.Address(2)) & "." & CStr(EchoReply.Address(3))
Else
MsgBox "Timeout", vbCritical, "错误"
End If
If EchoReply.Status = 0 Then
MsgBox HostName & " 的IP地址是: " & rIP & " 共使用 " & CStr(EchoReply.RoundTripTime) & " 毫秒"
Else
MsgBox "检测失败 ...", vbCritical, "错误"
End If
Call IcmpCloseHandle(hFile)
Call WSACleanup
End SubPrivate Sub Command2_Click()
Dim s As String * 255
GetComputerName s, 256
MsgBox "本机Net Name为：" & s, vbInformation, "信息"
Text2.Text = s
End SubPrivate Sub Form_Unload(Cancel As Integer)
If _
MsgBox("真的要关闭程序吗？？？", vbYesNo, "提示") _
= vbYes Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
但是C/S广播式的你会吐血！！！因为当多条消息从C→S的时候，你会发现VB6不支持多线程是多少的糟糕T T