'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