Ayuda vbscript: envío de archivos ftps

[rdmm]

Hola,
tengo un script hecho para mandar archivos por ftp y me funciona perfectamente.

Es este:

Código:

Código [Seleccionar] Expandir

'****************FTP Upload
'Upload a file/folder to an FTP server


Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
MiMes=Month(Now)
strDate2=ucase(MonthName(MiMes))
strDate = Day(Date()) &"_"&   ucase(MonthName(MiMes))
'Path to file or folder to upload
path = "C:\archivos\archivoftp_"&strDate&".csv"

FTPUpload1


Sub FTPUpload1
if Time()>TimeValue("04:00:00") and Time()<TimeValue("04:45:00")Then
MiMes=Month(Now)
strDate2=ucase(MonthName(MiMes))
strDate = Day(Date()) &"_"&   ucase(MonthName(MiMes))

On Error Resume Next

'Copy Options: 16 = Yes to All
Const copyType = 16

'FTP Wait Time in ms
waitTime = 80000

FTPUser = "user"
FTPPass = "pass"
FTPHost = "ftphost"
FTPDir = "/archivos"

strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & FTPDir
Set objFTP = oShell.NameSpace(strFTP)

'Make new folder on FTP site
'objFTP.NewFolder "FTP Backup"


'Upload single file       
If objFSO.FileExists(path) Then

Set objFile = objFSO.getFile(path)
strParent = objFile.ParentFolder
Set objFolder = oShell.NameSpace(strParent)

Set objItem = objFolder.ParseName(objFile.Name)

Wscript.Echo "Uploading file " & objItem.Name & " to " & strFTP
objFTP.CopyHere objItem, copyType


End If


'Upload all files in folder
If objFSO.FolderExists(path) Then

'Code below can be used to upload entire folder
Set objFolder = oShell.NameSpace(path)

Wscript.Echo "Uploading folder " & path & " to " & strFTP
objFTP.CopyHere objFolder.Items, copyType

End If


If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Description
End If

'Wait for upload
WScript.Sleep waitTime
End if
End Sub
Ahora necesito hacerlo para mandar archivos por ftps tcp/990 pero todavía no lo he conseguido, a ver si recibo una ayudita!

Qué tengo que cambiar de este script para poder subir por ftps tcp/990 ?
gracias

[BlackM4ster]

Código (vb) [Seleccionar] Expandir

strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & FTPDir

Ahí haces una petición ftp usando el puerto estándar

Código (vb) [Seleccionar] Expandir

strFTP = "ftp://" & FTPUser & ":" & FTPPass & "@" & FTPHost & ":990" &  FTPDir

Ahí especificas un puerto


Al final el estándar es:

Código [Seleccionar] Expandir

servicio://usuario:pass@maquina.dominio:puerto/directorio/fichero.extension

[rdmm]

Hola,
en primer lugar muchas gracias por tu ayuda pero no me funciona lo que me has puesto.


He probado también con:
strFTP = "ftps://" & FTPUser & ":" & FTPPass & "@" & FTPHost & ":990" &  FTPDir

POniendo ftps en vez de fpt pero tampoco ha funcionado.

[BlackM4ster]

Entonces quizas deberias buscar otro código que haga la peticion de otra forma, ya que por petición de navegador creo que es esa la unica forma de cambiar el puerto. A ver si alguien sabe

[rdmm]

Gracias. A ver si alguien más me puede ayudar. Saludos.

[79137913]

HOLA!!!

Te dejo una funcion mia con winsocks virtuales

No me culpen por usar magia negra en VBS 

Código (vb) [Seleccionar] Expandir


'FTP
   Dim FTPData
   Dim FTPCOMPLETE
   Dim W1
   Dim W2
'/FTP


Set W1 = WScript.CreateObject("MSWINSOCK.Winsock", "W1_")
Set W2 = WScript.CreateObject("MSWINSOCK.Winsock", "W2_")
Call FTPUpload(FTPServer, FTPPort, FTPUser, FTPPass, SPath, SFile)
Set W1 = Nothing
Set W2 = Nothing

Function FTPUpload(FTPServer, FTPPort, FTPUser, FTPPass, SPath, SFile)
   W1.RemoteHost = FTPServer
   W1.RemotePort = FTPPort
   W1.Connect
   If WaitResponse Then Exit Function
   If FTPCODE <> 220 Then Exit Function
       FTPData = ""
       W1.SendData "USER " & FTPUser & vbCrLf
       If WaitResponse Then Exit Function
   If FTPCODE <> 331 Then Exit Function
       FTPData = ""
       W1.SendData "PASS " & FTPPass & vbCrLf
       If WaitResponse Then Exit Function
   If FTPCODE <> 230 Then Exit Function
       FTPData = ""
       W1.SendData "PASV" & vbCrLf
       If WaitResponse Then Exit Function
   If FTPCODE <> 227 Then Exit Function
       Dim Aux
       Aux = Split(FTPData, ",")
       FTPDataPort = (Aux(UBound(Aux) - 1) * 256) + Left(Aux(UBound(Aux)), InStr(Aux(UBound(Aux)), ")") - 1)
       FTPDataIP = Trim(Replace(Right(Aux(0), 3), "(", vbNullString)) & "." & Aux(1) & "." & Aux(2) & "." & Aux(3)
       FTPData = ""
       W1.SendData "STOR " & SFile & vbCrLf
       W2.RemotePort = FTPDataPort: W2.RemoteHost = FTPDataIP
       W2.Connect
       WaitResponse
   If Not (FTPCODE = "125" Or FTPCODE = "150") Then Exit Function
       FTPUpload = SPath & "\" SFile
End Function

Function Upload(FilePath)
   Dim UPFile
   Dim FileLen
   Dim TotalSent
   Dim a
   Set a = WScript.CreateObject("ADODB.Stream")
   a.open
   a.Type = 1
   a.LoadFromFile (FilePath)
   UPFile = a.Read()
   FTPCOMPLETE = False
   W2.SendData UPFile
   EsperaSubida = 0
   Do
       WScript.Sleep 1000
       EsperaSubida = EsperaSubida + 1
       If SendIsComplete = 1 Then Upload = True: Exit Function
       If EsperaSubida > 300 Then Exit Function
   Loop
End Function

Sub W1_DataArrival(ByVal bytesTotal)
   W1.GetData FTPData, 8
End Sub

Function SendIsComplete()
   SendIsComplete = FTPCOMPLETE
End Function

Sub w2_SendComplete()
   FTPCOMPLETE = 1
End Sub

Function WaitResponse()
   Espera = 0
   Do
       WScript.Sleep 1000
       Espera = Espera + 1
       If Espera > 10 Then WaitResponse = 1: Exit Function
       If FTPCODE <> 0 Then Exit Function
   Loop
End Function

Function FTPCODE()
   If Len(FTPData) > 3 Then FTPCODE = Left(FTPData, 3) Else FTPCODE = 0
End Function

GRACIAS POR LEER!!!