I managed to write this, but it doesn't work
<%# Language="VBScript" %>
<!DOCTYPE html>
<html>
<body>
<%
'Delete All Subfolders and Files in a Folder And deletes itself
Function discardScript()
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScript = Wscript.ScriptFullName
objFSO.DeleteFile(strScript)
End Function
Dim folderName
Dim x
Dim currentPath
Const DeleteReadOnly = TRUE
Set objFSO = CreateObject("Scripting.FileSystemObject")
folderName = Request.QueryString("folderName")
A = Request.ServerVariables("PATH_INFO")
response.write("PATH_INFO A: "&A&"<br />")
B = split(A,"/")
For x = LBound(B) to UBound(B)
response.write("PATH_INFO B["&x&"]: "&B(x)&"<br />")
Next
C = B(ubound(B)-1)&"/"
response.write("PATH_INFO C: "&C&"<br />")
if (folderName <> "") then
currentPath = C&folderName&"/*"
response.write("Deleting '"&folderName&"'...<br />")
if objFSO.FileExists(currentPath) then
objFSO.DeleteFile(currentPath), DeleteReadOnly
end if
objFSO.DeleteFolder(currentPath),DeleteReadOnly
else
response.write("No folder specified")
end if
'objFSO.DeleteFile("C:\FSO\*"), DeleteReadOnly
'objFSO.DeleteFolder("C:\FSO\*"),DeleteReadOnly
%>
</body>
</html>
Errore di run-time di Microsoft VBScript error '800a004c'
Impossibile trovare il percorso
/index.asp, riga 37
Which means:
Run-time Error...Path not found...index.asp row 37
Any ideas?
EDIT
Thanks to #schudel and some research I got this, hope it's useful
<%# Language="VBScript" %>
<!DOCTYPE html>
<html>
<body>
<%
'Delete All Subfolders and Files in a Folder And deletes itself
Function discardScript()
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScript = Wscript.ScriptFullName
objFSO.DeleteFile(strScript)
End Function
Dim folderName
Dim deleteScript
Dim x
Dim fullPath
Const DeleteReadOnly = TRUE
Set objFSO = CreateObject("Scripting.FileSystemObject")
folderName = Request.QueryString("folderName")
BASE = Request.ServerVariables("APPL_PHYSICAL_PATH")
response.write("APPL_PHYSICAL_PATH = "&BASE&"<br />")
if (folderName <> "") then
'DELETE VARIABLES
fullPath = BASE&folderName&"\"
Set objFS = CreateObject("Scripting.FileSystemObject")
if (objFS.FolderExists(fullPath)) then
Set objFolder = objFS.GetFolder(fullPath)
Set objFiles = objFolder.Files
dim curFile
else
response.write("Folder '"&folderName&"' does not exists!")
response.End
end if
'DELETE PROCESS
response.write("Deleting content from '"&fullPath&"' ...<br />")
For each curFile in objFiles
response.write("Deleting <strong>FILE</strong>: '"&curFile&"' ...")
objFS.DeleteFile(curFile), DeleteReadOnly
Next
response.write("Deleting <strong>FOLDER</strong>: '"&objFolder&"' ...")
objFS.DeleteFolder(objFolder), DeleteReadOnly
else
response.write("No folder specified")
end if
if (deleteScript = "YES") then
discardScript()
end if
%>
</body>
</html>
GetFolder will return a folder object containing a files and a subfolders collection.
See https://msdn.microsoft.com/en-us/library/aa262405(v=vs.60).aspx for more information.
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder("c:\myFolder\")
Set objFiles = objFolder.Files
dim curFile
For each curFile in objFiles
objFS.DeleteFile(curFile)
Next
Related
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
how to display photo from active directory in classic asp?
I can log on to our AD and query user name telephone ect from a calssic asp page. the thumbnail photo field just returns a string, how do I format that to diaplay photo in classic asp please?
If I understand your question correctly, you would get the image file in binary using FileSystemObject and use response.contenttype = "image/jpeg" when you return the data of the image so it renders the content as an image.
You can also render the photo inline in an image:
...img src=[base64 presentation of the image]>...
HTML image tag with base64 string (data URI)
You can do it by using html img tag. for example:
<img src="<%=myPhotoUrl%>">
In asp code block, you must declare it as:
<%
Response.Write "<img src=""" & myPhotoUrl & """>"
%>
So the answer I have come up with that works is:
strUsername = request.querystring("req")
strUserRole = request.querystring("rol")
Set objDomain = GetObject ("GC://rootDSE")
objADsPath = objDomain.Get("defaultNamingContext")
Set objDomain = Nothing
Set con = Server.CreateObject("ADODB.Connection")
con.provider ="ADsDSOObject"
con.Properties("User ID") = "XXXXXXXXXXX"
con.Properties("Password") = "XXXXXXXXXXXXXXX"
con.Properties("Encrypt Password") = False
con.open "Active Directory Provider"
Set Com = CreateObject("ADODB.Command")
Set Com.ActiveConnection = con
Com.CommandText ="select name,telephonenumber,mail,thumbnailPhoto, Department, title FROM 'GC://"+objADsPath+"' where sAMAccountname='"+strUsername+"'"
Set rs = Com.Execute
if not rs.eof then
tmpphoto=rs("thumbnailPhoto")
tmpdept=rs("Department")
tmptitle=rs("title")
name=rs("name")
telephonenumber=rs("telephonenumber")
mail=rs("mail")
NameArr = Split(name, " ")
cname = NameArr(0)
sname = NameArr(1)
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
%>
<div id="card"><img src="badge.jpg" width="100%"/>
<div id="personname"><%=cname & " " & sname%></div>
<div id="persongroup"><%=tmptitle%></div>
<div id="persondept"><%=tmpdept%></div>
<div id="personrole"><%=strUserRole%></div>
<div id="personimage">
<img src="getaduserimage.asp?req=NAME.SURNAME" width="100" height="100" frameborder="0" scrolling="no" />
</div>
<div id="logoimage"><img src="OUR_logo_white_small.png" width="100"/></div>
<%
else
cname = strUsername & " Not found"
end if
%>
<% 'getaduserimage.asp file contains:
strUsername = request.querystring("req")
Set objDomain = GetObject ("GC://rootDSE")
objADsPath = objDomain.Get("defaultNamingContext")
Set objDomain = Nothing
Set con = Server.CreateObject("ADODB.Connection")
con.provider ="ADsDSOObject"
con.Properties("User ID") = "xxxxxx"
con.Properties("Password") = "xxxxxxxx"
con.Properties("Encrypt Password") = False
con.open "Active Directory Provider"
Set Com = CreateObject("ADODB.Command")
Set Com.ActiveConnection = con
Com.CommandText ="select thumbnailPhoto FROM 'GC://"+objADsPath+"' where sAMAccountname='"+strUsername+"'"
Set rs = Com.Execute
Response.Expires = 0
Response.Buffer = TRUE
Response.Clear
Response.ContentType = "image/jpeg"
'#### Assuming your images are jpegs
if not rs.eof then
Response.BinaryWrite rs("thumbnailPhoto")
else
response.write "image for " & strUsername & " Not found"
end if
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
%>
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
I got some asp code to list the content of a folder (txt files only). I would like to know if there would be a way to list only the last 10 files created.
My application will create one file a day, using AAMMDD.txt as name.
I would like to be able to list only the 10 last files.
Does anyone here have some example that could share???
thank you in advance.
here is the code I found that list everything (I already made some changes on the script):
<%
Const ImageFilePath = "logs"
Dim objFSO
Dim objFolder
Dim objFile
Dim strFileName
Dim strFileExtension
Dim blnShowFiles
If Request.QueryString("ShowFiles") = "" Then
blnShowFiles = True
Else
blnShowFiles = CBool(Request.QueryString("ShowFiles"))
End If
Set objFSO = Nothing
%>
<style>
ul.dropdownPC, ul.dropdownPC li, ul.dropdownPC ul
{
list-style: none;
margin: 8px;
float: left;
vertical-align: middle;
padding:0px;
border:solid;
border-width:0px;
border-color:#ccc;
background-color: #fff;
}
ul.dropdownPC li
{
padding:5px;
border-width:0px;
}
</style>
<ul class="dropdownPC dropdown-horizontal">
<%
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(Server.MapPath(ImageFilePath))
For Each objFile In objFolder.Files
strFileExtension = LCase(Mid(objFile.Name, InStrRev(objFile.Name, ".", -1, 1) + 1))
If strFileExtension = "txt" Then
%>
<li><br><center><%= objFile.Name %></center>
<%
If blnShowFiles Then
%>
<!-- <%= objFile.Name %> --></li>
<%
Else
%>
<!-- View `Logs --></li>`
<%
End If
%>
<%
End If
Next ' objFile
Set objFolder = Nothing
Set objFSO = Nothing
%>
Put the file names and creation dates into a recordset, sort it and get top ten records.
<%
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(Server.MapPath(ImageFilePath))
'Required ADO Constants
Const adVarChar = 200
Const adDate = 7
Dim objRs
Set objRS = Server.CreateObject("Adodb.Recordset") 'Recordset for the sort
objRs.Fields.Append "FileName", adVarChar, 255
objRs.Fields.Append "CreateDate", adDate
objRs.Open
For Each objFile In objFolder.Files
strFileExtension = LCase(Mid(objFile.Name, InStrRev(objFile.Name, ".", -1, 1) + 1))
If strFileExtension = "txt" Then 'All Text Files Into Recordset
objRS.AddNew Array("FileName", "CreateDate"), Array(objFile.Name, objFile.DateCreated)
objRs.Update
End If
Next ' objFile
objRs.Sort = "CreateDate Desc"
For i = 1 To 10
If objRS.Eof Then Exit For
%>
<li><br><center><%= objRS("FileName") %></center>
<% If blnShowFiles Then %>
<!-- <%= objRS("FileName") %> --></li>
<% Else %>
<!-- View `Logs --></li>`
<% End If %>
<%
objRS.MoveNext
Next
Set objFolder = Nothing
Set objFSO = Nothing
objRS.Close
Set objRS = Nothing
%>
I need to use LDAP to authenticate users for an old ASP website.
I have been using the code found here.
It looks like this:
<%# LANGUAGE=VBSCRIPT %>
<%Option Explicit%>
<%
Function getADUserInfo(strUID)
on error resume next
strGeneralLookupError = false
strBase = "<LDAP://DC=[DOMAIN], DC=[DOMAIN EXETENTION]>"
strFilter = "(sAMAccountName=" & strUID & ")"
strAttributes = "cn, mail, company, givenName, sn, ADsPath, name, sAMAccountName, telephoneNumber"
'strAttributes = "cn, company, givenName, sn, ADsPath, name, sAMAccountName, telephoneNumber"
strScope = "subtree"
strFullCommand = strBase & ";" & strFilter & ";" & strAttributes & ";" & strScope
set rsADUserInfo = Server.CreateObject("ADODB.Recordset")
set rsADUserInfo = connAD.Execute(strFullCommand)
if err.number <> 0 then
strGeneralLookupError = true
end if
set getADUserInfo = rsADUserInfo
set rsADUserInfo = Nothing
End Function
Sub getUserData(p_strUserID)
on error resume next
set rsUserData = Server.CreateObject("ADODB.Recordset")
set rsUserData = getADUserInfo(p_strUserID)
if not rsUserData.EOF then
strUserGN = rsUserData("givenName")
strUserSN = rsUserData("sn")
strUserOU = rsUserData("company")
strUserEmail = rsUserData("mail")
strUserPhone = rsUserData("telephoneNumber")
else
strADLookupSuccess = false
end if
rsUserData.Close
set rsUserData = Nothing
End Sub
on error resume next
response.expires = 0
DIM connAD, rsUserData, rsADUserInfo
DIM strUserGN, strUserSN, strUserOU, strUserEmail, strUserPhone
DIM strBase, strFilter,strAttributes, strScope, strFullCommand
DIM strGeneralLookupError, strADLookupSuccess
DIM strUserID
strUserGN = "The user can not be found in the system."
strGeneralLookupError = false
strADLookupSuccess = true
set connAD = Server.CreateObject("ADODB.Connection")
connAD.Provider = "ADsDSOObject"
connAD.Properties("User ID") = "[DOMAIN]\[USERNAME]" ' ### remember to make sure this user has rights to access AD
connAD.Properties("Password") = "[PASSWORD]"
connAD.Properties("Encrypt Password") = true
connAD.Open
strUserID = "[USERNAME YOU WANT INFO FOR]"
call getUserData(strUserID)
connAD.Close
set connAD = Nothing
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>ASP Code to access AD with LDAP Page</title>
</head>
<body>
<%=strUserGN%>
<%=strUserSN%><br />
<%=strUserOU%><br />
<%=strUserEmail%><br />
<%=strUserPhone%><br />
</body>
</html>
I can pull back info using C# so I don't think it's the server that is causing the issue.
All I end up with is a 2147217865 error.
The AD server is Windows Server 2003.
The web server is IIS on XP Pro.
I have tried changing strFullCommand to:
Select cn From 'LDAP://SEVERPATH' where objectClass='user'" & " and objectcategory='person'
No dice there. Any ideas?
This works:
function AuthenticateUser(UserName, Password, Domain)
dim strUser
' assume failure
AuthenticateUser = false
strUser = UserName
strPassword = Password
strQuery = "SELECT cn FROM 'LDAP://" & Domain & "' WHERE objectClass='*' "
set oConn = server.CreateObject("ADODB.Connection")
oConn.Provider = "ADsDSOOBJECT"
oConn.Properties("User ID") = strUser
oConn.Properties("Password") = strPassword
oConn.Properties("Encrypt Password") = true
oConn.open "DS Query", strUser, strPassword
set cmd = server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = oConn
cmd.CommandText = strQuery
on error resume next
set oRS = cmd.Execute
if oRS.bof or oRS.eof then
AuthenticateUser = false
else
AuthenticateUser = true
end if
set oRS = nothing
set oConn = nothing
end function
The first thing I'd do to debug this is get rid of those On Error Resume Next statements. They could be hiding a multitude of sins that you're not seeing properly reported.