VB 6 Как проверить наличие файла на всех имеющихся дисках?

Тема в разделе "Visual Basic 6 / Сценарии VBScript, JScript", создана пользователем Kиpилл, 11 сен 2016.

  1. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    То есть включая флэшки,ромы и т.д.
    Известны только название папки и ее адрес на предполагаемом диске,а имя диска сохранить в переменную.
    Например как тут
    Код (vb.net):
    for %%i in (C D E F G H I J K L M N O P Q R S T U V W X Y Z) do if exist %%i:\WIN51 set CDROM=%%i:
     
  2. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.477
    Симпатии:
    4.306
    Например, через WinAPI вот так:

    Код (vb.net):
    Option Explicit

    Private Const MAX_PATH As Long = 260&

    Private Declare Function GetLogicalDriveStrings Lib "kernel32.dll" Alias "GetLogicalDriveStringsW" (ByVal nBufferLength As Long, ByVal lpBuffer As Long) As Long
    Private Declare Function DeviceIoControl Lib "kernel32.dll" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, ByVal lpOutBuffer As Long, ByVal nOutBufferSize As Long, lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
    Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileW" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long

    Private Const FILE_READ_ATTRIBUTES          As Long = &H80&
    Private Const OPEN_EXISTING                 As Long = 3&
    Private Const FILE_SHARE_READ               As Long = &H1&
    Private Const FILE_SHARE_WRITE              As Long = &H2&
    Private Const IOCTL_STORAGE_CHECK_VERIFY2   As Long = &H2D0800

    Private Sub Form_Load()

        Dim Drives() As String
        Dim i As Long
       
        'список дисков в массив
        Drives = GetDrives()

        'перечисляем содержимое массива
        For i = 1 To UBound(Drives)
            Debug.Print Drives(i)
        Next
       
    End Sub

    Function GetDrives() As String()
       
        Dim BufLen As Long
        Dim Buf As String
        Dim i As Long
        Dim Drives
        Dim ReadyDrives() As String
        Dim idx As Long
        Dim hDevice As Long
        Dim cbBytesReturned As Long

        Buf = String$(MAX_PATH, 0)

        'получаем список всех букв дисков в системе
        BufLen = GetLogicalDriveStrings(MAX_PATH, StrPtr(Buf))
       
        If BufLen <> 0 Then
            Buf = Left$(Buf, BufLen - 1)
            Drives = Split(Buf, vbNullChar)
           
            ReDim ReadyDrives(UBound(Drives) + 1)
           
            For i = 0 To UBound(Drives)
                hDevice = CreateFile(StrPtr("\\.\" & Left$(Drives(i), 2)), _
                                 FILE_READ_ATTRIBUTES, _
                                 FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                                 ByVal 0&, OPEN_EXISTING, 0&, 0&)
           
                If hDevice <> 0 Then
               
                    'проверяем готово ли устройство (вставлен ли диск)
                    If DeviceIoControl(hDevice, _
                                IOCTL_STORAGE_CHECK_VERIFY2, _
                                ByVal 0&, 0&, _
                                0&, 0&, _
                                cbBytesReturned, _
                                0&) Then
                       
                        idx = idx + 1
                        ReadyDrives(idx) = Drives(i)
                    End If
                   
                    CloseHandle hDevice
                End If
            Next
        End If
       
        If idx > 0 Then
            ReDim Preserve ReadyDrives(idx)
        Else
            ReDim ReadyDrives(0)
        End If
       
        GetDrives = ReadyDrives
       
        '// todo: do not send IOCTL_STORAGE_CHECK_VERIFY2 control code to floppy drive.
        'use IOCTL_STORAGE_CHECK_VERIFY instead.
       
    End Function
     
     
    Kиpилл нравится это.
  3. Сергей
    Оффлайн

    Сергей Активный пользователь

    Сообщения:
    252
    Симпатии:
    120
    А как Вам FSO?
    Код (vb.net):
    For i = 65 To 90
       If fso.FileExists(Chr(i) + ":\Papka\Fajl") Then
       '...
       End If
    Next i
    Или по контролу Drive
    Код (vb.net):
    Drive1.Refresh
    For i = 0 to Drive1.ListCount
       If fso.FileExists(Left(Drive1.List(i), 1) + ":\Papka\Fajl") Then
       '...
       End If
    Next i
     
    Последнее редактирование модератором: 12 сен 2016
    Kиpилл нравится это.
  4. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.477
    Симпатии:
    4.306
    Это не тоже самое. Здесь нет проверки на готовность устройства. Если этого не делать, система (не программа) выдаст предупреждение "Устройство не готово" на некоторых дисках, например, пустом кардридере, а Ваша программа в этот момент подвиснет.

    Если нужно через FSO, то делается так:
    Код (vb.net):
    Option Explicit

    Private Sub Form_Load()
        Dim oFSO As Object
        Dim oDrive As Object

        Set oFSO = CreateObject("Scripting.FileSystemObject")
       
        For Each oDrive In oFSO.Drives
            If oDrive.IsReady Then
                Debug.Print oDrive.DriveLetter
            End If
        Next
    End Sub
    Но в отличие от варианта через WinAPI будет зависимость от COM (библиотека scrrun.dll)
     
    Kиpилл нравится это.
  5. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    Да,ребята)
    Я примерно вариант Сергея мудрить пытался,но не додумался про перебор по цифрам.
    Надо все испытать в бою,результаты сообщу)
     
  6. Сергей
    Оффлайн

    Сергей Активный пользователь

    Сообщения:
    252
    Симпатии:
    120
    Если проверять наличие файла, то в FSO это очень быстро, быстрее от Dir(...) в разы, если не десятки раз. Но обращаясь к диску в FSO, Вы скрыто получаете очень много информации
    Код (vb.net):
        Set Disk = fso.Getdrive("D")
    if Disk.IsReary Then
     
    обращаясь к Getdrive Вам заранее подготавливается ответ на вопрос про подключен ли диск, название файловой системы, букву дика, название, серийный номер, розмер диска и свободного места на нем... - это может занять больше секунды. А потом мы спрашиваем всего лишь IsReary или нет. Мне кажется, єто будет дольше, чем проверка пустого привода, там будет просто ответ, что файла нет. Если так необходимо, то можно воспользоваться Drive1.Refresh контрола Drive он то покажет только существующие диски (а во время подключения сидюка там будет ожидание, пока он подключится)
     
  7. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.477
    Симпатии:
    4.306
    А FSO-шная FileExists что из воздуха будет брать инфу о проверке файла?
    Конечно же будет обращение к диску и аналогичный результат - "Устройство не готово", если произойдёт обращение к отключённому диску.
    GetDrive делать не нужно, если уже есть коллекция Drives. Её элементами и есть объекты Drive.

    Если нужна скорость, быстрее всего будет через WinAPI, т.к. в итоге все вызовы сводятся к нему и не будет попытки получить ненужную в данный момент информацию, как с объектом Drive, на что тратится дополнительное время.
     
    Сергей нравится это.
  8. glax24
    Оффлайн

    glax24 Разработчик

    Сообщения:
    2.000
    Симпатии:
    1.450
    это точно
     
    Сергей нравится это.
  9. Сергей
    Оффлайн

    Сергей Активный пользователь

    Сообщения:
    252
    Симпатии:
    120
    FSO иногда берет инфу чуть ли не с воздуха. Например MsgBox fso.GetExtensionName("Aaa.bbb") дает правильное розширение "bbb", хотя файла такого не существует. Или MsgBox fso.GetParentFolderName("123:\456\789") даст правильный адрес несуществующей родительской папки "123:\456".
    _ Что инетересно, если проверять существование разных файлов 100000 раз или одного 100000 раз, то для 1 файла одинаковая команда выполняется быстрее. Видимо оно где то запечатляется. Проверка существования одного файла при помощи Dir тем медленнее, чем больше файлов в папке, и зависит от файловой системы (FAT32 медленнее чем NTFS, в которой Dir не бегает по всему (фрагментированному) диску, а проверяет лишь "список" существующих).
    _ И Вы (Dragokas) правы, что API быстрее тех, кто к ней обращается. А возможно ли в API ошибочно прибегнуть к тому, чем пользуется Dir а не к тому чем пользуется FSO.FileExists, или у них разный подход к одному и тому же?
    _
    _Так или иначе человеку в теме нужен был не метод проверки существования файла, а метод перебора дисков.
     
    Последнее редактирование: 14 сен 2016
  10. Dragokas
    Оффлайн

    Dragokas Very kind Developer Команда форума Супер-Модератор Разработчик Клуб переводчиков

    Сообщения:
    4.477
    Симпатии:
    4.306
    А зачем ему существовать. Обычный парсинг. Можно самому написать. Я обычно так и делаю, чтобы не использовать FSO.
    Тоже самое. Просто отсекается всё после последнего слеша.
    Если стоит задача ускорить проверку файлов с учетом повторов, то быстрее будет создать параллельно с проверкой локальный кеш на основе словаря.
    Вообще, проверку на наличие файла можно выполнить как минимум 6 способами (имеется в виду на основе WinAPI).
    FSO.FileExists не использует FindFirstFile API
    fso.png
    Нет. Это из-за журналирования и индексации.
    Не понял вопроса.
    Не я поднял этот вопрос. Хотите, создайте новую тему.
     
    Kиpилл и Сергей нравится это.
  11. Kиpилл
    Оффлайн

    Kиpилл Команда форума Администратор

    Лучший автор месяца

    Сообщения:
    12.208
    Симпатии:
    4.977
    Если честно и то и другое,ну дальше попробую разобраться самостоятельно.

    Испытал все предложенные методы,ощутимой разницы в скорости не увидел...но у меня нету картридера сидюка,так что ситуацию с ними спроецировать не могу пока.
     

Поделиться этой страницей