GetUNCName – Convert a file path to a UNC path

GetUNCName – Convert a file path to a UNC path

' Converts a reference to a file in the standard Windows' format (e.g. "H:ServerDirFilename.ext") in the corresponding UNC' format (e.g. "\ServerNameExportedDirServerDirFileName.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 versionConst VER_PLATFORM_WIN32s = 0               'Win32s on Windows 3.1Const VER_PLATFORM_WIN32_WINDOWS = 1        'Win32 on Windows 95Const VER_PLATFORM_WIN32_NT = 2             'Win32 on Windows NTType OSVERSIONINFO    dwOSVersionInfoSize As Long    dwMajorVersion As Long    dwMinorVersion As Long    dwBuildNumber As Long    dwPlatformId As Long    szCSDVersion As String * 128End TypePrivate Declare Function GetVersionEx Lib "Kernel32" Alias "GetVersionExA" _    (lpVersionInformation As OSVERSIONINFO) As Long' Declare for Registry functionsConst HKEY_CLASSES_ROOT = &H80000000Const HKEY_CURRENT_USER = &H80000001Const HKEY_LOCAL_MACHINE = &H80000002Const HKEY_USERS = &H80000003Const HKEY_PERFORMANCE_DATA = &H80000004Const HKEY_CURRENT_CONFIG = &H80000005Const HKEY_DYN_DATA = &H80000006Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _    LongPrivate 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 LongPrivate 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 ByValPrivate 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 LongPrivate 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 LongPrivate 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 LongPrivate Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _    (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As LongPrivate Declare Function GetComputerName Lib "Kernel32" Alias _    "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As LongPrivate 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 groupPublic 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 95Private 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 = "SOFTWAREMicrosoftWindowsCurrentVersionNetworkLanman"    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 NTPrivate 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 = "SYSTEMCurrentControlSetServicesLanmanServerShares"    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 = pathNameEnd Function' support routinePrivate 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 IfEnd Function

Share the Post:
XDR solutions

The Benefits of Using XDR Solutions

Cybercriminals constantly adapt their strategies, developing newer, more powerful, and intelligent ways to attack your network. Since security professionals must innovate as well, more conventional endpoint detection solutions have evolved

AI is revolutionizing fraud detection

How AI is Revolutionizing Fraud Detection

Artificial intelligence – commonly known as AI – means a form of technology with multiple uses. As a result, it has become extremely valuable to a number of businesses across

AI innovation

Companies Leading AI Innovation in 2023

Artificial intelligence (AI) has been transforming industries and revolutionizing business operations. AI’s potential to enhance efficiency and productivity has become crucial to many businesses. As we move into 2023, several

data fivetran pricing

Fivetran Pricing Explained

One of the biggest trends of the 21st century is the massive surge in analytics. Analytics is the process of utilizing data to drive future decision-making. With so much of

kubernetes logging

Kubernetes Logging: What You Need to Know

Kubernetes from Google is one of the most popular open-source and free container management solutions made to make managing and deploying applications easier. It has a solid architecture that makes

ransomware cyber attack

Why Is Ransomware Such a Major Threat?

One of the most significant cyber threats faced by modern organizations is a ransomware attack. Ransomware attacks have grown in both sophistication and frequency over the past few years, forcing

data dictionary

Tools You Need to Make a Data Dictionary

Data dictionaries are crucial for organizations of all sizes that deal with large amounts of data. they are centralized repositories of all the data in organizations, including metadata such as