假设服务器(win2k)\\1.1.1.1\aaa是共享的,用户名aa密码bb,如果要访问其下面的c.txt文件,要求不通过映射网络驱动器的方法如何访问共享文件夹,注意在该程序运行前.中.后等情况下,用户通过资源管理器访问该文件夹仍然是要提示密码的,主要是为了安全起见,共享文件夹中的内容只有由该程序和知道密码的人访问,普通用户不可见。
如果客户端98和2k写法不一样,请分别给予代码!3Q~~

解决方案 »

  1.   

    例如:If Left$(P_DbCode, 2) = "\\" Then
           TmpPath = FilePath(P_DbCode)'取路径名
           DisNet "M:"                    '先断开M
           DoEvents
            '映射网络路径为本地M盘. 
           MapDriv "M:", Left(TmpPath, Len(TmpPath) - 1), P_UserLog.NetPwd, P_UserLog.NetUser
           Call Wait(5)'等0.5秒
           DisNet "M:" '断开M盘.
        End If'***************************************
    Option ExplicitPrivate 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 TypeConst NO_ERROR = 0
    Const CONNECT_UPDATE_PROFILE = &H1Const RESOURCETYPE_DISK = &H1
    Const RESOURCETYPE_PRINT = &H2
    Const RESOURCETYPE_ANY = &H0
    Const RESOURCE_CONNECTED = &H1
    Const RESOURCE_REMEMBERED = &H3
    Const RESOURCE_GLOBALNET = &H2
    Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
    Const RESOURCEDISPLAYTYPE_GENERIC = &H0
    Const RESOURCEDISPLAYTYPE_SERVER = &H2
    Const RESOURCEDISPLAYTYPE_SHARE = &H3
    Const RESOURCEUSAGE_CONNECTABLE = &H1
    Const RESOURCEUSAGE_CONTAINER = &H2Private Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" _
                                                    (lpNetResource As NETRESOURCE, _
                                                     ByVal lpPassword As String, _
                                                     ByVal lpUserName As String, _
                                                     ByVal dwFlags As Long) As LongPrivate Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" _
                                                       (ByVal lpName As String, _
                                                        ByVal dwFlags As Long, _
                                                        ByVal fForce As Long) As LongPublic Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
                            (ByVal lpBuffer As String, nSize As Long) As Long
                
    Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
                   (ByVal lpBuffer As String, nSize As Long) As Long
    '返回网络资源的UNC路径
    Public Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
                                                        (ByVal lpszLocalName As String, _
                                                         ByVal lpszRemoteName As String, _
                                                         cbRemoteName As Long) As Long
    Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As Long
    ''记录操作员登录信息
    Public Type UserLog
           ID As String             '操作员ID
           Name As String           '操作员名称
           PassWord As String       '操作员密码
           LogDate As Date          '登录日期
           LogTime As Date          '登录时间
           NetUser As String
           NetPwd As String
    End TypePublic P_DbCtrl As New SmDbCtrl
    Public P_Cnn As New ADODB.Connection
    Public P_WorkPath As String
    Public P_DbCode As String
    Public P_UserLog As UserLog'
    '取路径名
    '函数:FilePath
    '参数: Fname 文件绝对路径.
    '返回值:路径名.
    '如:"C:\PROMAS\AA.EXE",则返回 "C:\PROMAS\"
    Public Function FilePath(Fname As String) As String
        Dim A As Integer
        Dim B As Integer
        Dim JlStr As String
        FilePath = ""
        B = 0
        For A = Len(Fname) To 1 Step -1
            If Mid$(Fname, A, 1) = "\" Then
               B = A: GoTo 100
            End If
        Next A100:
        
        JlStr = Left$(Fname, B)
        FilePath = JlStr
    End Function
    '建立和断开网络映射,取工作站名称及用户名称
    '------------------------------------------
    '1.MapDriv
    '**建立网络映射** _
     NETFLAG=MapDriv(DrivName, NetPath,Password, UserName)'参数说明: _
     DrivName 映射成的本地驱动器名 _
     NetPath  网络路径 _
     Password 密码(如果没有则用"") _
     UserName 用户名(如果没有则用"") _'返回值   =TRUE 连接成功,=FALSe 连接失败
    '------------------------------------------
    '2.DisNet
    '**断开网络驱动器** _
       FLAG=DisNet(NetDriv) _
       NetDriv 断开的网络驱动器名 _'返回值 =True 成功,=False 失败
    '-----------------------------------------
    '3.ComputerName
    '**返回本工作站名称** _
       ComName = ComputerName()'返回值: 本机名称
    '-----------------------------------------
    '4.UserName
    '**返回当前用户名称** _
     UserName() As String
    '
    '返回值: 网络登录者名称
    '----------------------------------------'**建立网络映射**
    'NETFLAG=MapDriv(DrivName, NetPath,Password, UserName)'参数说明:
    'DrivName 映射成的本地驱动器名
    'NetPath  网络路径
    'Password 密码(如果没有则用"")
    'UserName 用户名(如果没有则用"")
    '返回值 =TRUE 成功连接,=FALSe 连接失败
    '============================================
    Public Function MapDriv(DrivName As String, NetPath As String, PassWord As String, UserName As String) As Boolean
    '建立网络连接
      Dim NetR As NETRESOURCE
      Dim ErrInfo As Long  With NetR
           .dwScope = RESOURCE_GLOBALNET
           .dwType = RESOURCETYPE_DISK
           .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
           .dwUsage = RESOURCEUSAGE_CONNECTABLE
           .lpLocalName = UCase(DrivName) '映射成本机盘符
           .lpRemoteName = UCase(NetPath) '映射的网络路径
      End With
    '建立连接,返回ERR代码
      ErrInfo = WNetAddConnection2(NetR, PassWord, UserName, 0)
    '检查代码
     MapDriv = (ErrInfo = NO_ERROR)
    End Function
    ''**断开网络驱动器**
    'FLAG=DisNet(NetDriv)
    'NetDriv 断开的网络驱动器名
    '返回值 =True 成功,=False 失败
    '=====================================
    Public Function DisNet(NetDriv As String) As Boolean
      Dim ErrInfo As Long
      Dim ErrRe As Long
      Dim strLocalName As String
      strLocalName = UCase(NetDriv) '断开的映射盘
      '断开,返回ERR代码
      ErrRe = WNetCancelConnection(strLocalName, True)
      ErrInfo = WNetCancelConnection2(strLocalName, CONNECT_UPDATE_PROFILE, True)
      '检查代码
      If ErrInfo = NO_ERROR Then
         DisNet = True
      Else
         DisNet = False
      End If
    End Function
    ''------------------------------------
    '**返回本工作站名称**
    Public Property Get ComputerName() As String
      Dim nSize As Long
      Dim lpBuffer As String
      nSize = 255 '保存工作站名称的缓冲区
      lpBuffer = Space$(nSize)
      If GetComputerName(lpBuffer, nSize) Then
         ComputerName = Left$(lpBuffer, nSize)
      Else
         ComputerName = ""
      End If
    End Property
    ''-----------------------------------
    '**返回登录用户名称**
    Public Property Get UserName() As String
      Dim lpBuffer As String
      Dim nSize As Long
      nSize = 255 '保存用户名的缓冲区
      lpBuffer = Space$(nSize)
      If GetUserName(lpBuffer, nSize) Then
        UserName = Left$(lpBuffer, nSize - 1)
      Else
        UserName = ""
      End If
    End Property
    ''-------------------------------------------
    '**返回网络资源的UNC路径**
    'LocaName  要查询的本地资源名称
    Public Function GetNetUNC(LocaName As String) As String
      Dim Rc As Long
      Dim lpBuff As String
      Dim cbBuff As Long
      '设置缓冲区
      cbBuff = 255
      lpBuff = String$(cbBuff, Chr$(0))
      '调用API
      If WNetGetConnection(LocaName, lpBuff, cbBuff) = NO_ERROR Then
         GetNetUNC = Left$(lpBuff, cbBuff)
      Else
         GetNetUNC = ""
      End If
    End Function'调用说明:
    'WAIT N
    '等待.N*0.1Public Sub Wait(N As Integer)
      Dim ltime As Date
      ltime = Timer()
      While Timer() - ltime <= N * 0.05
        DoEvents
      Wend
    End Sub
      

  2.   

    MSTOP(陈建华(东莞立晨企资)) 你的代码我没调试,但有点问题,断开映射后用户去资源管理器访问共享文件夹win会不会问密码?
      

  3.   

    请问mstop这个代码在98下可以正常使用吗?
    我记得98是不是需要注销然后用存在的id登录网络下?
      

  4.   

    代码我就不写了,这么多Code凑起来绝对够用
    只需要注意以下几点就可以了1 实现共享不需要非得映射驱动器.这点楼主大可放心.(试验过)当时我的概念了解的不是很清楚,走了很多弯路.回头看看其实不难2 一开始我是在2000<=>2000之间做的测试,而且是在没有域的情况下.所以只要配置好权限就可以了.建议楼主首先在这样的环境下测试,很容易成功.否则对代码测试不利(起码知道问题出现在哪里)3 98<=>2000 因为两者的安全性不一样,访问方法也不一样.当然提供的API也不一样.所以问题比较多.大多数的错误其实是win2000的配置出现问题,导致win98无权访问win2000.建议您先手动连接试试,先排除配置问题再测试代码.4 98<=>98,没什么好说的,我也没有尝试过.因为我用不到所以没有试.我还有部分做好的模块(98 NT 以及 判断操作系统),要的话可以给您发过去.
      

  5.   

    1 实现共享不需要非得映射驱动器.这点楼主大可放心.(试验过)当时我的概念了解的不是很清楚,走了很多弯路.回头看看其实不难
    ----------
    不映射我就不知道怎样访问了,你以前的一个帖子里说用net use访问,但那样用户就可以通过资源管理器访问了
      

  6.   

    下面是我的现在在使用的代码~~
    Add Three Command And Two TextBox On The Form:
    'Form:
    Private Sub Command1_Click()
        
        '添加网络驱动器(第一个参数共享信息、第二个参数、共享到本地的磁盘、第三个参数:登陆用户名第四个参数:登陆密码)
        If NetDriveConnect("\\TollServer\Pic$", "S:", Trim$(Text.Text), Trim$(Text2.Text)) = False Then
            MsgBox "无法建立网络驱动器,请确认网络服务器可以使用且共享已经打开!"
            Exit Sub
        End If
        
    End SubPrivate Sub Command2_Click()   '关闭网络驱动器
       Call NetDriveDisconnect(LocalNetDrive)End SubPrivate Sub Command3_Click()
        
        Dim f As New FileSystemObject
        Dim SourceFile As String
        Dim DestFile As String
        
        f.CopyFile SourceFile, LocalNetDrive & "\" & DestFile, True
        
    End Sub'Module:
    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 LongPublic Const NO_ERROR = 0
    Public Const CONNECT_UPDATE_PROFILE = &H1'网络驱动器参数
    Public Const RESOURCETYPE_DISK = &H1
    Public Const RESOURCETYPE_PRINT = &H2
    Public Const RESOURCETYPE_ANY = &H0
    Public Const RESOURCE_CONNECTED = &H1
    Public Const RESOURCE_REMEMBERED = &H3
    Public Const RESOURCE_GLOBALNET = &H2
    Public Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
    Public Const RESOURCEDISPLAYTYPE_GENERIC = &H0
    Public Const RESOURCEDISPLAYTYPE_SERVER = &H2
    Public Const RESOURCEDISPLAYTYPE_SHARE = &H3
    Public Const RESOURCEUSAGE_CONNECTABLE = &H1
    Public Const RESOURCEUSAGE_CONTAINER = &H2
    '错误常量
    Public Const ERROR_ACCESS_DENIED = 5&
    Public Const ERROR_ALREADY_ASSIGNED = 85&
    Public Const ERROR_BAD_DEV_TYPE = 66&
    Public Const ERROR_BAD_DEVICE = 1200&
    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_CANCELLED = 1223&
    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 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 LocalNetDrive As String
    '*********************网络驱动器定义结束       ***************************************'
    '*********************网络驱动器开始           ***************************************''连接到网络驱动器
    Public Function NetDriveConnect(ByVal RemotePath As String, ByVal Localpath As String, ByVal lpUserName As String, ByVal lpPassword As String) As Boolean
        
        NetDriveConnect = False
        Dim NetR As NETRESOURCE
        Dim ErrInfo As Long
        
        On Error GoTo Error_NetDriveConnect
        
        If f.DriveExists(Localpath) = True Then '如果该磁盘已经存在,就不再重新建立连接
            NetDriveConnect = True
            LocalNetDrive = Localpath
        Else
            NetR.dwScope = RESOURCE_GLOBALNET
            NetR.dwType = RESOURCETYPE_DISK
            NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
            NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
            NetR.lpLocalName = Localpath
            LocalNetDrive = Localpath
            NetR.lpRemoteName = RemotePath
            ErrInfo = WNetAddConnection2(NetR, lpPassword, lpUserName, CONNECT_UPDATE_PROFILE) '用户名和密码
            If ErrInfo = NO_ERROR Then NetDriveConnect = True
        End If
        Exit Function
        
    Error_NetDriveConnect:
        NetDriveConnect = False
        
    End Function
    '断开网络驱动器
    Public Function NetDriveDisconnect(ByVal LocalNetDrive As String) As Boolean    NetDriveDisconnect = False
        Dim ErrInfo As Long
        
        On Error GoTo Error_NetDriveDisconnect
        
        ErrInfo = WNetCancelConnection2(LocalNetDrive, CONNECT_UPDATE_PROFILE, True)
        If ErrInfo = NO_ERROR Then NetDriveDisconnect = True
        
        Exit Function
        
    Error_NetDriveDisconnect:
      NetDriveDisconnect = False
      
    End Function
      

  7.   

    完全用程序控制,最后要调用NetDriveDisconnect断开连接~~