Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Visual Basic Новый топик    Ответить
 Некорректное получение имен файлов с FTP  [new]
Bobax012
Member

Откуда:
Сообщений: 89
Хочу получить имена всех файлов с FTP. Когда запускаю код на Windows 7 x32 Excel 2010, то все работает корректно, как только запускаю Windows 10 x64 Excel 2016, то получаю имя файла без первых 4 символов. Например на ftp файл физкультура.txt, на Windows 7 x32 Excel 2010 - результат "физкультура.txt", на Windows 10 x64 Excel 2016 -результат "ультура.txt". В чем может быть дело, подскажите.

Option Explicit
 
Const MAX_PATH                          As Integer = 260
Const INTERNET_SERVICE_FTP              As Long = 1
Const INTERNET_FLAG_RELOAD              As Long = &H80000000
Const INTERNET_FLAG_NO_CACHE_WRITE      As Long = &H4000000

Const FTP_TRANSFER_TYPE_BINARY          As Long = &H2


Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As Currency
    ftLastAccessTime As Currency
    ftLastWriteTime As Currency
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type


#If VBA7 Then
    Private Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, _
    ByVal lAccessType As LongPtr, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As LongPtr) As LongPtr
     
    Private Declare PtrSafe Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternetSession As LongPtr, _
    ByVal sServerName As String, _
    ByVal nServerPort As Integer, _
    ByVal sUsername As String, _
    ByVal sPassword As String, _
    ByVal lService As LongPtr, _
    ByVal lFlags As LongPtr, _
    ByVal lContext As LongPtr) As LongPtr
     
     '--
     Private Declare PtrSafe Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
    (ByVal hFtpSession As LongPtr, _
    ByVal lpszRemoteFile As String, _
    ByVal lpszNewFile As String, _
    ByVal fFailIfExists As Boolean, _
    ByVal dwFlagsAndAttributes As LongPtr, _
    ByVal dwFlags As LongPtr, _
    ByVal dwContext As LongPtr) As Boolean
 
    Private Declare PtrSafe Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
    (ByVal hFtpSession As LongPtr, _
    ByVal lpszLocalFile As String, _
    ByVal lpszRemoteFile As String, _
    ByVal dwFlags As LongPtr, _
    ByVal dwContext As LongPtr) As Boolean
     '--
     
    Private Declare PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As LongPtr, _
    ByVal lpszDirectory As String) As Boolean
     
    Private Declare PtrSafe Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As LongPtr, _
    ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, _
    ByVal dwFlags As LongPtr, _
    ByVal dwContent As LongPtr) As LongPtr
     
    Private Declare PtrSafe Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As LongPtr, _
    lpFindFileData As WIN32_FIND_DATA) As LongPtr
     
    Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As LongPtr) As Integer
    
#Else

    Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, _
    ByVal lAccessType As Long, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long
     
    Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternetSession As Long, _
    ByVal sServerName As String, _
    ByVal nServerPort As Integer, _
    ByVal sUsername As String, _
    ByVal sPassword As String, _
    ByVal lService As Long, _
    ByVal lFlags As Long, _
    ByVal lContext As Long) As Long
     
     '--
    Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
    (ByVal hFtpSession As Long, _
    ByVal lpszRemoteFile As String, _
    ByVal lpszNewFile As String, _
    ByVal fFailIfExists As Boolean, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Boolean
 
    Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
    (ByVal hFtpSession As Long, _
    ByVal lpszLocalFile As String, _
    ByVal lpszRemoteFile As String, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Boolean
     '--
     
    Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, _
    ByVal lpszDirectory As String) As Boolean
     
    Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As Long, _
    ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, _
    ByVal dwFlags As Long, _
    ByVal dwContent As Long) As Long
     
    Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long
     
    Private Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As Long) As Integer
    
