filetransfer.bas

一个同学用VB编写的局域网通讯程序

Attribute VB_Name = "FileTransfer"
Option Explicit
Public Declare Function GetTickCount Lib "kernel32" () As Long

Public Const Port = 1256                ' Port to listen on
Public Const MAX_CHUNK = 4169           ' Max size of sendable data

Public bInconnection     As Boolean     ' True if connected



' --- SendFile() Function
'
' Sends a file from one computer to another via WinSock

Sub SendFile(Fname As String)
    Dim DataChunk As String
    Dim passes As Long
    
   
    ' pause to give app time to get ready
    Pause 200
    
    ' open the file to be sent
    intfile = FreeFile()
    Open Fname$ For Binary As #intfile
       
        Do While Not EOF(intfile)
        
          ' get some of the file data
          DataChunk$ = Input(MAX_CHUNK, #intfile)
          ' send it to the server
          SendData DataChunk$
    
          Pause 200
          DoEvents
        Loop ' loop until all data is sent
        
        ' transfer done, notify the server to close the file
        SendData "CloseFile,"
      
    Close #intfile
End Sub

' --- send data function this is merely a better way to access
' the winsock "SendData" function. does it's own error
' checking

Sub SendData(sData As String)
    On Error GoTo ErrH

    Dim TimeOut As Long
    
    MainForm.ClientSck.SendData sData
    
    Do Until (MainForm.ClientSck.State = 0) Or (TimeOut < 10000)
        DoEvents
        TimeOut = TimeOut + 1
        If TimeOut > 10000 Then Exit Do
    Loop
    
ErrH:
    Exit Sub
End Sub