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

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

  

  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