#End If


    
Public Sub ZagruzkaSFTP()
     
    #If VBA7 Then
        Dim hOpen As LongPtr, hConn As LongPtr, hFind As LongPtr, ret As LongPtr, ftpMode As LongPtr
    #Else
        Dim hOpen As Long, hConn As Long, hFind As Long, ret As Long, ftpMode As Long
    #End If

    Dim hostName As String, port As Long, username As String, password As String
    Dim localFolder As String
    Dim remoteDirectory As String, remoteMatchFiles As String
    Dim fileFind As WIN32_FIND_DATA
    Dim newestFileTime As Currency
    Dim newestFileName As String
    
    Dim fDate As Date
    Dim srtMassivArhFTP()
    Dim intElemMassivArhFTP As Integer
    Dim XXX As Integer
    Dim DataVFaile As String
    
    Dim srtMassivNujnArh()
    Dim srtElemMassivNujnArh
    
    Dim PoluchData
    Dim Schetchik As Integer
    
    Dim failARH As String
    Dim blnNaidenAll As Boolean
    
    intElemMassivArhFTP = 0
    '========== User-defined settings ==========
    
    localFolder = "C:\Path\To\Local\Folder\"
    hostName = "ftp.server.host.name"
    port = 21
    username = "YourUsername"
    password = "YourPassword"
    remoteDirectory = "/remote/server/directory/"
    remoteMatchFiles = "*"

    '===========================================
    
    ftpMode = 0
    'ftpMode = INTERNET_FLAG_PASSIVE    'passive mode FTP
    
    ret = InternetOpen("ftp VBA", 1, vbNullString, vbNullString, 0)
    hOpen = ret
    
    If ret > 0 Then
        ret = InternetConnect(hOpen, hostName, port, username, password, INTERNET_SERVICE_FTP, ftpMode, 0)
        hConn = ret
    End If
    
    If ret > 0 Then
        ret = FtpSetCurrentDirectory(hConn, remoteDirectory)
    End If
    
    If ret > 0 Then
        
        'Find first matching file
        
        fileFind.cFileName = String(MAX_PATH, vbNullChar)
        
        
        ret = FtpFindFirstFile(hConn, remoteMatchFiles, fileFind, INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRITE, 0)
        hFind = ret
    
        While ret > 0
            Debug.Print TrimNulls(fileFind.cFileName)

            newestFileName = TrimNulls(fileFind.cFileName)

            fileFind.cFileName = String(MAX_PATH, vbNullChar)
            ret = InternetFindNextFile(hFind, fileFind)

        Wend

    End If
    
    If ret = 0 Then
        Debug.Print "FtpGetFile error "; Err.LastDllError
        MsgBox "FtpGetFile error "
    End If
    
    'Release handles
    
    InternetCloseHandle hFind
    InternetCloseHandle hConn
    InternetCloseHandle hOpen
    
End Sub


Private Function TrimNulls(buffer As String) As String
    TrimNulls = Left(buffer, InStr(buffer, vbNullChar) - 1)
End Function
11 янв 19, 00:11    [21782317]     Ответить | Цитировать Сообщить модератору
 Re: Некорректное получение имен файлов с FTP  [new]
ldfanate
Member

Откуда:
Сообщений: 62
м.б. InstrB, InstrW следует применять (т.к. разрядность систем различная, то и соотношение симоволов:байт будет другое)?
11 янв 19, 09:21    [21782438]     Ответить | Цитировать Сообщить модератору
 Re: Некорректное получение имен файлов с FTP  [new]
iMrTidy
Member

Откуда:
Сообщений: 675
ldfanate,

Вам в принципе стоит добавить еще условного компилирования для 32/64 битности, в идеале получится 4 случая.
11 янв 19, 10:52    [21782527]     Ответить | Цитировать Сообщить модератору
 Re: Некорректное получение имен файлов с FTP  [new]
Bobax012
Member

Откуда:
Сообщений: 89
На 64 разрядной системе при поэтапном просмотре выполнения кода, я вижу, что имя файла я получаю после выполнения кода

ret = FtpFindFirstFile(hConn, remoteMatchFiles, fileFind, INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRITE, 0)


но почему не полное имя, не понятно.


ldfanate
м.б. InstrB, InstrW следует применять (т.к. разрядность систем различная, то и соотношение симоволов:байт будет другое)?


Можете подсказать, где именно на моем примере можно использовать данные операторы. Честно, про InstrW вообще не нашел информации.

