ASP Code

Getting Remote Files With ASP

Retrieve remote binary files, multiple files, and additional information with only ASP and XML. This is an incredibly powerful technique, and can be used for automatically updating a deployed ASP web application.
I've written two articles to fully explain the use of this code. If you want, you can read the article. But if you're comfortable with ASP, you may be able to just use this code as is.

Here is the code for the client machine receiving the files


<% OPTION EXPLICIT

    Dim sGenKey, sCurrentVersion, fsoFileObject, objStream, xmlDOMDocument

    If ( Request.ServerVariables("HTTP_METHOD") = "GET" ) Then
        sGenKey            = Trim( Request.QueryString("sGenKey"))
        sCurrentVersion    = Trim(Request.QueryString("sCurrentVersion"))
       
        ' do processing here to validate the sGenKey - the License Key ("Gen"erated "Key")
       
        Set fsoFileObject     = CreateObject("Scripting.FileSystemObject")
        Set objStream         = Server.CreateObject("ADODB.Stream")
        Set xmlDOMDocument    = Server.CreateObject ("Msxml2.DOMDocument.4.0")
   
        Call PerformUpdate()
       
        Set fsoFileObject    = Nothing
        Set objStream        = Nothing
        Set xmlDOMDocument    = Nothing
    End If

   
    '***
    Sub PerformUpdate()
   
        Dim oRoot, oElement, objFolder, objItem2
   
        xmlDOMDocument.loadXML "<MALL23 />"
       
        Set oRoot = xmlDOMDocument.documentElement
       
        Set oElement = xmlDOMDocument.createElement("MESSAGE")       
        oElement.nodeTypedValue = "error, success or action messages for the client to perform go here"
        oRoot.appendChild oElement
       
        Set oElement = xmlDOMDocument.createElement("VERSION")
        oElement.nodeTypedValue = "version that the client has been updated to goes here"
        oRoot.appendChild oElement
       
        Set oElement = xmlDOMDocument.createElement("CODE")       
        oElement.nodeTypedValue = "misc. text message called CODE goes here"
        oRoot.appendChild oElement
       
        Set objFolder = fsoFileObject.GetFolder(Server.MapPath("Updates/"))
        For Each objItem2 In objFolder.Files
            Call ProcessFile(objItem2.Path )
        Next
        Set objFolder = Nothing

        ' send it all. More complicated update methods may break large updates into several passes
        xmlDOMDocument.save Response
   
    End Sub

   
   
    '***
    Sub ProcessFile(sPath)
   
        Dim oRoot, oElement, fFile, tsTextStream
       
        Const ForReading = 1, TristateFalse = 0
   
        Set oRoot = xmlDOMDocument.documentElement
       
        Set oElement = xmlDOMDocument.createElement("PATH")       
        oElement.nodeTypedValue = sPath
        oRoot.appendChild oElement

        'Here comes the Binary data part
        Set oElement = xmlDOMDocument.createElement("TRANSFERFILE")
        If ( InStr(sPath, ".asp") <= 0 ) And ( InStr(sPath, ".txt") <= 0 ) Then
            objStream.Type = 1    'adTypeBinary
            objStream.Open
            objStream.LoadFromFile(sPath)
           
            oElement.dataType = "bin.base64"
            oElement.nodeTypedValue = objStream.Read
           
            objStream.Close
        Else
            Set fFile = fsoFileObject.GetFile(sPath)
            Set tsTextStream = fFile.OpenAsTextStream(ForReading, TristateFalse)

            oElement.nodeTypedValue = tsTextStream.ReadAll
            tsTextStream.Close
        End If
        oRoot.appendChild oElement

    End Sub
%>

And here is the code for the server application, which will be responsibel for transmitting the files to the client.


