1 Imports System.DirectoryServices
2 Imports System.Configuration.ConfigurationManager
3
4 Namespace ActiveDirectory
5
6 Public Class ADPasswordPolicy
7 Private m_Entry As New DirectoryEntry
8 Private m_Attribs As ResultPropertyCollection
9 Private m_PasswordComplexity As Boolean
10
11 #Region "PUBLIC PROPERTIES"
12
13 Public ReadOnly Property MaxPasswordAge() As TimeSpan
14 Get
15 If m_Attribs.Contains("maxPwdAge") Then
16 Dim ticks As Long = GetAbsValue(m_Attribs("maxPwdAge")(0))
17 If ticks > 0 Then
18 Return TimeSpan.FromTicks(ticks)
19 End If
20 End If
21 Return TimeSpan.MaxValue
22 End Get
23 End Property
24
25 Public ReadOnly Property MinPasswordAge() As TimeSpan
26 Get
27 If m_Attribs.Contains("minPwdAge") Then
28 Dim ticks As Long = GetAbsValue(m_Attribs("minPwdAge")(0))
29 If ticks > 0 Then
30 Return TimeSpan.FromTicks(ticks)
31 End If
32 End If
33 Return TimeSpan.MaxValue
34 End Get
35 End Property
36
37 Public ReadOnly Property MinPasswordLength() As Integer
38 Get
39 Return m_Attribs("minPwdLength")(0)
40 End Get
41 End Property
42
43 Public ReadOnly Property PasswordHistoryLength() As Integer
44 Get
45 Return m_Attribs("pwdHistoryLength")(0)
46 End Get
47 End Property
48
49 Public Property PasswordComplexity() As Boolean
50 Get
51 Return m_PasswordComplexity
52 End Get
53 Set(ByVal value As Boolean)
54 m_PasswordComplexity = value
55 End Set
56 End Property
57
58 #End Region
59
60 Public Sub New()
61
62 'Get connection string, username and password to connect to Active Directory.
63 Dim ADConnString As String = ConnectionStrings("ADConnString").ConnectionString
64 Dim ADUserName As String = AppSettings("ADUserName")
65 Dim ADPassword As String = AppSettings("ADPassword")
66
67 'Start Directory Entry.
68 m_Entry = New DirectoryEntry(ADConnString, ADUserName, ADPassword)
69
70 'Load and find Policy Attributes.
71 Dim myPolicyAttributes As String() = {"maxPwdAge", "minPwdAge", "minPwdLength", "pwdHistoryLength"}
72 Dim mySearcher As New DirectorySearcher(m_Entry, "(objectClass=domainDNS)", myPolicyAttributes, SearchScope.Base)
73 Dim result As SearchResult = mySearcher.FindOne()
74
75 'Set ResultPropertyCollection to Search Result.
76 m_attribs = result.Properties
77
78 'Check if Password Complexy is enabled.
79 Dim myHash As New Hashtable
80 myHash.Add("DOMAIN_PASSWORD_COMPLEX", 1)
81 m_passwordcomplexity = IIf(myHash("DOMAIN_PASSWORD_COMPLEX") And m_attribs("PwdProperties").GetHashCode, True, False)
82
83 End Sub
84
85 'Public function to determine if password is expired.
86 Public Function PasswordIsExpired(ByVal _username As String) As Boolean
87
88 'Get membership user based on username.
89 Dim u As MembershipUser = Membership.GetUser(_username)
90
91 'Active Directory does not provide means to determine if password is expired.
92 'Workaround: Check last time user changed password and add Max Password Age derived from AD.
93 If u.LastPasswordChangedDate.AddDays(Me.MaxPasswordAge.Days) < DateTime.Now Then
94
95 'Just for reference - Active Directory return year 1600 if user never changed password before.
96
97 'If u.LastPasswordChangedDate.Year.ToString = "1600" Then
98 ' User has never change password before.
99 'End If
100
101 Return True
102
103 Else
104
105 Return False
106
107 End If
108
109 End Function
110
111 Public Function ChangeUserPassword(ByVal _userName As String, ByVal _oldPassword As String, _
112 ByVal _newPassword As String) As String
113
114 Try
115
116 Dim mySearch As New DirectorySearcher(m_Entry)
117 mySearch.Filter = "(SAMAccountName=" & _userName & ")"
118 Dim result As SearchResult = mySearch.FindOne()
119 Dim userEntry As DirectoryEntry = result.GetDirectoryEntry()
120
121
122
123 userEntry.Invoke("ChangePassword", New Object() {_oldPassword, _newPassword})
124 userEntry.CommitChanges()
125
126 Return "Your password was changed successfully."
127
128 Catch ex As Exception
129
130 'FIND REASON WHY CHANGEPASSWORD INVOKE PROCEDURE FAILED (4 POSSIBLE REASONS):
131 '-----------------------------------------------------------------------------------------------------------------
132 '#1 - Min Password Age
133 '-----------------------------------------------------------------------------------------------------------------
134 Dim myUser As MembershipUser = Membership.GetUser(_userName)
135
136 If myUser.LastPasswordChangedDate.AddDays(Me.MinPasswordAge.Days) > Today.Date Then
137 Return "Your password cannot be changed until " & myUser.LastPasswordChangedDate.AddDays(Me.MinPasswordAge.Days).ToLongDateString & "."
138 Exit Function
139 End If
140
141 '-----------------------------------------------------------------------------------------------------------------
142 '#2 - Min Password Length
143 '-----------------------------------------------------------------------------------------------------------------
144 Dim r As Regex = New Regex("(?=^.{" & Me.MinPasswordLength & ",}$)")
145
146 If Not r.IsMatch(_newPassword) Then
147 Return "Password length must be at least " & Me.MinPasswordLength & " characters long."
148 Exit Function
149 End If
150
151 '-----------------------------------------------------------------------------------------------------------------
152 '#3 - Password Complexity
153 '-----------------------------------------------------------------------------------------------------------------
154 If m_passwordcomplexity = True Then 'Only check if policy is actually enabled on Active Directory.
155 Dim PwdComplexPass As String = CheckPasswordComplexity(_userName, _newPassword)
156 If PwdComplexPass <> "success" Then
157 Return PwdComplexPass
158 Exit Function
159 End If
160 End If
161
162 '-----------------------------------------------------------------------------------------------------------------
163 '#4 - Password History Length (If all else passes, failure is result of wrong password entered or password history length.
164 '-----------------------------------------------------------------------------------------------------------------
165
166 Return "Password was entered wrong or password entered was the same as the previous " & Me.PasswordHistoryLength & " passwords set."
167
168 End Try
169
170 End Function
171
172 Private Function CheckPasswordComplexity(ByVal myUserName As String, ByVal myNewPassword As String) As String
173
174 Dim r As Regex
175
176 '-----------------------------------------------------------------------------------------------------------------
177 '#1 - Check for consecutive characters.
178 '-----------------------------------------------------------------------------------------------------------------
179 If CheckForConsecutiveCharacters(myUserName, myNewPassword) = True Then
180 Return "Password must not contain 3 or more consecutive characters within your user name or full name."
181 Exit Function
182 End If
183
184 '-----------------------------------------------------------------------------------------------------------------
185 '#2 - Must be at least 6 characters in length.
186 '-----------------------------------------------------------------------------------------------------------------
187 r = New Regex("(?=^.{6,}$)")
188 If Not r.IsMatch(myNewPassword) Then
189 Return "Password must have 6 or more characters."
190 Exit Function
191 End If
192
193 '-----------------------------------------------------------------------------------------------------------------
194 '#3 - Must contain characters from 3 of the 4 following categories: uppercase, lowercase, 10 digits, special char.
195 '-----------------------------------------------------------------------------------------------------------------
196 Dim RegExpressions As String() = {"[A-Z]", "[a-z]", "[0-9]", "(?=.*\W+)"}
197 Dim criteriaMet As Integer = 0
198 For I As Integer = 0 To RegExpressions.Count - 1
199 r = New Regex(RegExpressions(I))
200 If r.IsMatch(myNewPassword) Then criteriaMet += 1
201 Next I
202
203 If criteriaMet < 3 Then
204 Return "Password must contain characters from 3 of the 4 following categories: Uppercase, Lowercase, Numbers, Special Characters."
205 Exit Function
206 End If
207
208 Return "success"
209
210 End Function
211
212 Private Function CheckForConsecutiveCharacters(ByVal userName As String, ByVal myNewPassword As String) As Boolean
213
214 'Purpose: Loops through username and fullname of user in Active Directory.
215 '**username is split apart only using the period as a delimeter - all split segments < 3 are ignored.
216 '**FullName is split using period, comma, hyphen, underscore, space, pound-sign and Tab.
217 '**If any 3 consecutive characters in the new password match the username or FullName this function returns True.
218 '**All of these checks are case-insensitive.
219
220 Dim Delimeters As String() = {".", ",", "-", "_", " ", "#", vbTab.ToString}
221 Dim userFullName As New ADUser(userName)
222
223 Dim NamesToCheck As String() = {userName, userFullName.DisplayName}
224
225 Dim splitToken As String()
226 Dim userSegment, pwdSegment As String
227
228 For K As Integer = 0 To 1 '0 = username, 1 = FullName
229
230 For Each singleDelimeter In Delimeters
231
232 splitToken = NamesToCheck(K).Split(singleDelimeter)
233
234 'First check for 3 consecutive characters in Full Name:
235 For Each singleToken In splitToken
236
237 'Only check token if length is 3 or more characters.
238 If singleToken.Length > 2 Then
239
240 'Loop through username 3 characters per pass.
241 '---------------------------------------------------
242 For I As Integer = 0 To singleToken.Length - 3
243 userSegment = singleToken.Substring(I, 3)
244
245 'Loop through password 3 characters per pass.
246 '-----------------------------------------------
247 For J As Integer = 0 To myNewPassword.Length - 3
248
249 pwdSegment = myNewPassword.Substring(J, 3)
250
251 If userSegment = pwdSegment Then
252 Return True
253 Exit Function
254 End If
255
256 Next J
257
258 Next I
259
260 End If
261
262 Next singleToken
263
264 If K = 0 Then Exit For 'Only split by period if comparing username.
265
266 Next singleDelimeter
267
268 Next K
269
270 'If no consecutive characters match then return false:
271 Return False
272
273 End Function
274
275 Private Function GetAbsValue(ByVal longInt As Object) As Long
276 Return Math.Abs(CLng(longInt))
277 End Function
278
279 End Class
280
281 End Namespace