Remote Printing with Dropbox – Visual Basic Script

With the help of Dropbox, you can easily print files from mobile phones. This is the VBS code that makes it happen – it watches your Print Queue folder in Dropbox and sends it to the default printer as soon as it discovers a new file in that watched folder.

'Remote Printing through Dropbox
'Written by Amit Agarwal http://www.labnol.org/
 
Option Explicit
On Error Resume Next
 
Const WAIT_TIME  = 5000 '5 seconds
Const PRINT_TIME = 5000 '5 seconds
 
Dim WshShell, fso, configFile, objReadFile, str64, strPath, ApplicationData
Dim dbWatchDir, attFolder, objShell, objFolder, colItems, objItem, dbLogDir, logFolder, doneFolder
 
Set WshShell = CreateObject("Wscript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
ApplicationData = WshShell.ExpandEnvironmentStrings("%APPDATA%")
 
'Find the Dropbox Folder Location
configFile = ApplicationData & "\Dropbox\host.db"
 
If fso.FileExists( configFile ) Then
 Set objReadFile = fso.OpenTextFile( configFile, 1)
 Do Until objReadFile.AtEndOfStream
  str64 = objReadFile.ReadLine
 Loop
strPath = Base64Decode(str64)
'WScript.Echo "Your Dropbox folder is located at " & strPath
Else
WScript.Echo "Looks like Dropbox is not installed on this computer." &  VbCrLf & "Please install Dropbox and run this script again."
WScript.Quit()
End If
 
dbWatchDir = strPath & "\Attachments"
 
If Not fso.FolderExists (dbWatchDir) Then
 Set attFolder = fso.CreateFolder (dbWatchDir)
 WScript.Echo "Created a folder to hold your new print jobs - " & dbWatchDir
End If
 
dbLogDir = dbWatchDir & "\Print_Log"
 
If Not fso.FolderExists (dbLogDir) Then
 Set logFolder = fso.CreateFolder (dbLogDir)
 WScript.Echo "Created a folder to hold processed jobs - " & dbLogDir
End If
 
Do While True
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(dbWatchDir)
Set colItems = objFolder.Items
doneFolder = dbLogDir & "\" & DateDiff("s", "1/1/2010", Now)
 
For Each objItem in colItems
 If Not objItem.IsFolder Then  
  If Not fso.FolderExists (doneFolder) Then
   Set logFolder = fso.CreateFolder (doneFolder)
   WScript.Echo "Created a folder to save processed jobs - " & doneFolder
  End If
  objItem.InvokeVerbEx("Print")
  WScript.Echo "Now printing: " & objItem.Name  
  WScript.Sleep(PRINT_TIME)
  fso.MoveFile dbWatchDir & "\" & objItem.Name & "*", doneFolder
 end if
Next
WScript.Sleep(WAIT_TIME)
Set objShell = nothing
Set objFolder = nothing
Set colItems = nothing
Loop
 
' Decodes a base-64 encoded string (BSTR type).
' 1999 - 2004 Antonin Foller, http://www.motobit.com
Function Base64Decode(ByVal base64String)
  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
 
 
  For groupBegin = 1 To dataLength Step 4
    Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
    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