2013-09-04

Locate the local path for Google Drive, DropBox, SkyDrive in VBscript

When scripting up a storm, I sometimes need to place output into folders that I know will be stored in the cloud. The following script set will return the folder on the local windows drives where the cloud apps will be syncing their files, or an empty string if the script fails due to the cloud application having not been installed or some other issue such as Microsoft moving their registry setting or Google changing the readability of their config file.
WScript.Echo "Dropbox : " & GetDropBoxFolder
WScript.Echo "Google Drive : " & GetGoogleDriveFolder
WScript.Echo "Skydrive : " & GetSkyDriveFolder

Function GetSkyDriveFolder ()
Dim WshShell, f
set WshShell = WScript.CreateObject ("WScript.Shell")
On Error Resume Next
f = WshShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\SkyDrive\UserFolder") ' Windows 7
If Err.Number <> 0 Then
 Err.Clear
 ' Allegedly this is windows 8 key, however this appears not to be the Case
 f = WshShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\SkyDrive\UserFolder")
End If
GetSkyDriveFolder = f & ""
On Error GoTo 0
End Function

Function GetAppDataFolder ()
' returns C:\\\AppData\Roaming
' returns empty strong if not found
Dim WshShell, f
set WshShell = WScript.CreateObject ("WScript.Shell")
On Error Resume Next
f = WshShell.ExpandEnvironmentStrings("%APPDATA%") & ""
If Err.Number Then Err.Clear
On Error GoTo 0
GetAppDataFolder = f
End Function

Function GetLocalAppDataFolder ()
' returns C:\\\AppData\Roaming
' returns empty strong if not found
Dim WshShell, f
set WshShell = WScript.CreateObject ("WScript.Shell")
On Error Resume Next
f = WshShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & ""
If Err.Number Then Err.Clear
On Error GoTo 0
GetLocalAppDataFolder = f
End Function

Function Base64Decode(ByVal base64String)
'rfc1521 1999 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
  Err.Raise 1, "Base64Decode", "Bad Base64 string."
  Exit Function
End If
Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
For groupBegin = 1 To dataLength Step 4
  numDataBytes = 3
  nGroup = 0
  For CharCounter = 0 To 3
    thisChar = Mid(base64String, groupBegin + CharCounter, 1)
    If thisChar = "=" Then
      numDataBytes = numDataBytes - 1
      thisData = 0
    Else
      thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
    End If
    If thisData = -1 Then
      Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
      Exit Function
    End If
    nGroup = 64 * nGroup + thisData
  Next
  nGroup = Hex(nGroup)
  nGroup = String(6 - Len(nGroup), "0") & nGroup
  pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) +  Chr(CByte("&H" & Mid(nGroup, 3, 2))) +  Chr(CByte("&H" & Mid(nGroup, 5, 2)))
  sOut = sOut & Left(pOut, numDataBytes)
Next
Base64Decode = sOut
End Function

Function GetDropBoxFolder ()
' Returns Empty String If host.db not found and decoded properly
' %APPDATA%\Dropbox\host.db
Dim fso, hostdb, p, f
f = ""
p = GetAppDataFolder
If p <> "" Then
 On Error Resume Next
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set hostdb = fso.OpenTextFile(p & "\Dropbox\host.db", 1, False, -2)
 If Err.Number <> 0 Then
  Err.Clear
 Else
  f = hostdb.ReadLine & "" ' junk line
  If Err.Number <> 0 Then Err.Clear
  f = hostdb.ReadLine & "" ' this line!
  If Err.Number <> 0 Then Err.Clear
  hostdb.Close
  If Err.Number <> 0 Then Err.Clear
  If f <> "" Then f = Base64Decode(f) & ""
  If Err.Number <> 0 Then Err.Clear
 End If
 On Error GoTo 0
End If
GetDropBoxFolder = f
End Function

Function GetGoogleDriveFolder ()
' Returns Empty String If sync_config.db not found and decoded properly
' %LOCALAPPDATA%\Google\Drive\sync_config.db
' local_sync_root_pathvalue\\?\C:\Users\thsforsy\Google Drive[RS][ETX][EOT]
' 123456789012345678901234567890
Dim fso, datafile, p, alltext, cleantext, f, i
f = ""
p = GetLocalAppDataFolder
If p <> "" Then
 On Error Resume Next
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set datafile = fso.OpenTextFile(p & "\Google\Drive\sync_config.db", 1, False, 0)
 If Err.Number <> 0 Then
  ' No folder, just let the system exit and return empty string
  Err.Clear
 Else
  startpos = 0
  Do While Not datafile.AtEndOfStream And startpos = 0
   alltext = datafile.ReadLine & ""
   If Err.Number <> 0 Then Err.Clear
   cleantext = ""
   For i = 1 To Len(alltext)
    If Asc(Mid(alltext,i,1)) = 30 OR Asc(Mid(alltext,i,1)) >=32 Then cleantext = cleantext & Mid(alltext,i,1)
   Next
   startpos = InStr(1,cleantext,"local_sync_root_pathvalue")
   If startpos > 0 Then
    endpos = startpos + 29
    Do While endpos < Len(cleantext) And Asc(Mid(cleantext,endpos,1)) >= 32
     IF Asc(Mid(cleantext,endpos,1)) <> 0 Then f = f & Mid(cleantext,endpos,1)
     endpos = endpos + 1
    Loop
   End If
  Loop
  datafile.Close
  If Err.Number <> 0 Then Err.Clear
 End If
 On Error GoTo 0
End If
GetGoogleDriveFolder = Trim(f)
End Function