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

Узнай цену своей работы

Формулировка задачи:

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

Решение задачи: «Некорректное получение имен файлов с FTP»

textual
Листинг программы
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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

10   голосов , оценка 4.2 из 5