In NT4 the c$-share was only accessible to Administrator by default. I think
the same goes for 2000/XP...
/Peter
> Hi Guys,
>
> I'm stumped and would appreciate your help.....
>
> Problem: UNC path should be returned but is not
> Application: VB6, SQL Server (MSDE)
> OS: XP
>
> My VB client app calls a Stored procdure on the Server passing to it a
> parameter containing the UNC path to an Excel file on the client PC's C:\
> drive. What the stored proc actually does is not relevent to this
> enquiry,
> it is only important to realise that SQL server needs the UNC
> path and not
> the local path of the client PS ie. '\\ANDY\SHARED\MyApp' not 'C:\MyApp'
>
> I use some code that I found at VB2theMax.com uses the WNetGetConnection
> api call to return a UNC path. I have included it at end of this post
> though I suspect that problem lies elsewhere . It all works fine on my PC
> (Windows 98, C:\ drive shared out as 'SHARED'). However, on my users PC
> (XP and the C:\ drive shared out as 'C$') it always returns the
> local path.
>
> Do you have any ideas?
>
> TIA,
> andy
>
> <Code to return UNC path>
>
> ' Converts a reference to a file in the standard Windows
> ' format (e.g. "H:\ServerDir\Filename.ext") in the corresponding UNC
> ' format (e.g. "\\ServerName\ExportedDir\ServerDir\FileName.txt")
> '
> ' It turns to be very useful when a program running on a workstation
> ' has to pass a file reference to another app running on another
> workstation
> ' or when the file reference should be stored in a database for use from
> ' every application on the network.
>
> ' Declares for querying Windows version
>
> Const VER_PLATFORM_WIN32s = 0 'Win32s on Windows 3.1
> Const VER_PLATFORM_WIN32_WINDOWS = 1 'Win32 on Windows 95
> Const VER_PLATFORM_WIN32_NT = 2 'Win32 on Windows NT
>
> Type OSVERSIONINFO
> dwOSVersionInfoSize As Long
> dwMajorVersion As Long
> dwMinorVersion As Long
> dwBuildNumber As Long
> dwPlatformId As Long
> szCSDVersion As String * 128
> End Type
> Private Declare Function GetVersionEx Lib "Kernel32" Alias
> "GetVersionExA"
> _
> (lpVersionInformation As OSVERSIONINFO) As Long
>
> ' Declare for Registry functions
>
> Const HKEY_CLASSES_ROOT = &H80000000
> Const HKEY_CURRENT_USER = &H80000001
> Const HKEY_LOCAL_MACHINE = &H80000002
> Const HKEY_USERS = &H80000003
> Const HKEY_PERFORMANCE_DATA = &H80000004
> Const HKEY_CURRENT_CONFIG = &H80000005
> Const HKEY_DYN_DATA = &H80000006
>
> Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As
> Long) As _
> Long
> Private Declare Function RegOpenKeyEx Lib "advapi32.dll"
> Alias "RegOpenKeyExA" _
> (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As
> Long, _
> ByVal samDesired As Long, phkResult As Long) As Long
> Private Declare Function RegQueryValue Lib "advapi32.dll" Alias _
> "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, _
> ByVal lpValue As String, lpcbValue As Long) As Long
>
> ' Note that if you declare lpData as String, then it is necessary to pass
> it
> ' with ByVal
> Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
> "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
> ByVal lpReserved As Long, lpType As Long, lpData As Any, _
> lpcbData As Long) As Long
> Private Declare Function RegEnumKey Lib "advapi32.dll" Alias
> "RegEnumKeyA"
> _
> (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
> ByVal cbName As Long) As Long
> Private Declare Function RegEnumValue Lib "advapi32.dll"
> Alias "RegEnumValueA" _
> (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As
> String, _
> lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
> ByVal lpData As String, lpcbData As Long) As Long
> Private Declare Function RegOpenKey Lib "advapi32.dll" Alias
> "RegOpenKeyA"
> _
> (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As
> Long
> Private Declare Function GetComputerName Lib "Kernel32" Alias _
> "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
> Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _
> "WNetGetConnectionA" (ByVal lpszLocalName As String, _
> ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
>
> ' This is the main function of the group
>
> Public Function GetUNCName(pathName As String) As String
>
> Dim os As OSVERSIONINFO
>
> ' determine if we're running under Windows 9x or NT
> os.dwOSVersionInfoSize = Len(os)
> GetVersionEx os
>
> If (os.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) Then
> ' runnning under Windows 9x
> GetUNCName = GetUNCName95(pathName)
> ElseIf (os.dwPlatformId = VER_PLATFORM_WIN32_NT) Then
> ' running under Windows NT
> GetUNCName = GetUNCNameNT(pathName)
> End If
>
> End Function
>
> ' Private function that does the work under Windows 95
>
> Private Function GetUNCName95(pathName As String) As String
> Dim hKey As Long
> Dim hKey2 As Long
> Dim exitFlag As Boolean
> Dim i As Double
> Dim ErrCode As Long
> Dim rootKey As String
> Dim key As String
> Dim computerName As String
> Dim lComputerName As Long
>
> ' First of all, verify whether the disk is networked
> If Mid(pathName, 2, 1) = ":" Then
> Dim UNCName As String
> Dim lenUNC As Long
>
> UNCName = String$(260, 0)
> lenUNC = 260
>
> ErrCode = WNetGetConnection(Left(pathName, 2), UNCName, lenUNC)
>
> If ErrCode = 0 Then
> UNCName = Trim(Left$(UNCName, InStr(UNCName, vbNullChar) - 1))
> GetUNCName95 = UNCName & Mid(pathName, 3)
> Exit Function
> End If
> End If
>
> ' else, scan the registry looking for shared resources (Win9x version)
> computerName = String$(255, 0)
> lComputerName = Len(computerName)
> ErrCode = GetComputerName(computerName, lComputerName)
> If ErrCode <> 1 Then
> GetUNCName95 = pathName
> Exit Function
> End If
>
> computerName = Trim(Left$(computerName, InStr(computerName, _
> vbNullChar) - 1))
> rootKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Network\Lanman"
> ErrCode = RegOpenKey(HKEY_LOCAL_MACHINE, rootKey, hKey)
> If ErrCode <> 0 Then
> GetUNCName95 = pathName
> Exit Function
> End If
>
> i = 0
> Do Until exitFlag
> Dim szValue As String
> Dim szValueName As String
> Dim cchValueName As Long
> Dim szResourceName As String
> Dim cchResourceName As Long
> Dim dwValueType As Long
> Dim dwValueSize As Long
> Dim exitw As Boolean
> Dim Path As String
> Dim j As Double
>
> szResourceName = String(1024, 0)
> cchResourceName = Len(szResourceName)
>
> ' loop on all shared resources
> ErrCode = RegEnumKey(hKey, i, szResourceName, cchResourceName)
>
> If ErrCode <> 0 Then
> exitFlag = True
> Else
> ' for each shared resource, read the value looking for PATH
> szResourceName = Trim(Left$(szResourceName, InStr
> (szResourceName, _
> vbNullChar) - 1))
> key = rootKey & "\" & szResourceName
> RegOpenKey HKEY_LOCAL_MACHINE, key, hKey2
>
> j = 0
> Do Until exitw
> szValue = String$(260, 0)
> dwValueSize = Len(szValue)
> szValueName = String(1024, 0)
> cchValueName = Len(szValueName)
>
> ErrCode = RegEnumValue(hKey2, j, szValueName,
> cchValueName, 0, _
> dwValueType, szValue, dwValueSize)
> If ErrCode <> 0 Then
> exitw = True
> Else
> szValueName = Trim(Left$(szValueName, InStr
> (szValueName, _
> vbNullChar) - 1))
> If UCase(szValueName) = "PATH" Then
> ' we found the path the corresponds to the shared
> ' resource
> Path = Trim(Left$(szValue, InStr(szValue, _
> vbNullChar) - 1))
> If UCase(Path) = UCase(Left(pathName, Len(Path)))
> Then
> GetUNCName95 = "\\" & computerName & "\" & _
> szResourceName & Mid$(pathName, Len(Path))
> exitFlag = True
> End If
> exitw = True
> End If
> End If
> j = j + 1
> Loop
> exitw = False
> RegCloseKey hKey2
> End If
> i = i + 1
> Loop
>
> RegCloseKey hKey
>
> If GetUNCName95 = "" Then GetUNCName95 = pathName
>
> End Function
>
> ' Private function that does the work under Windows NT
>
> Private Function GetUNCNameNT(pathName As String) As String
> Dim hKey As Long
> Dim hKey2 As Long
> Dim exitFlag As Boolean
> Dim i As Double
> Dim ErrCode As Long
> Dim rootKey As String
> Dim key As String
> Dim computerName As String
> Dim lComputerName As Long
> Dim stPath As String
> Dim firstLoop As Boolean
> Dim ret As Boolean
>
> ' first, verify whether the disk is connected to the network
> If Mid(pathName, 2, 1) = ":" Then
> Dim UNCName As String
> Dim lenUNC As Long
>
> UNCName = String$(520, 0)
> lenUNC = 520
> ErrCode = WNetGetConnection(Left(pathName, 2), UNCName, lenUNC)
>
> If ErrCode = 0 Then
> UNCName = Trim(Left$(UNCName, InStr(UNCName, vbNullChar) - 1))
> GetUNCNameNT = UNCName & Mid(pathName, 3)
> Exit Function
> End If
> End If
>
> ' else, scan the registry looking for shared resources (NT version)
> computerName = String$(255, 0)
> lComputerName = Len(computerName)
> ErrCode = GetComputerName(computerName, lComputerName)
> If ErrCode <> 1 Then
> GetUNCNameNT = pathName
> Exit Function
> End If
>
> computerName = Trim(Left$(computerName, InStr(computerName, _
> vbNullChar) - 1))
> rootKey = "SYSTEM\CurrentControlSet\Services\LanmanServer\Shares"
> ErrCode = RegOpenKey(HKEY_LOCAL_MACHINE, rootKey, hKey)
>
> If ErrCode <> 0 Then
> GetUNCNameNT = pathName
> Exit Function
> End If
>
> firstLoop = True
>
> Do Until exitFlag
> Dim szValue As String
> Dim szValueName As String
> Dim cchValueName As Long
> Dim dwValueType As Long
> Dim dwValueSize As Long
>
> szValueName = String(1024, 0)
> cchValueName = Len(szValueName)
> szValue = String$(500, 0)
> dwValueSize = Len(szValue)
>
> ' loop on "i" to access all shared DLLs
> ' szValueName will receive the key that identifies an element
> ErrCode = RegEnumValue(hKey, i#, szValueName, cchValueName, 0, _
> dwValueType, szValue, dwValueSize)
>
> If ErrCode <> 0 Then
> If Not firstLoop Then
> exitFlag = True
> Else
> i = -1
> firstLoop = False
> End If
> Else
> stPath = GetPath(szValue)
> If firstLoop Then
> ret = (UCase(stPath) = UCase(pathName))
> stPath = ""
> Else
> ret = (UCase(stPath) = UCase(Left$(pathName,
> Len(stPath))))
> stPath = Mid$(pathName, Len(stPath))
> End If
> If ret Then
> exitFlag = True
> szValueName = Left$(szValueName, cchValueName)
> GetUNCNameNT = "\\" & computerName & "\" & szValueName &
> stPath
> End If
> End If
> i = i + 1
> Loop
>
> RegCloseKey hKey
> If GetUNCNameNT = "" Then GetUNCNameNT = pathName
> End Function
>
> ' support routine
>
> Private Function GetPath(st As String) As String
> Dim pos1 As Long, pos2 As Long, pos3 As Long
> Dim stPath As String
>
> pos1 = InStr(st, "Path")
> If pos1 > 0 Then
> pos2 = InStr(pos1, st, vbNullChar)
> stPath = Mid$(st, pos1, pos2 - pos1)
> pos3 = InStr(stPath, "=")
> If pos3 > 0 Then
> stPath = Mid$(stPath, pos3 + 1)
> GetPath = stPath
> End If
> End If
> End Function
>
> <\Code to return UNC path>
>