Подключение ресурсов С помощью ... Код не мой нашёл в нете, только что! Option Explicit Public 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 Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long Public ErrorNum As Long Public ErrorMsg As String Public rc As Long Public RemoteName As String Public Const ERROR_BAD_DEV_TYPE = 66& Public Const ERROR_ALREADY_ASSIGNED = 85& Public Const ERROR_ACCESS_DENIED = 5& Public Const ERROR_BAD_NET_NAME = 67& Public Const ERROR_BAD_PROFILE = 1206& Public Const ERROR_BAD_PROVIDER = 1204& Public Const ERROR_BUSY = 170& Public Const ERROR_CANCEL_VIOLATION = 173& Public Const ERROR_CANNOT_OPEN_PROFILE = 1205& Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202& Public Const ERROR_EXTENDED_ERROR = 1208& Public Const ERROR_INVALID_PASSWORD = 86& Public Const ERROR_NO_NET_OR_BAD_PATH = 1203& Public Const ERROR_NO_NETWORK = 1222& Public Const ERROR_NO_CONNECTION = 8 Public Const ERROR_NO_DISCONNECT = 9 Public Const ERROR_DEVICE_IN_USE = 2404& Public Const ERROR_NOT_CONNECTED = 2250& Public Const ERROR_OPEN_FILES = 2401& Public Const ERROR_MORE_DATA = 234 Public Const CONNECT_UPDATE_PROFILE = &H1 Public Const RESOURCETYPE_DISK = &H1 Public 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 Public lpNetResourse As NETRESOURCE Public wn_HOST As String, wn_USERNAME As String, wn_PASW As String Public shr_ent As Boolean Public 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 Public 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
Ответить
|