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
%>
1 Comments
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