I have few urls which are linked to a pdf example
abc.com/1.pdf
abc.com/2g.pdf
abc.com/i8.pdf
What i wanted to do is Download the PDFs automatically in a Folder using Classic ASP
I tried to use this code http://blog.netnerds.net/2007/01/classic-asp-push-file-downloads-from-directory-outside-of-the-web-root/
but this doesnt work for Http it works good if the files are local.
I want to do it automatically.
I used the code posted by user580950 and the comment by AnthonyWJones and created a function version of the code. Call the function and it returns the content type of the file downloaded or an empty string if the file wasn't found.
public function SaveFileFromUrl(Url, FileName)
dim objXMLHTTP, objADOStream, objFSO
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.3.0")
objXMLHTTP.open "GET", Url, false
objXMLHTTP.send()
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
Set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.Fileexists(FileName) Then objFSO.DeleteFile FileName
Set objFSO = Nothing
objADOStream.SaveToFile FileName
objADOStream.Close
Set objADOStream = Nothing
SaveFileFromUrl = objXMLHTTP.getResponseHeader("Content-Type")
else
SaveFileFromUrl = ""
End if
Set objXMLHTTP = Nothing
end function
I got this code somewhere on the internet if anyone wants to use it.
<%
Server.ScriptTimeout = 60 * 20
' Set your settings
strFileURL = "http://pathtofile.zip"
strHDLocation = "c:\filename.zip"
' Fetch the file
Set objXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.3.0")
objXMLHTTP.Open "GET", strFileURL, False
objXMLHTTP.Send()
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strHDLocation) Then objFSO.DeleteFile strHDLocation
Set objFSO = Nothing
objADOStream.SaveToFile strHDLocation
objADOStream.Close
Set objADOStream = Nothing
End if
Set objXMLHTTP = Nothing
%>
Related
I have a website written in Classic ASP
One page creates a .CSV file from a SQL database and stores it in the root directory along with a "Click Here" link to download it to the users PC
It has been working fine for many years and is still working fine when downloading small files, but now it comes up with a "THIS PAGE CAN'T BE DISPLAYED" error when downloading a .csv file (in this example) of some 785 records
The code is pretty short as below with the one Private Sub that does the download
<%#Language="VBScript"%>
<%Reponse.Buffer = True%>
<%
On Error Resume Next
Dim strPath
strPath = CStr(Request.QueryString("File"))
'-- do some basic error checking for the QueryString
If strPath = "" Then
Response.Clear
Response.Write("No file specified.")
Response.End
ElseIf InStr(strPath, "..") > 0 Then
Response.Clear
Response.Write("Illegal folder location.")
Response.End
ElseIf Len(strPath) > 1024 Then
Response.Clear
Response.Write("Folder path too long.")
Response.End
Else
Call DownloadFile(strPath)
End If
Private Sub DownloadFile(file)
'--declare variables
Dim strAbsFile
Dim strFileExtension
Dim objFSO
Dim objFile
Dim objStream
'-- set absolute file location
strAbsFile = Server.MapPath(file)
'-- create FSO object to check if file exists and get properties
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
'-- check to see if the file exists
If objFSO.FileExists(strAbsFile) Then
Set objFile = objFSO.GetFile(strAbsFile)
'-- first clear the response, and then set the appropriate headers
Response.Clear
'-- the filename you give it will be the one that is shown
' to the users by default when they save
Response.AddHeader "Content-Disposition", "attachment; filename=" & objFile.Name
Response.AddHeader "Content-Length", objFile.Size
Response.ContentType = "application/octet-stream"
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open
'-- set as binary
objStream.Type = 1
Response.CharSet = "UTF-8"
'-- load into the stream the file
objStream.LoadFromFile(strAbsFile)
'-- send the stream in the response
Response.BinaryWrite(objStream.Read)
objStream.Close
Set objStream = Nothing
Set objFile = Nothing
Else 'objFSO.FileExists(strAbsFile)
Response.Clear
Response.Write("No such file exists.")
End If
Set objFSO = Nothing
End Sub
%>
So something has changed in recent months
Ay advice much appreciated
Thanks in advance
Your IIS version and configuration might be needed to help but I know IIS6 introduced a 4MB limit to BinaryWrite. Try sending your file in chunks instead.
<% Response.Buffer = False %>
...
With Server.CreateObject("ADODB.Stream")
.Open
.Type = 1
.LoadFromFile strPath
' Send 256K chunks...
Const intChunkSize = 262144
Do While Response.IsClientConnected And (.Position < .Size)
Response.BinaryWrite .Read(intChunkSize)
Loop
.Close
End With
I have a old VBScript function that save a file copy on the server from the URL. If the file already exists the function deletes the previous version and rewrites a new file version. The problem is that I need to insert case sensitive file names. For instance, the file names "Test.html" and "test.html" should be saved as different copys and my function just replaces them. Any suggestion?
The function:
Public Function SaveToChache(Url, SaveToFolder, FileName)
Dim ChacheFolder: ChacheFolder = SaveToFolder 'Folder where will the cache files be stored (include trailing slash)
Dim FilePath: FilePath = Server.MapPath(ChacheFolder & FileName)
Dim objXMLHTTP: Set objXMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objXMLHTTP.open "GET", Url, false
objXMLHTTP.send()
If objXMLHTTP.Status = 200 Then
Dim objADOStream: Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
Dim objFSO: Set objFSO = Createobject("Scripting.FileSystemObject")
If objFSO.FileExists(FilePath) Then objFSO.DeleteFile FilePath
Set objFSO = Nothing
objADOStream.SaveToFile FilePath
objADOStream.Close
Set objADOStream = Nothing
SaveToChache = objXMLHTTP.getResponseHeader("Content-Type")
Else
SaveToChache = ""
End if
Set objXMLHTTP = Nothing
End Function
Calling the function:
savefile = SaveToChache("http://www.example.com", "/cache/", "Test.html")
Thanks!
I would use a direct compare instead of objFSO.FileExists.
for example:
Dim objFSO: Set objFSO = Createobject("Scripting.FileSystemObject")
FilePath = "C:\Test\test.txt"
'Get path to file
strParentPath = objFSO.GetFile(FilePath).ParentFolder
'Get each file in the folder
Set objCheck = objFSO.GetFolder(strParentPath).Files
For Each x In objCheck
If x = FilePath Then objFSO.DeleteFile(FilePath)
Next
Basically, x will only equal FilePath if the case is also the same.
I'm creating a download manager, and everything seems to work. But the file that I get downloaded can not be opened. The file has the correct name and the extension .pdf - but my Mac says that the file cannot be opened (the file on the server works).
if request.querystring("downloadFile") <> "" then
strFilePath = Server.MapPath("/_customerFiles/"& session("URLmapping") &"/documents/"& request.querystring("downloadFile"))
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFilePath) Then
Set objFile = objFSO.GetFile(strFilePath)
intFileSize = objFile.Size
Set objFile = Nothing
strFileName = request.querystring("filename")
strFileName = replace(request.querystring("downloadFile")," ","-")
Response.AddHeader "Content-Disposition","attachment; filename=" & strFileName
Response.ContentType = "application/octet-stream"
Response.AddHeader "Content-Length", intFileSize
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 1 'adTypeBinary '
objStream.LoadFromFile strFilePath
Do While Not objStream.EOS And Response.IsClientConnected
Response.BinaryWrite objStream.Read(1024)
Response.Flush()
Loop
objStream.Close
Set objStream = Nothing
End if
Set objFSO = Nothing
end if
Have you considered that the output stream is having a Byte Order Mark (BOM) added (or maybe removed)? I would open both files in a hex editor and look for 3 bytes added at the start (and everything else moved along).
I know I'm late getting to this question, but I was just dealing with something similar and wanted share my observations to try to clear it up.
I have read (sorry I dont have a source) that the ADODB.Stream has to have its .Type specified prior to calling .Open
I also set the Stream .Mode property to 3 (meaning "open file for Reading") to prevent file access lock errors if multiple people try to access the file at the same time -- Also must be done before calling .Open
I have had varying success with Response.ContentType "application/octet-stream", and after some problems there, I changed mine to Response.ContentType "xxx/xxx". The browser will accept it as an unknown file type and then prompt the user to open it based on the registered program for that file extension.
Before you start adding Response Headers, you should call Response.Clear (just to be sure you're not sending extra markup)
After closing your FileSystemObject, you should call Response.End (again, just to be sure)
You needs to add the Response.Clear before Response.AddHeader and change the Response.ContentType, so the code is like below:
if request.querystring("downloadFile") <> "" then
strFilePath = Server.MapPath("/_customerFiles/"& session("URLmapping") &"/documents/"& request.querystring("downloadFile"))
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFilePath) Then
Set objFile = objFSO.GetFile(strFilePath)
intFileSize = objFile.Size
Set objFile = Nothing
strFileName = request.querystring("filename")
strFileName = replace(request.querystring("downloadFile")," ","-")
Response.Clear
Response.AddHeader "Content-Disposition","attachment; filename=" & strFileName
Response.ContentType = "xxx/xxx"
Response.AddHeader "Content-Length", intFileSize
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open
objStream.Type = 1 'adTypeBinary '
objStream.LoadFromFile strFilePath
Do While Not objStream.EOS And Response.IsClientConnected
Response.BinaryWrite objStream.Read(1024)
Response.Flush()
Loop
objStream.Close
Set objStream = Nothing
End if
Set objFSO = Nothing
End if
I'd like to manually change the date and time for a specified time by invoking SetFileTime or something similar but on ASP Classic. As far as I know, ASP File Object provides method for retrieving the creation & modification times for the file but provides no methods for actually setting them.
How can I achieve this?
I found the answer relatively quickly:
Sub ModifyLastAccessedDate(emlFilePath, newDate)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set file = objFSO.GetFile(emlFilePath)
Set app = Server.CreateObject("Shell.Application")
Set folder = app.NameSpace(file.ParentFolder & "\")
Set fileModify = folder.ParseName(file.Name)
fileModify.ModifyDate = NewDate
Set objFSO = Nothing
Set file = Nothing
Set folder = Nothing
Set app = Nothing
Set fileModify = Nothing
End Sub
And then you just call the routine by
Call ModifyLastAccessedDate("C:\Folder\SomeFile.Txt","2013-03-05")
Here is an example in JScript, and again in VB, taken directly from Microsoft just for posterity (and as another example of how the date and time string can be set):
<script language="JScript">
function fnModifyDateGetSetJ()
{
var objShell = new ActiveXObject("shell.application");
var objFolder2;
var ssfWINDOWS = 36;
objFolder2 = objShell.NameSpace(ssfWINDOWS);
if (objFolder2 != null)
{
var objFolderItem;
objFolderItem = objFolder2.ParseName("NOTEPAD.EXE");
if (objFolderItem != null)
{
var szReturn;
szReturn = objFolderItem.ModifyDate;
objFolderItem.ModifyDate = "01/01/1900 6:05:00 PM";
}
}
}
</script>
VB:
Private Sub fnModifyDateGetSetVB()
Dim objShell As Shell
Dim objFolder2 As Folder2
Dim ssfWINDOWS As Long
ssfWINDOWS = 36
Set objShell = New Shell
Set objFolder2 = objShell.NameSpace(ssfWINDOWS)
If (Not objFolder2 Is Nothing) Then
Dim objFolderItem As FolderItem
Set objFolderItem = objFolder2.ParseName("NOTEPAD.EXE")
If (Not objFolderItem Is Nothing) Then
Dim szReturn As String
szReturn = objFolderItem.ModifyDate
objFolderItem.ModifyDate = "01/01/1900 6:05:00 PM"
Else
'FolderItem object returned nothing.
End If
Set objFolderItem = Nothing
Else
'Folder object returned nothing.
End If
Set objFolder2 = Nothing
Set objShell = Nothing
End Sub
I am working on Classic Asp with VBScript. I am trying to display list of files from a directory with download option. like,
When i click on the download link the corresponding file need to be download for that i have used the following code like,
<html>
<head>
<title> My First ASP Page </title>
</head>
<body>
<%
Dim fso
Dim ObjFolder
Dim ObjOutFile
Dim ObjFiles
Dim ObjFile
'Creating File System Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Getting the Folder Object
Set ObjFolder = fso.GetFolder("F:\karthik")
'Creating an Output File to write the File Names
Set ObjOutFile = fso.CreateTextFile("F:\WindowsFiles.txt")
'Getting the list of Files
Set ObjFiles = ObjFolder.Files
'Writing Name and Path of each File to Output File
Response.Write("<table cellpadding=""4"" cellspacing=""5"" >")
For Each ObjFile In ObjFiles
Response.Write("<tr><td>"&ObjFile.Name & String(50 - Len(ObjFile.Name), " ")&"</td><td>Download</td></tr>")
Next
Response.Write("</table>")
ObjOutFile.Close
%><br>
<script language="vbscript" type="text/vbscript">
Sub HTTPDownload( myURL, myPath )
' Standard housekeeping
Dim i, objFile, objFSO, objHTTP, strFile, strMsg
Const ForReading = 1, ForWriting = 2, ForAppending = 8
' Create a File System Object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Check if the specified target file or folder exists,
' and build the fully qualified path of the target file
If objFSO.FolderExists( myPath ) Then
strFile = objFSO.BuildPath( myPath, Mid( myURL, InStrRev( myURL, "/" ) + 1 ) )
ElseIf objFSO.FolderExists( Left( myPath, InStrRev( myPath, "\" ) - 1 ) ) Then
strFile = myPath
Else
WScript.Echo "ERROR: Target folder not found."
Exit Sub
End If
' Create or open the target file
Set objFile = objFSO.OpenTextFile( strFile, ForWriting, True )
' Create an HTTP object
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
' Download the specified URL
objHTTP.Open "GET", myURL, False
objHTTP.Send
' Write the downloaded byte stream to the target file
For i = 1 To LenB( objHTTP.ResponseBody )
objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )
Next
' Close the target file
objFile.Close( )
End Sub
</script>
</body>
</html>
It seems you are trying to do this on the server-side using client-side scripting. Here is a better solution that uses server-side ASP to send the file. You will need to split your code over two pages.
Your current script should be replaced with this:
<html>
<head>
<title> My First ASP Page </title>
</head>
<body>
<% Dim fso
Dim ObjFolder
Dim ObjOutFile
Dim ObjFiles
Dim ObjFile
'Creating File System Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Getting the Folder Object
Set ObjFolder = fso.GetFolder("F:\karthik")
'Getting the list of Files
Set ObjFiles = ObjFolder.Files
'Writing Name and Path of each File to Output File
Response.Write("<table cellpadding=""4"" cellspacing=""5"" >")
For Each ObjFile In ObjFiles
Response.Write("<tr><td>"&ObjFile.Name & String(50 - Len(ObjFile.Name), " ")&"</td><td>Download</td></tr>")
Next
Response.Write("</table>")
%><br>
</body>
</html>
Then you need to create another script which I have called download.asp which handles the download:
<%
Dim objConn, strFile
Dim intCampaignRecipientID
strFile = Request.QueryString("file")
If strFile <> "" Then
Response.Buffer = False
Dim objStream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary
objStream.Open
objStream.LoadFromFile("F:\karthik\" & strFile)
Response.ContentType = "application/x-unknown"
Response.Addheader "Content-Disposition", "attachment; filename=" & strFile
Response.BinaryWrite objStream.Read
objStream.Close
Set objStream = Nothing
End If
%>
I like this solution, but users can see the downloads in the history, or modify the querystring. This solution can be modified for POST usage this way:
in the page code modify the link:
FileName`
and further down
<form id="frm2dl" action="download.asp" method="post"><input type="hidden" id="file2dl" name="file2dl" value="" /></form>
then in your javascript file get the filename:
function getfile(obj) {
var f=obj.innerText;
$("#frm2dl #file2dl").val(f);
$("#frm2dl").submit();
}
alternately you could use a file ID then in the download.asp have a lookup function from ID to filename.
Then in the download.asp use request.form("file2dl") instead of request.querystring.
UPDATE:
Also, depending on server version you might get the 4MB limit (I have to work with Microsoft-IIS/7.5 on intranet). Therefore for large files the code will not work. Here is my improved version:
Dim strFileName, strFilePath, objFSO, objStream, objFile, intFileSize
Const lChkSize = 524288 ' 500KB - server typical limit is 4MB
'If session("loggedIn") = True Then ' insert your logon validation code here. bypassed for testing
strFileName = request.form("file2dl")
strFilename = Replace(strFilename,"..","") ' prevent parent path navigation - also ensure uploaded files do not contain this sequence
strFilename = Replace(strFilename,"/","") ' prevent path navigation
strFilename = Replace(strFilename,"\","") ' filenames should already be cleaned by a previous process
strFilePath = server.MapPath("/insert your URL absolute sources filepath here/" & strFilename)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strFilePath) Then
Set objFile = objFSO.GetFile(strFilePath)
intFileSize = objFile.Size
Set objFile = Nothing
Response.AddHeader "Content-Disposition","attachment; filename=" & strFileName
Response.ContentType = "application/x-msdownload"
Response.AddHeader "Content-Length", intFileSize
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1 'adTypeBinary
objStream.Open
objStream.LoadFromFile strFilePath
Do While Not objStream.EOS And Response.IsClientConnected
Response.BinaryWrite objStream.Read(lChkSize)
Response.Flush()
Loop
objStream.Close
Set objStream = Nothing
Else
Response.write "Error finding file: " & request.form("file2dl")
End if
Set objFSO = Nothing
'End If