Mapping Nt Network Drives Using Win32 Api

Тема в разделе "Работа с API", создана пользователем morpheus, 15 окт 2008.

  1. morpheus

    morpheus скриптописец

    Регистрация:
    7 авг 2006
    Сообщения:
    3.927
    Симпатии:
    0
    Description
    This library provides functions for mapping NT network drives using Win 32 API (only tested on NT 4.0, Service Pack 3). These functions are particularly useful for background agents that run on an NT server where the Domino server is set up as a NT service using the Local System account. In this case, the NT machine is not logged into any domain and no drives are mapped. UNC names do not work in this situation either.

    To use these Functions, add the following line to the Declarations section of your script module:


    Code

    [codebox]----- File that contains SYS_USERNAME and SYS_PASSWORD constants for login
    %INCLUDE "LOGIN.LSS"

    '----- DLL containing the needed Win32 functions
    Public Const WIN32_DLL = "mpr.dll"

    '----- Flags
    Public Const RESOURCETYPE_ANY = &H00000000
    Public Const RESOURCETYPE_DISK = &H00000001
    Public Const RESOURCETYPE_PRINT = &H00000002
    Public Const CONNECT_UPDATE_PROFILE = &H00000001

    '----- Network resource structure
    Public Type WIN32_NETRESOURCE
    dwScope As Long
    dwType As Long '<< Any/disk/print
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As String '<< Local drive name to use
    lpRemoteName As String '<< Remote path
    lpComment As String
    lpProvider As String
    End Type

    '----- Win 32 API function(s)
    Declare Function WNetAddConnection2& Lib WIN32_DLL Alias "WNetAddConnection2A" ( _
    lpNetResource As WIN32_NETRESOURCE, _ 'Network resource structure
    Byval lpPassword As String, _ 'User password
    Byval lpUserName As String, _ 'User name
    Byval dwFlags As Long) 'Flags

    Declare Function WNetCancelConnection& Lib WIN32_DLL Alias "WNetCancelConnectionA" ( _
    Byval lpName As String, _ 'Name of local device to disconnect
    Byval fForce As Long) 'Force the disconnect

    '----- Error codes from error.h
    Public Const NO_ERROR = 0
    Public Const ERROR_ACCESS_DENIED = 5
    Public Const ERROR_ALREADY_ASSIGNED = 85
    Public Const ERROR_INVALID_PASSWORD = 86

    '----- Error codes from winerror.h
    Public Const ERROR_BAD_DEV_TYPE = 66
    Public Const ERROR_BAD_NET_NAME = 67
    Public Const ERROR_BUSY = 170
    Public Const ERROR_BAD_DEVICE = 1200
    Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202
    Public Const ERROR_NO_NET_OR_BAD_PATH = 1203
    Public Const ERROR_BAD_PROVIDER = 1204
    Public Const ERROR_CANNOT_OPEN_PROFILE = 1205
    Public Const ERROR_BAD_PROFILE = 1206
    Public Const ERROR_EXTENDED_ERROR = 1208
    Public Const ERROR_NO_NETWORK = 1222
    Public Const ERROR_CANCELLED = 1223
    Public Const ERROR_NOT_CONNECTED = 2250
    Public Const ERROR_DEVICE_IN_USE = 2404
    Dim retCode&, ascLett&, drivNam$, tmp$

    Public Function Win32ConnectDrive$(Byval pathNam$)

    Win32ConnectDrive = ""
    On Error Goto Errors
    Const FUNC_NAME = "Win32ConnectDrive"
    Dim netRes As WIN32_NETRESOURCE
    Dim retCode&, ascLett&, drivNam$
    Dim fst&, sec&, mach$, shar$, pth$, tmp$
    drivNam = ""
    If Instr(pathNam, "") = 0 Then Goto TheEnd

    '----- Try to find a drive that isn't being used
    For ascLett = 90 To 68 Step -1
    tmp = Chr$(ascLett) & ":"
    If Not(IsDriveAvailable(tmp)) Then
    drivNam = tmp
    Exit For
    End If
    Next ascLett
    If drivNam = "" Then Goto TheEnd

    '----- Explode the pieces of the UNC name
    pathNam = Mid$(pathNam, 3) 'remove first 2 slashes
    fst = Instr(pathNam, "") 'first slash ""
    mach = Left$(pathNam, fst-1) 'machine name
    sec = Instr(fst+1, pathNam, "") 'second slash ""
    If (sec <> 0) Then
    shar = Mid$(pathNam, fst+1, Instr(fst+1, pathNam, "")-(fst+1)) 'share name
    Else
    shar = Mid$(pathNam, fst+1)
    End If

    tmp = "" & mach & "" & shar
    pth = Mid$(pathNam, Len(tmp))
    pathNam = tmp

    '----- Fill out the relevant info in the resource structure
    netRes.dwType = RESOURCETYPE_DISK
    netRes.lpLocalName = drivNam
    netRes.lpRemoteName = pathNam

    '----- Make the necessary call to map the drive
    retCode = WNetAddConnection2(netRes, SYS_PASSWORD, SYS_USERNAME, 0)
    If (retCode <> NO_ERROR) Then
    tmp = Win32GetErrorString(retCode)
    Print FUNC_NAME & ": " & tmp & "(" & Trim$(Str(retCode)) & ")"
    Exit Function
    End If

    '----- Return the new full path
    Win32ConnectDrive = drivNam & "" & pth

    TheEnd:
    Exit Function

    Errors:
    Win32ConnectDrive = ""
    Print FUNC_NAME & ": " & Error$
    Resume TheEnd

    End Function

    Function Win32GetErrorString$(retCode&)

    Dim tmp$
    Select Case(retCode)

    Case NO_ERROR:
    tmp = "No error"
    Case ERROR_ACCESS_DENIED:
    tmp = "Access to resource was denied"
    Case ERROR_ALREADY_ASSIGNED:
    tmp = "Resource already assigned"
    Case ERROR_INVALID_PASSWORD:
    tmp = "Specified password is invalid"
    Case ERROR_BAD_DEV_TYPE:
    tmp = "Type of local device and the type of network resource do not match"
    Case ERROR_BAD_NET_NAME:
    tmp = "The resource name is invalid, or the named resource cannot be located"
    Case ERROR_BUSY:
    tmp = "The router or provider is busy, possibly initializing"
    Case ERROR_BAD_DEVICE:
    tmp = "The local name is invalid"
    Case ERROR_DEVICE_ALREADY_REMEMBERED:
    tmp = "An entry for the specified device is already in the user profile"
    Case ERROR_NO_NET_OR_BAD_PATH:
    tmp = "A network component has not started, or the specified name could not be handled"
    Case ERROR_BAD_PROVIDER:
    tmp = "The provider value is invalid"
    Case ERROR_CANNOT_OPEN_PROFILE:
    tmp = "Unable to open the user profile to process persistent connections"
    Case ERROR_BAD_PROFILE:
    tmp = "The user profile is in an incorrect format"
    Case ERROR_EXTENDED_ERROR:
    tmp = "A network specific error occurred"
    Case ERROR_NO_NETWORK:
    tmp = "No network is present"
    Case ERROR_CANCELLED:
    tmp = "The action was cancelled"
    Case Else:
    tmp = "Error"
    End Select
    Win32GetErrorString = tmp
    End Function
    Public Function Win32DisconnectDrive(Byval drivNam$) As Variant
    Const FUNC_NAME = "Win32DisconnectDrive"
    On Error Goto Errors
    Dim retCode&, tmp$
    Win32DisconnectDrive = True

    drivNam = Left$(drivNam, Instr(drivNam, ":"))
    If Not(IsDriveAvailable(drivNam)) Then Exit Function
    retCode = WNetCancelConnection(drivNam, 1)
    If (retCode <> NO_ERROR) Then
    tmp = Win32GetErrorString(retCode)
    Print FUNC_NAME & ": " & tmp & " (" & Trim$(Str$(retCode)) & ")"
    End If

    TheEnd:
    Exit Function

    Errors:
    Print FUNC_NAME & ": " & Error$
    Win32DisconnectDrive = False
    Resume TheEnd

    End Function
    Function IsDriveAvailable(drivNam$) As Variant
    On Error Goto Errors
    IsDriveAvailable = False
    If Dir$(drivNam, 8) <> "" Then
    IsDriveAvailable = True
    End If
    TheEnd:
    Exit Function
    Errors:
    Resume TheEnd
    End Function
    Public Function SetupPathRoot(Byval filePathRoot$) As String

    On Error Goto Errors
    Dim bak$
    bak = filePathRoot

    '----- If we are dealing with UNC names, map a drive
    If Instr(filePathRoot, ":") = 0 And Left$(filePathRoot, 2) = "" Then
    filePathRoot = Win32ConnectDrive(filePathRoot)
    If filePathRoot = "" Then filePathRoot = bak
    End If

    '----- Make sure the last character is a backslash
    If Right(filePathRoot, 1) <> "" Then filePathRoot = filePathRoot & ""
    SetupPathRoot = filePathRoot

    TheEnd:
    Exit Function

    Errors:
    SetupPathRoot = bak
    Resume TheEnd

    End Function
    Public Function TermPathRoot(Byval filePath$)

    On Error Goto Errors
    Call Win32DisconnectDrive(filePath)
    TermPathRoot = True

    TheEnd:
    Exit Function

    Errors:
    TermPathRoot = False
    Resume TheEnd

    End Function[/codebox]

    Comments
    Error in code
    There are some typos in the code - the Win32ConnectDrive function is missing some backslashes.
    A working copy of the same code can be found here :
    http://www-10.lotus.com/ldd/46dom.nsf/0/55...e6?OpenDocument
    or you can do a search on Google for 'WNetAddConnection2 domino' to find other code that uses the same API function
    otherwise it does work correctly...

    Источник - _http://openntf.org/Projects/codebin/codebin.nsf/CodeBySubType/905238D64CADE53488256BDC000CC17D
     
Загрузка...
Похожие Темы - Mapping Network Drives
  1. Rahmatov
    Ответов:
    7
    Просмотров:
    674
  2. AndreyBell
    Ответов:
    0
    Просмотров:
    357

Поделиться этой страницей