| Версия для печати
Нажмите сюда для просмотра этой темы в оригинальном формате |
| Форум на Исходниках.RU > Работа с аппаратурой > Как программно подключить/отключить сете |
| Автор: Dufa 30.03.04, 16:20 |
| 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 |