modfiletransfer.bas

关于WINSOCK控件基本编程的例程,提供电子邮件例程

Attribute VB_Name = "modFileTransfer"
Declare Function GetTickCount Lib "kernel32" () As Long
Public Const Port = 2001
Public Const MAX_CHUNK = 4169

Public bInconnection     As Boolean
Sub Pause(HowLong As Long)
    Dim u%, tick As Long
    tick = GetTickCount()
    Do
      u% = DoEvents
    Loop Until tick + HowLong < GetTickCount
End Sub
Sub SendFile(Fname As String)
    Dim DataChunk As String
    Dim passes As Long
    SendData "OpenFile," & Fname$
    Pause 200
    Open Fname$ For Binary As #1
        Do While Not EOF(1)
          passes& = passes& + 1
          DataChunk$ = Input(MAX_CHUNK, #1)
          SendData DataChunk$
          Status "Transfering... " & (MAX_CHUNK * passes&) & " bytes"
          frmServer.txtView = frmServer.txtView & DataChunk$
          Pause 200
          DoEvents
        Loop
        SendData "CloseFile,"
        Status "监听中…已经连接"
        passes& = 0
    Close #1
End Sub
Sub SendData(sData As String)
    On Error GoTo ErrH
    Dim TimeOut As Long
    frmServer.tcpServer.SendData sData
    Do Until (frmServer.tcpServer.State = 0) Or (TimeOut < 10000)
        DoEvents
        TimeOut = TimeOut + 1
        If TimeOut > 10000 Then Exit Do
    Loop
ErrH:
    Exit Sub
End Sub
Function GetFileName(Fname As String) As String
    Dim i As Integer
    Dim tempStr As String
    For i% = 1 To Len(Fname$)
       tempStr$ = Right$(Fname$, i%)
       If Left$(tempStr$, 1) = "\" Then
         GetFileName$ = Mid$(tempStr$, 2, Len(tempStr$))
         Exit Function
       End If
    Next i
End Function
Public Function EvalData(sIncoming As String, iRtLt As Integer, _
                  Optional sDivider As String) As String
   Dim i As Integer
   Dim tempStr As String
   Dim sSplit As String
   If sDivider = "" Then
      sSplit = ","
   Else
      sSplit = sDivider
   End If
   Select Case iRtLt
      Case 1
          For i = 0 To Len(sIncoming)
            tempStr = Left(sIncoming, i)
            
            If Right(tempStr, 1) = sSplit Then
              EvalData = Left(tempStr, Len(tempStr) - 1)
              Exit Function
            End If
          Next
      Case 2
          For i = 0 To Len(sIncoming)
            tempStr = Right(sIncoming, i)
            
            If Left(tempStr, 1) = sSplit Then
              EvalData = Right(tempStr, Len(tempStr) - 1)
              Exit Function
            End If
          Next
   End Select
End Function
Public Sub Status(Msg As String)
   frmServer.lblStatus = " 状态：" & Msg$
End Sub