iMrTidy
ldfanate,

Вам в принципе стоит добавить еще условного компилирования для 32/64 битности, в идеале получится 4 случая.


А можно поподробнее или ссылку?


Если у кого-то есть еще какие-то варианты решения проблемы, напишите пожалуйста.
12 янв 19, 00:23    [21783388]     Ответить | Цитировать Сообщить модератору
 Re: Некорректное получение имен файлов с FTP  [new]
iMrTidy
Member

Откуда:
Сообщений: 675
Bobax012,

https://docs.microsoft.com/en-us/office/vba/language/concepts/getting-started/64-bit-visual-basic-for-applications-overview
12 янв 19, 21:43    [21783810]     Ответить | Цитировать Сообщить модератору
 Re: Некорректное получение имен файлов с FTP  [new]
ldfanate
Member

Откуда:
Сообщений: 62
ещё м.б. потому что из API-структуры в Private Function TrimNulls(buffer As String) строку передаёте не как ByVal (т.е. lpstr) а как ByRef, т.е. в формате bstr - там какраз первые 4 байта в 64-битных должен занять счётчик количества символов в строке, вот его наверное и отрезает, т.к. процедура не понимает, что ей на вход строка без счётчика передаётся из API.
14 янв 19, 09:06    [21784481]     Ответить | Цитировать Сообщить модератору
 Re: Некорректное получение имен файлов с FTP  [new]
Bobax012
Member

Откуда:
Сообщений: 89
Переделал немного код, нашел открытый ftp, чтобы было наглядно видно как работает код, может кто-то попробует решить эту проблему, перепробовал всё, что знал, ни чего не помогает.

Option Explicit
 
Const MAX_PATH                          As Integer = 260
Const INTERNET_SERVICE_FTP              As Long = 1
Const INTERNET_FLAG_RELOAD              As Long = &H80000000
Const INTERNET_FLAG_NO_CACHE_WRITE      As Long = &H4000000
Const INTERNET_FLAG_PASSIVE = &H8000000
Const FTP_TRANSFER_TYPE_BINARY          As Long = &H2


Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As Currency
    ftLastAccessTime As Currency
    ftLastWriteTime As Currency
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type


#If VBA7 Then
    Private Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, _
    ByVal lAccessType As LongPtr, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As LongPtr) As LongPtr
     
    Private Declare PtrSafe Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternetSession As LongPtr, _
    ByVal sServerName As String, _
    ByVal nServerPort As Integer, _
    ByVal sUsername As String, _
    ByVal sPassword As String, _
    ByVal lService As LongPtr, _
    ByVal lFlags As LongPtr, _
    ByVal lContext As LongPtr) As LongPtr
     
     '--
     Private Declare PtrSafe Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
    (ByVal hFtpSession As LongPtr, _
    ByVal lpszRemoteFile As String, _
    ByVal lpszNewFile As String, _
    ByVal fFailIfExists As Boolean, _
    ByVal dwFlagsAndAttributes As LongPtr, _
    ByVal dwFlags As LongPtr, _
    ByVal dwContext As LongPtr) As Boolean
 
    Private Declare PtrSafe Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
    (ByVal hFtpSession As LongPtr, _
    ByVal lpszLocalFile As String, _
    ByVal lpszRemoteFile As String, _
    ByVal dwFlags As LongPtr, _
    ByVal dwContext As LongPtr) As Boolean
     '--
     
    Private Declare PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As LongPtr, _
    ByVal lpszDirectory As String) As Boolean
     
    Private Declare PtrSafe Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As LongPtr, _
    ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, _
    ByVal dwFlags As LongPtr, _
    ByVal dwContent As LongPtr) As LongPtr
     
    Private Declare PtrSafe Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As LongPtr, _
    lpFindFileData As WIN32_FIND_DATA) As LongPtr
     
    Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As LongPtr) As Integer
    