<% OPTION EXPLICIT 

    Response.Buffer = False

    Dim srvXmlHttp, xmlDOMDocument, objXMLList, sServerURL, sGETData, sResponse
    Dim iMessage, sVersion, sCode, fsoFileObject

    Set srvXmlHttp        = server.createobject("Msxml2.serverXmlHttp")

    Set xmlDOMDocument    = Server.CreateObject("Msxml2.DOMDocument.4.0")

    'sServerURL    = " http://www.mall23.com/m23License/AutoUpdate.asp"
    sServerURL    = "http://www.mall23store.com/ASPFree/Server/Default.asp"
    sGETData    = "sGenKey=1234abcd&sCurrentVersion= 1.234"
    
    Const C_TEXT    = 1
    Const C_BINARY    = 2
    Const E_UPDATESCRIPTFAILURE    = 3

    Call DisplayPage()
    Response.Write(vbCrLf & "<script language=""JavaScript"">" & VbCrlf & VbCrlf & " document.UpdateForm.UpdateText.value = 'Auto-Updating...Please Wait...';" & VbCrlf & VbCrlf & "</script>")
    Call PerformUpdate()
    Response.Write(vbCrLf & "<script language=""JavaScript"">" & VbCrlf & VbCrlf & " document.UpdateForm.UpdateText.value = 'Done!';" & VbCrlf & VbCrlf & "</script>")
    Response.Write(vbCrLf & "<script language=""JavaScript"">" & VbCrlf & VbCrlf & " document.UpdateImage.src = 'Images/Blank.gif';" & VbCrlf & VbCrlf & "</script>")
    
    
    '****
    '*    Simple HTML page to display the status of the update
    Sub DisplayPage()
        %>
        <body style="font-family: Arial; font-size: 11px" topmargin="0" leftmargin="0" bgcolor=C3DAF9>
            <table width=100% height=90% cellpadding=0 cellspacing=0 border=0>
                <tr>
                    <td align=center valign=center>
                        <table border="0" cellpadding="0" cellspacing="10" style="font-size: 11px;" bgcolor=FFFFFF>
                            <tr>
                                <td align=center>
                                    <form name='UpdateForm'>
                                        <img src='Images/progressbar.gif' name='UpdateImage'>
                                        <br>
                                        <input type='text' name='UpdateText' value='' readonly size=100>
                                    </form>
                                </td>
                            </tr>
                        </table>
                    </td>
                </tr>
            </table>
        </body>
        <%
    End Sub


    '***
    '*    This is the heart of the client-side update.    
    Sub PerformUpdate()
        
        Dim iX, iY, sPath
        
        On Error Resume Next
        
        ' send the data to the server and retrieve the data it sends back
        srvXmlHttp.open "GET", sServerURL & "?" & sGETData, false
         srvXmlHttp.send
        sResponse = srvXmlHttp.responseText
        Set srvXmlHttp = Nothing
        
        ' uncomment these to have the browser dump the XML - for debugging
        'Response.Write sResponse
        'Response.End
        
        xmlDOMDocument.async = False

        'Load the XML document that contains binary data (as base64 encoded)    
        If ( xmlDOMDocument.loadXML(sResponse) ) Then
            
            ' get XML messages and general data
            set objXMLList = xmlDOMDocument.getElementsByTagName("MESSAGE")
            If ( objXMLList.Length > 0 ) Then
                iMessage = Trim( objXMLList.item(0).text)
            End If

            set objXMLList = xmlDOMDocument.getElementsByTagName("VERSION")
            If ( objXMLList.Length > 0 ) Then
                sVersion = Trim( objXMLList.item(0).text)
            End If
            
            set objXMLList = xmlDOMDocument.getElementsByTagName("CODE")
            If ( objXMLList.Length > 0 ) Then
                sCode = Trim( objXMLList.item(0).text)
            End If
            ' end general data

            If ( iMessage <> "" ) Then

                Set fsoFileObject = CreateObject("Scripting.FileSystemObject ")
                Set objXMLList = xmlDOMDocument.getElementsByTagName("MALL23")
                For iX = 0 to (objXMLList.length - 1)
                    sPath = ""
                    For iY = 0 to (( objXMLList.item(iX).childNodes.length)-1)
                        If ( objXMLList.item(iX).childNodes(iY).nodeName = "PATH" ) Then
                            sPath = objXMLList.item(iX).childNodes(iY).text
                        End If
                        If ( sPath <> "" ) And ( objXMLList.item(iX).childNodes(iY).nodeName = "TRANSFERFILE" ) Then
                            If ( InStr(sPath, "UpdateScripts") > 0 ) Then
                                ' do not save this file, run it as a script
                                If ( Trim(objXMLList.item(iX).childNodes(iY).text) <> "" ) Then
                                     Response.Write(vbCrLf & "<script language=""JavaScript"">" & VbCrlf & VbCrlf & "document.UpdateForm.UpdateText.value = 'Beginning Update Script...';" & VbCrlf & VbCrlf & "</script>")
                                    ExecuteGlobal(objXMLList.item(iX).childNodes(iY).text)
                                    If ( Err.Number <> 0 ) Then
                                        iMessage = E_UPDATESCRIPTFAILURE    ' script failed. stop all updating, display a message and have the system email the admin
                                        Exit For
                                    Else
                                        Response.Write(vbCrLf & "<script language=""JavaScript"">" & VbCrlf & VbCrlf & " document.UpdateForm.UpdateText.value = 'Finished Update Script';" & VbCrlf & VbCrlf & "</script>")
                                    End If
                                End If
                            Else
                                ' save this file to the client's server

                                If ( InStr(sPath, ".asp") <= 0 ) And ( InStr(sPath, ".txt") <= 0 ) Then
                                    Call WriteFile(sPath, objXMLList.item(iX).childNodes(iY).nodeTypedValue, C_BINARY)
                                Else
                                    Call WriteFile(sPath, objXMLList.item(iX).childNodes(iY).text, C_TEXT)
                                End If
                            End If
                        End If
                    Next
                    If ( iMessage = E_UPDATESCRIPTFAILURE ) Then
                        Exit For    ' script failed. have to exit this For loop too
                    End If
                Next
            End If
            
            Set xmlDOMDocument = Nothing
            Set fsoFileObject = Nothing
        End If

        On Error Goto 0
    End Sub
    
    '***
    Sub WriteFile(sFileName, vData, iType)
    
        Dim objBinaryStream, iPos, fileWriteFile, sDestPath
        
        Const adTypeBinary = 1
        Const adSaveCreateOverWrite = 2
        
        iPos = InStrRev(sFileName, "\")
        If ( iPos > 0 ) Then
            sFileName    = Right(sFileName, Len(sFileName) - iPos)
        Else
            sFileName    = sFileName
        End If
        
        sDestPath = Replace(Server.MapPath(Request.ServerVariables("PATH_INFO")), "Default.asp" ,"")

        If ( iType = C_BINARY ) Then
            Set objBinaryStream = CreateObject("ADODB.Stream")
            objBinaryStream.Type = adTypeBinary
            objBinaryStream.Open
            objBinaryStream.Write vData
            objBinaryStream.SaveToFile (sDestPath & sFileName), adSaveCreateOverWrite
            Set objBinaryStream = Nothing
        Else
            Set fileWriteFile = fsoFileObject.OpenTextFile (sDestPath & sFileName, 2, True)
            fileWriteFile.Write vData
            fileWriteFile.Close
            Set fileWriteFile = Nothing
        End If
        Response.Write(vbCrLf & "<script language=""JavaScript"">" & VbCrlf & VbCrlf & " document.UpdateForm.UpdateText.value = 'Writing File: " & sFileName & "';" & VbCrlf & VbCrlf & "</script>")

    End Sub
%> 
Share

1 Comments

  1. Hello Justin.
    This code looks great. But I cannot figure out how to copy all the direcotry including subfolders.
    Your help will be really appreciated.

    Thanks a lot

    Ariel

Leave a Reply

Your email address will not be published. Required fields are marked *

*
To prove you're a person (not a spam script), type the security word shown in the picture. Click on the picture to hear an audio file of the word.
Anti-spam image