Contoh Program Pengiriman Data XML menggunakan VB

Setelah dibuatkan Script untuk penerimaan data XML di Web server, selanjutnya di sisi client dibuatkan program untuk upload data XML, contoh program berikut penulis menggunakan VB. berikut contoh  prosedur untuk pengiriman data XML :
‘Fungsi utama untuk mengirim data XML ke web server
Public Function SendXml(urlx As String, dt1 As Date, dt2 As Date) As Boolean
Dim url As String
url = urlx
SendXml = False
‘HTTP variable
Dim myHTTP As Object
‘HTTP object
Set myHTTP = CreateObject(“msxml2.xmlhttp”)
‘create dom document variable  ‘stores the xml to send
Dim myDom As Object
‘Create the DomDocument Object
Set myDom = CreateObject(“MSXML2.DOMDocument”)
‘Load entire Document before moving on
myDom.async = False
‘xml string variable
‘replace with location if sending from file or URL
Dim myxml As String
‘myxml = “” & _
“” & _
“1024634” & _
“0” & _
“”
Call getdataxml(myDom, dt1, dt2)
‘loads the xml
‘change to .Load for file or url
‘myDom.loadXML (myxml)
‘myDom.Save “c:\tes.xml”
‘open the connection
myHTTP.Open “post”, url, False
myHTTP.setRequestHeader “Content-Type”, “text/xml;charset=utf-8″
myHTTP.setRequestHeader “Connection”, “keep-alive”
myHTTP.setRequestHeader “Accept”, “text/xml, multipart/related,text/html, image/gif, image/jpeg, *; q=.2, */*; q=.2″
myDom.async = False
‘myDom.loadXML myxml
Screen.MousePointer = 11
myHTTP.send myDom.xml
Screen.MousePointer = 0
‘send the XML
‘myHTTP.send (myDom.xml)
‘Display the response
SendXml = True
If myHTTP.responseText = “Sukses” Then
MsgBox (“Upload Data ke Web Pojokbursa Selesai”)
Else
MsgBox (“Upload Data ke Web Pojokbursa Gagal”)
End If
‘Label3.Caption = “Request XML is Posted Successfully”
Set myHTTP = Nothing
End Function

‘Prosedur untuk mengkonversi record di table kedalam data XML
‘Paramter input :
‘ xmldom : Objek Referensi XMLDocument
‘ dt1 : filtering mulai data dari tanggal
‘ dt2 : filtering mulai data sampai dengan tanggal
Private Sub getdataxml(xmldom As Object, dt1 As Date, dt2 As Date)
Dim rs As New ADODB.Recordset
Dim sql As String
Dim dta1, dta2 As String
Dim xmlP, objDoc, objRoot, objN As Object
dta1 = Format(dt1, “yyyy-mm-dd”)
dta2 = Format(dt2, “yyyy-mm-dd”)
Set xmlP = xmldom.createProcessingInstruction(“xml”, “version=’1.0′”)
xmldom.appendChild xmlP
Set objRoot = xmldom.createElement(“stk”)
xmldom.appendChild objRoot
Set objR1 = xmldom.createElement(“stocks”)
objRoot.appendChild objR1
sql = “select * from stock_eod where stk_date>=’” & dta1 & “‘ and stk_date<=’” & dta2 & “‘”
Set rs = Conn.Execute(sql)
If Not rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF
Set objR = xmldom.createElement(“stock”)
objR1.appendChild objR
For i = 0 To rs.Fields.Count – 1
Set objData = xmldom.createElement(LCase(rs.Fields(i).Name))
If rs.Fields(i).Type = adDBDate Then
objData.Text = Format(rs.Fields(i).Value, “yyyy-mm-dd”)
Else
objData.Text = IIf(IsNull(rs.Fields(i).Value), 0, rs.Fields(i).Value)
End If
objR.appendChild objData
Set objData = Nothing
Next i
Set objR = Nothing
rs.MoveNext
Loop
End If
Set objR2 = xmldom.createElement(“inxs”)
objRoot.appendChild objR2
sql = “select * from index_eod where inx_date>=’” & dta1 & “‘ and inx_date<=’” & dta2 & “‘”
Set rs = Conn.Execute(sql)
If Not rs.EOF Then
rs.MoveFirst
Do While Not rs.EOF
Set objR = xmldom.createElement(“inx”)
objR2.appendChild objR
For i = 0 To rs.Fields.Count – 1
Set objData = xmldom.createElement(LCase(rs.Fields(i).Name))
If rs.Fields(i).Type = adDBTimeStamp Then
objData.Text = Format(rs.Fields(i).Value, “yyyy-mm-dd”)
Else
objData.Text = IIf(IsNull(rs.Fields(i).Value), 0, rs.Fields(i).Value)
End If
objR.appendChild objData
Set objData = Nothing
Next i
Set objR = Nothing
rs.MoveNext
Loop
End If
‘xmldom.Save “c:\tes.xml”
End Sub