tcp/ip集团通讯演示程序,在win98调试通过,详细请自行下载进行学习测试,程序大小4k
下载地址:http://www.lshdic.com/download/lshdic/vb_winsock.zip
代码浏览:
private sub check3_click() '客户端二开启及中断对服务器的连接
if check3.value = 1 then
on error resume next
w3.remotehost = text9.text: w3.remoteport = text10.text: w3.connect
if err.number <> 0 then msgbox "被连接的主机地址或连接端口号错误", vbcritical, "找不到服务器": check3.value = 0: exit sub
else
if w3.state = 7 then w3.senddata "职员2[" & w3.remotehostip & "]终止连接,退出系统": doevents: text11.text = ""
w3.close
end if
end sub
private sub command1_click() '服务器发送数据
str0 = 0
for i = 0 to w1.count - 1
doevents
if w1(i).state = 7 then w1(i).senddata "企业管理员公告:" & text4.text: str0 = str0 + 1
next
if str0 = 0 then msgbox "未用客户正连接服务器,无法发送数据", vbcritical, "未有用户"
end sub
private sub command2_click() '客户端一发送数据
if w2.state <> 7 then msgbox "未连接主机或连接主机工作正在进行,无法发送数据", vbcritical, "连接不正常": exit sub
w2.senddata "职员1:" & text8.text
end sub
private sub command3_click()
if w3.state <> 7 then msgbox "未连接主机或连接主机工作正在进行,无法发送数据", vbcritical, "连接不正常": exit sub
w3.senddata "职员2:" & text12.text
end sub
private sub form_load() '启动时开启服务器监听
text1.text = w1(0).localip: text5.text = w1(0).localip: text9.text = w1(0).localip
w1(0).localport = text2.text: w1(0).listen
end sub
private sub check1_click() '开启及关闭服务器端
if check1.value = 1 then
w1(0).localport = text2.text: w1(0).listen
else
for i = 0 to w1.count - 1
if w1(i).state = 7 then w1(i).senddata "服务器以关闭,停止接收用户资料": doevents
w1(i).close
if i <> 0 then unload w1(i)
next
text3.text = "": text7.text = "": text11.text = ""
end if
end sub
private sub check2_click() '客户端一开启及中断与服务器的连接
if check2.value = 1 then
on error resume next
w2.remotehost = text5.text: w2.remoteport = text6.text: w2.connect
if err.number <> 0 then msgbox "被连接的主机地址或连接端口号错误", vbcritical, "找不到服务器": check2.value = 0: exit sub
else
if w2.state = 7 then w2.senddata "职员1[" & w2.remotehostip & "]终止连接,退出系统": doevents: text7.text = ""
w2.close
end if
end sub
private sub form_queryunload(cancel as integer, unloadmode as integer)
w3.close: w2.close
for i = 0 to w1.count - 1
doevents
w1(i).close
next
end
end sub
private sub timer1_timer()
users = 0
for i = 0 to w1.count - 1
str1 = str1 & w1(i).state & ","
if w1(i).state = 7 then users = users + 1
next
me.caption = "主机状态:" & left(str1, len(str1) - 1) & ",客户端一状态:" & w2.state & ",客户端二状态:" & w3.state
label3.caption = "用户连接数:" & users & ",tcp/ip集团通讯演示原程序" & vbcrlf & "原作者:风云舞(http://www.lshdic.com)"
text3.selstart = len(text3.text): text7.selstart = len(text7.text): text11.selstart = len(text11.text)
end sub
private sub w1_close(index as integer)
if check1.value = 0 then '如果是服务器端工作人员关机则关闭
for i = 0 to w1.count - 1
w1(i).close
if i <> 0 then unload w1(i)
next
else
w1(index).close
end if
end sub
private sub w1_connectionrequest(index as integer, byval requestid as long) '服务器接到连接申请
if w1.count = 1 then
load w1(w1.count)
w1(w1.count - 1).close
w1(w1.count - 1).accept requestid
exit sub
end if
len1 = 0
for i = 1 to w1.count - 1
if w1(i).state = 0 then w1(i).accept requestid: exit sub
next
load w1(w1.count): w1(w1.count - 1).accept requestid
end sub
private sub w1_dataarrival(index as integer, byval bytestotal as long) '服务器接到数据
dim w1str as string
w1(index).getdata w1str
text3.text = text3.text & w1str & vbcrlf
for i = 0 to w1.count - 1
doevents
if w1(i).state = 7 then w1(i).senddata w1str
next
end sub
private sub w2_close() '客户端一即将关闭连接
w2.close
if check2.value = 1 then check2.value = 0
end sub
private sub w2_connect()
w2.senddata "系统消息:职员1 成功登陆集团通讯系统"
end sub
private sub w2_dataarrival(byval bytestotal as long) '客户端一收到数据
dim w2str as string
w2.getdata w2str
text7.text = text7.text & w2str & vbcrlf
end sub
private sub w2_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)
msgbox "出现错误,连接服务器失败,可能服务器未开启或连接端口及地址错误", vbcritical, "出错": check2.value = 0
w2.close
end sub
private sub w3_close() '客户端二即将关闭连接