| Brian,
I asked the exactly the same question at the VB news group and
received exactly the code I needed, this is it:
Danny.
How to make a network connection with VB4.0-32
------------------------------------------------
Attribute VB_Name = "NetworkFunctions"
Option Explicit
'---------------------------------------------------------------------
------------------------------
' MODULE: NetworkRoutines
'---------------------------------------------------------------------
------------------------------
' General Declarations:
'---------------------------------------------------------------------
------------------------------
Private Declare Function WNetAddConnection Lib "mpr.dll" Alias
"WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword
As String, ByVal lpszLocalName As String) As Long
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias
"WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal
lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias
"WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As
Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const ERROR_ACCESS_DENIED = 5&
Private Const ERROR_ALREADY_ASSIGNED = 85&
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_BAD_NET_NAME = 67&
Private Const ERROR_INVALID_PASSWORD = 86&
Private Const ERROR_INVALID_ADDRESS = 487&
Private Const ERROR_INVALID_PARAMETER = 87
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_UNEXP_NET_ERR = 59&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_OPEN_FILES = 2401&
Private Const ERROR_NOT_ENOUGH_MEMORY = 8
Private Const NO_ERROR = 0
Private Const WN_ACCESS_DENIED = ERROR_ACCESS_DENIED
Private Const WN_ALREADY_CONNECTED = ERROR_ALREADY_ASSIGNED
Private Const WN_BAD_LOCALNAME = ERROR_BAD_DEVICE
Private Const WN_BAD_NETNAME = ERROR_BAD_NET_NAME
Private Const WN_BAD_PASSWORD = ERROR_INVALID_PASSWORD
Private Const WN_BAD_POINTER = ERROR_INVALID_ADDRESS
Private Const WN_BAD_VALUE = ERROR_INVALID_PARAMETER
Private Const WN_MORE_DATA = ERROR_MORE_DATA
Private Const WN_NET_ERROR = ERROR_UNEXP_NET_ERR
Private Const WN_NOT_CONNECTED = ERROR_NOT_CONNECTED
Private Const WN_NOT_SUPPORTED = ERROR_NOT_SUPPORTED
Private Const WN_OPEN_FILES = ERROR_OPEN_FILES
Private Const WN_OUT_OF_MEMORY = ERROR_NOT_ENOUGH_MEMORY
Private Const WN_SUCCESS = NO_ERROR
'---------------------------------------------------------------------
------------------------------
' GetUNCPath Routine
'---------------------------------------------------------------------
------------------------------
Function GetUNCPath(DriveLetter As String, DrivePath, ErrorMsg As
String) As Long
On Local Error GoTo GetUNCPath_Err
Dim status As Long
Dim lpszLocalName As String
Dim lpszRemoteName As String
Dim cbRemoteName As Long
lpszLocalName = DriveLetter
If Right$(lpszLocalName, 1) <> Chr$(0) Then lpszLocalName =
lpszLocalName & Chr$(0)
lpszRemoteName = String$(255, Chr$(32))
cbRemoteName = Len(lpszRemoteName)
status = WNetGetConnection(lpszLocalName, lpszRemoteName,
cbRemoteName)
GetUNCPath = status
Select Case status
Case WN_SUCCESS
' all is successful...
Case WN_NOT_SUPPORTED
ErrorMsg = "This function is not supported"
Case WN_OUT_OF_MEMORY
ErrorMsg = "The System is Out of Memory."
Case WN_NET_ERROR
ErrorMsg = "An error occurred on the network"
Case WN_BAD_POINTER
ErrorMsg = "The network path is invalid"
Case WN_BAD_VALUE
ErrorMsg = "Invalid local device name"
Case WN_NOT_CONNECTED
ErrorMsg = "The drive is not connected"
Case WN_MORE_DATA
ErrorMsg = "The buffer was too small to return the fileservice
name"
Case Else
ErrorMsg = "Unrecognized Error - " & Str$(status) & "."
End Select
If Len(ErrorMsg) Then
DrivePath = ""
Else
' Trim it, and remove any nulls
DrivePath = StripNulls(lpszRemoteName)
End If
GetUNCPath_End:
Exit Function
GetUNCPath_Err:
MsgBox Err.Description, vbInformation
Resume GetUNCPath_End
End Function
'---------------------------------------------------------------------
------------------------------
' GetUserName routine
'---------------------------------------------------------------------
------------------------------
Function sGetUserName() As String
Dim lpBuffer As String * 255
Dim lRet As Long
lRet = GetUserName(lpBuffer, 255)
sGetUserName = StripNulls(lpBuffer)
End Function
'---------------------------------------------------------------------
------------------------------
' StripNulls routine
'---------------------------------------------------------------------
------------------------------
Private Function StripNulls(s As String) As String
'Truncates string at first null character, any text after first null
is lost
Dim I As Integer
StripNulls = s
If Len(s) Then
I = InStr(s, Chr$(0))
If I Then StripNulls = Left$(s, I - 1)
End If
End Function
'---------------------------------------------------------------------
------------------------------
' MapNetworkDrive routine
'---------------------------------------------------------------------
------------------------------
Function MapNetworkDrive(UNCname As String, _
Password As String, _
DriveLetter As String, _
ErrorMsg As String) As Long
Dim status As Long
Dim tUNCname As String, tPassword As String, tDriveLetter As String
On Local Error GoTo MapNetworkDrive_Err
tUNCname = UNCname
tPassword = Password
tDriveLetter = DriveLetter
If Right$(tUNCname, 1) <> Chr$(0) Then tUNCname = tUNCname & Chr$(0)
If Right$(tPassword, 1) <> Chr$(0) Then tPassword = tPassword &
Chr$(0)
If Right$(tDriveLetter, 1) <> Chr$(0) Then tDriveLetter = tDriveLetter
& Chr$(0)
status = WNetAddConnection(tUNCname, tPassword, tDriveLetter)
Select Case status
Case WN_SUCCESS
ErrorMsg = ""
Case WN_NOT_SUPPORTED
ErrorMsg = "Function is not supported."
Case WN_OUT_OF_MEMORY:
ErrorMsg = "The system is out of memory."
Case WN_NET_ERROR
ErrorMsg = "An error occurred on the network."
Case WN_BAD_POINTER
ErrorMsg = "The network path is invalid."
Case WN_BAD_NETNAME
ErrorMsg = "Invalid network resource name."
Case WN_BAD_PASSWORD
ErrorMsg = "The password is invalid."
Case WN_BAD_LOCALNAME
ErrorMsg = "The local device name is invalid."
Case WN_ACCESS_DENIED
ErrorMsg = "A security violation occurred."
Case WN_ALREADY_CONNECTED
ErrorMsg = "This drive letter is already connected to a
network drive."
Case Else
ErrorMsg = "Unrecognized Error - " & Str$(status) & "."
End Select
MapNetworkDrive = status
MapNetworkDrive_End:
Exit Function
MapNetworkDrive_Err:
MsgBox Err.Description, vbInformation
Resume MapNetworkDrive_End
End Function
'---------------------------------------------------------------------
------------------------------
' DisconnectNetworkDrive routine
'---------------------------------------------------------------------
------------------------------
Function DisconnectNetworkDrive(DriveLetter As String, _
ForceFileClose As Long, _
ErrorMsg As String) As Long
Dim status As Long
Dim tDriveLetter As String
On Local Error GoTo DisconnectNetworkDrive_Err
tDriveLetter = DriveLetter
If Right$(tDriveLetter, 1) <> Chr$(0) Then tDriveLetter = tDriveLetter
& Chr$(0)
status = WNetCancelConnection(tDriveLetter, ForceFileClose)
Select Case status
Case WN_SUCCESS
ErrorMsg = ""
Case WN_BAD_POINTER:
ErrorMsg = "The network path is invalid."
Case WN_BAD_VALUE
ErrorMsg = "Invalid local device name"
Case WN_NET_ERROR:
ErrorMsg = "An error occurred on the network."
Case WN_NOT_CONNECTED
ErrorMsg = "The drive is not connected"
Case WN_NOT_SUPPORTED
ErrorMsg = "This function is not supported"
Case WN_OPEN_FILES
ErrorMsg = "Files are in use on this service. Drive was not
disconnected."
Case WN_OUT_OF_MEMORY:
ErrorMsg = "The System is Out of Memory"
Case Else:
ErrorMsg = "Unrecognized Error - " & Str$(status) & "."
End Select
DisconnectNetworkDrive = status
DisconnectNetworkDrive_End:
Exit Function
DisconnectNetworkDrive_Err:
MsgBox Err.Description, vbInformation
Resume DisconnectNetworkDrive_End
End Function
|