Visual Basic - Subir varios archivo al servidor con vb6

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil

Subir varios archivo al servidor con vb6

Publicado por Javier (9 intervenciones) el 17/01/2008 21:30:00
Hola amigos, tengo incorporado en mi sistema un ejemplo para subir un archivo al servidor, me funciona a la perfeccion, el problema surge cuando quiero que se envie mas de un archivo, osea, enviar el contenido completo de una carpeta al servidor con solo apretar un boton. Espero que me puedan ayudar, Gracias
El codigo que estoy ocupando es el siguiente:

'**************************************
' Name: Upload a file to an FTP using Wi
' nsock
' Description:It Uploads a file to an FT
' P using Winsock
'
' Inputs:Two winsock controls (winsock1
' and Winsock2), a command button (command
' 1) and a labal (label1).
'
'**************************************
Type Com
Reply As String
BackCommand As String
End Type

Dim Commun(5) As Com
Dim CommunState As Integer
Dim Site As String
Dim Username As String
Dim Password As String
Dim Remotefile As String
Dim Localfile As String
Dim Buffersize As Long
Dim CloseAfterSend As Boolean

Private Sub Command1_Click()
Site = ""
Username = ""
Password = ""
Localfile = "c:windowsdesktopview.exe"
Remotefile = "/view.exe"
Commun(0).Reply = "220"
Commun(0).BackCommand = "USER " + Username
Commun(1).Reply = "331"
Commun(1).BackCommand = "PASS " + Password
Commun(2).Reply = "230"
Commun(2).BackCommand = "TYPE I"
Commun(3).Reply = "200"
Commun(3).BackCommand = "PORT"
Commun(4).Reply = "200"
Commun(4).BackCommand = "STOR " + Remotefile
Commun(5).Reply = ""
Commun(5).BackCommand = ""
Buffersize = 2920
Dim Nr1 As Integer
Dim Nr2 As Integer
Dim LocalIP As String
LocalIP = Winsock1.LocalIP

Do Until InStr(LocalIP, ".") = 0
LocalIP = Left(LocalIP, InStr(LocalIP, ".") - 1) + "," + Right(LocalIP, Len(LocalIP) - InStr(LocalIP, "."))
Loop
Randomize Timer
Nr1 = Int(Rnd * 12) + 5
Nr2 = Int(Rnd * 254) + 1
Commun(3).BackCommand = "PORT " + LocalIP + "," + Trim(Str(Nr1)) + "," + Trim(Str(Nr2))
Winsock2.Close

Do Until Winsock2.State = 0

DoEvents
Loop
Winsock2.LocalPort = (Nr1 * 256) + Nr2
Winsock2.Listen
Winsock1.Close

Do Until Winsock1.State = 0

DoEvents
Loop
Winsock1.RemoteHost = Site
Winsock1.RemotePort = 21
Winsock1.Connect
CommunState = 0

Do Until Winsock1.State = 7 Or Winsock1.State = 9

DoEvents
Loop

Select Case Winsock1.State
Case 9
MsgBox "Couldn't reach server " + Site + ".", vbOKOnly + vbInformation, "FTP Upper"
Case 7
Open Localfile For Binary As #1
End Select
End Sub

Private Sub Form_Load()
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim tmpS As String
Winsock1.GetData tmpS, , bytesTotal
Debug.Print tmpS;

Select Case Left(tmpS, 3)
Case Commun(CommunState).Reply
Winsock1.SendData Commun(CommunState).BackCommand + Chr(13) + Chr(10)
Debug.Print Commun(CommunState).BackCommand
CommunState = CommunState + 1
Case "150"

Do Until Winsock2.State = 7

DoEvents
Loop
SendNextData
Case "226"
Winsock1.Close

Do Until Winsock1.State = 0

DoEvents
Loop
MsgBox "Transfer complete.", vbOKOnly + vbInformation, "FTP Upper"
Case Else
MsgBox "Bad reply: " + Left(tmpS, Len(tmpS) - 2), vbOKOnly + vbInformation, "FTP Upper"
End Select
End Sub

Private Sub Winsock2_ConnectionRequest(ByVal requestID As Long)
Winsock2.Close

Do Until Winsock2.State = 0

DoEvents
Loop
Winsock2.Accept requestID

Do Until Winsock2.State = 7

DoEvents
Loop
End Sub

Sub SendNextData()
Dim Take As Long
Dim Buffer As String
If LOF(1) - Seek(1) < Buffersize Then Take = LOF(1) - Seek(1) + 1 Else Take = Buffersize
Buffer = Input(Take, 1)
Winsock2.SendData Buffer

If Take < Buffersize Then
Close #1
CloseAfterSend = True
End If
On Error Resume Next
Label1 = Trim(Str(Seek(1))) + "/" + Trim(Str(LOF(1)))
On Error Goto 0
End Sub

Private Sub Winsock2_SendComplete()

If CloseAfterSend = True Then
Winsock2.Close

Do Until Winsock2.State = 0

DoEvents
Loop
CloseAfterSend = False
Else
SendNextData
End If
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder