การเชื่อมต่อ PSU Passport : ASP-LDAP

วิธีการเชื่อมต่อ PSU Passport ด้วย ASP Classic ผ่าน LDAPS

ทดสอบบน : Windows 2008 R2 / IIS 7.5

Code ดังนี้

Class PSULdap (psuldap.inc)

<%
'PSU Passport ASP-LDAP Class Version 1.0.0
'Author : Jatuporn Chuchuay ISD CC PSU (Tel.2121)
'Update : 06/02/2013
Class PSULdap
        Private strAdsPath
        Private strUserName
        Private strPassWord
        Private strDC

        Public Property Let AdsPath(sAdsPath)
                strAdsPath = sAdsPath
        End Property
        Public Property Let UserName(sUserName)
                strUserName = sUserName
        End Property
        Public Property Let PassWord(sPassWord)
                strPassWord = sPassWord
        End Property
        Public Property Let DC(sDC)
                strDC = sDC
        End Property
        Public Property Get vAdsPath
                vAdsPath = strAdsPath
        End Property
        Public Property Get vUserName
                vUserName = strUserName
        End Property
        Public Property Get vPassWord
                vPassWord = strPassWord
        End Property
        Public Property Get vDC
                vDC = strDC
        End Property

        Public Function LdapAuthen()
                Dim objConn,objRS,objCom, strDescription, strLine, listDC, authenCheck, i
                Dim MyVar(1,20)
                Set objConn = Server.CreateObject("ADODB.Connection")
                objConn.provider ="ADsDSOObject"
                objConn.Properties("User ID") = "psu\" & strUserName
                objConn.Properties("Password") = strPassWord
                objConn.Properties("Encrypt Password") = True
                objConn.open "Active Directory Provider"
                Set objCom = CreateObject("ADODB.Command")
                Set objCom.ActiveConnection = objConn
                listDC = Split(strDC,",",-1,1)
                authenCheck = false
                i = 0
                While i <= UBound(listDC) and authenCheck = false
                        objCom.CommandText ="select sAMAccountname,cn," & _
"distinguishedName,employeeid,citizenid,company,campusid,department,departmentid," & _
"physicaldeliveryofficename,positionid,description,displayname,title,personaltitle," & _
"personaltitleid,givenname,sn,sex,userprincipalname,mail from 'LDAP://" & listDC(i) & _
":636/"+strAdsPath+"' where sAMAccountname='" & strUserName & "' and objectClass='user'"
                        On Error Resume Next
                        Set objRS = objCom.Execute
                        If Not Err.Number = 0 Then
                                MyVar(0,0) = false
                                MyVar(1,0) = Err.Description
                                'Debug
                                'Response.write listDC(i) & ":" & MyVar(0,0) & ":" & _
'MyVar(1,0) & "<br/>"
                        Else
                                MyVar(0,0) = true
                                'Debug
                                'Response.write listDC(i) & ":" & MyVar(0,0) & "<br/>"
                                authenCheck = true
                        End If
                        i = i + 1
                Wend
                If authenCheck = true Then
                        MyVar(1,0) = objRS("sAMAccountname")
                        MyVar(1,1) = objRS("cn")
                        MyVar(1,2) = objRS("employeeid")
                        MyVar(1,3) = objRS("citizenid")
                        MyVar(1,4) = objRS("company")
                        MyVar(1,5) = objRS("campusid")
                        MyVar(1,6) = objRS("department")
                        MyVar(1,7) = objRS("departmentid")
                        MyVar(1,8) = objRS("physicaldeliveryofficename")
                        MyVar(1,9) = objRS("positionid")
                        For Each strLine In objRS.Fields("description").Value
                                strDescription = strDescription & strLine
                        Next
                        MyVar(1,10) = strDescription
                        MyVar(1,11) = objRS("displayname")
                        MyVar(1,12) = objRS("title")
                        MyVar(1,13) = objRS("personaltitle")
                        MyVar(1,14) = objRS("personaltitleid")
                        MyVar(1,15) = objRS("givenname")
                        MyVar(1,16) = objRS("sn")
                        MyVar(1,17) = objRS("sex")
                        MyVar(1,18) = objRS("userprincipalname")
                        MyVar(1,19) = objRS("mail")
                        MyVar(1,20) = objRS("distinguishedName")
                End If
                LdapAuthen = MyVar
                objRS.Close
                objConn.Close
                Set objRS = Nothing
                Set objConn = Nothing
                Set objCom = Nothing
        End Function
