Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
This code uses the ProvideAudio function to upload an audio file to an account's audio library for use in future broadcasts.
Option Compare Database
Private Sub TestXMLHTTP()
Dim username As String
Dim pin As String
Dim AudioType As String
Dim BinaryMessage As String
Dim AudioDescription As String
Dim TheBytes() As Byte
Rem ===================================
Rem Use your account credentials here
Rem ===================================
username = "99919991"
pin = "9991"
Rem ================================
Rem AudioType = 0 = WAV, 1 = MP3, 2 = AVI, 3 = All Else
Rem ================================
AudioType = "0"
Rem ================================
Rem AudioDescription is string
Rem ================================
AudioDescription = "My Uploaded File"
With CreateObject("ADODB.Stream")
.Open
.Type = 1 ' adTypeBinary
.LoadFromFile "c:\myaudio.wav" ' file.Path
TheBytes = .Read
.Close
End With
BinaryMessage = EncodeBase64(TheBytes)
Rem ===================================
Rem The endpoint (staging/Production)
Rem ===================================
Dim strURL As String
strURL = "http://localhost:4405/webservices/CEAAPI_v2.asmx"
Rem strURL = "http://staging-api.call-em-all.com/webservices/ceaapi_v2.asmx"
Rem For Production use the following
Rem ================================
Rem strURL = "http://staging-api.call-em-all.com/webservices/ceaapi_v2.asmx"
Rem ================================
Dim FunctionName As String
FunctionName = "ProvideAudio"
Dim SoapPost As String
SoapPost = "<?xml version=""1.0"" encoding=""utf-8""?>" _
& "<soap12:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap12=""http://www.w3.org/2003/05/soap-envelope"">" _
& "<soap12:Body>" _
& "<" & FunctionName & " xmlns=""http://call-em-all.com/"">" _
& " <myRequest>" _
& " <username>" & username & "</username>" _
& " <pin>" & pin & "</pin>" _
& " <AudioType>" & AudioType & "</AudioType>" _
& " <BinaryMessage><![CDATA[" & BinaryMessage & "]]></BinaryMessage>" _
& " <AudioDescription>" & AudioDescription & "</AudioDescription>" _
& " </myRequest>" _
& "</" & FunctionName & ">" _
& "</soap12:Body>" _
& "</soap12:Envelope>"
Rem ================================
Rem Debugging use
Rem ================================
Rem MsgBox (SoapPost)
Rem ================================
Dim xmldoc As Object
Set xmldoc = CreateObject("MSXML2.DOMDocument")
xmldoc.async = False
xmldoc.loadXML (SoapPost)
Dim oReq As Object
Set oReq = CreateObject("MSXML2.XMLHTTP")
Dim oDOM As Object
Set oDOM = CreateObject("MSXML2.DOMDocument.3.0")
oDOM.async = "false"
Dim oNodeList As IXMLDOMNodeList
On Error GoTo ErrRoutine
oReq.Open "POST", strURL, False
oReq.setRequestHeader "Host", "api.call-em-all.com"
oReq.setRequestHeader "Content-Type", "application/soap+xml; charset=""utf-8"""
oReq.setRequestHeader "Content-Length", Len(SoapPost)
oReq.send xmldoc.XML
Rem ================================
Rem Debugging use
Rem ================================
Rem MsgBox (xmldoc.XML)
Rem ================================
oDOM.loadXML (oReq.responseText)
Rem ================================
Rem Debugging use
Rem ================================
Rem MsgBox (oReq.responseText)
Rem ================================
Rem ================================
Rem Destroy the request object
Rem ================================
Set oReq = Nothing
Dim errorCode As String
Dim errorMessage As String
Rem ================================
Rem Get the result codes
Rem ================================
Set oNodeList = oDOM.getElementsByTagName(FunctionName & "Result/errorCode")
If oNodeList.length = 0 Then
MsgBox ("FAILURE Proper response not returned")
GoTo EndRoutine
Else
errorCode = oNodeList.Item(0).text
End If
Set oNodeList = oDOM.getElementsByTagName(FunctionName & "Result/errorMessage")
errorMessage = oNodeList.Item(0).text
MsgBox ("ErrorCode: " & errorCode & vbCrLf & "ErrorMessage: " & errorMessage)
Rem ================================
Rem Use the XML Dom to get any other
Rem data passed back
Rem ================================
EndRoutine:
Exit Sub
ErrRoutine:
MsgBox Err.Number & " - " & Err.Description, _
vbOKOnly Or vbCritical, _
"TestXMLHTTP"
GoTo EndRoutine
End Sub
Private Function EncodeBase64(ByRef arrData() As Byte) As String
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
' help from MSXML
Set objXML = New MSXML2.DOMDocument
' byte array to base64
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.text
' thanks, bye
Set objNode = Nothing
Set objXML = Nothing
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.