VBNet - Форум - О поиске логических дисков

Вопрос: О поиске логических дисков Добавлено: 02.09.07 03:22

Автор вопроса: Winand | Web-сайт: winandfx.narod.ru

Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Public Function FirstMuVoDrive() As String
Dim i As Long
For i = 67 To 90    ' От 'C:\' до 'Z:\'
    If GetDriveType(Chr$(i) & ":\") = 2 Then
        FirstMuVoDrive = Chr$(i) & ":\"
        Exit Function
    End If
Next i
FirstMuVoDrive = "C:\"
End Function

Вот такой был код.

ну зачем проверять весь диапазон? можно же получить сначала количество дисков в системе, их буквы, а потом уже их тип...

Тогда я придумал вот такой способ

Option Explicit
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Public remDriveLetters() As String

Public Sub GetRemDriveLetters()
Dim sDrives As String * 255, arDrives() As String
Dim POS As Long

Call GetLogicalDriveStrings(255, sDrives)
POS = InStr(1, sDrives, vbNullChar & vbNullChar)
sDrives = Left(sDrives, POS - 1)
arDrives = Split(sDrives, vbNullChar)

Dim i As Long
For i = 0 To UBound(arDrives)
    If GetDriveType(arDrives(i)) = 2 Then
        ReDim Preserve remDriveLetters(UUBound + 1)
        remDriveLetters(UUBound) = arDrives(i)
    End If
Next i
End Sub

Private Function UUBound() As Long
On Error GoTo X:
UUBound = UBound(remDriveLetters)
Exit Function
X: UUBound = -1
End Function

Как обычно мне интересно: есть ли варианты лучше? ))
Ответить

Ответы Всего ответов: 16

Номер ответа: 1 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #1	Добавлено: 02.09.07 03:24
	Собственно поиск СЪёМНЫХ дисков происходит Ответить

Номер ответа: 2 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445	Web-сайт: hw.t-k.ru Профиль \| \| #2	Добавлено: 02.09.07 11:18
	1. лучше способа не предусмотрено 2. ты не учитываешь что буфер может потребоваться большей длинны чем ты его задаешь. Так что сделал бы ты лучше динамическое выделение памяти, а размер узнавал бы вызовом GetLogicalDriveStrings(0, vbNullString) Ответить

Номер ответа: 3 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #3	Добавлено: 02.09.07 12:08
	Option Explicit Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Public remDriveLetters() As String Public Sub GetRemDriveLetters() Dim sDrives As String, arDrives() As String Dim LNG As Long LNG = GetLogicalDriveStrings(0, vbNullString) sDrives = Space(LNG - 2) 'String ends with double chr$(0),so we need "-2" Call GetLogicalDriveStrings(LNG, sDrives) arDrives = Split(sDrives, vbNullChar) Dim i As Long For i = 0 To UBound(arDrives) If GetDriveType(arDrives(i)) = 2 Then ReDim Preserve remDriveLetters(UUBound + 1) remDriveLetters(UUBound) = arDrives(i) End If Next i End Sub Private Function UUBound() As Long On Error GoTo X: UUBound = UBound(remDriveLetters) Exit Function X: UUBound = -1 End Function ВО! Ответить

Номер ответа: 4 Автор ответа: udpn Вопросов: 2 Ответов: 45	Профиль \| \| #4	Добавлено: 02.09.07 22:12
	DriveLetters никогда не будет больше 26. К чему этот гемор с динамическим массивом? Времени жрет до хрена, а выиграть 100 байт памяти - это смешно ))) Отпадает необходимость в медленном вызове UUBound (засунуть в стек все регистры и перейти! + отлов ошибок + без того медленный убаунд) В любом случае вместо UBound можно использовать переменную верхней границы (Split - единственное место где без него не обойтись). sDrives = Space(LNG - 2) опять же, зачем? разводишь перспективу для багов? да и вариант без минуса будет в итоге быстрее наконец, что если объявлять remDriveLetters типом As String * 1? попробуй оба варианта в твоем контексте, они равновероятно оказываются то быстрее, то медленнее. GetDriveType(arDrives(i)) = 2 в норме, но неплохо бы дать Const. Это будет хорошим стилем программирования. Ответить

Номер ответа: 5 Автор ответа: udpn Вопросов: 2 Ответов: 45	Профиль \| \| #5	Добавлено: 02.09.07 22:15
	да, еще. отступ необходим для любой открывающей конструкции, будь то Do, For, While, With или Function. Ответить

