Jaa

Howto: WebDAV PUT using VBScript

  • Artikkeli

' This example shows how to do a PUT of a message to a folder. What is being written with a PUT would
' be the MIME of a message and such MIME can also contain the MIME of the message.  PUT works against
' messaging items directly such as mail messages. It cannot be used to add an attachment without
' recreating the entire message. PUT is a desctructive write against the URL specified.

' You can use Outlook Express to create a mime message. To use this sample, create a mime message
' and save it as c:\MyTestEmail.eml, the run the code.

' NOTE: You need to have a header of "Translate" set to "f" in order to read mime of an item with a PUT.
' NOTE: A PUT should only be used for writting message. It's often used for creating messages for sending.

' Do the TODO Sections
'-----------------------------------------------------------------------------------
' ReadFileText - Used to PUT (write) an item to a file in a folder.
' Parameters:
'   sFile - The file to read
'
' Returns:
'   A string containing the content of the file.
'-----------------------------------------------------------------------------------
Function ReadFileText (sFile)
    Dim objFSO 'As FileSystemObject
    dim oTS
    dim sText
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set oTS = objFSO.OpenTextFile(sFile)
    sText = oTS.ReadAll

    oTS.close
    set oTS = nothing
    Set objFSO = nothing
 
    ReadFileText = sText
    
end Function

'-----------------------------------------------------------------------------------
' DoWebdavPut- Used to PUT (write) an item to a file in a folder.' Parameters:
'  sFolder          - The complete URI to PUT the item (includes item name).
'  sText            - The contents to write in the file.
'  sUser            - User ID for logging in.  Set to "" if using windows authentication
'  sPassword        - Password for logging in.  Set to "" if using windows authentication
' Returns:
'   Status response text
'--------------------------------------------------------------------------------
Private Function DoWebdavPut(sFolder, sText, sUser, sPassword) 
    Dim oXMLHttp 'As New MSXML2.XMLHTTP30
    Dim bSucess 'As Boolean
    Dim iStatus 'As Integer
    Dim sStatus 'As String
    Dim sResponse 'As String

    set oXMLHttp = CreateObject("microsoft.xmlhttp")
   
    If sUser <> "" Then
        oXMLHttp.Open "PUT", sFolder, False, sUser, sPassword   
    Else
         oXMLHttp.Open "PUT", sFolder, False ', sUser, sPassword   
    End If
    oXMLHttp.setRequestHeader "translate", "f" ' Set this to prevent stream problems
    oXMLHttp.Send sText ' Send the stream across
   
    bSucess = False
   
    iStatus = oXMLHttp.Status
    sStatus = oXMLHttp.statusText
    If (iStatus >= 200 And iStatus < 300) Then
        wscript.echo  "PUT: Success!   " & "Results = " & iStatus & ": " & sStatus
        bSucess = True
    ElseIf iStatus = 401 Then
        wscript.echo  "PUT: You don't have permission to do the job! Please check your permissions on this item."
    Else
        wscript.echo  "PUT: Request Failed.  Results = " & iStatus & ": " & sStatus
    End If
   
    Set oXMLHttp = Nothing
   
    DoWebdavPut = sStatus
End Function

Dim sHREF   'As String
Dim sUserName   'As String
Dim sPassword   'As String
Dim sFile  'As String
Dim sRet  'As String

sHREF = "https://myexserver/exchange/Administrator/Inbox/testabcdxx.EML"  ' TODO: change
sUserName = "Administrator"    ' TODO: change
sPassword = "test"    ' TODO: change
sFile = "c:\MyTestEmail.eml"  ' TODO: change
sRet = ""

sString = ReadFileText(sFile)

sRet = DoWebdavPut(sHREF, sString, sUserName, sPassword)

wscript.echo sRet

Comments