VB.NET Function to get the local path of a OneDrive/SharePoint synchronized Microsoft Office file

GetLocalOneDrivePathVB.NET.vb

' VB.NET Function to get the local path of OneDrive/SharePoint synchronized
' Microsoft Office files
'
' Author: Guido Witt-Dörring
' Created: 2022/07/01
' Updated: 2022/10/20
' License: MIT
'
' ----------------------------------------------------------------
' https://gist.github.com/guwidoe/bc875f4f25e0e970c62959d3c59da1d6
' ----------------------------------------------------------------
'
' Copyright (c) 2022 Guido Witt-Dörring
'
' MIT License:
' Permission is hereby granted, free of charge, to any person obtaining a copy
' of this software and associated documentation files (the "Software"), to
' deal in the Software without restriction, including without limitation the
' rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
' sell copies of the Software, and to permit persons to whom the Software is
' furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in
' all copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
' FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
' IN THE SOFTWARE.

' This is a VB.NET port of the VBA function published here:
' https://gist.github.com/guwidoe/038398b6be1b16c458365716a921814d

Public Function GetLocalPath(ByVal Path As String,
                  Optional ByVal rebuildCache As Boolean = False,
                  Optional ByVal returnAll As Boolean = False,
                  Optional ByVal preferredMountPointOwner As String = "") _
                           As String
#If Mac Then
    GetLocalPath = Path: Exit Function
