' Written by Jeff Jones 3-30-2004.  Pure freeware, please redistribute.
'=================================

'Use this function call to upload a single file
WebUploadFile "C:\file.txt", "http://server/folder/file.txt", "domain\user", "password"

'Use this function call and constant to upload a directory and all it's subdirectories
Const basedir = "c:\temp"
WebUploadDir "", "http://server/folder/", "domain\user", "password"


'====================== WebDAV upload single file
Function WebUploadFile (file, url, user, pass)
  Dim objXMLHTTP
  Dim objADOStream
  Dim arrbuffer
  Set objADOStream = CreateObject("ADODB.Stream")
  objADOStream.Open
  objADOStream.Type = 1
  objADOStream.LoadFromFile file
  arrbuffer = objADOStream.Read()
  Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
  objXMLHTTP.open "PUT", url, False, user, pass
  objXMLHTTP.send arrbuffer
End Function


'====================== WebDAV upload directroy
Function WebUploadDir (dir, baseUrl, usr, pwd)
  Set fso = CreateObject("Scripting.FileSystemObject")
  If dir = "" Then dir = basedir
  Set srcFolder = fso.GetFolder(dir)
	
  Dim fl
  Set files = srcFolder.files
  For Each fl in files
    Dim relpath
    relpath = Right(fl.path,Len(fl.path)-Len(basedir)-1)
    relpath =  Replace(relpath, "\", "/")
    WebUploadFile fl.path, baseUrl & relpath, usr, pwd
  Next
  
  Dim sf
  Set subfold = srcFolder.SubFolders
  For Each sf in subfold
     Set f = fso.GetFolder(sf)
     relpath = Right(f,Len(f)-Len(basedir)-1)
     relpath =  Replace(relpath, "\", "/")
     Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
     objXMLHTTP.open "MKCOL", baseUrl & relpath, False, usr, pwd
     objXMLHTTP.send
     WebUploadDir f , baseUrl, usr, pwd
  Next
End Function