#Else

    Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, _
    ByVal lAccessType As Long, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long
     
    Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternetSession As Long, _
    ByVal sServerName As String, _
    ByVal nServerPort As Integer, _
    ByVal sUsername As String, _
    ByVal sPassword As String, _
    ByVal lService As Long, _
    ByVal lFlags As Long, _
    ByVal lContext As Long) As Long
     
     '--
    Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
    (ByVal hFtpSession As Long, _
    ByVal lpszRemoteFile As String, _
    ByVal lpszNewFile As String, _
    ByVal fFailIfExists As Boolean, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Boolean
 
    Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
    (ByVal hFtpSession As Long, _
    ByVal lpszLocalFile As String, _
    ByVal lpszRemoteFile As String, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Boolean
     '--
     
    Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, _
    ByVal lpszDirectory As String) As Boolean
     
    Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As Long, _
    ByVal lpszSearchFile As String, _
    lpFindFileData As WIN32_FIND_DATA, _
    ByVal dwFlags As Long, _
    ByVal dwContent As Long) As Long
     
    Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long
     
    Private Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As Long) As Integer
    
#End If


    
Public Sub ZagruzkaSFTP()
     
    #If VBA7 Then
        Dim hOpen As LongPtr, hConn As LongPtr, hFind As LongPtr, ret As LongPtr, ftpMode As LongPtr
    #Else
        Dim hOpen As Long, hConn As Long, hFind As Long, ret As Long, ftpMode As Long
    #End If

    Dim hostName As String, port As Long, username As String, password As String
    Dim localFolder As String
    Dim remoteDirectory As String, remoteMatchFiles As String
    Dim fileFind As WIN32_FIND_DATA
    Dim newestFileTime As Currency
    Dim newestFileName As String
    
    Dim fDate As Date
    Dim srtMassivArhFTP()
    Dim intElemMassivArhFTP As Integer
    Dim XXX As Integer
    Dim DataVFaile As String
    
    Dim srtMassivNujnArh()
    Dim srtElemMassivNujnArh
    
    Dim PoluchData
    Dim Schetchik As Integer
    
    Dim failARH As String
    Dim blnNaidenAll As Boolean
    
    intElemMassivArhFTP = 0
    
    localFolder = PutKPapkeProg & PapkaSArhivami
    hostName = "ftp.intel.com"
    port = 21
    username = ""
    password = ""
    remoteDirectory = "/Pub/papers/"
    remoteMatchFiles = "*"

    '===========================================
    
    'ftpMode = 0
    ftpMode = INTERNET_FLAG_PASSIVE    'passive mode FTP
    
    ret = InternetOpen("ftp VBA", 1, vbNullString, vbNullString, 0)
    hOpen = ret
    
    If ret > 0 Then
        ret = InternetConnect(hOpen, hostName, port, username, password, INTERNET_SERVICE_FTP, ftpMode, 0)
        hConn = ret
    End If
    
    If ret > 0 Then
        ret = FtpSetCurrentDirectory(hConn, remoteDirectory)
    End If
    
    If ret > 0 Then
        
        'Find first matching file
        
        fileFind.cFileName = String(MAX_PATH, vbNullChar)
        
        
        ret = FtpFindFirstFile(hConn, remoteMatchFiles, fileFind, INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRITE, 0)
        hFind = ret
        newestFileName = ""
        
        While ret > 0
            Debug.Print TrimNulls(fileFind.cFileName)

            newestFileName = newestFileName & TrimNulls(fileFind.cFileName) & Chr(10)

            fileFind.cFileName = String(MAX_PATH, vbNullChar)
            ret = InternetFindNextFile(hFind, fileFind)

        Wend

    End If
    
    If ret = 0 Then
        Debug.Print "FtpGetFile error "; Err.LastDllError
        MsgBox "FtpGetFile error "
    End If
    
    'Release handles
    
    InternetCloseHandle hFind
    InternetCloseHandle hConn
    InternetCloseHandle hOpen
    
    MsgBox "Файлы:" & Chr(10) & newestFileName
End Sub


Private Function TrimNulls(buffer As String) As String
    TrimNulls = Left(buffer, InStr(buffer, vbNullChar) - 1)
End Function


К сообщению приложен файл. Размер - 70Kb
15 янв 19, 03:40    [21785328]     Ответить | Цитировать Сообщить модератору
 Re: Некорректное получение имен файлов с FTP  [new]
