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
    
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.
Subscribe to:
Comments (Atom)
Books Read 2024
Below are the books that I read during 2024 and my rating out of 5. Rating Title Author Book# 5 Moriarty: The Devil's Game ‡...
- 
When you're feeling mellow and creative and you don't have a camera then poems can be an easy outlet for those creative juices or ev...
 - 
New bike day! VelectriX Ascent+29 (2018) electric power assisted mountain bicycle. I moved to a suburb 12km farther out from work (now ...
 - 
So you have this iSight camera built into your Mac and you want to make it take images on demand. My first thought was to get Automator to d...