Как подключиться к сетевому ресурсу

Автор: Randy Birch

Компилятор: Visual Basic

Первые две функции показывают стандартные диалоги "Подключение сетевого диска" и "отключение ..". Вторые две показывают диалоги подключения и отключения сетевого принтера. Третья пара функций поключает сетевые диски без участия пользователя. Предвоследняя кнопка показывает Проводник, чтобы видеть изменения в системе.

Добавьте на форму восемь кнопок и следующий код:

Option Explicit

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" _
    Alias "WNetAddConnection2A" _
   (lpNetResource As NETRESOURCE, _
    ByVal lpPassword As String, _
    ByVal lpUserName As String, _
    ByVal dwFlags As Long) As Long
       
Private Declare Function WNetCancelConnection2 Lib "mpr" _
    Alias "WNetCancelConnection2A" _
   (ByVal lpName As String, _
    ByVal dwFlags As Long, _
    ByVal fForce As Long) As Long
       
Private Declare Function WNetConnectionDialog Lib "mpr" _
   (ByVal hwnd As Long, ByVal dwType As Long) As Long
   
Private Declare Function WNetDisconnectDialog Lib "mpr" _
   (ByVal hwnd As Long, ByVal dwType As Long) As Long

'Private Const RESOURCE_CONNECTED = &H1
'Private Const RESOURCE_REMEMBERED = &H3
'Private Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
'Private Const RESOURCEDISPLAYTYPE_GENERIC = &H0
'Private Const RESOURCEDISPLAYTYPE_SERVER = &H2
'Private Const RESOURCEUSAGE_CONTAINER = &H2

Private Const ERROR_SUCCESS = 0
Private Const CONNECT_UPDATE_PROFILE = &H1
Private Const RESOURCETYPE_DISK = &H1
Private Const RESOURCETYPE_PRINT = &H2
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCEDISPLAYTYPE_SHARE = &H3
Private Const RESOURCEUSAGE_CONNECTABLE = &H1

Private Declare Function ShellExecute Lib "shell32" _
    Alias "ShellExecuteA" _
   (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
    
Private Const SW_SHOWNORMAL = 1

         
Private Sub Command1_Click(Index As Integer)

   Dim x As Long
   
   Select Case Index
      Case 0: 'Диалог подключения сетевого диска
              'Если функция выполнена успешно, то возвращённое значение
              'будет ERROR_SUCCESS (0). Если пользователь нажал "отмену"
              'то вернётся значение &HFFFFFFFF (или -1).
              '
              'Если в функцию передать hwnd, то диалог отобразится
              'модально по отношению к форме. Если вместо этого параметра
              'передать 0&, то родительским будет рабочий стол.
               Call WNetConnectionDialog(Me.hwnd, RESOURCETYPE_DISK)
      
      Case 1: 'Отключение сетевого диска
              'В случае удачи вернётся значение
              'ERROR_SUCCESS (0). В случае отмены &HFFFFFFFF.
              '
              'Если в функцию передать hwnd, то диалог отобразится
              'модально по отношению к форме. Если вместо этого параметра
              'передать 0&, то родительским будет рабочий стол.
               Call WNetDisconnectDialog(Me.hwnd, RESOURCETYPE_DISK)
               
      Case 2: 'Подключаем сетевой принтер.
              'если писать в одну строку, то должно быть так:
              '"rundll32.exe shell32.dll,SHHelpShortcuts_RunDLL AddPrinter"
              'без дополнительных пробелов.
               Call Shell("rundll32.exe shell32.dll," & _
                          "SHHelpShortcuts_RunDLL AddPrinter", _
                           vbNormalFocus)
              'В Windows NT, можно вызвать встроенный системный диалог
              'подключения сетевого принтера при помощи API функции -
              'ConnectToPrinterDlg. Однако этот диалог не получится
              'вызвать из Visual Basic в Windows 95.
              'Тем не менее, Вы должны использовать командную строку
              'как описано в статье MSDN "Add Printer Wizard"
              '(KB article Q154007)
               
      Case 3: 'Отключаем сетевой принтер
              'В случае удачи вернётся значение
              'ERROR_SUCCESS (0). В случае отмены &HFFFFFFFF.
              '
              'Если в функцию передать hwnd, то диалог отобразится
              'модально по отношению к форме. Если вместо этого параметра
              'передать 0&, то родительским будет рабочий стол.
               Call WNetDisconnectDialog(Me.hwnd, RESOURCETYPE_PRINT)
      
      Case 4: 'Подключаем ресурс как букву диска
               MsgBox ConnectThisNetworkDrive("\\someserver\c$", "G:")
      
      Case 5: 'Подключаем ресурс к следующей свободной букве диска
               MsgBox ConnectNextFreeNetworkDrive("\\someserver\c$")
      
      Case 6: 'показываем проводник
               Call ShellExecute(0&, "Open", _
                                 "explorer.exe", "/e,/n,c:\", _
                                 0&, SW_SHOWNORMAL)
      Case 7: 'Завершаем программу
               Unload Me
      
   End Select
   
End Sub


Private Function ConnectNextFreeNetworkDrive(sServer As String) As String

   Dim NETR As NETRESOURCE
   Dim errInfo As Long
   Dim x As Long
   Dim testDrv As String
   
  'устанавливаем первую букву как C (ASCII 67), а затем, в случае
  'неудачи, увеличиваем её.
   x = 67
   
   Do
     
     'пробуем использовать букву D:
      x = x + 1
      testDrv = Chr$(x) & ":"
      
      With NETR
         .dwScope = RESOURCE_GLOBALNET
         .dwType = RESOURCETYPE_DISK
         .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
         .dwUsage = RESOURCEUSAGE_CONNECTABLE
         .lpRemoteName = sServer
         .lpLocalName = testDrv
      End With
      
      errInfo = WNetAddConnection2(NETR, _
                                   vbNullString, _
                                   "username", _
                                   CONNECT_UPDATE_PROFILE)
      
   Loop Until x = 90 Or errInfo = ERROR_SUCCESS   '90 = "z"
   
   
  'в случае удачи возвращаем диск
   If errInfo = ERROR_SUCCESS Then
         ConnectNextFreeNetworkDrive = testDrv
   Else: ConnectNextFreeNetworkDrive = "no dice"
   End If
   
End Function


Private Function ConnectThisNetworkDrive(sServer As String, _
                                         sDrv As String) As Boolean

  'Пытаемся подключить сетевой ресурс
  'как указанный диск.
  'если всё впорядке, то ErrInfo=ERROR_SUCCESS

   Dim NETR As NETRESOURCE
   Dim errInfo As Long
   
   With NETR
      .dwScope = RESOURCE_GLOBALNET
      .dwType = RESOURCETYPE_DISK
      .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
      .dwUsage = RESOURCEUSAGE_CONNECTABLE
      .lpRemoteName = sServer
      .lpLocalName = sDrv
   End With
   
   errInfo = WNetAddConnection2(NETR, _
                                vbNullString, _
                                "username", _
                                CONNECT_UPDATE_PROFILE)
   
   ConnectThisNetworkDrive = errInfo = ERROR_SUCCESS

End Function