高分寻求源代码！！！！点对点文件传输，一定要能完整传输word,excel文件！

Question

如果是局域网传输，我倒可以回去给你看一下，我们老师曾给过我们源代码，是C写的。不过不知道能否完整传输word,excel文件！

Answer 1

Public shakehand As Integer, ltms As Integer, sout As Integer
Private Sub Command1_Click()
Dim line As String, filenumber As Integer
Dim str As String, sty As String
filenumber = FreeFile
If Len(Dir1.Path) > 3 Then
sty = File1.Path + "\" + File1.FileName
Else
sty = File1.Path + File1.List(File1.ListIndex)
End If
Open sty For Input As #filenumber
Do While Not EOF(filenumber)
Line Input #filenumber, line
str = str + line + Chr(13) + Chr(10)
Loop
Text2.Text = str
StatusBar1.SimpleText = sty + "已打开..."
Close #filenumber
End SubPrivate Sub Command2_Click()
Reset
Text2.Text = ""
StatusBar1.SimpleText = "已清空..."
End SubPrivate Sub Command3_Click()
If Text1.Text = "" Then
MsgBox "请先输入对方地址或IP！", 48 + 4096, "警告！"
StatusBar1.SimpleText = "等待输入对方地址..."
Text1.SetFocus
Else
StatusBar1.SimpleText = ""
End If
On Error GoTo et
sout = 1
udppeera.RemoteHost = Text1.Text
If ltms = 0 Then
udppeera.SendData Text2.Text
Else
 udppeera.SendData Text3.Text
 End If
Exit Sub
et:
If Err.Number = 10065 Then
MsgBox "无法到达对方！", 48 + 4096, "警告!"
Text1.Text = ""
Text1.SetFocus
End If
End SubPrivate Sub Command4_Click()
digsave.Filter = "txt 文件(*.txt)|*.txt"
digsave.ShowSave
Dim fen As Integer
fen = FreeFile
If digsave.FileName <> "" Then
Open digsave.FileName For Output As #fen
Print #fen, Text2.Text
StatusBar1.SimpleText = "已保存到" + digsave.FileName + "..."
Close #fen
File1.Refresh
End If
End SubPrivate Sub Command5_Click()
If Text1.Text = "" Then
MsgBox "请先输入对方地址或IP！", 48 + 4096, "警告！"
StatusBar1.SimpleText = "等待输入对方地址..."
Text1.SetFocus
Else
StatusBar1.SimpleText = ""
End If
On Error GoTo errortrap
udppeera.RemoteHost = Text1.Text
udppeera.SendData "---testing signals---"
sout = 1
Exit Sub
errortrap:
If Err.Number = 10065 Then
MsgBox "无法到达对方！", 48 + 4096, "警告!"
Text1.Text = ""
Text1.SetFocus
End If
End SubPrivate Sub Command6_Click()
Unload Me
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End SubPrivate Sub Drive1_Change()
Dir1.Path = Drive1.Drive
File1.Path = Dir1.Path
End SubPrivate Sub File1_DblClick()
Dim line As String, filenumber As Integer
Dim str As String, sty As String
filenumber = FreeFile
If Len(Dir1.Path) > 3 Then
sty = File1.Path + "\" + File1.FileName
Else
sty = File1.Path + File1.List(File1.ListIndex)
End If
Open sty For Input As #filenumber
Do While Not EOF(filenumber)
Line Input #filenumber, line
str = str + line + Chr(13) + Chr(10)
Loop
Text2.Text = str
StatusBar1.SimpleText = sty + "已打开..."
Close #filenumber
End SubPrivate Sub Form_Load()
sout = 0
ltms = 0
shakehand = 0
Drive1.Drive = "c:\"
Drive1.Refresh
Dir1.Path = Drive1.Drive
File1.Path = Dir1.Path
File1.Pattern = "*.txt"
StatusBar1.SimpleText = "等待输入对方地址..."
udppeera.RemotePort = 1001
Command6.Visible = True
Select Case MsgBox("是否要将本机作为上位机？", 3 + 4096, "清确认！")
Case Is = vbYes
udppeera.RemotePort = 1001
udppeera.Bind 1002
Case Is = vbNo
udppeera.RemotePort = 1002
udppeera.Bind 1001
Case Is = vbCancel
Unload Me
End Select
End Sub
Private Sub udppeera_DataArrival(ByVal bytesTotal As Long)
On Error GoTo ert
Dim strData As String
udppeera.GetData strData
If (shakehand = 0) And (strData = "---testing signals---") And (sout = 0) Then
shakehand = 1
StatusBar1.SimpleText = "握手成功..."
udppeera.RemoteHost = Text1.Text
udppeera.SendData "---testing signals---"
Else
If (sout = 1) And (strData = "---testing signals---") Then
sout = 0
StatusBar1.SimpleText = "能够到达对方..."
Command5.Enabled = False
Else
Text2.Text = strData
StatusBar1.SimpleText = "收到数据..."
End If
End If
Exit Sub
ert:
If Err.Number = 10065 Then
MsgBox "清确认地址是否正确！", 48 + 4096, "警告!"
Text1.Text = ""
Text1.SetFocus
End If
End Sub
Private Sub 对话_Click()
Dim lcg As Integer
lcg = 2500
Text2.Left = Text2.Left - lcg
Text2.Width = Text2.Width + lcg
Text2.Height = 2300
Text3.Visible = True
Dir1.Visible = False
Command4.Visible = False
Command1.Visible = False
Command2.Visible = False
Text3.SetFocus
ltms = 1
Text2.Text = ""
Text3.Text = ""
StatusBar1.SimpleText = "通话中..."
Text2.Locked = True
End Sub
Private Sub 文件传送_Click()
Dim lcg As Integer
lcg = 2500
Text2.Left = Text2.Left + lcg
Text2.Width = Text2.Width - lcg
Text2.Height = 4690
Text3.Visible = False
Dir1.Visible = True
Command4.Visible = True
Command1.Visible = True
Command2.Visible = True
ltms = 0
StatusBar1.SimpleText = "文件传送模式..."
Text2.Text = ""
Text2.Locked = False
End Sub这是我写的用UDP协议可以传输*.txt的源代码。稍微改一下应该可以。