VB在局域网中传递数据!!

Question

VB在局域网中传递数据!!我想在局域网来传递数据.从书上抄了一个程序下来,试试不通.以下为程序望各位指点 谢谢!如哪位有可以在局域网中传递数据的程序可发到.cn (最好是有源程序的)
谢谢!!!
服务端Private Sub Form_Load()'端口侦听
WinSock1.Close
WinSock1.LocalPort = 52000
WinSock1.Listen
End SubSub WinSock1_ConnectionRequest(ByVal requestID As Long)'接收客户的请求
WinSock1.Close
WinSock1.Accept requestID
End SubSub WinSock1_DataArrival(ByVal bytesTotal As Long)'接收数据
Dim StrData As String
WinSock1.GetData StrData
Text2.Text = StrData
End SubPrivate Sub Command1_Click()'发送数据
WinSock1.SendData Text1.Text          
End SubPrivate Sub WinSock1_Close(Index As Integer)'当客户关闭连接时，服务器会产生Close事件
WinSock1.Close
WinSock1.Listen
End SubSub Form_Unload(Cancel As Integer)
WinSock1.Close
End Sub
客户端Private Sub Form_Load()
WinSock1.RemoteHost = Text2.Text              '服务器主机名
WinSock1.RemotePort = Int(Text3.Text)        '服务器端口号
WinSock1.Connect                              '连接到服务器
End SubSub WinSock2_ConnectionRequest(ByVal requestID As Long)
WinSock2.Close
WinSock2.Accept requestID
End SubSub WinSock2_DataArrival(ByVal bytesTotal As Long)
Dim StrData As String
WinSock2.GetData StrData
Text2.Text = StrData
End SubPrivate Sub Command1_Click()
WinSock2.SendData Text1.Text
End SubPrivate Sub WinSock2_Close(Index As Integer)
WinSock2.Close
End SubSub Form_Unload(Cancel As Integer)
WinSock2.Close
End Sub

Answer 1

局域网两机通讯
服务器
Option Explicit
Dim uFlags As Long
Private intmax As Long
Private Sub Command1_Click()
    End
End Sub
  
Private Sub Form_Load()    intmax = 0
    Winsockserver(0).LocalPort = 1200
    Winsockserver(0).Listen
End SubPrivate Sub textsend_Change()
    Winsockserver.SendData textsend.Text
End SubPrivate Sub Winsockserver_Close(index As Integer)
    Winsockserver.Close
    End
End Sub
Private Sub Winsockserver_ConnectionRequest(index As Integer, ByVal requestID As Long)
      If index = 0 Then
       intmax = intmax + 1
       Load Winsockserver(intmax)
       Winsockserver(intmax).LocalPort = 0
       Winsockserver(intmax).Accept requestID
       Load txtData(intmax)
   End If
End SubPrivate Sub Winsockserver_DataArrival(index As Integer, ByVal bytesTotal As Long)   Dim tmpstr As String
   Winsockserver.GetData tmpstr
   textget.Text = tmpstr
End Sub客户端
Option Explicit
Dim uFlags As Long
Private Sub Command1_Click()
    End
End SubPrivate Sub Command2_Click()
   Winsockclient.Connect
End Sub
  
Private Sub Form_Load()
   Winsockclient.RemotePort = 1200
   Winsockclient.RemoteHost = "sccdsz"
End Sub
  
Private Sub Text1_Change()
   Winsockclient.RemoteHost = Text1.Text
End SubPrivate Sub textsend_Change()
   Winsockclient.SendData textsend.Text
End SubPrivate Sub Winsockclient_Close()
   Winsockclient.Close
   End
End SubPrivate Sub winsockclient_Connect()
   Command2.Visible = False
End Sub
  
Private Sub winsockclient_DataArrival(ByVal bytesTotal As Long)
   Dim tmpstr As String
   Winsockclient.GetData tmpstr
   textget.Text = tmpstr
End Sub

Answer 2

我建议将 KissApple(夜凉如水) 的如下过程
Private Sub Winsockserver_DataArrival(index As Integer, ByVal bytesTotal As Long)   Dim tmpstr As String
   Winsockserver.GetData tmpstr
   textget.Text = tmpstr
End Sub
的第三行代码改为:
Winsockserver（index).GetData tmpstr

Answer 3

