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
%>
Related
i am looking for a way to display in classic asp an image stored in an ole object of a sql db.
I've been looking around for a while, and the only thing I've found is such a thing that I've readjusted for my needs.
Unfortunately, however, it does not work, you only see a small square with a central x.
Do you have a suggestion?
Thanks
<%#LANGUAGE = VBScript%>
<%
id = Request.Querystring("id")
Set Conn1 = Server.CreateObject("ADODB.Connection")
Conn1.open "Driver={SQL Server};Server=ARCA;Database=CDB_EVEREX;Uid=everex;Pwd=everex1989;"
Dim strSQL, Rs
Set Rs = Server.CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM Attrezzatura_Catalogo WHERE ID_Catalogo=" & id & ";"
Rs.Open strSQL, Conn1, 3, 1
' Clear out the existing HTTP header information
'Response.Expires = 0
'Response.Buffer = TRUE
'Response.Clear
' Change the HTTP header to reflect that an image is being passed.
Response.ContentType = "image/bmp"
Response.BinaryWrite Rs("Immagine")
'Response.End
Rs.Close
Conn1.Close
Set Conn1 = Nothing
%>
make sure stored data is binary and try this?
<%
Response.ContentType = "image/bmp"
Response.Buffer = True
Response.AddHeader "Content-Disposition", "inline; filename=file001.bmp"
Response.Clear
Response.BinaryWrite Rs("Immagine")
Response.Flush
%>
maybe stored data can be base64. if data base64 then type directly into img src
Thanks for your answer, I tried your suggestion by adapting the code as you suggested (if I understand correctly) but the problem is not solved, you always see only the square with the central x :(
<%#LANGUAGE = VBScript%>
<%
id = Request.Querystring("id")
Set Conn1 = Server.CreateObject("ADODB.Connection")
Conn1.open "Driver={SQL Server};Server=ARCA;Database=CDB_EVEREX;Uid=everex;Pwd=everex1989;"
Dim strSQL, Rs
Set Rs = Server.CreateObject("ADODB.Recordset")
strSQL = "SELECT * FROM Attrezzatura_Catalogo WHERE ID_Catalogo=" & id & ";"
Rs.Open strSQL, Conn1, 3, 1
Response.ContentType = "image/bmp"
Response.Buffer = True
Response.AddHeader "Content-Disposition", "inline; filename=file001.bmp"
Response.Clear
Response.BinaryWrite Rs("Immagine")
Response.Flush
Rs.Close
Conn1.Close
Set Conn1 = Nothing
%>
I have the following code to pull the organizational structure from Active Directory:
<%# Language="VBScript"%>
<% response.Buffer = True
'Define the AD OU that contains our users
dim department
%>
<!--#include file="includes/functions.asp"-->
<!--#include file="includes/display.asp"-->
<h1>Organisational Structure</h1>
<div class="commandspace">
<p class="infotext">The org structure can be viewed with or without staff, indented or left justified.</p>
</div>
<div class="Structure_Item_1">
<%
ADUser = "LDAP://OU=Staff,OU=Users,DC=DOMAIN,DC=internal"
' Make AD connection and run query
Set objCon = Server.CreateObject("ADODB.Connection")
objCon.provider ="ADsDSOObject"
objCon.Properties("User ID") = "DOMAIN\example_user"
objCon.Properties("Password") = "password"
objCon.Properties("Encrypt Password") = TRUE
objCon.open "Active Directory Provider"
Set objCom = CreateObject("ADODB.Command")
Set objCom.ActiveConnection = objCon
objCom.CommandText ="select company FROM '"& ADUser &"' where company ='*' ORDER by company ASC"
Set objRS = objCom.Execute
' Loop over returned recordset and output HTML
Do While Not objRS.EOF Or objRS.BOF
Response.Write "<div id='Structure_Item_Field'>" & objRS("company") & "</div>"
Set objCom = CreateObject("ADODB.Command")
Set objCom.ActiveConnection = objCon
objCom.CommandText ="select department FROM '"& ADUser &"' where company ='*" & objRS("company") & "*' ORDER BY company ASC"
Set department = objCom.Execute
' Loop over returned recordset and output HTML
Do While Not department.EOF Or department.BOF
Response.Write " " & department("department") & "<br>"
'  is the HTML entity of a space character. I put   four times so that the department is indented four spaces
Set objCom = CreateObject("ADODB.Command")
Set objCom.ActiveConnection = objCon
objCom.CommandText ="select givenName, sn FROM '"& ADUser &"' where department ='*" & department("department") & "*' ORDER by givenName ASC"
Set names = objCom.Execute
Do While Not names.EOF Or names.BOF
Response.Write " " & names("givenName") & " " & names("sn") & "<br>"
names.MoveNext
Response.Flush
Loop
department.MoveNext
Response.Flush
Loop
objRS.MoveNext
Response.Flush
Loop
' Clean up
objRS.Close
objCon.Close
Set objRS = Nothing
Set objCon = Nothing
Set objCom = Nothing
%>
Excuse my ignorance but it seems very slow and I'm not sure why. I'm not sure what I need to do to improve performance.
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
I'm new to asp my code is working absolutely fine, but i am facing two problems although these problems are not affecting the application. I just want to make good functionality to the application logically.
When i upload excel file, if file with the same name it's already present, i overwrite it; if i manually change file name then file is saved with new name.
What i want to do is:
save this new file with unique name or new name, i don’t know how to do this.
save this file in the db with the login user information (for future reference)
i hope my problems will be solved. many thanks
this is the url from which I got help..
CODE
upload_excel.asp
< form action="upload_excel_process.asp" method="post" enctype="multipart/form-data" name="frmMain" onSubmit="return checkData();" >
<input name="file1" type="file"> <input type="submit" name="Submit" value="Submit">
< %mem_id=session("mem_id")%>
< input type="hidden" name="client_id" value="<%=mem_id%>">
< /form>
upload_excel_process.asp
<%client_id=session("mem_id")%>
<%
Dim xlApp,xlBook,xlSheet1,xlSheet2,OpenFile,i
Dim Conn,strSQL,client_id,objExec
Dim mySmartUpload
Dim sFileName
Set mySmartUpload = Server.CreateObject("aspSmartUpload.SmartUpload")
mySmartUpload.Upload
sFileName = mySmartUpload.Files("file1").FileName
If sFileName <> "" Then
mySmartUpload.Files("file1").SaveAs(Server.MapPath("excel/"&sFileName))
OpenFile = "excel/"&sFileName
Set xlApp = Server.CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(Server.MapPath(OpenFile))
Set xlSheet1 = xlBook.Worksheets(1)
Set Conn = Server.Createobject("ADODB.Connection")
Conn.Open "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & Server.MapPath("../db/database.mdb"),"" , ""
For i = 2 To 5
If Trim(xlSheet1.Cells.Item(i,1)) <> "" Then
strSQL = "" <br>
strSQL = strSQL &"INSERT INTO add_contacts "
strSQL = strSQL &"(client_id,name_receiver,contact_person_receiver,street_receiver,city_receiver, tel_receiver,fax_receiver,country_receiver,zip_code_receiver) "
> i have added fields to the db for file (file_name and file_id)
strSQL = strSQL &"VALUES "
strSQL = strSQL &"('"&client_id&"', '"&xlSheet1.Cells.Item(i,1)&"','"&xlSheet1.Cells.Item(i,2)&"','"&xlSheet1.Cells.Item(i,3) &"'"
strSQL = strSQL &",'"&xlSheet1.Cells.Item(i,4)&"','"&xlSheet1.Cells.Item(i,5)&"','"&xlSheet1. Cells.Item(i,6)&"','"&xlSheet1.Cells.Item(i,7)&"','"&xlSheet1.Cells.Item(i,8)&"')"
Set objExec = Conn.Execute(strSQL)
Set objExec = Nothing
End IF
Next
xlApp.Application.Quit
Conn.Close()
Set Conn = Nothing
Set xlSheet1 = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
Set mySmartUpload = Nothing
%>
Cheking of existens
If you want to check if a filename does aleready exists, you have to use the method FileExists from standard FilesystemObject (for more information see http://msdn.microsoft.com/en-us/library/x23stk5t(v=VS.85).aspx ).
So what do have to do?
If sFileName <> "" Then
Dim fullFilePath = Server.MapPath("excel/"&sFileName)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(filespec)) Then
//Rem Whatever you want to do here
End If
mySmartUpload.Files("file1").SaveAs(fullFilePath)
and so far...
If I understand your question you want to save the file with filename as unique to avoid the overwrite.
The best approach is to check before saving if the file exist in the destination directory or not. If it exists change the file name by appending some unique id like timestamp.
To save the file use saveas method.
strFileName = PMSmartUpload.Files.Item(1).FileName
strFilePath = strFileDirectory & "\" & strFileName
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(strFilePath)) Then
''rename suffix for file
strDateExt = cstr(month(Date)) +cstr(day(Date))+cstr(year(Date)) +cstr(Hour(Now)) +cstr(Minute(Now)) +cstr(Second(Now))
strFileExtension =fso.GetExtensionName(strFileName)
strFileBaseName = fso.GetBaseName(strFileName)
strFileName = strFileBaseName+"_"+ strDateExt +"."+strFileExtension
End If
'response.write strFileDirectory&"\"&strFileName
PMSmartUpload.Files.Item(1).saveas strFileDirectory&"\"&strFileName
In short the saveas method will save the posted file with specified name(full path)
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.