Bobax012
Member

Откуда:
Сообщений: 89
ldfanate
ещё м.б. потому что из API-структуры в Private Function TrimNulls(buffer As String) строку передаёте не как ByVal (т.е. lpstr) а как ByRef, т.е. в формате bstr - там какраз первые 4 байта в 64-битных должен занять счётчик количества символов в строке, вот его наверное и отрезает, т.к. процедура не понимает, что ей на вход строка без счётчика передаётся из API.


А как-то это можно подправить в коде?
15 янв 19, 03:43    [21785329]     Ответить | Цитировать Сообщить модератору
 Re: Некорректное получение имен файлов с FTP  [new]
ZVI
Member

Откуда: Sevastopol
Сообщений: 435
Bobax012, для 64-битного варианта просто откусите 4 недостающих байта из структуры, например, за счет dwReserved1.
И везде вместо #If VBA7 нужно #If Win64
Option Explicit

Const MAX_PATH As Integer = 260
Const INTERNET_SERVICE_FTP As Long = 1
Const INTERNET_FLAG_RELOAD As Long = &H80000000
Const INTERNET_FLAG_NO_CACHE_WRITE As Long = &H4000000
Const INTERNET_FLAG_PASSIVE = &H8000000
Const FTP_TRANSFER_TYPE_BINARY As Long = &H2

#If Win64 Then

  Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As Currency
    ftLastAccessTime As Currency
    ftLastWriteTime As Currency
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    'dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
  End Type


  Private Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, _
     ByVal lAccessType As LongPtr, _
     ByVal sProxyName As String, _
     ByVal sProxyBypass As String, _
     ByVal lFlags As LongPtr) As LongPtr

  Private Declare PtrSafe Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternetSession As LongPtr, _
     ByVal sServerName As String, _
     ByVal nServerPort As Integer, _
     ByVal sUsername As String, _
     ByVal sPassword As String, _
     ByVal lService As LongPtr, _
     ByVal lFlags As LongPtr, _
     ByVal lContext As LongPtr) As LongPtr

  '--
  Private Declare PtrSafe Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
    (ByVal hFtpSession As LongPtr, _
     ByVal lpszRemoteFile As String, _
     ByVal lpszNewFile As String, _
     ByVal fFailIfExists As Boolean, _
     ByVal dwFlagsAndAttributes As LongPtr, _
     ByVal dwFlags As LongPtr, _
     ByVal dwContext As LongPtr) As Boolean

  Private Declare PtrSafe Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
    (ByVal hFtpSession As LongPtr, _
     ByVal lpszLocalFile As String, _
     ByVal lpszRemoteFile As String, _
     ByVal dwFlags As LongPtr, _
     ByVal dwContext As LongPtr) As Boolean
  '--

  Private Declare PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As LongPtr, _
     ByVal lpszDirectory As String) As Boolean

  Private Declare PtrSafe Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As LongPtr, _
     ByVal lpszSearchFile As String, _
     lpFindFileData As WIN32_FIND_DATA, _
     ByVal dwFlags As LongPtr, _
     ByVal dwContent As LongPtr) As LongPtr

  Private Declare PtrSafe Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As LongPtr, _
     lpFindFileData As WIN32_FIND_DATA) As LongPtr

  Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As LongPtr) As Integer

