NetworkRoutines

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