Номер ответа: 6 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #6	Добавлено: 03.09.07 01:50
	Хмм... Здесь всего 1 вызов UBound и 2 - ReDim Preserve Посчитал, если 26 лог.дисков, то буфер нужен длиной 103 (в функции длину нужно указывать на 2 больше - 105) Добавил константы, remDriveLetters - фиксированной длины (as string * 3) Option Explicit Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Const DRIVE_UNKNOWN As Long = 0 Private Const DRIVE_NO_ROOT_DIR As Long = 1 Private Const DRIVE_REMOVABLE As Long = 2 Private Const DRIVE_FIXED As Long = 3 Private Const DRIVE_REMOTE As Long = 4 Private Const DRIVE_CDROM As Long = 5 Private Const DRIVE_RAMDISK As Long = 6 Public remDriveLetters() As String * 3 Public Sub GetRemDriveLetters() Dim sDrives As String * 103, arDrives() As String Dim LNG As Long LNG = GetLogicalDriveStrings(0, vbNullString) Call GetLogicalDriveStrings(103 + 2, sDrives) arDrives = Split(sDrives, vbNullChar) Dim i As Long, uuBound As Long, topIndex As Long, driveType As Long topIndex = -1 uuBound = UBound(arDrives) ReDim Preserve remDriveLetters(uuBound) For i = 0 To uuBound driveType = GetDriveType(arDrives(i)) If driveType = DRIVE_REMOVABLE Then topIndex = topIndex + 1 remDriveLetters(topIndex) = arDrives(i) ElseIf driveType = DRIVE_NO_ROOT_DIR Then Exit For End If Next i ReDim Preserve remDriveLetters(topIndex) End Sub Ответить

Номер ответа: 7 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #7	Добавлено: 03.09.07 01:52
	Dim LNG As Long LNG = GetLogicalDriveStrings(0, vbNullString) Это забыл удалить Ответить

Номер ответа: 8 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #8	Добавлено: 03.09.07 02:10
	Осенило))ЮБаунд вообще не нужен оказывается Option Explicit Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Const DRIVE_NO_ROOT_DIR As Long = 1 Private Const DRIVE_REMOVABLE As Long = 2 Public remDriveLetters() As String * 3 Public Sub GetRemDriveLetters() Dim sDrives As String * 103, arDrives() As String Call GetLogicalDriveStrings(103 + 2, sDrives) arDrives = Split(sDrives, vbNullChar) Dim i As Long, topIndex As Long, driveType As Long topIndex = -1 ReDim Preserve remDriveLetters(25) For i = 0 To 25 driveType = GetDriveType(arDrives(i)) If driveType = DRIVE_REMOVABLE Then topIndex = topIndex + 1 remDriveLetters(topIndex) = arDrives(i) ElseIf driveType = DRIVE_NO_ROOT_DIR Then Exit For End If Next i ReDim Preserve remDriveLetters(topIndex) End Sub Ответить

Номер ответа: 9 Автор ответа: udpn Вопросов: 2 Ответов: 45	Профиль \| \| #9	Добавлено: 03.09.07 15:42
	молодец, сделал именно то о чем я говорил. а теперь попробуй заменить звезданутые стринги на обычные и сравни производительность в контексте. результат непредсказуем, но по-моему без активной работы со строковыми функциями (Mid, Left, Right) звездочки быстрее есть одно большое но, только сейчас заметил. прога вылетит к чертям если зареганы все диски. подумай почему. короче, говорить бесполезно, надо писать все самому ) Option Explicit Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long ' Никогда не удаляем ненужные константы. Комментируем "на случай если кому..." (c) Беляев или кто там так подписывается 'Private Const DRIVE_UNKNOWN As Long = 0 'Private Const DRIVE_NO_ROOT_DIR As Long = 1 Private Const DRIVE_REMOVABLE As Long = 2 'Private Const DRIVE_FIXED As Long = 3 'Private Const DRIVE_REMOTE As Long = 4 Private Const DRIVE_CDROM As Long = 5 'Private Const DRIVE_RAMDISK As Long = 6 Private mLetters(25) As String * 1 ' * 3 если надо "A:\" вместо "A". Обрезается оно автоматически и времени не занимет, так что оба варианта хороши. Private mCount As Long Public Sub GetRemDriveLetters() Dim DrivesStr As String Dim DrivesArr() As String Dim i As Long Dim DrivesStrLen As Long mCount = 0 rivesStrLen = GetLogicalDriveStrings(0, vbNullString) rivesStr = Space(DrivesStrLen) Call GetLogicalDriveStrings(DrivesStrLen, DrivesStr) rivesArr = Split(DrivesStr, vbNullChar) For i = 0 To UBound(DrivesArr) Select Case GetDriveType(DrivesArr(i)) Case DRIVE_REMOVABLE, DRIVE_CDROM 'CDROM тоже в некотоом смысле сменный... Ну да тебе виднее mLetters(mCount) = DrivesArr(i) mCount = mCount + 1 End If Next End Sub Ответить

