1 |
Attribute VB_Name = "ADsHelper" |
2 |
Option Explicit |
3 |
|
4 |
Public Declare Function FileTimeToLocalFileTime Lib "kernel32" _ |
5 |
(lpFileTime As FILETIME, _ |
6 |
lpLocalFileTime As FILETIME) As Long |
7 |
|
8 |
Public Declare Function FileTimeToSystemTime Lib "kernel32" _ |
9 |
(lpFileTime As FILETIME, _ |
10 |
lpSystemTime As SYSTEMTIME) As Long |
11 |
|
12 |
Public Declare Function SystemTimeToVariantTime Lib "oleaut32.dll" _ |
13 |
(lpSystemTime As SYSTEMTIME, _ |
14 |
dbTime As Double) As Long |
15 |
|
16 |
Public Type FILETIME |
17 |
dwLowDateTime As Long |
18 |
dwHighDateTime As Long |
19 |
End Type |
20 |
|
21 |
Public Type SYSTEMTIME |
22 |
wYear As Integer |
23 |
wMonth As Integer |
24 |
wDayOfWeek As Integer |
25 |
wDay As Integer |
26 |
wHour As Integer |
27 |
wMinute As Integer |
28 |
wSecond As Integer |
29 |
wMilliseconds As Integer |
30 |
End Type |
31 |
|
32 |
|
33 |
|
34 |
Function LargeInteger_To_Time(oLargeInt As LargeInteger, vTime As Variant) As Boolean |
35 |
'This function will convert the ADSI datatype LargeInteger, in the schema as 'Integer8', to a Variant value |
36 |
|
37 |
On Error Resume Next |
38 |
Dim pFileTime As FILETIME |
39 |
Dim pLocalFT As FILETIME |
40 |
Dim pSysTime As SYSTEMTIME |
41 |
Dim dbTime As Double |
42 |
Dim lResult As Long |
43 |
|
44 |
If (oLargeInt.HighPart = 0 And oLargeInt.LowPart = 0) Then |
45 |
vTime = 0 |
46 |
'Debug.Print "No Value" |
47 |
LargeInteger_To_Time = True |
48 |
Exit Function |
49 |
End If |
50 |
|
51 |
If (oLargeInt.LowPart = -1) Then |
52 |
vTime = -1 |
53 |
'Debug.Print "Never Expires" |
54 |
LargeInteger_To_Time = True |
55 |
Exit Function |
56 |
End If |
57 |
|
58 |
pFileTime.dwHighDateTime = oLargeInt.HighPart |
59 |
pFileTime.dwLowDateTime = oLargeInt.LowPart |
60 |
|
61 |
'Convert the value to Local time |
62 |
lResult = FileTimeToLocalFileTime(pFileTime, pLocalFT) |
63 |
If lResult = 0 Then |
64 |
LargeInteger_To_Time = False |
65 |
Debug.Print "FileTimeToLocalFileTime: " + Err.Number + " - " + Err.Description |
66 |
Exit Function |
67 |
End If |
68 |
|
69 |
'Convert the FileTime to System time |
70 |
lResult = FileTimeToSystemTime(pLocalFT, pSysTime) |
71 |
If lResult = 0 Then |
72 |
LargeInteger_To_Time = False |
73 |
Debug.Print "FileTimeToSystemTime: " + Err.Number + " - " + Err.Description |
74 |
Exit Function |
75 |
End If |
76 |
|
77 |
'Convert System Time to a Double |
78 |
lResult = SystemTimeToVariantTime(pSysTime, dbTime) |
79 |
If lResult = 0 Then |
80 |
LargeInteger_To_Time = False |
81 |
Debug.Print "SystemTimeToVariantTime: " + Err.Number + " - " + Err.Description |
82 |
Exit Function |
83 |
End If |
84 |
|
85 |
'Place the double in the variant |
86 |
vTime = CDate(dbTime) |
87 |
'debug.print vTime |
88 |
LargeInteger_To_Time = True |
89 |
End Function |
90 |
|
91 |
|
92 |
Public Function LogonHours_To_String(pLogonHours() As Byte, strLoginHours As String) As Boolean |
93 |
'This function will take the LogonHours property in the Active Directory and convert it into a |
94 |
'string of Days and Times, separated by line feeds |
95 |
|
96 |
'These dates/times will be in GMT |
97 |
|
98 |
Dim strDay As String |
99 |
Dim strTime As String |
100 |
Dim iBase As Integer |
101 |
Dim iBitMax As Integer |
102 |
Dim lVal As Long |
103 |
Dim iTotalBytes As Integer |
104 |
Dim iOffset As Integer |
105 |
Dim j As Integer |
106 |
Dim k As Integer |
107 |
|
108 |
|
109 |
iBase = 2 |
110 |
iBitMax = 8 |
111 |
iTotalBytes = 21 |
112 |
LogonHours_To_String = False |
113 |
For k = 1 To iTotalBytes |
114 |
|
115 |
' Get the block of time during the day |
116 |
Select Case (k - 1) |
117 |
Case 0, 1, 2: |
118 |
strDay = "Sunday" |
119 |
Case 3, 4, 5: |
120 |
strDay = "Monday" |
121 |
Case 6, 7, 8: |
122 |
strDay = "Tuesday" |
123 |
Case 9, 10, 11: |
124 |
strDay = "Wednesday" |
125 |
Case 12, 13, 14: |
126 |
strDay = "Thursday" |
127 |
Case 15, 16, 17: |
128 |
strDay = "Friday" |
129 |
Case 18, 19, 20: |
130 |
strDay = "Saturday" |
131 |
End Select |
132 |
|
133 |
Select Case (k - 1) |
134 |
Case 0, 3, 6, 9, 12, 15, 18: |
135 |
For j = 0 To iBitMax - 1 |
136 |
lVal = iBase ^ j |
137 |
If (pLogonHours(k - 1) And (lVal)) = lVal Then |
138 |
Select Case j |
139 |
Case 0: |
140 |
strTime = "00:00-59" |
141 |
Case 1: |
142 |
strTime = "01:00-59" |
143 |
Case 2: |
144 |
strTime = "02:00-59" |
145 |
Case 3: |
146 |
strTime = "03:00-59" |
147 |
Case 4: |
148 |
strTime = "04:00-59" |
149 |
Case 5: |
150 |
strTime = "05:00-59" |
151 |
Case 6: |
152 |
strTime = "06:00-59" |
153 |
Case 7: |
154 |
strTime = "07:00-59" |
155 |
End Select |
156 |
strLoginHours = strLoginHours + strDay + " " + strTime + vbLf |
157 |
End If |
158 |
Next j |
159 |
|
160 |
Case 1, 4, 7, 10, 13, 16, 19: |
161 |
For j = 0 To iBitMax - 1 |
162 |
lVal = iBase ^ j |
163 |
If (pLogonHours(k - 1) And (lVal)) = lVal Then |
164 |
Select Case j |
165 |
Case 0: |
166 |
strTime = "08:00-59" |
167 |
Case 1: |
168 |
strTime = "09:00-59" |
169 |
Case 2: |
170 |
strTime = "10:00-59" |
171 |
Case 3: |
172 |
strTime = "11:00-59" |
173 |
Case 4: |
174 |
strTime = "12:00-59" |
175 |
Case 5: |
176 |
strTime = "13:00-59" |
177 |
Case 6: |
178 |
strTime = "14:00-59" |
179 |
Case 7: |
180 |
strTime = "15:00-59" |
181 |
End Select |
182 |
strLoginHours = strLoginHours + strDay + " " + strTime + vbLf |
183 |
End If |
184 |
Next j |
185 |
|
186 |
Case 2, 5, 8, 11, 14, 17, 20: |
187 |
For j = 0 To iBitMax - 1 |
188 |
lVal = iBase ^ j |
189 |
If (pLogonHours(k - 1) And (lVal)) = lVal Then |
190 |
Select Case j |
191 |
Case 0: |
192 |
strTime = "16:00-59" |
193 |
Case 1: |
194 |
strTime = "17:00-59" |
195 |
Case 2: |
196 |
strTime = "18:00-59" |
197 |
Case 3: |
198 |
strTime = "19:00-59" |
199 |
Case 4: |
200 |
strTime = "20:00-59" |
201 |
Case 5: |
202 |
strTime = "21:00-59" |
203 |
Case 6: |
204 |
strTime = "22:00-59" |
205 |
Case 7: |
206 |
strTime = "23:00-59" |
207 |
End Select |
208 |
strLoginHours = strLoginHours + strDay + " " + strTime + vbLf |
209 |
End If |
210 |
Next j |
211 |
End Select |
212 |
Next k |
213 |
LogonHours_To_String = True |
214 |
End Function |
215 |
|
216 |
Public Sub EnumeratePropertyValue(oPropEntry As PropertyEntry, strValue As String) |
217 |
Dim vPropValues, val, vProp As Variant |
218 |
Dim oPropValue As PropertyValue |
219 |
Dim strTemp As String |
220 |
Dim strName As String |
221 |
Dim lResult As Integer |
222 |
|
223 |
vPropValues = oPropEntry.Values |
224 |
For Each val In vPropValues |
225 |
If TypeName(val) = "Object" Then |
226 |
Set oPropValue = val |
227 |
Select Case oPropValue.ADsType |
228 |
Case ADSTYPE_INVALID: |
229 |
strTemp = "Value is invalid" |
230 |
Case ADSTYPE_DN_STRING: |
231 |
strTemp = oPropValue.DNString |
232 |
Case ADSTYPE_CASE_EXACT_STRING: |
233 |
strTemp = oPropValue.CaseExactString |
234 |
Case ADSTYPE_CASE_IGNORE_STRING: |
235 |
strTemp = oPropValue.CaseIgnoreString |
236 |
Case ADSTYPE_PRINTABLE_STRING: |
237 |
strTemp = oPropValue.PrintableString |
238 |
Case ADSTYPE_NUMERIC_STRING: |
239 |
strTemp = oPropValue.NumericString |
240 |
Case ADSTYPE_BOOLEAN: |
241 |
strTemp = CStr(CBool(oPropValue.Boolean)) |
242 |
Case ADSTYPE_INTEGER: |
243 |
strTemp = CStr(oPropValue.Integer) |
244 |
Case ADSTYPE_OCTET_STRING: |
245 |
'Get the name of the property to handle |
246 |
strName = oPropEntry.Name |
247 |
|
248 |
'Handle differently depending on the name |
249 |
If strName = "objectGUID" Then |
250 |
strTemp = "Property is a GUID" |
251 |
ElseIf strName = "objectSid" Then |
252 |
' Dim oSid As New ADsSID |
253 |
' oSid.SetAs ADS_SID_RAW, oPropValue.OctetString |
254 |
' strTemp = CStr(oSid.GetAs(ADS_SID_HEXSTRING)) |
255 |
' 'strTemp = CStr(oSid.GetAs(ADS_SID_SDDL)) |
256 |
' Set oSid = Nothing |
257 |
ElseIf strName = "logonHours" Then |
258 |
Dim pHours() As Byte |
259 |
pHours = oPropValue.OctetString |
260 |
LogonHours_To_String pHours, strTemp |
261 |
End If |
262 |
Case ADSTYPE_UTC_TIME: |
263 |
strTemp = CStr(CDate(oPropValue.UTCTime)) |
264 |
Case ADSTYPE_LARGE_INTEGER: |
265 |
'Get the name of the property to handle |
266 |
strName = oPropEntry.Name |
267 |
If strName = "accountExpires" Or _ |
268 |
strName = "badPasswordTime" Or _ |
269 |
strName = "lastLogon" Or _ |
270 |
strName = "lastLogoff" Or _ |
271 |
strName = "lockoutTime" Or _ |
272 |
InStr(LCase(strName), "time") Or _ |
273 |
InStr(LCase(strName), "date") Or _ |
274 |
strName = "pwdLastSet" Then |
275 |
LargeInteger_To_Time oPropValue.LargeInteger, vProp |
276 |
strTemp = CStr(vProp) |
277 |
Else |
278 |
Dim oLargeInt As LargeInteger |
279 |
Set oLargeInt = oPropValue.LargeInteger |
280 |
strTemp = "&H" + CStr(Hex(oLargeInt.HighPart)) + CStr(Hex(oLargeInt.LowPart)) + " (LargeInteger)" |
281 |
End If |
282 |
Case ADSTYPE_PROV_SPECIFIC: |
283 |
strTemp = "Value is provider Specific" |
284 |
Case ADSTYPE_NT_SECURITY_DESCRIPTOR: |
285 |
strTemp = "Value of type NT Security Descriptor" |
286 |
|
287 |
|
288 |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' |
289 |
' The propertyValue.ADsType should not be returned as the below values |
290 |
' for IADsUser objects |
291 |
' |
292 |
Case ADSTYPE_OBJECT_CLASS: |
293 |
strTemp = "Value of object class" |
294 |
Case ADSTYPE_CASEIGNORE_LIST: |
295 |
strTemp = "Value caseignore list" |
296 |
Case ADSTYPE_OCTET_LIST: |
297 |
strTemp = "Value of octet list" |
298 |
Case ADSTYPE_PATH: |
299 |
strTemp = "Value of path" |
300 |
Case ADSTYPE_POSTALADDRESS: |
301 |
strTemp = "Value of postal address" |
302 |
Case ADSTYPE_TIMESTAMP: |
303 |
strTemp = "Value of time stamp" |
304 |
Case ADSTYPE_BACKLINK: |
305 |
strTemp = "Value of back link" |
306 |
Case ADSTYPE_TYPEDNAME: |
307 |
strTemp = "Value of typedName" |
308 |
Case ADSTYPE_HOLD: |
309 |
strTemp = "Value of hold" |
310 |
Case ADSTYPE_NETADDRESS: |
311 |
strTemp = "Value of netaddress" |
312 |
Case ADSTYPE_REPLICAPOINTER: |
313 |
strTemp = "Value of replica pointer" |
314 |
Case ADSTYPE_FAXNUMBER: |
315 |
strTemp = "Value of fax number" |
316 |
Case ADSTYPE_DN_WITH_BINARY: |
317 |
strTemp = "Value of DN with binary" |
318 |
Case ADSTYPE_DN_WITH_STRING: |
319 |
strTemp = "Value of DN with string" |
320 |
Case ADSTYPE_UNKNOWN: |
321 |
strTemp = "Value of unknown type" |
322 |
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' |
323 |
Case Else |
324 |
strTemp = "Error : Unknown Property Value type" |
325 |
End Select |
326 |
Else 'value is not IDispatch |
327 |
strTemp = val |
328 |
End If |
329 |
If strValue = "" Then |
330 |
strValue = strTemp |
331 |
Else |
332 |
strValue = strValue + "# " + strTemp |
333 |
End If |
334 |
Next val |
335 |
End Sub |
336 |
|
337 |
Public Sub GUIDtoBindableString(pGUID() As Byte, strGUIDString As String) |
338 |
|
339 |
End Sub |