USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Internet)

Título da Dica:  Mandando arquivo via Winsock
Postada em 28/1/2004 por mamonalta         
Private Sub cmdAtivar_Click()

If cmdAtivar.Caption = "Ativar Servidor" Then
     cmdAtivar.Caption = "Parar Servidor"
      wsTCP(0).LocalPort = 2000
      wsTCP(0).Listen
Else
     wsTCP(0).Close
     cmdAtivar.Caption = "Ativar Servidor"
End If

End Sub


Private Sub wsTCP_ConnectionRequest(Index As Integer, ByVal requestID As Long)
     Load wsTCP(1)
     If wsTCP(1).State <> sckClosed Then wsTCP(1).Close
     wsTCP(1).Accept requestID
End Sub
Private Sub wsTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)

If Not bOK Then
    wsTCP(1).GetData fnome
    If InStr(fnome, vbCrLf) <> 0 Then fnome = Left(fnome, InStr(fnome, vbCrLf) - 1)
    bOK = True
      If Dir(Dir1.Path & "\" & fnome) <> "" Then Kill Dir1.Path & "\" & fnome
      Open Dir1.Path & "\" & fnome For Binary As 1
      lPos = 1
      wsTCP(1).SendData "OK" & vbCrLf
Else
     Dim buffer() As Byte
     wsTCP(1).GetData buffer
     Put #1, lPos, buffer
     lPos = lPos + UBound(buffer) + 1
End If

End Sub
Private Sub wsTCP_Close(Index As Integer)
  Close #1
   Unload wsTCP(1)
   bOK = False
End Sub
Private Sub cmdEnvia_Click()
   cmdEnvia.Enabled = False
   lBytes = 0

   ReDim buffer(FileLen(dlg.FileName) - 1)

   Open dlg.FileName For Binary As 1
   Get #1, 1, buffer
   Close #1  

   Load wsTCP(1)

   wsTCP(1).RemoteHost = "127.0.0.1"
   wsTCP(1).RemotePort = 2000
   wsTCP(1).Connect

   lblStatus.Caption = "Conectando..."
End Sub
Private Sub wsTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)
   wsTCP(1).GetData temp
   If InStr(temp, vbCrLf) <> 0 Then temp = Left(temp, InStr(temp, vbCrLf) - 1)
       If temp = "OK" Then
      wsTCP(1).SendData buffer
   Else
      lblStatus.Caption = "Ocorreu um problema durante a recepção..."
     Unload wsTCP(1)
     cmdEnvia.Enabled = True
End If
End Sub
Private Sub wsTCP_SendProgress(Index As Integer, ByVal bytesSent As Long, ByVal bytesRemaining As Long)
If temp = "OK" Then
lBytes = lBytes + bytesSent
lblStatus = lBytes & " de um total de " & UBound(buffer) & " bytes enviados"
End If
End Sub
Private Sub wsTCP_SendComplete(Index As Integer)
If temp = "OK" Then
   lblStatus.Caption = "Remessa do arquivo completada com sucesso !"
   temp = ""
   Unload wsTCP(1)
   cmdEnvia.Enabled = True
End If
End Sub
Private Sub wsTCP_Close(Index As Integer)
lblStatus.Caption = "Conexão fechada..."
Unload wsTCP(1)
End Sub



Pronto

DL
 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página