Ситуация следующая: Я маунчу сетевой каталог, как диск. Чтобы далее с файлами на нём работать уже по локальным путям, а не unc.
- Код: Выделить всё
Option Explicit
Private Const NO_ERROR = 0
Private Const CONNECT_UPDATE_PROFILE = &H1
Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCETYPE_DISK = &H1
Private Const RESOURCEDISPLAYTYPE_SHARE = &H3
Private Const RESOURCEUSAGE_CONNECTABLE = &H1
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type
Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Public Function MountNetFolder(ByVal UNCPath As String, ByVal DriveLetter As String) As Boolean
Dim NetR As NETRESOURCE
Dim ErrInfo As Long
If IsValidDriveLetter(DriveLetter) = False Then
MountNetFolder = False
Exit Function
End If
With NetR
.dwScope = RESOURCE_GLOBALNET
.dwType = RESOURCETYPE_DISK
.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
.dwUsage = RESOURCEUSAGE_CONNECTABLE
.lpLocalName = DriveLetter 'Óêàçûâàòü ñ äâîåòî÷èåì
.lpRemoteName = UNCPath
End With
ErrInfo = WNetAddConnection2(NetR, vbNullString, vbNullString, CONNECT_UPDATE_PROFILE)
MountNetFolder = IIf((ErrInfo = NO_ERROR), True, False)
End Function
Проблема с дочерней функцией IsValidDriveLetter
Далее идёт полнейший бред, который ещё и криво работает. Сильно не бейте.
- Код: Выделить всё
Private Function IsValidDriveLetter(ByVal DriveLetter As String) As Boolean
DriveLetter = UCase$(DriveLetter)
'1 - Z 2 - Z:
If Len(DriveLetter) = 0 Or Len(DriveLetter) > 2 Then
IsValidDriveLetter = False
Exit Function
End If
'Задана только буква
If Len(DriveLetter) = 1 Then
If StrComp(DriveLetter, "A", vbTextCompare) <> 0 Then
IsValidDriveLetter = False
Exit Function
End If
If StrComp(DriveLetter, "B", vbTextCompare) <> 0 Then
IsValidDriveLetter = False
Exit Function
End If
If StrComp(DriveLetter, "C", vbTextCompare) <> 0 Then
IsValidDriveLetter = False
Exit Function
End If
DriveLetter = DriveLetter & ":"
End If
'Задана буква и второй символ (ожидается двоеточие)
If Len(DriveLetter) = 2 Then
If Mid$(DriveLetter, 2, 1) <> ":" Then
IsValidDriveLetter = False
Exit Function
End If
If StrComp(DriveLetter, "A:", vbTextCompare) <> 0 Then
IsValidDriveLetter = False
Exit Function
End If
If StrComp(DriveLetter, "B:", vbTextCompare) <> 0 Then
IsValidDriveLetter = False
Exit Function
End If
If StrComp(DriveLetter, "C:", vbTextCompare) <> 0 Then
IsValidDriveLetter = False
Exit Function
End If
End If
IsValidDriveLetter = True
End Function
То есть, мне надо проверить валидность имени диска, перед тем, как маунтить на него сетевой ресурс. Я понимаю, что такая проверка делается строк в 5 кода.
Далее я напишу функцию проверки, не занята ли данная буква диска. Заранее - огромное спасибо!