VB中使用 Winsock 传送文件的问题-------------------------------------------------------------------------
//下面的代码既是服务器又是客户端
//采用应答式发送方式
//自动拆分文件，包括2进制Option Explicit
Dim mybyte() As Byte '发送方数组
Const filecomesMSG = "a file is coming " '有文件到来
Const RemoteIsReadyMSG = "I'm ready " '准备好了
Const FileisOverMSG = "the file is ended" '文件完毕
Const RemoteDenyMSG = "the user canceled"
Const filecountMSG = "the file lengh is"
Dim arrdata() As Byte '收到的信息
Dim filesave As Integer '保存文件的句柄
Dim filehandle As Integer '发送方文件的句柄
Dim MyLocation As Double
Dim myMSG As String '消息
Dim FileisTransfer As Boolean '文件正在传送
Dim Isendfile As Boolean '是否是本人在传送
Dim FileisOver As Boolean '文件是否已经完毕
Dim Counttime As Integer '需要传递的次数
Dim totaltime As Variant
Private Sub cmdsend_Click()
On Error GoTo errorhandle
'this is needed for correct filename
filehandle = FreeFile
If Mid(File1.Path, Len(File1.Path), 1) = "\" Then
Open File1.Path & File1.FileName For Binary Access Read As #filehandle
Else
Open File1.Path & "\" & File1.FileName For Binary Access Read As #filehandle
End If
Isendfile = True '是本人在传送
FileisOver = False '文件刚开始
cmdsend.Enabled = False
Label1.Caption = "Wait for reply..."
MsgBox ("the selected file size is " & LOF(filehandle) & " bytes")
totaltime = Int(LOF(filehandle) / 4000 + 1)
MyLocation = Loc(filehandle)
Winsock.SendData filecomesMSG & File1.FileName '发送发出文件信息
Winsock.SendData filecountMSG & totaltime
Exit Sub
errorhandle: MsgBox ("You havn't choose a file!")
End SubPrivate Sub Dir1_Change()
File1.Path = Dir1.Path
End SubPrivate Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End SubPrivate Sub Form_Load()
Drive1.Drive = "c:\"
Winsock.RemoteHost = "255.255.255.255"
Winsock.LocalPort = 7904
Winsock.Bind 7904
Winsockfile.RemoteHost = "255.255.255.255"
Winsockfile.LocalPort = 7905
Winsockfile.Bind 7905
FileisTransfer = False 'initialize the bool value
Isendfile = False
FileisOver = True
Counttime = 0
Label1.Caption = "Ready..."
End SubPrivate Sub Timer1_Timer()
Dim i As Integer
If LOF(filehandle) - MyLocation > 4000 Then
ReDim mybyte(0 To 4000)
Get #filehandle, , mybyte
MyLocation = Loc(filehandle)
Winsockfile.SendData mybyte
Counttime = Counttime + 1
Label1.Caption = "the select file is being transfered..." & "about " & Counttime & " / " & totaltime
Timer1.Enabled = False
Else
ReDim mybyte(0 To LOF(filehandle) - MyLocation - 1)
Get #filehandle, , mybyte
Winsockfile.SendData mybyte
FileisTransfer = False
Timer1.Enabled = False
FileisOver = True
End IfEnd SubPrivate Sub Winsock_DataArrival(ByVal bytesTotal As Long)
Winsock.GetData myMSG
Select Case Mid(myMSG, 1, 17)
Case filecomesMSG '这些消息发送方和接受方都可收到
'do display a form
If Not Isendfile Then '接受方处理这些事情
On Error GoTo errorhandle
CommonDialog1.FileName = Mid(myMSG, 17, Len(myMSG))
CommonDialog1.ShowSave
filesave = FreeFile
FileisTransfer = True
cmdsend.Enabled = False
Open CommonDialog1.FileName For Binary Access Write As #filesave
Winsock.SendData RemoteIsReadyMSG
Label1.Caption = "the select file is being transfered..."
End If
Case RemoteIsReadyMSG
'do begin transfer a file
'如果文件还没有结束，也就是说，只有主机才能受到
If Isendfile Then
If Not FileisOver Then
Timer1.Enabled = True
Label1.Caption = "the select file is being transfered..."
Else
Winsock.SendData FileisOverMSG
End If
End If
Case FileisOverMSG
If Not Isendfile Then '客户机处理
Close #filesave
FileisTransfer = False
Else '主机处理
Isendfile = False
Close #filehandle
End If
MsgBox ("the file is transfered successfully!") '大家一起处理
Isendfile = False
cmdsend.Enabled = True
Label1.Caption = "Ready..."
Case RemoteDenyMSG
If Isendfile Then
MsgBox ("The user canceled this transfer session!")
Isendfile = False
FileisOver = True
cmdsend.Enabled = True
Label1.Caption = "Ready..."
Close #filehandle
End If
Case filecountMSG
If Not Isendfile Then
totaltime = Mid(myMSG, 17, Len(myMSG))
End If
End Select
Exit Sub
errorhandle: Winsock.SendData RemoteDenyMSG
End Sub
Private Sub writetofile()
Put #filesave, , arrdata
End SubPrivate Sub Winsockfile_DataArrival(ByVal bytesTotal As Long)
If FileisTransfer Then
Winsockfile.GetData arrdata, vbArray + vbByte, 4001
writetofile
Winsock.SendData RemoteIsReadyMSG
Counttime = Counttime + 1
Label1.Caption = "the select file is being transfered..." & "about " & Counttime & "/" & totaltime
End If
End Sub