/[cvs]/joko/TestArea/vb/ActiveDirectory/vb/04-AdsContainerExample/ADsHelper.bas
ViewVC logotype

Annotation of /joko/TestArea/vb/ActiveDirectory/vb/04-AdsContainerExample/ADsHelper.bas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Thu Jan 23 23:17:28 2003 UTC (21 years, 5 months ago) by joko
Branch: MAIN
CVS Tags: HEAD
+ initial check-in

1 joko 1.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

MailToCvsAdmin">MailToCvsAdmin
ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed