Using File System Object with case sensitive file names - asp-classic

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.

Related

Proceed to each link, find file type and download

I am wondering is there any solution to download files from a website with VBscript?
I know how to download a single file from a website but how can I make it into a loop? Also how can I search a particular page for a certain file extension and download the file(s) if available?
For each pdf in website
xhr.open "GET", pdf.src, False
xhr.send
set stream = CreateObject("Adodb.Stream")
with stream
.type = 1
.Open
.Write xhr.responsebody
.SaveToFile "C:\temp\" + CStr(index) + ".pdf", 2
end with
stream.Close
set stream = nothing
index = index + 1
Next
Let's say we have a website https://website.com/productpage/ then there are links that all have the same structure https://website.com/products/xx-x-xx-x/ so all needed links start with https://website.com/products/. There seems to be 33 links of that kind according to source code.
Then after proceeding to some page there are PDF files. Sometimes one, sometimes 3 or 4. However link to the PDF file is something like https://website.com/wp-content/uploads/2016/12/xxxx.pdf where xxxx.pdf can actually be a filename.
Here is what I have managed to get for one file:
dim xHttp: Set xHttp = createobject("Microsoft.XMLHTTP")
dim bStrm: Set bStrm = createobject("Adodb.Stream")
xHttp.Open "GET", "https://website.com/wp-content/uploads/2016/12/xxxx.pdf", False
xHttp.Send
with bStrm
.type = 1 '//binary
.open
.write xHttp.responseBody
.savetofile "c:\temp\xxxx.pdf", 2 '//overwrite
end with
EDIT:
Should it go like:
Get all the needed links
Proceed to each link
Search for links that are ending with ".pdf"
Download files to C:\temp\
Structure of website:
https://website.com/productpage/
https://website.com/products/xx-x/
https://website.com/wp-content/uploads/2016/12/xx-xx.pdf
https://website.com/products/xxxxx-xsx/
https://website.com/wp-content/uploads/2018/12/x-xx-x.pdf
https://website.com/wp-content/uploads/2015/12/x-x-xx.pdf
https://website.com/wp-content/uploads/2019/12/xxx-x.pdf
https://website.com/products/x-xx-xsx/
https://website.com/wp-content/uploads/2014/12/x-xxx.pdf
https://website.com/wp-content/uploads/2013/12/x-x-x-x.pdf
https://website.com/products/xx-x-xsx/
https://website.com/wp-content/uploads/2012/12/x-xxxx.pdf
Since you have the code to save a link, you can wrap it into a sub for re-use:
Sub GetFile(p_sRemoteFile, p_sLocalFile)
Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
xHttp.open "GET", p_sRemoteFile, False
xHttp.Send
With bStrm
.Type = 1 '//binary
.open
.write xHttp.responseBody
.SaveToFile p_sLocalFile, 2 '//overwrite
End With
End Sub
Then, you can use the InternetExplorer object to get a collection of links in a page:
Sub GetPageLinks(p_sURL)
Dim objIE
Dim objLinks
Dim objLink
Dim iCounter
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
objIE.Navigate p_sURL
Do Until objIE.ReadyState = 4
Wscript.Sleep 100
Loop
Set objLinks = objIE.Document.All.Tags("a")
For iCounter = 1 To objLinks.Length
Set objLink = objLinks(iCounter - 1)
With objLink
If StrComp(Right(.href, 3), "pdf", 1) = 0 Then
' Get file
GetFile .href, "C:\temp\downloads\" & GetFileNameFromURL(.href)
Else
' Process page
GetPageLinks .href
End If
End With
Next
End Sub
Here's a function that extracts the file name from a URL:
Function GetFileNameFromURL(p_sURL)
Dim arrFields
arrFields = Split(p_sURL, "/")
GetFileNameFromURL = arrFields(UBound(arrFields))
End Function
This function will return xxxx.pdf given https://website.com/wp-content/uploads/2016/12/xxxx.pdf.

Manually changing date and time of a file

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

How to download the files using vbscript in classic asp

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

Download Files from URL using Classic ASP

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

search engine in asp classic

I already try a search engine script like below:
<HTML><BODY>
<B>Search Results for <%=Request("SearchText")%></B><BR>
<%
Const fsoForReading = 1
Dim strSearchText
strSearchText = Request("SearchText")
''# Now, we want to search all of the files
Dim objFSO
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Dim objFolder
Set objFolder = objFSO.GetFolder(Server.MapPath("/"))
Dim objFile, objTextStream, strFileContents, bolFileFound
bolFileFound = False
For Each objFile in objFolder.Files
If Response.IsClientConnected then
Set objTextStream = objFSO.OpenTextFile(objFile.Path,fsoForReading)
strFileContents = objTextStream.ReadAll
If InStr(1,strFileContents,strSearchText,1) then
Response.Write "<LI><A HREF=""/" & objFile.Name & _
""">" & objFile.Name & "</A><BR>"
bolFileFound = True
End If
objTextStream.Close
End If
Next
if Not bolFileFound then Response.Write "No matches found..."
Set objTextStream = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
%>
</BODY></HTML>
the output will show only the name of file, what i want is the title of the file.
my question is, how to get the string between in order to show up for the result? or is there any other script related to search engine in asp classic?
I'm not sure I get what you mean, but if you intend on grabbing the file name without the path nor extension, here's a snippet I use:
Public Function GetFileName(flname As String) As String
'From: http://www.freevbcode.com/ShowCode.asp?ID=1638
'By: Maria Rapini
'Get the filename without the path or extension.
'Input Values:
' flname - path and filename of file.
'Return Value:
' GetFileName - name of file without the extension.
Dim posn As Integer, i As Integer
Dim fName As String
posn = 0
'find the position of the last "\" character in filename
For i = 1 To Len(flname)
If (Mid(flname, i, 1) = "\") Then posn = i
Next i
'get filename without path
fName = Right(flname, Len(flname) - posn)
'get filename without extension
posn = InStr(fName, ".")
If posn <> 0 Then
fName = Left(fName, posn - 1)
End If
GetFileName = fName
End Function

Resources