映射网络盘-类模 [ 作者:gnoy 转贴自:歌逸软件网 点击数:155 更新时间:2006-11-4 文章录入:gnoy ] 发布日期:2006-11-4 作 者: gnoy 摘 要:用来映射网络硬盘的类模块 正 文: Option Compare Database Option Explicit 'Name clsMapdriver 'Purpose: Map net driver 'Version: 1.1 'Calls: None 'Returns: Property values. 'Created by: Gnoy Wang 'Credits: It's yours for the taking!<grin> 'Date: Jun 19,2004 'Time: 13:31:11 pm 'Feedback: gnoy@163.com 'Copyright: Please feel free to use this code ' without restriction in any application you develop, ' whether private or commercial. ' This code may not be resold by itself or as ' part of a collection. ' 'What's Missing!: Lots! This is just a start but you have to start somewhere! 'Bugs: Let me know! 'eg: '=================================================================================== ' Dim objMapdriver As New clsMapdriver ' With objMapdriver ' .Localdriver = "w:" 'to be changed ' .RemoteName = "\\...\..." 'to be changed ' .UserName = "username" 'to be changed ' .UserPassword = "password" 'to be changed ' ' If Not .Added Then ' .AddNetDriver ' End If ' 'If Not .Deleted Then ' '.DeleteNetDriver ' 'End If ' End With '=================================================================================== 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 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 Dim theNetResource As NETRESOURCE Dim strUserName As String Dim strUserPassword As String Dim strNetFullpath As String Dim strLocaldriver As String Dim blnadd As Boolean Dim blndelete As Boolean Public Property Let RemoteName(strRemoteName As String) strNetFullpath = strRemoteName End Property Public Property Let UserName(strName As String) strUserName = strName End Property Public Property Let UserPassword(strPassword As String) strUserPassword = strPassword End Property Public Property Let Localdriver(strdriver As String) strLocaldriver = strdriver End Property Public Property Get Localdriver() As String Localdriver = strLocaldriver End Property Public Property Get UserPassword() As String UserPassword = strUserPassword End Property Public Property Get UserName() As String UserName = strUserName End Property Public Property Get RemoteName() As String RemoteName = strNetFullpath End Property Public Property Get Added() As Boolean Added = blnadd End Property Public Property Get Deleted() As Boolean Deleted = blndelete End Property Private Sub Class_Initialize() ' End Sub Private Sub Class_Terminate() ' End Sub Public Function AddNetDriver() As Boolean On Error GoTo ADD_Err: theNetResource.lpRemoteName = RemoteName theNetResource.lpLocalName = Localdriver UserName = UserName UserPassword = UserPassword theNetResource.dwType = RESOURCETYPE_DISK WNetAddConnection2 theNetResource, UserPassword, UserName, 0 AddNetDriver = True blnadd = True Exit Function ADD_Err: AddNetDriver = False blnadd = False End Function Public Function DeleteNetDriver() As Boolean On Error GoTo delete_Err: theNetResource.lpRemoteName = RemoteName WNetCancelConnection2 theNetResource.lpLocalName, 0, 0 DeleteNetDriver = True blndelete = True Exit Function delete_Err: DeleteNetDriver = False blndelete = False End Function 将以上类模保存为:clsMapdriver 然后按如下调用 'eg: '=================================================================================== ' Dim objMapdriver As New clsMapdriver ' With objMapdriver ' .Localdriver = "w:" 'to be changed ' .RemoteName = "\\...\..." 'to be changed ' .UserName = "username" 'to be changed ' .UserPassword = "password" 'to be changed ' ' If Not .Added Then ' .AddNetDriver ' End If ' 'If Not .Deleted Then ' '.DeleteNetDriver ' 'End If ' End With '===================================================================================
|