Номер ответа: 10 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #10	Добавлено: 03.09.07 19:41
	Попробовал запихнуть в sDrives все букавы от A до Z. Не вылетела. А разве Select Case хорошая (всмысле скорости) функция? Ответить

Номер ответа: 11 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #11	Добавлено: 03.09.07 20:08
	константы это я именно в том коде удалил - чтоб меньше код был, а так и правда лучше знать все возможные варианты)) Option Explicit Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long 'Private Const DRIVE_UNKNOWN As Long = 0 'Private Const DRIVE_NO_ROOT_DIR As Long = 1 Private Const DRIVE_REMOVABLE As Long = 2 'Private Const DRIVE_FIXED As Long = 3 'Private Const DRIVE_REMOTE As Long = 4 Private Const DRIVE_CDROM As Long = 5 'Private Const DRIVE_RAMDISK As Long = 6 Public mLetters(25) As String * 3 Public mCount As Long Public Sub GetRemDriveLetters() Dim DrivesStr As String 'lpBuffer Dim DrivesStrLen As Long 'nBufferLength Dim DrivesArr() As String 'ALL Drives Array Dim drvType As Long '= GetDriveType Dim i As Long mCount = 0 rivesStrLen = GetLogicalDriveStrings(0, vbNullString) rivesStr = Space(DrivesStrLen - 2) Call GetLogicalDriveStrings(DrivesStrLen, DrivesStr) rivesArr = Split(DrivesStr, vbNullChar) For i = 0 To UBound(DrivesArr) drvType = GetDriveType(DrivesArr(i)) If drvType = DRIVE_REMOVABLE Then mLetters(mCount) = DrivesArr(i) mCount = mCount + 1 ElseIf drvType = DRIVE_CDROM Then mLetters(mCount) = DrivesArr(i) mCount = mCount + 1 End If Next End Sub Все таки настаиваю на DrivesStr = Space(DrivesStrLen - 2) Иначе массив после split получается с 2 лишними пустыми значениями. Тут нужно оставить комментарий, шоб понятно было Ответить

Номер ответа: 12 Автор ответа: udpn Вопросов: 2 Ответов: 45	Профиль \| \| #12	Добавлено: 03.09.07 20:21
	да ну ) а по-моему, если заняты все диски, ему не хватает буфера, происходит излияние в чужое пространство и порча либо соседних переменных либо едреный вылет с кодом 5 Программа выполнила... У меня происходит именно второе. Писать надо For i = 0 To UBound(DrivesArr) - 2 Select Case БЫВАЕТ быстрее. этот случай - как раз тот самый. Только End Select надо поставить Ответить

Номер ответа: 13 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #13	Добавлено: 03.09.07 22:21
	Ясно. Спасибо) Еще вопрос под конец Если сделать так: Public Function GetRemDriveLetters() As Long Можно ли вместо Public mCount As Long использовать саму функцию? Ответить

Номер ответа: 14 Автор ответа: udpn Вопросов: 2 Ответов: 45	Профиль \| \| #14	Добавлено: 03.09.07 23:04
	можно. но не нужно. а еще лучше объявить mCount и mLetters как Private и использовать ReadOnly свойства Ответить

Номер ответа: 15 Автор ответа: Winand Вопросов: 87 Ответов: 2795	Web-сайт: winandfx.narod.ru Профиль \| \| #15	Добавлено: 04.09.07 00:48
	Так это ж всё в модуле. Как я буду обращаться к mCount и mLetters, если они Private. Про ReadOnly ничего не знаю (вру: в UserControl это достигается вызовом ошибки при Property Let) Ответить

Страница: 1 | 2 |