HI @all,
i have a problem and did not know how to resolve.
I use VB6 and have registered the WINSCP (Creating the tlb file ...)
i have a class named cSFTP:
a typical function to connect (bConnect)
a Property to get all all files (Property Get)
Connecting to the Host works fine (bConnect)
Getting all Files from SFTP works fine (Property Get oDirectoryFiles)
If i still download ALL FILES (o.bGetFile) in the loop it works fine
But if i wont download some files and skip in the loop a file it doenst work. i dont know why
i hope someone can help me
'Code From frmMain
Dim o As New cSFTP
bOK = o.bConnect(Protocol_Sftp, Me.txtHost, Me.txtUser, Me.txtPW, Me.txtHKey, False, sErr)
'oFls is still class with a collection and reference to an new class for the file
Set oFls.oFiles = o.oDirectoryColFileList(Me.txtDownRDir, isNew, "")
'/// HERE IS THE PROBLEM
'/// Skipping an file, the next file will not download
For i = 1 To oFls.nCount
'If i skip a file bgetfile (mySession.getfiles(sRemoteFileWithPath, sTargetPath, bRemoveFile).IsSuccess) returns false
bOK = o.bGetFile(Me.txtDownRDir & "/" & oFls.oFile(i).sName, Me.txtDownLDir & oFls.oFile(i).sName, True)
next i
'Code from Class
Dim mySessionOptions As SessionOptions
Dim mySession As Session
Dim myDirectoryInfo As RemoteDirectoryInfo
Dim myFileInfo As RemoteFileInfo
Dim myFiles As Collection
Const FileExtensionOK As String = "OK"
Public Enum enmProtocol
Protocol_Sftp = 0
Protocol_Scp = 1
Protocol_Ftp = 2
End Enum
Public Enum enmFileStatus
isNew = 1
isDownloaded
All
End Enum
Private Sub Class_Terminate()
If Not mySession Is Nothing Then
mySession.dispose
End If
Set mySessionOptions = Nothing
Set mySession = Nothing
Set myDirectoryInfo = Nothing
Set myFileInfo = Nothing
Set myFiles = Nothing
End Sub
Property Get oSession() As Session
Set oSession = mySession
End Property
Property Get oDirectoryFiles(Optional sPath As String = "/") As RemoteDirectoryInfo
If myDirectoryInfo Is Nothing Then
Set oDirectoryFiles = mySession.ListDirectory(sPath)
End If
End Property
Property Get oDirectoryColFileList(Optional sPath As String = "/", Optional FileStatus As enmFileStatus = 1, Optional sFileExt As String = "") As Collection
On Error GoTo errHandle
Dim oUBSFile As cUBSFile
Dim bDownload As Boolean
Set oDirectoryColFileList = New Collection
goLog.Log = "Ermittle Remote Dateien .."
If myDirectoryInfo Is Nothing Then
Set myDirectoryInfo = mySession.ListDirectory(sPath)
goLog.Log = "Ermittle Remote Dateien ..OK"
End If
goLog.Log = "Anzahl Remote Dateien .. " & oDirectoryColFileList.Count
For Each myFileInfo In myDirectoryInfo.Files
bDownload = False
If myFileInfo.Name = "." Or _
myFileInfo.Name = ".." Then
Else
If FileStatus = All Then
bDownload = True
ElseIf FileStatus = isDownloaded Then
If UCase(Right(myFileInfo.Name, 2)) = UCase(FileExtensionOK) Then
bDownload = True
End If
ElseIf FileStatus = isNew Then
If UCase(Right(myFileInfo.Name, 3)) <> UCase(FileExtensionOK) Then
bDownload = True
End If
End If
If sFileExt <> "" Then
If UCase(Right(myFileInfo.Name, Len(sFileExt))) <> UCase(sFileExt) Then
bDownload = False
End If
End If
If bDownload Then
Set oUBSFile = New cUBSFile
With oUBSFile
.bIsDirectory = myFileInfo.isdirectory
.dtLastWriteTime = myFileInfo.lastwritetime
.nLen = myFileInfo.length
.sName = myFileInfo.Name
End With
oDirectoryColFileList.Add oUBSFile, "K" & oUBSFile.sName
Set oUBSFile = Nothing
End If
End If
Next
goLog.Log = "Ermittle Remote Dateien .. abgeschlossen"
Exit Property
errHandle:
goLog.Log = "Fehler bei Ermittlung Remote Dateien .." & Err.Number & "." & Err.Description
Err.Clear
End Property
Public Function bConnect(m_enmProtocol As enmProtocol, sHostName As String, _
sUserName As String, sPWD As String, _
Optional sHostKey As String = "", _
Optional bReConnectIfConnected As Boolean = False, _
Optional sErr As String = "") As Boolean
On Error GoTo err_Init
goLog.Log = "Verbindung .."
If mySession Is Nothing Then
Set mySession = New Session
Else
If bReConnectIfConnected Then
mySession.dispose
Set mySession = Nothing
Set mySessionOptions = Nothing
Set mySession = New Session
End If
End If
Set mySessionOptions = New SessionOptions
With mySessionOptions
.Protocol = m_enmProtocol
.HostName = sHostName
.UserName = sUserName
.Password = sPWD
.SshHostKey = sHostKey
'.GiveUpSecurityAndAcceptAnySshHostKey = True
End With
mySession.Open mySessionOptions
bConnect = True
goLog.Log = "Verbindung ..OK"
Exit Function
err_Init:
goLog.Log = "Fehler beim Verbinden " & Err.Number & "." & Err.Description
sErr = Err.Number & "-" & Err.Description
Err.Clear
mySession.dispose
Set mySession = Nothing
Set mySessionOptions = Nothing
bConnect = False
End Function
Public Function bGetFile(sRemoteFileWithPath As String, sTargetPath As String, _
Optional bRemoveFile As Boolean = False, _
Optional bSetStatus As Boolean = True) As Boolean
On Error GoTo err_GetFile
goLog.Log = "Ermittlung der Remote Daten"
If mySession Is Nothing Then
bGetFile = False
Else
bGetFile = mySession.getfiles(sRemoteFileWithPath, sTargetPath, bRemoveFile).IsSuccess
goLog.Log = "Lade Datei .."
If (bGetFile And bSetStatus) And Not bRemoveFile Then
Call bRenameFile(sRemoteFileWithPath, sRemoteFileWithPath & "." & FileExtensionOK)
End If
End If
goLog.Log = "Ermittlung abgeschlossen"
Exit Function
err_GetFile:
goLog.Log = "Fehler bei der Ermittlung der Remote Daten " & Err.Number & "." & Err.Description
Err.Clear
bGetFile = False
End Function
Public Function bPutFile(sRemotePath As String, sLocalPath As String, _
Optional sFile As String = "*.*", _
Optional bRemoveFile As Boolean = False, _
Optional bSetStatus As Boolean = True, _
Optional sErr As String) As Boolean
On Error GoTo err_PutFile
Dim myTransferOptions As New TransferOptions
Dim transferResult As TransferOperationResult
Dim transfer As TransferEventArgs
Dim l As Long
Dim bOK As Boolean
goLog.Log = "Upload ... "
If Right(sLocalPath, 1) <> "\" Then
sLocalPath = sLocalPath & "\"
End If
If Right(sRemotePath, 1) <> "/" Then
sRemotePath = sRemotePath & "/"
End If
bOK = gbDirExist(sLocalPath & DIRBACKUP)
If Not bOK Then
bOK = gbMkDir(sLocalPath & DIRBACKUP)
End If
myTransferOptions.TransferMode = TransferMode_Binary
If mySession Is Nothing Then
bPutFile = False
Else
goLog.Log = "Upload .. "
Set transferResult = mySession.PutFiles(sLocalPath & sFile, sRemotePath, False, myTransferOptions)
transferResult.Check
For Each transfer In transferResult.Transfers
bPutFile = (sLocalPath & sFile = transfer.FileName)
If (bPutFile And bSetStatus) And Not bRemoveFile Then
If bOK Then
goLog.Log = "Upload .. OK"
Call bReNameLocalFile(sLocalPath & sFile, sLocalPath & DIRBACKUP & sFile & "." & FileExtensionOK)
Else
goLog.Log = "Upload .. Nicht OK"
End If
End If
Next
End If
Exit Function
err_PutFile:
goLog.Log = "Fehler bei Upload .. " & Err.Number & "." & Err.Description
Err.Clear
bPutFile = False
End Function
Public Function bRenameFile(sRemotePathFile As String, sRemotePathFileNew As String) As Boolean
On Error GoTo err_Rename
goLog.Log = "Umbenennen Remote Datei .. "
If mySession Is Nothing Then
bRenameFile = False
goLog.Log = "Umbenennen Remote Datei .. Nicht OK (Session getrennt)"
Else
Call mySession.MoveFile(sRemotePathFile, sRemotePathFileNew)
goLog.Log = "Umbenennen Remote Datei .. OK"
bRenameFile = True
End If
Exit Function
err_Rename:
goLog.Log = "Fehler beim Umbenennen .. " & Err.Number & "." & Err.Description
Err.Clear
bRenameFile = False
End Function
Public Function bReNameLocalFile(sPathFile As String, sPathFileNew As String) As Boolean
On Error GoTo errHandle
goLog.Log = "Umbenennen Lokale Datei .."
FileCopy sPathFile, sPathFileNew
Kill sPathFile
goLog.Log = "Umbenennen Lokale Datei .. OK"
errHandle:
goLog.Log = "Fehler beim Umbenennen Lokale Datei .." & Err.Number & "." & Err.Description
bReNameLocalFile = (Err.Number = 0)
Err.Clear
End Function