#Else

  Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As Currency
    ftLastAccessTime As Currency
    ftLastWriteTime As Currency
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
  End Type

  Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, _
     ByVal lAccessType As Long, _
     ByVal sProxyName As String, _
     ByVal sProxyBypass As String, _
     ByVal lFlags As Long) As Long

  Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
    (ByVal hInternetSession As Long, _
     ByVal sServerName As String, _
     ByVal nServerPort As Integer, _
     ByVal sUsername As String, _
     ByVal sPassword As String, _
     ByVal lService As Long, _
     ByVal lFlags As Long, _
     ByVal lContext As Long) As Long

  '--
  Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
    (ByVal hFtpSession As Long, _
     ByVal lpszRemoteFile As String, _
     ByVal lpszNewFile As String, _
     ByVal fFailIfExists As Boolean, _
     ByVal dwFlagsAndAttributes As Long, _
     ByVal dwFlags As Long, _
     ByVal dwContext As Long) As Boolean

  Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
    (ByVal hFtpSession As Long, _
     ByVal lpszLocalFile As String, _
     ByVal lpszRemoteFile As String, _
     ByVal dwFlags As Long, _
     ByVal dwContext As Long) As Boolean
  '--
  
  Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
    (ByVal hFtpSession As Long, _
     ByVal lpszDirectory As String) As Boolean

  Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
    (ByVal hFtpSession As Long, _
     ByVal lpszSearchFile As String, _
     lpFindFileData As WIN32_FIND_DATA, _
     ByVal dwFlags As Long, _
     ByVal dwContent As Long) As Long

  Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" _
    (ByVal hFind As Long, _
     lpFindFileData As WIN32_FIND_DATA) As Long

  Private Declare Function InternetCloseHandle Lib "wininet.dll" _
    (ByVal hInet As Long) As Integer

#End If


Public Sub ZagruzkaSFTP()

  #If Win64 Then
    Dim hOpen As LongPtr, hConn As LongPtr, hFind As LongPtr, ret As LongPtr, ftpMode As LongPtr
  #Else
    Dim hOpen As Long, hConn As Long, hFind As Long, ret As Long, ftpMode As Long
  #End If

  Dim hostName As String, port As Long, username As String, password As String
  Dim localFolder As String
  Dim remoteDirectory As String, remoteMatchFiles As String
  Dim fileFind As WIN32_FIND_DATA
  Dim newestFileTime As Currency
  Dim newestFileName As String

  Dim fDate As Date
  Dim srtMassivArhFTP()
  Dim intElemMassivArhFTP As Integer
  Dim XXX As Integer
  Dim DataVFaile As String

  Dim srtMassivNujnArh()
  Dim srtElemMassivNujnArh

  Dim PoluchData
  Dim Schetchik As Integer

  Dim failARH As String
  Dim blnNaidenAll As Boolean

  intElemMassivArhFTP = 0

  'localFolder = PutKPapkeProg & PapkaSArhivami
  hostName = "ftp.intel.com"
  port = 21
  username = ""
  password = ""
  remoteDirectory = "/Pub/papers/"
  remoteMatchFiles = "*"

  '===========================================

  'ftpMode = 0
  ftpMode = INTERNET_FLAG_PASSIVE      'passive mode FTP

  ret = InternetOpen("ftp VBA", 1, vbNullString, vbNullString, 0)
  hOpen = ret

  If ret > 0 Then
    ret = InternetConnect(hOpen, hostName, port, username, password, INTERNET_SERVICE_FTP, ftpMode, 0)
    hConn = ret
  End If

  If ret > 0 Then
    ret = FtpSetCurrentDirectory(hConn, remoteDirectory)
  End If

  If ret > 0 Then

    'Find first matching file

    fileFind.cFileName = String(MAX_PATH, vbNullChar)


    ret = FtpFindFirstFile(hConn, remoteMatchFiles, fileFind, INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRITE, 0)
    hFind = ret
    newestFileName = ""

    While ret > 0
      Debug.Print TrimNulls(fileFind.cFileName)

      newestFileName = newestFileName & TrimNulls(fileFind.cFileName) & Chr(10)

      fileFind.cFileName = String(MAX_PATH, vbNullChar)
      ret = InternetFindNextFile(hFind, fileFind)

    Wend

  End If

  '    If ret = 0 Then
  '        Debug.Print "FtpGetFile error "; Err.LastDllError
  '        MsgBox "FtpGetFile error "
  '    End If

  'Release handles

  InternetCloseHandle hFind
  InternetCloseHandle hConn
  InternetCloseHandle hOpen

  MsgBox "Файлы:" & Chr(10) & newestFileName
End Sub

Private Function TrimNulls(buffer As String) As String
  TrimNulls = Left(buffer, InStr(buffer, vbNullChar) - 1)
End Function
27 янв 19, 04:44    [21795081]     Ответить | Цитировать Сообщить модератору
Все форумы / Visual Basic Ответить