En realidad sólo supone pasar las subs al servicio y llamarlo.Me resisto a pasarlo a servicio... supondria una muy alta cantidad de horas de trabajo
Dim sf As Object = FTP.SendCommand("RNFR " & cRenameFrom & Chr(13) & Chr(10) & "RNTO", cRenameTo)
Wait For (sf) FTP_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
If Success Then
Log("Comando ejecutado: " & ReplyString )
Else
Log("Error ejecutando el comando: " & ReplyString)
End If
' Modulo MiFtp2
Sub Process_Globals
Dim FTP As FTP
Dim lEnviar As Boolean
Dim cFileDown As String
Dim cFolderFileDown As String
Dim cFolderUp As String
Dim lHacerTodo As Boolean ' Enviar y Recibir
Dim lFinishApp As Boolean
Dim nFileSizeDownloaded As Int
Dim nTotalDownloaded As Int
Dim nFileSizeUploaded As Int
Dim nTotalUploaded As Int
Dim cFileSubir As String
Dim lRenamed As Boolean
Dim RenameFrom As String, RenameTo As String
Dim lCommandCompleted As Boolean
End Sub
Sub Globals
End Sub
Sub Activity_Create(FirstTime As Boolean)
If Rut.oApl.lFinishedApp Then
Rut.oApl.lFinishedApp = False ' Solo finaliza la primera vez que la encuentra a true
Log("reentrando a finish 1 "& Rut.oApl.lFinishedApp)
Activity.Finish
Return
End If
Activity.Title = "Comunicaciones"
FTP.Initialize("FTP", "ftp.xxxxxx.fr", 21, "ftpcuenta@xxxxxx.com","9999xxxx")
'End If
'Activity.LoadLayout("test")
'Msgbox("recibiendo desde 1", "informa")
Rut.oApl.KeepAlive
Dim nPendientes As Int = DBUtils.RegistrosPendientesEnviar
Rut.DbasesClose
Log("Entrando 1")
If lHacerTodo = False Then
If lEnviar = False Then
RecibiendoDatos
Else
If nPendientes > 0 Then
EnviandoDatos
Else
FinFtp1(True)
Msgbox("No hay información para enviar", "Atención !")
Activity.Finish
StartActivity(Menu)
End If
End If
Else
If nPendientes > 0 Then
lEnviar = True ' Al menos para ToastMesage
EnviandoDatos
Else
lEnviar = False ' Al menos para ToastMesage
RecibiendoDatos
End If
End If
Log("Saliendo 1")
End Sub
Sub RecibiendoDatos
Log("Recibiendo datos")
'ProgressDialogShow2("Recibiendo...", False)
ProgressDialogShow2("Espere, recibiendo...", False)
FTP.PassiveMode = True
DownloadButton_Click
End Sub
Sub EnviandoDatos
Log("Enviando datos")
'ProgressDialogShow2("Enviando...", False)
ProgressDialogShow2("Espere, enviando...", False)
'
FTP.PassiveMode = True
' terminales: "error en subida ftp java.lang.runtime exception error uploading file 425 could not open data connection to port 62542
' connection timed out" (Esta raro porque es copiado a mano por un comercial de hida.)
'
UploadButton_Click
End Sub
Sub FTP_DownloadProgress (ServerPath As String, TotalDownloaded As Long, Total As Long)
Dim s As String
s = "Downloaded " & Round(TotalDownloaded / 1000) & "KB"
If Total > 0 Then s = s & " out of " & Round(Total / 1000) & "KB"
Log(s)
nTotalDownloaded = TotalDownloaded ' El ultimo sera el tamaño total descargado
End Sub
' caliente
Sub FTP_DownloadCompleted (ServerPath As String, Success As Boolean)
Dim lOk As Boolean
Log(ServerPath & ", Success=" & Success)
If Success = False Then
Log(LastException.Message)
Msgbox("Error en descarga ftp " & LastException.Message, "Atencion")
Else
If nFileSizeDownloaded = nTotalDownloaded Then
Log("Exito en la descarga" & nFileSizeDownloaded & File.Exists(Rut.oApl.cRutaDb, "maestros.Db"))
lOk = File.Delete(Rut.oApl.cRutaDb, "maestros.Db")
If lOk Then
lOk = File.Exists(Rut.oApl.cRutaDb, "maestros.Db") = False
End If
If lOk Then
File.Copy(Rut.oApl.cRutaDb, "maestros_badname.db", Rut.oApl.cRutaDb, "maestros.db")
File.Delete(Rut.oApl.cRutaDb, "maestros_badname.db") ' 22/04/21
Log("Exito en el rename !")
Else
Log("no se pudo borrar !")
End If
Else
Log("Fallo en la descarga")
End If
End If
'Msgbox("recibiendo desde 2", "informa")
'StartActivity(MiFtp)
Rut.oApl.IniIndexSearch()
FinFtp1(True)
FinFtp2
End Sub
Sub FTP_UploadProgress (ServerPath As String, TotalUploaded As Long, Total As Long)
Dim s As String
s = "Uploaded " & Round(TotalUploaded / 1000) & "KB"
If Total > 0 Then s = s & " out of " & Round(Total / 1000) & "KB"
Log(s)
nTotalUploaded = TotalUploaded
End Sub
Sub FTP_UploadCompleted (ServerPath As String, Success As Boolean)
Dim lFinFtp2 As Boolean = True
Dim lCloseFtp As Boolean = lHacerTodo = False
Dim lOk As Boolean
Log(ServerPath & ", Success=" & Success)
'If Success = False Then Log(LastException.Message)
'Success = False
' If Success = False Then
lOk = Success
If lOk Then
lOk = nTotalUploaded = nFileSizeUploaded
Log("mirando tamaño y tal " & lOk & " " & nTotalUploaded)
End If
If lOk = False Then
Log("antes eso es 1")
If LastException.IsInitialized Then
Log(LastException.Message)
End If
'Log("antes eso es 2"& FTP)
' Borra si no lo pudo subir.
' HECHO !!! HACER !! Tendria que poner como en la bajada (download) tambien que
' el tamaño coincida, sino darlo tambien como success == false. De momento lo dejo
FTP.DeleteFile(cFileSubir)
'Log("despues de borrar"& cFileSubir)
If LastException.IsInitialized Then
Msgbox("Error en subida ftp " & LastException.Message, "Atencion")
End If
End If
FinFtp1(lCloseFtp)
'Msgbox(Success, "hecho !!")
'If Success = True Then
If lOk Then
ProgressDialogShow("Terminando...")
'
' Quitado que copie al historico. Algunos usuario ya suman más de 200 kb. Lo ideal
' es grabar en otra database, por ejemplo Track.db y que no se envie. Mientras me entreo
' como se hace con el INSERT INTO (de una db a otra db) lo desconecto, puesto que parece que no hay
' errores y la prioridad es que la .db Grabacion.dbf sea pequeñita para que se mande facilmente
' al server
'
' Traspaso a Historico para tener copia de seguridad por si se produjera algun error.
' Rut.TableCopyTo(Rut.oApl.sqlGrabacion, "Precio", "HPrecio")
'
lRenamed = False
'FtpSend(RenameFrom, RenameTo)
FTP.List(cFolderUp)
' 'lFtpRenameFile(RenameFrom, RenameTo)
' Rut.lFtpRenameFile(FTP, cFolderUp, RenameFrom, RenameTo)
' lRenamed = Rut.lRenamed
Log("antes mirar si renombrado "& lRenamed)
If lRenamed Then
Log("renombrando con exito")
'
Rut.TableZap(Rut.oApl.sqlGrabacion, "Precio")
ProgressDialogHide()
If lHacerTodo Then
lEnviar = False
RecibiendoDatos
lFinFtp2 = False
End If
End If
End If
If lFinFtp2 Then
FinFtp2
End If
cFileSubir = "" ' Inicializa para que no haya problemas
End Sub
' Caliente
'Sub lFtpRenameFile(cRenameFrom As String, cRenameTo As String)
Sub xxxlFtpRenameFile(cRenameFrom As String, cRenameTo As String) ' As ResumableSub
Log("entrando a rename ")
' FTP.SendCommand("RNFR " & cRenameFrom & Chr(13) & Chr(10) & "RNTO", cRenameTo)
' Wait For Ftp_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
' Dim sf As Object = FtpSend(cRenameFrom, cRenameTo)
'
'Log("rename intermedio 0")
'
'Wait For (sf) FTP_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
'Wait For (sf) Complete (result As Int)
'
' Dim FTP2 As FTP
' FTP2.Initialize("FTP2", "ftp.xxxxxx.fr", 21, "ftpcuenta@xxxxxx.com","9999xxxx")
' FTP2.SendCommand("NOOP","")
Log("intermedio 1")
' FTP.SendCommand("RNFR " & cRenameFrom & Chr(13) & Chr(10) & "RNTO", cRenameTo)
' Log("intermedio 2")
' WAIT FOR FTP2_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
'Dim sf As Object = FTP2.SendCommand("RNFR " & cRenameFrom & Chr(13) & Chr(10) & "RNTO", cRenameTo)
Log("rename intermedio")
'Wait For (sf) FTP2_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
'Sleep(5000)
Log("intermedio 3")
lCommandCompleted = False
' Do While lCommandCompleted = False
'' Sleep(0)
' DoEvents
' Loop
Log("saliendo de rename")
Return True
End Sub
Sub FtpSend(cRenameFrom As String, cRenameTo As String)
'FTP.SendCommand("RNFR " & cRenameFrom & Chr(13) & Chr(10) & "RNTO", cRenameTo)
Rut.FtpSend(FTP, cRenameFrom, cRenameTo)
End Sub
Sub FTP_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
Log ("command=" & Command)
Log ("success=" & Success)
Log ("replyCODE=" & ReplyCode)
Log ("replystring=" & ReplyString)
' Select Case True
' Case Command="RNFR"
' Log("renameto " & RenameTo)
' FTP.SendCommand("RNTO", RenameTo)
' End Select
lRenamed = Success
lCommandCompleted = True
Log("comando completado !!"& lRenamed)
End Sub
Sub FinFtp1(lCloseFtp As Boolean)
If lCloseFtp Then
'Log("cerrando ftp")
FTP.Close
End If
'FTP.CloseNow ' Fuerza cerrar todo ya
Log("Fin carga !!")
'Rut.oApl.ReleaseKeepAlive
ProgressDialogHide()
Rut.DbasesOpen
End Sub
Sub FinFtp2
If lFinishApp == False Then
Log("no terminando")
Rut.oApl.ReleaseKeepAlive
If lEnviar Then
ToastMessageShow("fin envia", False)
Else
ToastMessageShow("fin recibe", False)
End If
Activity.Finish
If lHacerTodo = False Then
StartActivity(Menu)
Else
StartActivity(MenuPral)
End If
Else
Log("si terminando")
Rut.FinishApp(Activity, True)
End If
End Sub
Sub FTP_DeleteCompleted(ServerPath As String, Success As Boolean)
Log("FTP_DELETE FROM " &ServerPath & ", Success=" & Success)
End Sub
Sub UploadButton_Click
Dim cFileDestino As String
'FTP.UploadFile(File.DirRootExternal, "1.jpg", True, "/myandroidapp/1.jpg")
' añadir fecha y hora al nombre archivo destino
'cFileDestino = "/Grabacion/grabacion_" & Rut.oApl.cRoadUser & ".db"
' Para tuars.com no poner contrabarra inicial (\)
'
If Rut.lEsEU Then
'cFileDestino = "grabacion_almacen_eu/grabacion" & Rut.SufijoFilesUpload()& ".db"
' cFileDestino = "grabacion_almacen_eu/tmp" & Rut.SufijoFilesUpload()& ".tmp"
' RenameTo = "grabacion_almacen_eu/grabacion" & Rut.SufijoFilesUpload()& ".db"
cFolderUp = "grabacion_almacen_eu"
Else
'cFileDestino = "grabacion_almacen/grabacion" & Rut.SufijoFilesUpload()& ".db"
cFolderUp = "grabacion_almacen"
End If
cFileDestino = cFolderUp & "/tmp" & Rut.SufijoFilesUpload()& ".tmp"
RenameTo = cFolderUp & "/grabacion" & Rut.SufijoFilesUpload()& ".db"
RenameFrom = cFileDestino
cFileSubir = cFileDestino
nFileSizeUploaded = File.Size( Rut.oApl.cRutaDb, "grabacion.db")
FTP.UploadFile(Rut.oApl.cRutaDb, "grabacion.db", False, cFileDestino)
End Sub
'Sub DownloadButton_Click
'Dim cFolder As String
'Dim cFile As String
'Dim cFolderFile As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''FTP.DownloadFile("/public_html/maestros.db", False, File.DirRootExternal, "maestros_ftp.db")
''FTP.DownloadFile("/public_html/maestros.db", False, Rut.oApl.cRutaDb, "maestros.db")
''FTP.DownloadFile("/maestros/maestros_" & Rut.oApl.cRoadUser & ".db", False, Rut.oApl.cRutaDb, "maestros.db")
'
'' Para tuars.com no poner contrabarra inicial (\)
'cFile = "maestros_" & Rut.oApl.cRoadUser & ".db"
'cFolder = "maestros"
'cFolderFile = cFolder & "/" & cFile
'If True Then 'lFileInFtp(FTP, cFolder, cFile) Then
' FTP.DownloadFile(cFolderFile, False, Rut.oApl.cRutaDb, "maestros.db")
'Else
' ToastMessageShow("No encontrado: " & cFile, True)
'End If
'End Sub
Sub DownloadButton_Click
Dim cFolder As String
Dim cFile As String
Dim cFolderFile As String
''''''''''''''''''''''''''''''''''''''''''''''''''''FTP.DownloadFile("/public_html/maestros.db", False, File.DirRootExternal, "maestros_ftp.db")
'FTP.DownloadFile("/public_html/maestros.db", False, Rut.oApl.cRutaDb, "maestros.db")
'FTP.DownloadFile("/maestros/maestros_" & Rut.oApl.cRoadUser & ".db", False, Rut.oApl.cRutaDb, "maestros.db")
' Para tuars.com no poner contrabarra inicial (\)
cFile = "maestros_" & Rut.oApl.cRoadUser & ".db"
cFile = "maestros_unico.db"
'cFolder = "maestros_inventory"
If Rut.lEsEU Then
cFolder = "maestros_inventory_eu"
Else
cFolder = "maestros_inventory"
End If
cFolderFile = cFolder & "/" & cFile
cFileDown = cFile
cFolderFileDown = cFolderFile
FTP.List(cFolder)
Log("ftp download "& cFolder)
'If True Then 'lFileInFtp(FTP, cFolder, cFile) Then
' FTP.DownloadFile(cFolderFile, False, Rut.oApl.cRutaDb, "maestros.db")
'Else
' ToastMessageShow("No encontrado: " & cFile, True)
'End If
End Sub
Sub lFileInFtp(aFilesRecibe() As FTPEntry, cFile As String)
Dim nI As Int
Dim lFile As Boolean: lFile = False
'Msgbox("parando", aFilesRecibe.Length)
For nI = 0 To aFilesRecibe.Length- 1
'Msgbox(cFile & "///" , aFilesRecibe(nI).Name & "///\\\" & aFilesRecibe(nI).Name = cFile)
If aFilesRecibe(nI).Name = cFile Then
lFile = True
Exit
End If
Next
Return lFile
End Sub
Sub nFileSizeFtp(aFilesRecibe() As FTPEntry, cFile As String)
Dim nI As Int
Dim nSize As Int = 0
'Msgbox("parando", aFilesRecibe.Length)
For nI = 0 To aFilesRecibe.Length- 1
'Msgbox(cFile & "///" , aFilesRecibe(nI).Name & "///\\\" & aFilesRecibe(nI).Name = cFile)
If aFilesRecibe(nI).Name = cFile Then
nSize = aFilesRecibe(nI).Size
Exit
End If
Next
Return nSize
End Sub
'Sub btn_download_Click
' FTP.PassiveMode = True
' FTP.Initialize("FTP", "your FTP location", 21, "user", "passw")
' FTP.List("public_html/your folder or file")
'
'End Sub
Sub FTP_ListCompleted (ServerPath As String, Success As Boolean, Folders() As FTPEntry, Files() As FTPEntry)
Dim cFile As String: cFile = cFileDown
Dim cFolderFile As String: cFolderFile = cFolderFileDown
'Msgbox("completado " & CRLF & ", resultado: " & Success, ServerPath )
Log("----------entrando al LIST")
'lListCompleted = True
If Success == False Then
Log(LastException.Message)
Else
'aFilesRecibe = Files
'For i = 0 To Files.Length - 1
' 'Log(Files(i).Name)
'Next
'For i = 0 To Folders.Length - 1
' Log(Folders(i).Name)
'Next
If lFileInFtp(Files, cFile) Then
' Parametrizar bien la carpeta destino y el nombre fichero destino... deberia meterlo todo en un objeto...
'FTP.DownloadFile(cFolderFile, False, Rut.oApl.cRutaDb, "maestros.db")
'caliente
nFileSizeDownloaded = nFileSizeFtp(Files, cFile)
' Tag. "maestros_unico"
FTP.DownloadFile(cFolderFile, False, Rut.oApl.cRutaDb, "maestros_badname.db")
Else
Msgbox("Fichero no encontrado !!" & CRLF & ServerPath & cFolderFileDown, cFile)
FinFtp1(True)
FinFtp2
End If
End If
End Sub
Dim sf As Object = FTP.SendCommand("RNFR " & cRenameFrom & Chr(13) & Chr(10) & "RNTO", cRenameTo)
Wait For (sf) FTP_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
If Success Then
Log("Comando ejecutado: " & ReplyString )
Else
Log("Error ejecutando el comando: " & ReplyString)
End If[
/CODE]
Sub Process_Globals
'These global variables will be declared once when the application starts.
'These variables can be accessed from all modules.
Private xui As XUI
Private FTP As FTP
End Sub
Sub Globals
'These global variables will be redeclared each time the activity is created.
End Sub
Sub Activity_Create(FirstTime As Boolean)
Activity.LoadLayout("Layout")
File.Copy(File.DirAssets, "san_jeronimo.png", File.DirInternal, "san_jeronimo.png")
End Sub
Sub Activity_Resume
End Sub
Sub Activity_Pause (UserClosed As Boolean)
End Sub
Sub Button1_Click
If FTP.IsInitialized=False Then
Log("Inicializando FTP")
'****************************************
'*** CAMBIA AQUÍ LOS DATOS DE TU FTP ***
'****************************************
FTP.Initialize("FTP", "tu_servidor_ftp", 21, "usuario", "contraseña")
FTP.PassiveMode = True
End If
'CAMBIA /FTPSRAN/test/san_jeronimo.png por la ruta en tu FTP
Dim sf As Object = FTP.UploadFile(File.DirInternal & "/", "san_jeronimo.png", False, "/FTPSRAN/test/san_jeronimo.png")
Wait For (sf) FTP_UploadCompleted(ServerPath As String, Success As Boolean)
Log(LastException)
If Success Then
Log("El archivo se subió correctamente")
Dim sf As Object = FTP.SendCommand("RNFR " & "/FTPSRAN/test/san_jeronimo.png" & Chr(13) & Chr(10) & "RNTO", "/FTPSRAN/test/nuevo_nombre.png")
Wait For (sf) FTP_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
If Success Then
Log("Comando ejecutado: " & ReplyString )
Else
Log("Error ejecutando el comando: " & ReplyString)
End If
Else
Log("Error al subir el archivo")
End If
FTP.Close
End Sub
Es que con WaitFor no tienes que ejecutar comandos dentro de los eventos. Simplemente esperas que el evento ocurra, y si no da error, después ejecutas los comandos.UpdateCompleted
Es que con WaitFor no tienes que ejecutar comandos dentro de los eventos. Simplemente esperas que el evento ocurra, y si no da error, después ejecutas los comandos.
ProFTPD now detects the rename(2) error for renaming across mount points for a directory, and rejects the RNTO command, showing something like:
RNFR directory
350 File or directory exists, ready for destination name
RNTO /other/mount/directory
550 Rename /other/mount/directory: Is a directory
Dim sf As Object = FTP.UploadFile(File.DirInternal & "/", "san_jeronimo.png", False, "/FTPSRAN/test/san_jeronimo.png")
Wait For (sf) FTP_UploadCompleted(ServerPath As String, Success As Boolean)
Log(LastException)
If Success Then
Log("El archivo se subió correctamente")
Dim sf1 As Object = FTP.SendCommand("RNFR /FTPSRAN/test/san_jeronimo.png", "")
Wait For (sf) FTP_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
Dim sf2 As Object = FTP.SendCommand("RNTO /FTPSRAN/test/san_jeronimo3.png", "")
Wait For (sf1) FTP_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
If Success Then
Log("Comando ejecutado: " & ReplyString & " : " & ReplyCode)
Else
Log("Error ejecutando el comando: " & ReplyString & " : " & ReplyCode)
End If
Else
Log("Error al subir el archivo")
End If
Correcto, es lo que te indicaba en el otro hilo, es ese comando el que lo da, pero no parece haber problema, es por el sistema de archivos del FTP, ya la verdad es que no sabría como solucionarlo. Como te comentaba, prueba a poner los archivos en el raíz de tu FTP en vez de en la carpeta /FTPSRAN/test (que en realidad son carpetas de mi FTP, no tendrías que ponerlas en tu código).Pareciera que el RNFR es el que arroja el success erronamente a False
Sub Button1_Click
If FTP.IsInitialized=False Then
Log("Inicializando FTP")
'****************************************
'*** CAMBIA AQUÍ LOS DATOS DE TU FTP ***
'****************************************
FTP.Initialize("FTP", "servidor", 21, "usuario", "clave")
FTP.PassiveMode = True
End If
Dim sf As Object = FTP.UploadFile(File.DirInternal & "/", "san_jeronimo.png", False, "/FTPSRAN/test/san_jeronimo.png")
Wait For (sf) FTP_UploadCompleted(ServerPath As String, Success As Boolean)
Log(LastException)
If Success Then
Log("El archivo se subió correctamente")
Dim sf1 As Object = FTP.SendCommand("RNFR /FTPSRAN/test/san_jeronimo.png", "")
Wait For (sf1) FTP_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
If ReplyCode = 350 Then 'Comando recibido, a la espera de RNTO
Dim sf2 As Object = FTP.SendCommand("RNTO /FTPSRAN/test/san_jeronimo3.png", "")
Wait For (sf2) FTP_CommandCompleted (Command As String, Success As Boolean, ReplyCode As Int, ReplyString As String)
If Success Then
Log("Comando ejecutado: " & ReplyString & " : " & ReplyCode)
Else
Log("Error ejecutando el comando: " & ReplyString & " : " & ReplyCode)
End If
Else
Log("Hubo un problema en RNFR")
End If
Else
Log("Error al subir el archivo")
End If
FTP.Close
End Sub
pega el código como texto, no pongas pantallazos, es más cómodo si hay que copiar o algo. Los logs se pueden copiar también pulsando con el botón derecho sobre las líneas del log.
No te olvides
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?