Get logonHours from AD

Collapse
This topic is closed.
X
X
 
  • Time
  • Show
Clear All
new posts
  • =?Utf-8?B?dGhsMTAwMA==?=

    #1

    Get logonHours from AD

    Hi,

    i need help getting the logonHours from AD for a specific user.
    I found a vbscript doing exactly what i want:

    On Error Resume Next
    Dim arrLogonHoursBy tes(20)
    Dim arrLogonHoursBi ts(167)
    arrDayOfWeek = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")

    Set objUser = GetObject("LDAP ://cn=TEST01,ou=ab c,dc=mydom,dc=l ocal")
    arrLogonHours = objUser.Get("lo gonHours")


    For i = 1 To LenB(arrLogonHo urs)
    arrLogonHoursBy tes(i-1) = AscB(MidB(arrLo gonHours, i, 1))
    'WScript.Echo "MidB returns: " & MidB(arrLogonHo urs, i, 1)
    'WScript.Echo "arrLogonHoursB ytes: " & arrLogonHoursBy tes(i-1)
    'wscript.echo vbcrlf
    Next

    intCounter = 0
    intLoopCounter = 0


    'WScript.echo "Day Byte 1 Byte 2 Byte 3"
    For Each LogonHourByte In arrLogonHoursBy tes
    arrLogonHourBit s = GetLogonHourBit s(LogonHourByte )

    If intCounter = 0 Then
    WScript.STDOUT. Write arrDayOfWeek(in tLoopCounter) & Space(2)
    intLoopCounter = intLoopCounter + 1
    End If

    For Each LogonHourBit In arrLogonHourBit s
    WScript.STDOUT. Write LogonHourBit
    intCounter = 1 + intCounter

    If intCounter = 8 or intCounter = 16 Then
    Wscript.STDOUT. Write Space(1)
    End If
    ' If intCounter >= 1 Then
    ' Wscript.STDOUT. Write ";"
    ' End If

    If intCounter = 24 Then
    WScript.echo vbCr
    intCounter = 0
    End If
    Next
    Next

    Function GetLogonHourBit s(x)
    Dim arrBits(7)
    For i = 7 To 0 Step -1
    If x And 2^i Then
    arrBits(i) = 1
    Else
    arrBits(i) = 0
    End If
    Next
    GetLogonHourBit s = arrBits
    End Function

    My problem is to convert thios code to vb.net. I tried it with the following
    code, but it returns bullshit....


    Public Function Get_LogOnHours( ) As String

    Dim entry As DirectoryEntry = New
    DirectoryEntry( "LDAP://cn=TEST01,ou=ab c,dc=mydom,dc=l ocal")

    Dim oSearcher As DirectorySearch er = New DirectorySearch er(entry)

    Dim strLogOnHours As String = ""

    Dim arrLogonHoursBy tes(20) As Long

    Dim arrLogonHoursBi ts(167) As Long

    Dim arrDayOfWeek() = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}

    Dim i As Integer

    oSearcher.Filte r = "(&(objectClass =user) (sAMAccountName =" & strUser & "))"

    oSearcher.Prope rtiesToLoad.Add ("logonHours ")

    Try

    Dim oResult As SearchResult

    oResult = oSearcher.FindO ne

    If Not oResult.GetDire ctoryEntry().Pr operties("logon Hours").Value.T oString =
    "" Then

    For i = 1 To
    Len(oResult.Get DirectoryEntry( ).Properties("l ogonHours").Val ue.ToString)

    arrLogonHoursBy tes(i-1) =
    Asc(Mid(oResult .GetDirectoryEn try().Propertie s("logonHours") .Value.ToString ,
    i, 1))

    Next

    Dim intCounter As Integer = 0

    Dim intLoopCounter As Integer = 0


    For Each LogonHourByte As Object In arrLogonHoursBy tes

    Dim arrLogonHourBit s() = GetLogonHourBit s(LogonHourByte )

    If intCounter = 0 Then

    strLogOnHours += arrDayOfWeek(in tLoopCounter) & " "

    intLoopCounter += 1

    End If


    For Each LogonHourBit As Integer In arrLogonHourBit s

    strLogOnHours += LogonHourBit & ";"

    intCounter += 1

    If intCounter = 24 Then

    strLogOnHours += vbnewline

    intCounter = 0

    End If

    Next

    Next

    Get_LogOnHours = strLogOnHours

    End If

    Catch ex As Exception

    MessageBox.Show (ex.Message, "Error", MessageBoxButto ns.OK,
    MessageBoxIcon. Error)

    Get_LogOnHours = Nothing

    Finally

    entry.Dispose()

    entry = Nothing

    oSearcher = Nothing

    End Try

    End Function

    Private Function GetLogonHourBit s(ByVal x) As Object

    Dim arrBits(7)

    Dim i As Integer

    For i = 7 To 0 Step -1

    If x And 2 ^ i Then

    arrBits(i) = 1

    Else

    arrBits(i) = 0

    End If

    Next

    GetLogonHourBit s = arrBits

    End Function

    Anyideas to get this to work?

    Regards Thomas

Working...