Некорректное получение имен файлов с FTP / Visual Basic

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Некорректное получение имен файлов с FTP

9 сообщений из 9, страница 1 из 1

Некорректное получение имен файлов с FTP

#39758189

Bobax012

Гость

Хочу получить имена всех файлов с 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". В чем может быть дело, подскажите.

Код: vbnet

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
202.
203.
204.
205.
206.
207.
208.
209.
210.
211.
212.
213.
214.
215.
216.
217.
218.
219.
220.
221.
222.
223.
224.
225.
226.
227.
228.
229.
230.
231.
232.
233.
234.

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

...

Рейтинг:

0 / 0

11.01.2019, 00:11

| Ответить | Цитировать | Написать

Некорректное получение имен файлов с FTP

#39758256

ldfanate

Участник

Сообщения: 269

Рейтинг: 0 / 0

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

...

Рейтинг:

0 / 0

11.01.2019, 09:21

| Ответить | Цитировать | Написать

Некорректное получение имен файлов с FTP

#39758318

iMrTidy

Участник

Сообщения: 775

Рейтинг: 0 / 0

ldfanate,

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

...

Рейтинг:

0 / 0

11.01.2019, 10:52

| Ответить | Цитировать | Написать

Некорректное получение имен файлов с FTP

#39758657

Bobax012

Гость

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

Код: vbnet

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

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

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

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

iMrTidyldfanate,

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

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

Если у кого-то есть еще какие-то варианты решения проблемы, напишите пожалуйста.

...

Рейтинг:

0 / 0

12.01.2019, 00:23

| Ответить | Цитировать | Написать

Некорректное получение имен файлов с FTP

#39758837

iMrTidy

Участник

Сообщения: 775

Рейтинг: 0 / 0

Bobax012,

https://docs.microsoft.com/en-us/office/vba/language/concepts/getting-started/64-bit-visual-basic-for-applications-overview

...

Рейтинг:

0 / 0

12.01.2019, 21:43

| Ответить | Цитировать | Написать

Некорректное получение имен файлов с FTP

#39759179

ldfanate

Участник

Сообщения: 269

Рейтинг: 0 / 0

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

...

Рейтинг:

0 / 0

14.01.2019, 09:06

| Ответить | Цитировать | Написать

Некорректное получение имен файлов с FTP

#39759615

Bobax012

Гость

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

Код: vbnet

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

...

Рейтинг:

0 / 0

15.01.2019, 03:40

| Ответить | Цитировать | Написать

Некорректное получение имен файлов с FTP

#39759616

Bobax012

Гость

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

А как-то это можно подправить в коде?

...

Рейтинг:

0 / 0

15.01.2019, 03:43

| Ответить | Цитировать | Написать

Некорректное получение имен файлов с FTP

#39765426

ZVI

Участник

Откуда: Sevastopol

Сообщения: 473

Рейтинг: 0 / 0

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

Код: vbnet

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

...

Рейтинг:

0 / 0

27.01.2019, 04:44

| Ответить | Цитировать | Написать

9 сообщений из 9, страница 1 из 1

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Некорректное получение имен файлов с FTP

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=60&msg=39758837&tid=2154951]:	0ms
get settings:	11ms
get forum list:	12ms
check forum access:	3ms
check topic access:	3ms
track hit:	37ms
get topic data:	10ms
get forum data:	3ms
get page messages:	45ms
get tp. blocked users:	1ms
others:	266ms

total:	391ms