'КОД ФОРМЫ
Private Sub Command1_Click()
Call Module1.Connect("Sany\c$", "K:", "defaultsharename", "garik")
If (Module1.rc <> 0) And (Module1.rc <> 85) Then
MsgBox Module1.ErrorMsg
End If
End Sub
Private Sub Command2_Click()
Call Module1.DisConnect("K:", True)
If (Module1.rc <> 0) And (Module1.rc <> 85) Then
MsgBoxn Module1.ErrorMsg
End If
End Sub
'КОД МОДУЛЯ
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 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
EndFunction |
|
