Supplying username and password to repository via code

Question

Hi There,
Is there a way to supply the username and password to the webdav repository via code or in the address line? We have an ActiveX object accessing files and would like to avoid the repository prompting.
Thanks

Answer 1

With Script I can do it as follows.. See VerifyConnection
Option Explicit
Const iTimeOutInSecs = 60
Const ForWriting = 2
Rem ************** MAIN *****************
main
Wscript.quit
Sub Main
  Dim WShell, FileSystem
  Dim davControl
  Dim objArgs, targetPath, serverURL, username, password, rootFolder, filter
  Dim fileUploadList, result
  Dim folderList, filelist
  Dim status
  Dim spoolFile
  Set wShell     = WScript.CreateObject("WScript.Shell")
  Set fileSystem = WScript.CreateObject("Scripting.FileSystemObject")
  Set spoolFile = fileSystem.OpenTextFile("httpUploadLoad.log", ForWriting, True)
  Set objArgs = WScript.Arguments
  targetPath  = objArgs(0)
  serverUrl   = objArgs(1)
  username    = objArgs(2)
  password    = objArgs(3)
  rootFolder  = objArgs(4)
  If objArgs.length = 6 Then
    filter    = objArgs(5)
  Else
    filter = Empty
  End If
  Set fileUploadList = CreateObject("Msxml2.DOMDocument.4.0")
  fileUploadList.async = False
  result = fileUploadList.load(targetPath)
  If (result = False) Then
    MsgBox "Failure while loading or parsing file : " & targetPath,vbCritical
    Wscript.quit
  End If
  Set davControl = new DavControlClass
  davControl.setServer serverURL, username, password
  davControl.setSpoofile(spoolfile)
  status = verifyHttpConnection(davControl, username)
  Set folderList =  fileUploadList.documentElement.selectNodes("/Upload/directories/directory")
  createFolders davControl, rootFolder, folderList, username, password, filter
  Set fileList =  fileUploadList.documentElement.selectNodes("/Upload/files/file")
  uploadFiles davControl, rootFolder, fileList, username, password, filter
  spoolfile.close()
End Sub
Function verifyHttpConnection(davControl,username)
  Dim status, targetFolder
  targetFolder = "/home/" & username
  status = davControl.verifyConnection(targetFolder)
  verifyHttpConnection = status
End Function
Sub createFolders(davControl, rootFolder, folderList, username, password, filter)
  Dim i, targetFolder, targetFolderPath
  For i = 0 to folderList.length - 1
    Set targetFolder = folderList.item(i)
    targetFolderPath = rootFolder & targetFolder.text
    If IsNull(filter) or (InStr(targetFolder.text,filter) = 1) Then
      'wscript.echo "Making " & targetFolderPath
      davControl.makeDir targetFolderPath,true
    End If
  Next
