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 :
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
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 :
Ссылка скрыта от гостей
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