#End If
    Dim webRoot As String, locRoot As String, vKey As String
    Static locToWebDict As Dictionary(Of String, String)
    Static actLocToWebDict As Dictionary(Of String, String)
    Static locPathOwners As Dictionary(Of String, String)
    Dim resDict As Dictionary(Of String, String)
    resDict = New Dictionary(Of String, String)
    preferredMountPointOwner = LCase(preferredMountPointOwner)

    If Not actLocToWebDict Is Nothing And Not rebuildCache Then
      For Each pair As KeyValuePair(Of String, String) In actLocToWebDict
        locRoot = pair.Key : webRoot = pair.Value
        If InStr(1, Path, webRoot, vbBinaryCompare) = 1 Then _
        resDict.Add(locPathOwners(pair.Key),
                Replace(Replace(Path, webRoot, locRoot, , 1), "/", "\"))
      Next
      If resDict.Count = 0 Then Return Path
      If returnAll Then _
      Return Join(resDict.Values.ToArray, "/")
      If resDict.ContainsKey(preferredMountPointOwner) Then _
      Return resDict(preferredMountPointOwner)
      Return resDict.Values(0)
    End If

    locToWebDict = Nothing
    locPathOwners = Nothing
    locToWebDict = New Dictionary(Of String, String)
    actLocToWebDict = New Dictionary(Of String, String)
    locPathOwners = New Dictionary(Of String, String)
    Dim cid As String, fileNumber As Long, line As String, parts() As String
    Dim tag As String, mainMount As String, relPath As String
    Dim b() As Byte, n As Integer, i As Integer, j As Integer, k As Integer
    Dim l As Integer, s As String, bs As String, size As Long
    Dim parentID As String, folderID As String, folderName As String
    Dim folderIdPattern As String : folderIdPattern = ""
    Dim fileName As String, folderType As String
    Dim siteID As String, libID As String, webID As String, lnkID As String
    Dim odFolders As Dictionary(Of String, KeyValuePair(Of String, String))
    Dim cliPolDict As Dictionary(Of String, Dictionary(Of String, String))
    Dim UserEmail As String
    Const sig1 As Byte = &H2
    Dim vbNullByte As Byte
    vbNullByte = &H0 'VBA: MidB$(vbNullChar, 1, 1)

    Dim settPath As String, wDir As String, clpPath As String
    settPath = Environ("LOCALAPPDATA") & "\Microsoft\OneDrive\settings\"
    clpPath = Environ("LOCALAPPDATA") & "\Microsoft\Office\CLP\"

    'Find all subdirectories in OneDrive settings folder:
    Dim oneDriveSettDirs() As DirectoryInfo
    oneDriveSettDirs = New DirectoryInfo(settPath).GetDirectories()
    Dim dirName As String
    cid = ""
    'Writing LocToWebDict using .ini and .dat files in the OneDrive settings:
    For Each oneDriveSettDir As IO.DirectoryInfo In oneDriveSettDirs
      dirName = oneDriveSettDir.Name
      wDir = settPath & dirName & "\"
      'Read global.ini to get cid
      If Dir(wDir & "global.ini", vbNormal) = "" Then GoTo NextFolder
      Using fileStream = New FileStream(wDir & "global.ini", FileMode.Open,
                                        FileAccess.Read, FileShare.ReadWrite)
        Using streamReader = New StreamReader(fileStream, Encoding.Unicode)
          s = streamReader.ReadToEnd()
        End Using
      End Using
      For Each line In Split(s, vbCrLf)
        parts = Split(line, " = ")
        If parts(0) = "cid" Then : cid = parts(1) : Exit For : End If
      Next line

      If cid = "" Then GoTo NextFolder
      If (Dir(wDir & cid & ".ini") = "" Or
      Dir(wDir & cid & ".dat") = "") Then GoTo NextFolder
      If dirName Like "Business#" Then
        folderIdPattern = Replace(Space(32), " ", "[a-f0-9]")
      ElseIf dirName = "Personal" Then
        folderIdPattern = Replace(Space(16), " ", "[A-F0-9]") & "!###*"
      End If

      'Get UserEmail for business accounts
      '(only necessary to let user choose preferredMountPointOwner)
      fileName = Dir(clpPath, vbNormal)
      UserEmail = ""
      Do Until fileName = ""
        If InStr(1, fileName, cid) And cid <> "" Then _
        UserEmail = LCase(Left(fileName, InStr(fileName, cid) - 2)) : _
        Exit Do
        fileName = Dir()
      Loop

      'Read all the ClientPloicy.ini files:
      cliPolDict = New Dictionary(Of String, Dictionary(Of String, String))
      fileName = Dir(wDir, vbNormal)
      Do Until fileName = ""
        If fileName Like "ClientPolicy*.ini" Then
          Using fileStream = New FileStream(wDir & fileName, FileMode.Open,
                                           FileAccess.Read, FileShare.ReadWrite)
            Using streamReader = New StreamReader(fileStream, Encoding.Unicode)
              bs = streamReader.ReadToEnd()
            End Using
          End Using
          cliPolDict(fileName) = New Dictionary(Of String, String)
          For Each line In Split(bs, vbCrLf)
            If InStr(1, line, " = ", vbBinaryCompare) Then
              parts = Split(line, " = ") : tag = parts(0)
              s = Replace(line, tag & " = ", "", , 1)
              Select Case tag
                Case "DavUrlNamespace"
                  cliPolDict(fileName).Add(tag, s)
                Case "SiteID"
                  s = Replace(LCase(s), "-", "")
                  If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                  cliPolDict(fileName).Add(tag, s)
                Case "IrmLibraryId"
                  s = Replace(LCase(s), "-", "")
                  If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                  cliPolDict(fileName).Add(tag, s)
                Case "WebID"
                  s = Replace(LCase(s), "-", "")
                  If Len(s) > 3 Then s = Mid(s, 2, Len(s) - 2)
                  cliPolDict(fileName).Add(tag, s)
              End Select
            End If
          Next line
        End If
        fileName = Dir()
      Loop

      'Read dirName\cid.dat file
      Using fileStream = New FileStream(wDir & cid & ".dat", FileMode.Open,
                                        FileAccess.Read, FileShare.ReadWrite)
        Using byteReader = New BinaryReader(fileStream)
          Dim length = byteReader.BaseStream.Length
          b = byteReader.ReadBytes(length)
        End Using
      End Using
      size = b.Count - 1
      odFolders = New Dictionary(Of String, KeyValuePair(Of String, String))
      For j = 16 To 8 Step -8
        i = j + 1
        Do While i > j And i < size - 168
          If b(i) = sig1 Then
            i += 16
            If Not b(i) = &H1 Then Continue Do
            For k = 1 To 7
              i += 1
              If Not b(i) = &H0 Then Continue Do
            Next
            k = i + 1
            Do Until b(k) = &H0 Or k - i > 128
              k += 1
            Loop
            l = k - i
            If l > 128 Then
              i += l
              Continue Do
            End If
            If l > 39 Then : l = 39 : End If
            If l < 1 Then : l = 1 : End If
            folderID = Encoding.Unicode.GetString(
                Encoding.Convert(Encoding.ASCII,
                Encoding.Unicode, b.Skip(i + 1).Take(l - 1).ToArray()))
            i += 39
            k = i + 1
            Do Until b(k) = &H0 Or k - i > 128
              k = k + 1
            Loop
            l = k - i
            If l > 128 Then
              i += l
              Continue Do
            End If
            If l > 39 Then : l = 39 : End If
            If l < 1 Then : l = 1 : End If
            parentID = Encoding.Unicode.GetString(
                Encoding.Convert(Encoding.ASCII,
                Encoding.Unicode, b.Skip(i + 1).Take(l - 1).ToArray()))
            i += 121
            k = i + 1
            Do Until (b(k) = &H0 And b(k + 1) = &H0) Or k > size
              k = k + 2
            Loop
            l = k - i
            folderName = Encoding.Unicode.GetString(
                                  b.Skip(i + 1).Take(l - 1).ToArray())
            If folderID Like folderIdPattern Then
              If Not odFolders.ContainsKey(folderID) Then
                odFolders.Add(folderID, New KeyValuePair(Of String,
                              String)(parentID, folderName))
              End If
            End If
          End If
          i += 1
        Loop
      Next j

      'Read relevant .ini files
      Using fileStream = New FileStream(wDir & cid & ".ini", FileMode.Open,
                                        FileAccess.Read, FileShare.ReadWrite)
        Using streamReader = New StreamReader(fileStream, Encoding.Unicode)
          s = streamReader.ReadToEnd()
        End Using
      End Using
      Select Case True
        Case dirName Like "Business#"
          'Max 9 Business OneDrive accounts can be signed in at a time.
          mainMount = ""
          For Each line In Split(s, vbCrLf)
            Select Case Left(line, InStr(line, " = ") - 1)
              Case "libraryScope"
                webRoot = "" : parts = Split(line, """") : locRoot = parts(9)
                If locRoot = "" Then locRoot = Split(line, " ")(2) '=libNr
                folderType = parts(3) : parts = Split(parts(8), " ")
                siteID = parts(1) : webID = parts(2) : libID = parts(3)
                If mainMount = "" And folderType = "ODB" Then
                  mainMount = locRoot : fileName = "ClientPolicy.ini"
                  If cliPolDict.ContainsKey(fileName) Then _
          webRoot = cliPolDict(fileName)("DavUrlNamespace")
                Else
                  fileName = "ClientPolicy_" & libID & siteID & ".ini"
                  If cliPolDict.ContainsKey(fileName) Then _
          webRoot = cliPolDict(fileName)("DavUrlNamespace")
                End If
                If webRoot = "" Then 'Backup if previous method doesn't work
                  For Each pair As KeyValuePair(Of String,
                      Dictionary(Of String, String)) In cliPolDict
                    If pair.Value("SiteID") = siteID And pair.Value("WebID") =
                        webID And pair.Value("IrmLibraryId") = libID Then
                      webRoot = pair.Value("DavUrlNamespace") : Exit For
                    End If
                  Next
                End If
                locToWebDict.Add(locRoot, webRoot)
              Case "libraryFolder"
                webRoot = "" : locRoot = Split(line, """")(1)
                libID = Split(line, " ")(3)
                For Each vKey In locToWebDict.Keys
                  If vKey = libID Then
                    s = "" : parentID = Left(Split(line, " ")(4), 32)
                    Do Until Not odFolders.ContainsKey(parentID)
                      s = odFolders(parentID).Value & "/" & s
                      parentID = odFolders(parentID).Key
                    Loop
                    webRoot = locToWebDict(vKey) & s : Exit For
                  End If
                Next vKey
                locToWebDict.Add(locRoot, webRoot)
              Case "AddedScope"
                webRoot = "" : parts = Split(line, """")
                relPath = parts(5) : If relPath = " " Then relPath = ""
                parts = Split(parts(4), " ") : siteID = parts(1)
                webID = parts(2) : libID = parts(3) : lnkID = parts(4)
                fileName = "ClientPolicy_" & libID & siteID & lnkID & ".ini"
                If cliPolDict.ContainsKey(fileName) Then
                  webRoot = cliPolDict(fileName)("DavUrlNamespace") _
                & relPath : End If
                If webRoot = "" Then 'Backup if previous method doesn't work
                  For Each pair As KeyValuePair(Of String,
                      Dictionary(Of String, String)) In cliPolDict
                    If pair.Value("SiteID") = siteID And pair.Value("WebID") =
                        webID And pair.Value("IrmLibraryId") = libID Then
                      webRoot = pair.Value("DavUrlNamespace") & relPath
                      Exit For
                    End If
                  Next
                End If
                s = "" : parentID = Left(Split(line, " ")(3), 32)
                Do Until Not odFolders.ContainsKey(parentID)
                  s = odFolders(parentID).Value & "\" & s
                  parentID = odFolders(parentID).Key
                Loop
                locRoot = mainMount & "\" & s
                locToWebDict.Add(locRoot, webRoot)
              Case Else
                For Each pair As KeyValuePair(Of String, String) In locToWebDict
                  If pair.Key Like "#*" Then locToWebDict.Remove(pair.Key)
                Next
                Exit For
            End Select
          Next line
        Case dirName = "Personal"
          'Only one Personal OneDrive account can be signed in at a time.
          If Not cliPolDict.ContainsKey("ClientPolicy.ini") Then GoTo NextFolder
          For Each line In Split(s, vbCrLf)
            If line Like "library = *" Then _
            locRoot = Split(line, """")(3) : Exit For
          Next line
          webRoot = cliPolDict("ClientPolicy.ini")("DavUrlNamespace")
          If webRoot = "" Or locRoot = "" Or cid = "" Then GoTo NextFolder
          locToWebDict(locRoot) = webRoot & "/" & cid
          If Dir(wDir & "GroupFolders.ini") = "" Then GoTo NextFolder
          Using fileStream = New FileStream(wDir & "GroupFolders.ini",
                                            FileMode.Open,
                                           FileAccess.Read, FileShare.ReadWrite)
            Using streamReader = New StreamReader(fileStream, Encoding.Unicode)
              s = streamReader.ReadToEnd()
            End Using
          End Using
          cid = ""
          For Each line In Split(s, vbCrLf)
            If InStr(1, line, "BaseUri = ") And cid = "" Then
              cid = LCase(Mid(line, InStrRev(line, "/") + 1, 16))
              folderID = Left(line, InStr(line, "_") - 1)
            ElseIf cid <> "" Then
              locToWebDict.Add(locRoot & "\" & odFolders(folderID).Value,
                          webRoot & "/" & cid & "/" &
                          Replace(line, folderID & "_Path = ", ""))
              cid = "" : folderID = ""
            End If
          Next line
      End Select

      For Each pair As KeyValuePair(Of String, String) In locToWebDict
        locRoot = pair.Key : webRoot = pair.Value
        If Right(webRoot, 1) = "/" Then
          webRoot = Left(webRoot, Len(webRoot) - 1)
        End If
        If Right(locRoot, 1) = "\" Then
          locRoot = Left(locRoot, Len(locRoot) - 1)
        End If
        actLocToWebDict(locRoot) = webRoot
        If Not locPathOwners.ContainsKey(locRoot) Then
          locPathOwners.Add(locRoot, UserEmail)
        End If
      Next
NextFolder:
      cid = "" : s = "" : UserEmail = "" : odFolders = Nothing
    Next

    Return GetLocalPath(Path, False, returnAll, preferredMountPointOwner)
  End Function