Мой Kbyte.Ru
Рассылка Kbyte.Ru
Группы на Kbyte.Ru
Партнеры Kbyte.Ru
Реклама
Сделано руками
Сделано руками
> Исходные коды - Randy Birch -

Visual Basic 5.0/6.0 - Сеть и Интернет

Все примеры / Сеть и Интернет

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

Автор: Randy Birch | добавлено: 06.03.2010, 11:13 | просмотров: 3211 (2+) | комментариев: 0 | рейтинг: *x10
Первые две функции показывают стандартные диалоги "Подключение сетевого диска" и "отключение ..". Вторые две показывают диалоги подключения и отключения сетевого принтера. Третья пара функций подключает сетевые диски без участия пользователя. Предпоследняя кнопка показывает Проводник, чтобы видеть изменения в системе.

Инструкции

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

Код

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
Обратите внимание
Язык Visual Basic 6.0 является устаревшим. Многие примеры, размещенные на нашем сайте, были созданы еще во времена Windows 98 и могут не работать в современных операционных системах.
Если у вас возникнут какие-либо проблемы или вопросы, вы можете обратиться за помощью на наш форум.
Об авторе

Randy Birch

Нет информации об авторе...
Randy Birch
Последние комментарии (всего: 0)

Добавлять комментарии могут только зарегистрированные пользователи сайта.
Если у Вас уже есть учетная запись на Kbyte.Ru, пройдите процедуру авторизации OpenID.
Если Вы еще не зарегистрированы на Kbyte.Ru - зарегистрируйтесь.


Нет комментариев...

Авторизация
 
OpenID
Зарегистрируйся и получи 10% скидку на добавление своего сайта в каталоги! Подробнее »
Поиск по сайту
Реклама
Счетчики