End Class
%>

Code Login (default.asp)

<%@ Language=VBScript %>
<%
'PSU Passport ASP-LDAP Weblogin Version 1.0.0
'Author : Jatuporn Chuchuay ISD CC PSU (Tel.2121)
'Update : 06/02/2013
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>PSU Passport : ASP-LDAP example</title>
</head>
<body>
<!-- #include file ="psuldap.inc" -->
<%
Response.CharSet = "TIS-620"
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
        Dim PSULdapCls, AuthenResult, SamAccountName, EmployeeID, CitizenID, CN, DN
        Dim Campus, CampusID, Department, DepartmentID, WorkDetail, PositionID
        Dim Description,DisplayName, Detail, Title, TitleID, FirstName, LastName
        Dim Sex, Mail, Othermail
        Set PSULdapCls = New PSULdap
        PSULdapCls.AdsPath = "DC=psu,DC=ac,DC=th"
        'DC1(VM),2(RACK),7(VM)-Hatyai,DC3(RACK)-Pattani,DC5(RACK)-Surat,DC6(RACK)-Trang
        PSULdapCls.DC = "dc2.psu.ac.th,dc7.psu.ac.th,dc1.psu.ac.th"
        PSULdapCls.UserName = Request.Form("username")
        PSULdapCls.PassWord = Request.Form("password")
        AuthenResult = PSULdapCls.LdapAuthen()
        If AuthenResult(0,0) = True Then
                SamAccountName = AuthenResult(1,0)
                CN = AuthenResult(1,1)
                EmployeeID = AuthenResult(1,2)
                CitizenID = AuthenResult(1,3)
                CampusID = AuthenResult(1,5)
                WorkDetail = AuthenResult(1,8)
                Department = AuthenResult(1,6)
                DepartmentID = AuthenResult(1,7)
                Campus =  AuthenResult(1,4)
                PositionID = AuthenResult(1,9)
                Description = AuthenResult(1,10)
                Displayname = AuthenResult(1,11)
                Detail = AuthenResult(1,12)
                Title = AuthenResult(1,13)
                TitleID = AuthenResult(1,14)
                FirstName = AuthenResult(1,15)
                LastName = AuthenResult(1,16)
                Sex = AuthenResult(1,17)
                Mail = AuthenResult(1,18)
                Othermail = AuthenResult(1,19)
                DN = AuthenResult(1,20)
                'Display
                'On Error Resume Next
                Response.write "Authentication OK" & "<br/>"
                Response.write "<br/>>> User Profile <<<br/>"
                Response.write "Account Name : " & SamAccountName & "<br/>"
                Response.write "Employee ID/Student ID : " & EmployeeID & "<br/>"
                Response.write "Citizen ID : " & CitiZenID & "<br/>"
                Response.write "CN : " & CN & "<br/>"
                Response.write "DN : " & DN & "<br/>"
                Response.write "Campus : " & Campus & "(" & CampusID & ")<br/>"
                Response.write "Department : " & Department & "(" & DepartmentID & _
")<br/>"
                Response.write "Work Detail : " & WorkDetail & "<br/>"
                Response.write "Position ID : " & PositionID & "<br/>"
                Response.write "Description : " & Description & "<br/>"
                Response.write "Display Name : " & DisplayName & "<br/>"
                Response.write "Detail : " & Detail & "<br/>"
                Response.write "Title Name : " & Title & "(" & TitleID & ")<br/>"
                Response.write "First Name : " & FirstName & "<br/>"
                Response.write "Last Name : " & LastName & "<br/>"
                Response.write "Sex : " & Sex & "<br/>"
                Response.write "Mail : " & Mail & "<br/>"
                Response.write "Other Mail : " & Othermail & "<br/>"
                Response.write "<br/><a href='./default.asp'>Back to Login Page</a><br/>"
        Else
                Response.write "Authentication Failed" & "<br/>"
                Response.write "Reason : " & AuthenResult(1,0) & "<br/>"
        End If
Else
%>
This area is restricted.<br>
Please login to continue.<br>

<form method='post' action=''>
Username: <input type='text' name='username' value=''><br>
Password: <input type='password' name='password'><br>
<br>
<input type='submit' name='submit' value='Submit'><br>
</form>
<%
End If
%>
</body>
</html>