End Sub
Sub uploadFiles(davControl, rootFolder, fileList, username, password, filter)
  Dim i, targetFile, targetFilename, localFilename
  For i = 0 to fileList.length - 1
    Set targetFile = fileList.item(i)
    targetFilename = rootFolder & targetFile.text
    localFilename = Right(replace(targetFile.text,"/","\"),Len(targetFile.text)-1)
    If IsNull(filter) or (InStr(targetFile.text,filter) = 1) Then
      'wscript.echo "Uploading " &localFilename & " as " & targetFilename
      davControl.uploadFile localFIlename, targetFileName, "FORCE"
    End If
  Next
End Sub
Class DavControlClass
  Private HTTPUser
  Private HTTPPassword
  Private HTTPServer
  Private installParameters
  Private windowsShell
  Private XMLHTTP_CLASS_ID
  Private HttpObject
  Private spoolFile
  Dim     folderStatusList
  Private Sub Class_Initialize()
    XMLHTTP_CLASS_ID = "Msxml2.XMLHTTP.6.0"
    Set HttpObject = CreateObject(XMLHTTP_CLASS_ID)
    folderStatusList = Empty
  End Sub  
  Public Sub setSpoofile(file)
    Set spoolFile = file
  End Sub
  Public Sub setParameters(wshell, params)
    Set installParameters = params
    Set windowsShell = wShell
    setServer params.getServerURL(), params.getUser(), params.getPassword()
  End Sub
  Public Sub setServer(serverURL,serverUser,serverPassword)
    HTTPServer   = serverURL
    HTTPUser     = serverUser
    HTTPPassword = serverPassword
  End Sub
  Public Function getServerURL
    getServerURL= HTTPServer
  End Function       
  Public Function verifyConnection(target)
    On Error Resume Next
    HttpObject.Open "HEAD", HTTPServer & target, false, HTTPUser, HTTPPassword
    If Err.Number <> 0 Then
      WScript.echo "verifyConnection() - Fatal Error encountered accessing : " & HTTPServer & target & ". Status (" & Hex(Err.number)  & ") " & Err.Description
      Wscript.quit         
    End If
    On Error GoTo 0 
    HttpObject.setRequestHeader "Content-type", "text/xml"
    HttpObject.setRequestHeader "Depth", "1"
    On Error Resume Next
    HttpObject.send ("")
    If Err.Number <> 0 Then
      WScript.echo "resetConnection() - Fatal Error encountered accessing : " & HTTPServer & target & ". Status (" & Hex(Err.number)  & ") " & Err.Description
      Wscript.quit         
    End If
    On Error GoTo 0 
    If HTTPObject.status <> 200 Then
      MsgBox "Unable to access " & getServerURL() & target & ". HTTP Status = " & HTTPObject.status & ". Please correct installParameters.xml and restart Installation",vbCritical
      Wscript.quit
    End If
    spoolfile.writeline "HTTP Successfully Connected to '" & getServerURL() & target
    verifyConnection = HTTPObject.status
  End Function
  Public Function uploadFile (local, remote, mode)
    Dim returnCode, rc
    returnCode = doHead(remote)
    If returnCode = 401 Then
      MsgBox "uploadFile() - Unauthorized (Status (" & returnCode & "). Unable to upload '" & local & "' into '" & remote & "'.  Please check installParameters.xml and log files.",vbCritical
      Wscript.quit         
    End If
    If returnCode = 200 Then
      If mode = "ERROR" Then
        MsgBox "uploadFile() - Installation Failed. Resource Exists : '" & remote & "'. Please check installParameters.xml and restart Installation",vbCritical
        Wscript.quit
      End If
      If mode = "SKIP" Then
        uploadFile = returnCode
        Exit Function
      End If
      If mode = "FORCE" Then
        rc = doDelete(remote)
      End If
    End If
    uploadFile = doPut (local, remote, null)
    If uploadFile = 500 Then
      MsgBox "UploadFile() - Upload Failed (Status (" & uploadFile & "). Unable to upload '" & local & "' into '" & remote & "'.  Retry in Progress.",vbCritical
      uploadFile = doPut (local, remote, null, user, password)
      If uploadFile = 500 Then
        MsgBox "UploadFile() -  Installation Failed (Status (" & uploadFile & "). Unable to upload '" & local & "' into '" & remote & "'.  Please check installParameters.xml and log files.",vbCritical
        Wscript.quit         
      End If
    End If
    If uploadFile = 401 Then
      MsgBox "UploadFile() - Unauthorized (Status (" & uploadFile & "). Unable to upload '" & local & "' into '" & remote & "'.  Please check installParameters.xml and log files.",vbCritical
      Wscript.quit         
    End If
  End Function
  Public Function makeDir(targetFolder,force)
    Dim Status, ParentFolder
    status = doHEAD(targetFolder)
    If not IsEmpty(folderStatusList) Then
      folderStatusList.add targetFolder, status
    End If
    If (status = 404 or status = 409) and force Then
      parentFolder = Mid(targetFolder,1,InStrRev(targetFolder,"/")-1)
      makeDir parentFolder,true
      status = doMKCOL(targetFolder)
    End If
    makeDir = status   
    If status = 401 Then
      MsgBox "doMKCOL() - Unauthorized (Status (" & status & "). Unable to create '" & targetFolder & "'.  Please check installParameters.xml and log files.",vbCritical
      Wscript.quit         
    End If
  End Function
  Public Function doHEAD(remote)
    ' Dim HttpObject
    ' Set HttpObject = CreateObject(XMLHTTP_CLASS_ID)
    ' HttpObject.Open "HEAD", HTTPServer & remote, false, user, password
    HttpObject.Open "HEAD", HTTPServer & remote, false
    HttpObject.setRequestHeader "Content-type", "text/xml"
    HttpObject.setRequestHeader "Depth", "1"
    On Error Resume Next
    HttpObject.send ("")
    If Err.Number <> 0 Then
      WScript.echo "doHEAD() - Fatal Error encountered accessing : " & HTTPServer & remote & ". Status (" & Hex(Err.number)  & ") " & Err.Description
      Wscript.quit         
    End If
    On Error GoTo 0 
    doHead = HttpObject.status
  End Function
  Public Function doPUT(local,remote,contentType)
    Dim tmStart
    Dim tmCurr
    Dim iTimeTaken
    Dim currentStatus
    Dim ado_stream
    Dim uploadCount, uploadStatus
    Set ado_stream = CreateObject("ADODB.Stream")
    ado_stream.Type = 1
    ado_stream.Open()
    On Error Resume Next
    ado_stream.LoadFromFile(local)
    If Err.Number <> 0 Then
      WScript.echo "doPUT() - Fatal Error encountered reading File : " & local & ". Status (" & Hex(Err.number)  & ") " & Err.Description
      Wscript.quit         
    End If
    On Error GoTo 0 
    HttpObject.Open "PUT", HTTPServer & remote, false
    If not IsNull(contentType) Then
      HttpObject.setRequestHeader "Content-type", contentType
    End If
    tmStart = Now
    On Error Resume Next
    HTTPObject.send(ado_stream.Read(-1))
    If Err.number <> 0 Then
      '  Unexpected errors can occur as a result of the HTTP request being passed to wrong database instance
      '  when multiple databases are using the same listener.
      WScript.echo "doPUT() - Fatal Error encountered uploading File : " & local & ". Status (" & Hex(Err.number)  & ") " & Err.Description
      WScript.quit
   Else
      currentStatus = HTTPObject.status
    End If
    On Error GoTo 0 
    uploadCount = 1
    uploadStatus = doHead(remote)
    Do While uploadStatus <> 200 and uploadCount < 6
      '  Unexpected errors can occur as a result of the HTTP request being passed to wrong database instance
      '  when multiple databases are using the same listener.
      spoolfile.writeline "Http Error encountered uploading " & local & " to " & HTTPServer & remote &". Status=" & currentStatus
      currentStatus = retryPUT(local,remote,contentType)
      uploadCount = uploadCount + 1
      uploadStatus = doHead(remote)
    Loop
    If uploadStatus = 200 Then
      tmCurr = Now
      spoolFile.writeLine "Uploaded File " & local & ". Elapsed Time = " & CInt(DateDiff("s", tmStart, tmCurr)) & " seconds."
    Else
      WScript.echo "doPUT - Fatal Error uploading file (" & HTTPServer & remote & ") : Status=" & HTTPObject.status
      WScript.quit
    End If
    doPut = currentStatus
    ado_stream.Close()
  End Function
  Public Function retryPUT(local,remote,contentType)
    Dim ado_stream
    Set ado_stream = CreateObject("ADODB.Stream")
    ado_stream.Type = 1
    ado_stream.Open()
    On Error Resume Next
    ado_stream.LoadFromFile(local)
    If Err.number <> 0 Then
      WScript.echo "doPUT() - Fatal Error encountered reading File : " & local & ". Status (" & Hex(Err.number)  & ") " & Err.Description
      Wscript.quit         
    End If
    On Error GoTo 0 
    HttpObject.Open "PUT", HTTPServer & remote, true
    If not IsNull(contentType) Then
      HttpObject.setRequestHeader "Content-type", contentType
    End If
    On Error Resume Next
    HTTPObject.send(ado_stream.Read(-1))
    If Err.Number <> 0 Then
      ado_stream.Close()
      WScript.echo "doPUT() - Fatal Error encountered sending File : " & local & " to " & HTTPServer & remote &". Status (" & Hex(Err.number)  & ") " & Err.Description & ". Retrying ...."
      Wscript.quit         
    Else   
      Do While HTTPObject.readyState <> 4
        WScript.Sleep(1000)
      Loop
    End If
    On Error GoTo 0 
    ado_stream.Close()
    retryPut =  HTTPObject.status         
  End Function
  Public Function doMKCOL(remote)
    ' wscript.echo "doMKCOL (" & HTTPServer & remote & ")"
    Dim currentStatus
    HttpObject.Open "MKCOL", HTTPServer & remote, false
    HttpObject.setRequestHeader "Content-type", "text/xml"
    On Error Resume Next
    HttpObject.send("")
    If Err.Number <> 0 Then
      WScript.echo "doMKCOL() - Fatal Error encountered making Folder : " & HTTPServer & remote &". Status (" & Hex(Err.number)  & ") " & Err.Description
      Wscript.quit         
    End If
    On Error GoTo 0 
    If  HTTPObject.status <> 201 Then
      WScript.echo "doMKCOL() - Fatal Error encountered making Folder : " & HTTPServer & remote &". Status (" & HTTPObject.status & ")."
      Wscript.quit         
    End If
    doMKCOL = HTTPObject.status
  End Function
  Public Function doDELETE(remote)
    HttpObject.Open "DELETE", HTTPServer & remote, false
    HttpObject.setRequestHeader "Content-type", "text/xml"
    On Error Resume Next
    HttpObject.send("")
    If Err.Number <> 0 Then
      WScript.echo "doMKCOL() - Fatal Error deleting : " & HTTPServer & remote &". Status (" & Hex(Err.number)  & ") " & Err.Description
      Wscript.quit         
    End If
    On Error GoTo 0 
    doDELETE = HTTPObject.status
    If HTTPObject.status <> 201  and HTTPObject.status <> 204 and HTTPObject.status <> 207 and HTTPObject.status <> 404 Then
      wscript.echo "doDELETE (" & HTTPServer & remote & ") : Status=" & HTTPObject.status
    End If
  End Function
End Class