| If you haven't read Web Service vs Web Workspace Part I, then I'd encourage you to do so now. As previously discussed, XML plays a key role in moving data from our desktop app to the web site and back again. Speed is also a key factor and anyone who has worked with XML files knows they can get quite large. With that in mind, I went looking for an XML streaming compression component and found a fantastic one from XCeed at XCeedSoft.com. |
| |
|
|
| |
| Today, I'd simply like to provide a few code samples showing how to use the component to compress, send, receive, and uncompress the XML stream from a Visual Basic 6.0 desktop application to an ASP page on your web server. Notice that the license key for the component is required in your distributed executables. I chose to use the image data type for saving the compressed XML to a SQL Server table. A small snippet of that code is also available below. |
| |
| Visual Basic 6.0 XML Send Sample |
Public Function SendXML(ByVal sDeskTopPage As String, _
ByVal sXML As String, _
ByRef sRetXML As String) As boolean
Dim sFileName As String
Dim fDebug As Boolean
Dim sMsg As String
Dim oXMLHttp As MSXML2.XMLHTTP30
Dim vXML As Variant
Set oXMLHttp = New MSXML2.XMLHTTP30
SendXML = false
oXMLHttp.Open "post", "http://www.mysite.com/" & sDeskTopPage, False
vXML = Me.XMLCompress(sXML)
oXMLHttp.send vXML
If oXMLHttp.Status <> 200 Then GoTo SendXMLExit
vXML = oXMLHttp.responseBody
sRetXML = XMLDeCompress(vXML)
SendXML = true
Exit Function
SendXMLExit:
msgbox err.description
On Error Resume Next
Set oXMLHttp = Nothing
err.Clear
End Function
Public Function XMLCompress(ByVal sXML As String) As Variant
On Error GoTo ErrHandler
Dim oComp As XceedStreamingCompression
Dim sXMLCompressed As Variant
Dim fLicense As Boolean
Set oComp = New XceedStreamingCompression
fLicense = oComp.License("your license key goes here")
XMLSetCompressionFormat oComp
sXMLCompressed = oComp.Compress(sXML, True)
Set oComp = Nothing
XMLCompress = sXMLCompressed
Exit Function
ErrHandler:
MsgBox "Compress: " & err.Description
On Error Resume Next
Set oComp = Nothing
err.Clear
End Function
Public Function XMLDeCompress(ByVal sXMLCompressed As Variant) As String
On Error GoTo ErrHandler
Dim oComp As XceedStreamingCompression
Dim sXMLUnCompressed As Variant
Dim fLicense As Boolean
Set oComp = New XceedStreamingCompression
fLicense = oComp.License("your license key goes here")
XMLSetCompressionFormat oComp
sXMLUnCompressed = oComp.Decompress(sXMLCompressed, True)
Set oComp = Nothing
XMLDeCompress = CStr(sXMLUnCompressed)
Exit Function
ErrHandler:
MsgBox "Decompress: " & err.Description
On Error Resume Next
Set oComp = Nothing
err.Clear
End Function
Public Sub XMLSetCompressionFormat(ByRef oComp As XceedStreamingCompression)
On Error GoTo ErrHandler
Dim oBWT As XceedBWTCompressionMethod
Set oBWT = New XceedBWTCompressionMethod
Set oComp.CompressionFormat = oBWT
Set oBWT = Nothing
Exit Sub
ErrHandler:
MsgBox "Set compression error: " & err.Description
on error resume next
Set oBWT = nothing
err.clear
End Sub
|
| |
| Active Server Pages Sample |
Sub Main()
Dim oXMLDoc
Dim sRetXML
Dim sXML
Dim sXMLCompressed
on error resume next
Set oXMLDoc = Server.CreateObject("MSXML2.DOMDocument.4.0")
' Grab the Request object's binary compressed XML sent from
' the desktop application.
sXML = XMLDecompress()
' Load the uncompressed XML string into an XML Document.
oXMLDoc.loadXML sXML
' Do something with the XML Document here.
' Get the XML string from the adjusted document.
sXMLCompressed = oXMLDoc.xml
' Use the binarywrite method to send back a compressed
' response to your desktop applicaton.
Response.BinaryWrite XMLCompress(sXMLCompressed)
Set oXMLDoc = nothing
End Sub
Function XMLDecompress()
Dim oComp
Dim vaDecompressed
Dim oXMLDoc
on error resume next
' Store the Request object's binary compressed XML contents in a variant.
bXMLBinary=Request.BinaryRead(Request.TotalBytes)
Set oComp = Server.CreateObject("Xceed.StreamingCompression.1")
fLicense = oComp.License("your license key goes here")
' Create a compression format object.
Set oBWT = Server.CreateObject("Xceed.BWTCompression.1")
' Set the compression format. XCeed offers several different compresson
' formats.
Set oComp.CompressionFormat = oBWT
' Decompress the compressed XML and store it in a variant.
vaDecompressed = oComp.Decompress(bXMLBinary, True)
XMLDecompress = vaDecompressed
Set oBWT = nothing
Set oComp = Nothing
End Function
Function XMLCompress(stringToCompress)
Dim oComp
Dim vaCompressed
Dim oBWT
on error resume next
Set oComp = Server.CreateObject("Xceed.StreamingCompression.1")
fLicense = oComp.License("your license key goes here")
Set oBWT = Server.CreateObject("Xceed.BWTCompression.1")
Set oComp.CompressionFormat = oBWT
vaCompressed = oComp.Compress(stringToCompress, True)
if err.number <> 0 then
XMLCompress = err.description
else
XMLCompress = vaCompressed
end if
Set oComp = Nothing
End Function
Function SaveCompressedXML(sWorkSpaceID,sXML)
Dim oADOCon
Dim oADOCom
Dim bCompXML
Dim sNewID
Set oADOCon = Server.CreateObject("ADODB.Connection")
Set oADOCom = Server.CreateObject("ADODB.Command")
bCompXML = XMLCompress(sXML)
With oADOCom
.ActiveConnection = oADOCon
.CommandText = "InsertWorkSpace"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("@RETURN_VALUE", adInteger, adParamReturnValue,0)
.Parameters.Append .CreateParameter("@WorkspaceID", adInteger, adParamInput, , sWorkSpaceID)
.Parameters.Append .CreateParameter("@XMLTree",adLongVarBinary, adParamInput, 2147483647, bCompXML)
.Parameters.Append .CreateParameter("@NewID", adInteger, adParamOutput, 0)
.Execute lRecs, , adExecuteNoRecords
End With
sNewID = trim(moADOCom("@NewID"))
Set oADOCom = nothing
oADOCon.Close
Set oADOCon = nothing
End Function
|
| |
| SQL Server Save Compressed Stream To Database |
CREATE PROCEDURE dbo.InsertWorkSpace
(
@WorkSpaceID int,
@XMLTree image,
@NewID int output
)
AS
declare @rc int
select @rc = 0
BEGIN TRANSACTION sp_InsertWorkSpace
insert into PrimaryWorkSpace (WorkSpaceID, XMLTree) values (@WorkSpaceID, @XMLTree)
select @NewID = @@Identity
COMMIT TRANSACTION sp_InsertWorkSpace
if (@@ERROR <> 0)
BEGIN
ROLLBACK TRANSACTION sp_InsertWorkSpace
select @rc = @@Error
Goto OnExit
END
OnExit:
RETURN @rc
GO
|
| |
| Hopefully, these code samples for ASP and VB will help you implement your own web workspaces. I found this approach to be quite scalable and allowed us to create workspaces with thousands of questions. If you have any questions or comments, please post them to our forums by clicking the link below. |