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

Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long

Private ErrorNum As Long, ErrorMsg As String, rc As Long, RemoteName As String

Private Const ERROR_BAD_DEV_TYPE = 66&

Private Const ERROR_ALREADY_ASSIGNED = 85&

Private Const ERROR_ACCESS_DENIED = 5&

Private Const ERROR_BAD_NET_NAME = 67&

Private Const ERROR_BAD_PROFILE = 1206&

Private Const ERROR_BAD_PROVIDER = 1204&

Private Const ERROR_BUSY = 170&

Private Const ERROR_CANCEL_VIOLATION = 173&

Private Const ERROR_CANNOT_OPEN_PROFILE = 1205&

Private Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202&

Private Const ERROR_EXTENDED_ERROR = 1208&

Private Const ERROR_INVALID_PASSWORD = 86&

Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&

Private Const ERROR_NO_NETWORK = 1222&

Private Const ERROR_NO_CONNECTION = 8

Private Const ERROR_NO_DISCONNECT = 9

Private Const ERROR_DEVICE_IN_USE = 2404&

Private Const ERROR_NOT_CONNECTED = 2250&

Private Const ERROR_OPEN_FILES = 2401&

Private Const ERROR_MORE_DATA = 234

Private Const CONNECT_UPDATE_PROFILE = &H1

Private Const RESOURCETYPE_DISK = &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 lpNetResourse As NETRESOURCE



Private Sub Connect(ByVal HostName As String, ByVal RemoteName As String, ByVal Username As String, ByVal Password As String)

Dim lpUsername As String

Dim lpPassword As String

On Error GoTo Err_Connect

ErrorNum = 0

ErrorMsg = ""

lpNetResourse.dwType = RESOURCETYPE_DISK

lpNetResourse.lpLocalName = RemoteName & Chr(0)

'Drive Letter to use

lpNetResourse.lpRemoteName = "\\" & HostName & Chr(0)

'Network Path to share

lpNetResourse.lpProvider = Chr(0)

lpPassword = Password & Chr(0)

'password on share pass "" if none

lpUsername = Username & Chr(0)

'username to connect as if applicable

rc = WNetAddConnection2(lpNetResourse, lpPassword, lpUsername, CONNECT_UPDATE_PROFILE)

If rc <> 0 Then GoTo Err_Connect

Exit Sub

Err_Connect:

ErrorNum = rc

ErrorMsg = WnetError(rc)

End Sub



Private Sub DisConnect(ByVal Name As String, ByVal ForceOff As Boolean)

On Error GoTo Err_DisConnect

ErrorNum = 0

ErrorMsg = ""

rc = WNetCancelConnection2(Name & Chr(0), CONNECT_UPDATE_PROFILE, ForceOff)

If rc <> 0 Then GoTo Err_DisConnect

Exit Sub

Err_DisConnect:

ErrorNum = rc

ErrorMsg = WnetError(rc)

End Sub



Private Function WnetError(Errcode As Long) As String

Select Case Errcode

Case ERROR_BAD_DEV_TYPE

WnetError = "Bad device."

Case ERROR_ALREADY_ASSIGNED

WnetError = "Already Assigned."

Case ERROR_ACCESS_DENIED

WnetError = "Access Denied."

Case ERROR_BAD_NET_NAME

WnetError = "Bad net name"

Case ERROR_BAD_PROFILE

WnetError = "Bad Profile"

Case ERROR_BAD_PROVIDER

WnetError = "Bad Provider"

Case ERROR_BUSY

WnetError = "Busy"

Case ERROR_CANCEL_VIOLATION

WnetError = "Cancel Violation"

Case ERROR_CANNOT_OPEN_PROFILE

WnetError = "Cannot Open Profile"

Case ERROR_DEVICE_ALREADY_REMEMBERED

WnetError = "Device already remembered"

Case ERROR_EXTENDED_ERROR

WnetError = "Device already remembered"

Case ERROR_INVALID_PASSWORD

WnetError = "Invalid Password"

Case ERROR_NO_NET_OR_BAD_PATH

WnetError = "Could not find the specified device"

Case ERROR_NO_NETWORK

WnetError = "No Network Present"

Case ERROR_DEVICE_IN_USE

WnetError = "Connection Currently in use "

Case ERROR_NOT_CONNECTED

WnetError = "No Connection Present"

Case ERROR_OPEN_FILES

WnetError = "Files open and the force parameter is false"

Case ERROR_MORE_DATA

WnetError = "Buffer to small to hold network name, make lpnLength bigger"

Case Else:

WnetError = "Unrecognized Error " + Str(Errcode) + "."

End Select

End Function

‘ подключить

Call Connect("games\", "K:", "Andrey", "Password")

If (rc <> 0) And (rc <> 85) Then MsgBox ErrorMsg

‘отключить

Call DisConnect("K:", True)

If (rc <> 0) And (rc <> 85) Then MsgBox ErrorMsg