Wrox Home  
Search P2P Archive for: Go

  Return to Index  

pro_vb thread: Problem finding share name of C: drive


Message #1 by "andy irvine" <andy@i...> on Mon, 18 Nov 2002 13:30:00
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>
>


  Return to Index