|
|
|
|
|
|
|
|
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
|
|
|
|
|
