Atlanta Custom Software Development 

 
   Search        Code/Page
 

User Login
Email

Password

 

Forgot the Password?
Services
» Web Development
» Maintenance
» Data Integration/BI
» Information Management
Programming
  Database
Automation
OS/Networking
Graphics
Links
Tools
» Regular Expr Tester
» Free Tools

GetUNCName - Convert a file path to a UNC path

Total Hit ( 5738)

Rate this article:     Poor     Excellent 

 Submit Your Question/Comment about this article

Rating


 


Click here to copy the following block
' 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


Submitted By : Nayan Patel  (Member Since : 5/26/2004 12:23:06 PM)

Job Description : He is the moderator of this site and currently working as an independent consultant. He works with VB.net/ASP.net, SQL Server and other MS technologies. He is MCSD.net, MCDBA and MCSE. In his free time he likes to watch funny movies and doing oil painting.
View all (893) submissions by this author  (Birth Date : 7/14/1981 )


Home   |  Comment   |  Contact Us   |  Privacy Policy   |  Terms & Conditions   |  BlogsZappySys

© 2008 BinaryWorld LLC. All rights reserved.