能传TXT,bat文件,不能传EXE,压缩文件,还有WORD文档,可能还有很多不能传送的文件,不知道这是为什么?程序如下:服务端程序:
Dim dstpath As String     '目标路径
Dim bytesrec As Long      '文件字节数
Dim fl As Integer         '文件句柄Private Sub Form_Load()
 '初始化设置
 wskServer(0).Protocol = sckTCPProtocol
 wskServer(0).LocalPort = 1001
 wskServer(0).Listen
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  '在关闭前删除所有的winsock控件
  For cn = 0 To wskServer.Count - 1
    wskServer(cn).Close
  Next
End SubPrivate Sub wskServer_Close(Index As Integer)
  '第index个winsock控件关闭时显示相应的消息
  lblInfo.Caption = "connection close..."
End Sub
'动态增加winsock控件数组的大小
Private Sub wskServer_ConnectionRequest(Index As Integer, ByVal requestID As Long)
  Load wskServer(Index + 1)
  wskServer(Index + 1).Accept requestID
  lblInfo.Caption = "connetction estabilished.."
End SubPrivate Sub wskServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
  Dim recbuffer As String
  Dim ret As Integer
  On Error GoTo glocal
  wskServer(Index).GetData recbuffer
  Select Case Left(recbuffer, 8)
    Case "msg_eof_"  '信息结束
      Close #fl     '关闭文件
      lblInfo.Caption = "file received.."
    Case "msg_dst_"  '目标路径
      dstpath = Right(recbuffer, Len(recbuffer) - 8)
      fl = FreeFile  '新建文件句柄
      'overwrite file
      On Error Resume Next
      If Len(Dir(dstpath)) > 0 Then
        '询问是否覆盖
        ret = MsgBox("file already exist!" & vbCrLf & "you wont overwrite it??", vbQuestion + vbYesNo, "tftserver message")
        If ret = vbYes Then
          Kill dstpath
        Else
          Unload Me
        End If
     End If
     '打开文件
     Open dstpath For Binary As #fl
     '显示路径
     lbFileReceived.Caption = dstpath
     '返回客户端 信息ok
     wskServer(Index).SendData "msg_oks"
   Case Else
     bytesrec = bytesrec + Len(recbuffer)
     '写入
     Put #fl, , recbuffer
     lbBytesReceived.Caption = "bytes received:" & bytesrec
     '继续
     wskServer(Index).SendData "msg_rec"
   End Select
   Exit Sub
glocal:
  MsgBox Err.Description
  Unload Me
End SubPrivate Sub wskServer_Error(Index As Integer, 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)
  If Number <> 0 Then
    MsgBox Number
End Sub客户端程序:
Dim srcpath As String                '源路径
Dim dstpath As String                '目标路径
Dim isreceived As Boolean            '接受完毕为TRUE
Private Sub Text1_Change()
  dstpath = Text1.Text
End SubPrivate Sub wskclient_Close()
  lblInfo.Caption = "not connected.."
  wskclient.Close
End SubPrivate Sub wskclient_Connect()
  lblInfo.Caption = "i'm connected"
End SubPrivate Sub wskclient_DataArrival(ByVal bytesTotal As Long)
  Dim recbuffer As String
  wskclient.GetData recbuffer
  Select Case Left(recbuffer, 7)
  Case "msg_rec"  'Block Received
    isreceived = True
  Case "msg_oks"  'ok you can begin to send file
    sendfile
  End Select
End SubPrivate Sub wskclient_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)
   If Number <> 0 Then
      lblInfo.Caption = "not connected"
End Sub
'sendfile函数用于分块发送文件
Private Sub sendfile()
  Dim buffile As String    '文件内容
  Dim lnfile As Long       '长度
  Dim nloop As Long        '文件内容分的块数
  Dim nremain As Long      '最后剩下的大小
  Dim cn As Long
  
  On Error GoTo glocal:
  lnfile = FileLen(srcpath)
  If lnfile > 8192 Then
    '如果文件大于8K
    '则分块传输
    nloop = Fix(lnfile / 8192)
    nremain = lnfile Mod 8192
  Else
    nloop = 0
    nremain = lnfile
  End If
  
  If lnfile = 0 Then
    '文件大小为0
    MsgBox "invalid source file", vbCritical, "client message"
    Exit Sub
  End If
  
  Open srcpath For Binary As #1
  '打开源文件
  If nloop > 0 Then
     For cn = 1 To nloop
        buffile = String(8192, " ")
        Get #1, , buffile  '获取文件内容
        '发送文件块内容
        wskclient.SendData buffile
        isreceived = False
        lbbytesend.Caption = "Bytes Sent:" & cn * 8192 & "of" & lnfile
        lbbytesend.Refresh
        While isreceived = False
           DoEvents
        Wend
     Next
     ' 传输剩下的
     
     If nremain > 0 Then
        buffile = String(nremain, " ")
        Get #1, , buffile
        wskclient.SendData buffile
        isreceived = False
        lbbytesend.Caption = "Bytes Sent:" & lnfile & "of" & lnfile
        lbbytesend.Refresh
        While isreceived = False
           DoEvents
        Wend
     End If
  Else
     buffile = String(nremain, " ")
     Get #1, , buffile
     wskclient.SendData buffile
     isreceived = False
     While isreceived = False
        DoEvents
     Wend
  End If
  
  '发送结束符号
  wskclient.SendData "msg_eof_"     'end of file tag
  '关闭文件
  Close #1
  Exit Subglocal:
   MsgBox Err.DescriptionEnd Sub
Private Sub Command2_Click()
  '发送文件
  On Error GoTo glocal
  If srcpath = "" Then
     MsgBox "select file to transfer", vbInformation, "TFTPClient Message"
     Exit Sub
  End If
  lbfilesend.Caption = srcpath
  'send to server the remote path
  wskclient.SendData "msg_dst_" & dstpath
  Exit Sub
  
glocal:
  MsgBox Err.Description
  Resume Next
End Sub
Private Sub Command1_Click()
  '连接服务器
  On Error Resume Next
  wskclient.Connect "10.1.19.225", 1001
  If Err <> 0 Then
     wskclient.Close
  End If
End Sub
Private Sub Dir1_Change()
  File1.Path = Dir1.Path
End Sub
'驱动器变化
Private Sub Drive1_Change()
  Dir1.Path = Left(Drive1.Drive, 2) & "\"
End Sub
'文件点击
Private Sub file1_click()
  srcpath = File1.Path
  If Right(srcpath, 1) <> "\" Then
     srcpath = srcpath & "\"
  End If
  srcpath = srcpath & File1.FileName
  lbfilesend.Caption = srcpath
End Sub
小弟刚学,请帮忙指点下,谢谢!