| 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 |
Parent Directory
| 
Revision Log
